module Main exposing (Flags, Model, Msg, Object3d, main, sitemap) -- TODO: entries, colophon, contact/access import Angle import Array import Browser import Browser.Events as Events import Browser.Navigation as Nav import Camera3d import Clipboard exposing (copyToClipboard) import Color import Dict exposing (Dict) import Direction3d import Element exposing (..) import Element.Background as Background import Element.Border as Border import Element.Font as Font import Element.Input exposing (button) import Html exposing (Html) import Html.Attributes import Http import Json.Decode as Decode import Length import Obj.Decode import Pixels import Point3d exposing (Point3d) import Scene3d exposing (Entity) import Scene3d.Material as Material import Scene3d.Mesh as Mesh import Scroll exposing (scrollTo) import Simple.Animation as Animation exposing (Animation) import Simple.Animation.Animated as Animated import Simple.Animation.Property as P import Task import Time import TriangularMesh exposing (TriangularMesh) import Url import Viewpoint3d import WebGL.Texture getMesh : Cmd Msg getMesh = Http.get { url = "../assets/3d/macg/macgregor.obj.txt" , expect = Obj.Decode.expectObj GotMesh Length.meters Obj.Decode.texturedTriangles } getTexture : Cmd Msg getTexture = Material.loadWith Material.nearestNeighborFiltering "../assets/3d/macg/image0.jpg" |> Task.attempt GotTexture animatedUi : (List (Attribute msg) -> children -> Element msg) -> Animation -> List (Attribute msg) -> children -> Element msg animatedUi = Animated.ui { behindContent = Element.behindContent , htmlAttribute = Element.htmlAttribute , html = Element.html } animatedEl : Animation -> List (Element.Attribute msg) -> Element msg -> Element msg animatedEl = animatedUi Element.el main : Program Flags Model Msg main = Browser.application { init = init, update = update, subscriptions = subscribe, view = view, onUrlRequest = Request, onUrlChange = Load } type alias Model = { w : Int, h : Int, last : String, url : Url.Url, key : Nav.Key, mesh : Maybe Object3d, textures : Maybe (Material.Textured Obj.Decode.ObjCoordinates), angle : Float, radius : Float, elevation : Float } type alias Flags = ( Int, Int ) init : Flags -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) init flags url key = let ( width, height ) = flags in ( { w = width, h = height, last = "", url = url, key = key, mesh = Nothing, textures = Nothing, angle = 0, radius = 7.5, elevation = 5 }, Cmd.batch [ getMesh, getTexture ] ) type alias Object3d = TriangularMesh { position : Point3d Length.Meters Obj.Decode.ObjCoordinates, uv : ( Float, Float ) } type Msg = Resize Int Int | Request Browser.UrlRequest | Load Url.Url | GotMesh (Result Http.Error Object3d) | GotTexture (Result WebGL.Texture.Error (Material.Texture Color.Color)) | Rotate Time.Posix | Copy String String | Key String | Scroll String modulo : Float -> Float -> Float modulo a b = b - toFloat (floor (b / a)) * a canonicalize : Float -> Float canonicalize angle = modulo 360 angle update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = let wrap : Model -> ( Model, Cmd Msg ) wrap data = ( data, Cmd.none ) pass : ( Model, Cmd Msg ) pass = wrap model in case msg of Resize width height -> wrap { model | w = width, h = height } Request req -> case req of Browser.Internal url -> ( model, Nav.pushUrl model.key (Url.toString url) ) Browser.External href -> ( model, Nav.load href ) Load url -> wrap { model | url = url } GotMesh response -> case response of Err _ -> pass Ok object -> wrap { model | mesh = Just object } GotTexture result -> case result of Err _ -> pass Ok texture -> wrap { model | textures = Just (Material.texturedMatte texture) } Rotate time -> wrap { model | angle = canonicalize (model.angle + 2 * (2 + sin (toFloat (Time.posixToMillis time) / 1000))) , radius = 7.5 + 1 / 8 * model.radius + 5 * 13 / 11 * sin (toFloat (Time.posixToMillis time + 250) / 1000) , elevation = 9 + 1 / 4 * model.elevation + 5 * cos (toFloat (Time.posixToMillis time) / 1000) } Copy label text -> ( model, copyToClipboard ( label, text ) ) Key key -> ( { model | last = key }, Cmd.none ) Scroll loc -> ( model, scrollTo loc ) keyDecoder : Decode.Decoder String keyDecoder = Decode.field "key" Decode.string subscribe : Model -> Sub Msg subscribe _ = Sub.batch [ Events.onResize Resize , Events.onKeyPress (Decode.map Key keyDecoder) , Time.every (1000 / 30) Rotate ] vw : Model -> Float -> Float vw model percent = Basics.toFloat model.w * percent / 100 vh : Model -> Float -> Float vh model percent = Basics.toFloat model.h * percent / 100 white : Color white = rgb 255 255 255 black : Color black = rgb 0 0 0 btnStyle : List (Attribute msg) btnStyle = [ padding 10 , Font.color white , Font.family [ Font.typeface "Rubik" ] , Font.semiBold , Font.size 20 , Border.width 2 , Border.color white , mouseOver [ Background.color white, Font.color black ] ] linkBtn : String -> String -> Element msg linkBtn disp addr = newTabLink btnStyle { url = addr, label = text (String.toUpper disp) } btn : String -> Msg -> Element Msg btn disp act = button btnStyle { onPress = Just act, label = text (String.toUpper disp) } vw2pt : Model -> Float -> Int vw2pt model ratio = (round << vw model) ratio vw2px : Model -> Float -> Length vw2px model ratio = px (vw2pt model ratio) vh2pt : Model -> Float -> Int vh2pt model ratio = (round << vh model) ratio vh2px : Model -> Float -> Length vh2px model ratio = px (vh2pt model ratio) heading : List (Attr () msg) heading = [ Font.color white , Font.family [ Font.typeface "Imbue" ] , Font.size 96 ] subheading : List (Attr () msg) subheading = [ Font.color white , Font.family [ Font.typeface "Imbue" ] , Font.size 72 , width (px 600) ] bodyText : List (Attr () msg) bodyText = [ Font.color white , Font.family [ Font.typeface "Inter" ] , Font.size 20 , width (px 600) ] page : Model -> List (Attr () msg) page model = [ width fill , height (vh2px model 100) , spacing (vh2pt model -100) , Background.color black ] fullImage : Model -> List (Attr () msg) fullImage model = [ width fill , height (vh2px model 100) , alpha 0.5 ] pageText : Model -> List (Attr () msg) pageText model = [ spacing 30 , alignLeft , alignTop , width (vw2px model 50) , height (vh2px model 100) , paddingEach { top = vh2pt model 50 - 96 * 2 , bottom = 0 , left = vw2pt model 10 , right = 0 } ] inlineLink : String -> String -> Element msg inlineLink disp addr = newTabLink [ Font.underline , Font.bold ] { url = addr , label = text disp } inlineLinkInt : String -> String -> Element msg inlineLinkInt disp addr = link [ Font.underline , Font.bold ] { url = addr , label = text disp } id : String -> Element.Attribute msg id = Html.Attributes.id >> Element.htmlAttribute getPaths : String -> List String getPaths base = let root = "/" ++ base in List.map ((++) root) [ "", "/", "/index.html" ] itemize : List String -> a -> List ( String, a ) itemize multikeys entry = let key = List.head multikeys in case key of Just k -> ( k, entry ) :: itemize (List.drop 1 multikeys) entry Nothing -> [] sitemap : Dict String (Model -> List (Html Msg)) sitemap = Dict.fromList (itemize ([ "/", "/index.html" ] ++ getPaths "src" ++ getPaths "index" ++ getPaths "home") pageHome) loadUrl : Model -> List (Html Msg) loadUrl model = let req = Dict.get model.url.path sitemap in case req of Just builder -> builder model Nothing -> notFound model view : Model -> Browser.Document Msg view model = { title = "MacGregor House" , body = loadUrl model } pageHome : Model -> List (Html Msg) pageHome model = [ Element.layout [ width fill ] (column [ width fill ] [ column [ width fill , height fill , spacing (vh2pt model -100) , id "zero" ] [ el [ width fill , height (vh2px model 100) , Background.color black ] Element.none , animatedEl crossfadeIn [ width fill , height (vh2px model 100) , Background.gradient { angle = 45, steps = [ rgb255 200 0 100, rgb255 100 0 200 ] } ] Element.none , animatedEl crossfadeOut [ width fill , height (vh2px model 100) , Background.gradient { angle = 45, steps = [ rgb255 0 100 200, rgb255 0 200 100 ] } ] Element.none , el ([ alignLeft , alignTop , width (vw2px model 50) , height (vh2px model 100) , paddingEach { top = vh2pt model 50 - 96 , bottom = 0 , left = vw2pt model 10 , right = 0 } ] ++ heading ) (column [ spacing 35 ] [ text "MacGregor House" , column [ spacing 15 ] [ row [ spacing 15 ] [ linkBtn "See events" "https://calendar.google.com/calendar/embed?src=c_c9fb13003264d5becb74cf9ba42a087d8a4a180d927441994458a07ac146eb88%40group.calendar.google.com&ctz=America%2FNew_York" , linkBtn "Reserve space" "https://forms.gle/KxFAG65TQuPxdYak8" ] , row [ spacing 15 ] [ btn "↓" (Scroll "one") , btn "Copy iCal link" (Copy "iCal link" "https://calendar.google.com/calendar/ical/c_c9fb13003264d5becb74cf9ba42a087d8a4a180d927441994458a07ac146eb88%40group.calendar.google.com/public/basic.ics") ] ] ] ) , el [ alignRight , alignTop , width (vw2px model 60) , height (vh2px model 100) , paddingEach { top = vh2pt model 25 , bottom = vh2pt model 25 , left = 0 , right = 0 } ] (view3D model) ] , column (page model ++ [ id "one" ]) [ image (fullImage model) { src = "../assets/img/tall.jpg" , description = "the imposing macgregor superstructure stands tall in defiance of strong winds" } , column (pageText model) [ row [ spacing 10 ] [ btn "↑" (Scroll "zero") , btn "↓" (Scroll "two") ] , paragraph subheading [ text "The tallest undergraduate dormitory." ] , paragraph bodyText [ text "Enrico Fermi once said, \"Before I came here I was confused about this subject. Having listened to your lecture, I am still confused, but on a higher level.\" " , inlineLink "Pietro Belluschi" "https://listart.mit.edu/art-artists/macgregor-house-1970" , text " attended that lecture." ] ] ] , column (page model ++ [ id "two" ]) [ image (fullImage model) { src = "../assets/img/view.jpg" , description = "the macgregor pov just hits different" } , column (pageText model) [ row [ spacing 10 ] [ btn "↑" (Scroll "one") , btn "↓" (Scroll "three") ] , paragraph subheading [ text "Stunning vistas are just the beginning." ] , paragraph bodyText [ text "A view from MacGregor is like looking down on Earth from the stars. MacGregor's prime waterfront real estate offers breathtaking views of the Charles and the Boston skyline beyond." ] ] ] , column (page model ++ [ id "three" ]) [ image (fullImage model) { src = "../assets/img/free.jpg" , description = "macgregor is often seen as the gateway to new worlds, especially briggs field" } , column (pageText model) [ row [ spacing 10 ] [ btn "↑" (Scroll "two") , btn "↓" (Scroll "four") ] , paragraph subheading [ text "Free as in freedom." ] , paragraph bodyText [ text "This website's source code and infrastructure, the ability to cook, your choice of living community and room assignments—they operate in the public interest of all MacGregorites. You won't get this freedom at many other undergraduate dormitories at MIT." ] ] ] , column (page model ++ [ id "four" ]) [ image (fullImage model) { src = "../assets/img/location.jpg" , description = "the bright lights of the macgregor high rise shine down upon the glossy snow-covered surface of briggs field" } , column (pageText model) [ row [ spacing 10 ] [ btn "↑" (Scroll "three") , btn "↓" (Scroll "five") ] , paragraph subheading [ text "Nestled between Kendall and Cambridgeport." ] , paragraph bodyText [ text "Between " , inlineLink "the innovative spirit of Kendall" "https://kendallsquare.org/kendalls-history-orientation/" , text " and the industrial crossroads of Cambridgeport, there is a place—on a tiny stretch of street called Amherst Alley—that fills the quiet void with a voracious intellectual appetite and an unparalleled creative vision." ] ] ] , column (page model ++ [ id "five" ]) [ image (fullImage model) { src = "../assets/img/brick.jpg" , description = "multicolored bricks shine in the limelight of macgregorian festivities" } , column (pageText model) [ row [ spacing 10 ] [ btn "↑" (Scroll "four") , btn "↓" (Scroll "six") ] , paragraph subheading [ text "We like the ", el [ Font.bold, Font.size 96 ] (text "brick"), text "." ] , paragraph bodyText [ text "The bricks are everywhere—by far the most recognizable feature of MacGregor. You'll find them protecting the building's exterior from harsh Bostonian winters, lining its fabled corridors, and in your room, as much an architectural statement as they are a testament to the people of MacGregor." ] ] ] , column (page model ++ [ id "six" ]) [ image (fullImage model) { src = "../assets/img/belong.jpg" , description = "the cultural murals of macgregor breathe life into its ancient pedestrian thoroughfares" } , column (pageText model) [ row [ spacing 10 ] [ btn "↑" (Scroll "five") , btn "Top" (Scroll "zero") ] , paragraph subheading [ text "You belong here." ] , paragraph bodyText [ text "MacGregor's greatness is the greatness of its people. Living in MacGregor inevitably connects you to its people and its culture—one of the most diverse, unique, and historic of any MIT dorm—spanning nine entries, countless murals and traditions, and a couple hundred current residents." ] ] ] ] ) ] notFound : Model -> List (Html Msg) notFound model = [ Element.layout [ width fill ] (column [ width fill ] [ column [ width fill , height fill , spacing (vh2pt model -100) ] [ el [ width fill , height (vh2px model 100) , Background.color black ] Element.none , animatedEl crossfadeIn [ width fill , height (vh2px model 100) , Background.gradient { angle = 45, steps = [ rgb255 100 200 0, rgb255 200 100 0 ] } ] Element.none , animatedEl crossfadeOut [ width fill , height (vh2px model 100) , Background.gradient { angle = 45, steps = [ rgb255 0 150 50, rgb255 0 50 150 ] } ] Element.none , el ([ alignLeft , alignTop , width (vw2px model 50) , height (vh2px model 100) , paddingEach { top = vh2pt model 35 - 96 , bottom = 0 , left = vw2pt model 10 , right = 0 } ] ++ heading ) (column [ spacing 35 ] [ text "Error! 404." , paragraph (bodyText ++ [ Font.size 24 ]) [ text "We went all the way up to A entry, then back down and around to J, yet no trace of this page could be found. Perhaps it's in 𝑖 entry?" ] , paragraph (bodyText ++ [ width (vw2px model 33) ]) [ text "You were likely redirected here by a link to a page on the old website, the last known archive of which can be found " , inlineLink "here" "https://web.archive.org/web/20170529064230/http://macgregor.mit.edu/" , text ". Unless you want to conduct research on ancient MIT traditions, you can probably find what you're looking for on the new " , inlineLinkInt "main page" "/src" , text ". If you believe this page really is missing, " , inlineLink "contact the webmaster" "mailto:ananthv@mit.edu" , text "." ] ] ) , el [ alignRight , alignTop , width (vw2px model 60) , height (vh2px model 100) , paddingEach { top = vh2pt model 25 , bottom = vh2pt model 25 , left = 0 , right = 0 } ] (view3DTower model) ] ] ) ] pyramidMesh : Mesh.Uniform coordinates pyramidMesh = let -- Define the vertices of our pyramid frontLeft : Point3d Length.Meters coordinates frontLeft = Point3d.centimeters 250 500 0 frontRight : Point3d Length.Meters coordinates frontRight = Point3d.centimeters 400 0 -500 backLeft : Point3d Length.Meters coordinates backLeft = Point3d.centimeters -250 500 -500 backRight : Point3d Length.Meters coordinates backRight = Point3d.centimeters -250 0 0 tip : Point3d Length.Meters coordinates tip = Point3d.centimeters 0 0 500 -- Create a TriangularMesh value from an array of vertices and list -- of index triples defining faces (see https://package.elm-lang.org/packages/ianmackenzie/elm-triangular-mesh/latest/TriangularMesh#indexed) triangularMesh : TriangularMesh (Point3d Length.Meters coordinates) triangularMesh = TriangularMesh.indexed (Array.fromList [ frontLeft -- 0 , frontRight -- 1 , backLeft -- 2 , backRight -- 3 , tip -- 4 ] ) [ ( 1, 0, 4 ) -- front , ( 0, 2, 4 ) -- left , ( 2, 3, 4 ) -- back , ( 3, 1, 4 ) -- right , ( 1, 3, 0 ) -- bottom , ( 0, 3, 2 ) -- bottom ] in -- Create a elm-3d-scene Mesh value from the TriangularMesh; we use -- Mesh.indexedFacets so that normal vectors will be generated for each face Mesh.indexedFacets triangularMesh view3D : Model -> Element msg view3D model = Element.html (let entity : Entity Obj.Decode.ObjCoordinates entity = case model.mesh of Nothing -> Scene3d.mesh (Material.matte (Color.rgb255 173 111 101)) pyramidMesh Just mesh -> case model.textures of Nothing -> Scene3d.mesh (Material.matte (Color.rgb255 173 111 101)) (Mesh.texturedFacets mesh) Just textures -> Scene3d.mesh textures (Mesh.texturedFacets mesh) camera : Camera3d.Camera3d Length.Meters coordinates camera = Camera3d.perspective { viewpoint = Viewpoint3d.lookAt { focalPoint = Point3d.origin , eyePoint = let theta : Angle.Angle theta = Angle.degrees model.angle in Point3d.meters (10 * Angle.cos theta) 2 (10 * Angle.sin theta) , upDirection = Direction3d.xy (Angle.degrees 90) } , verticalFieldOfView = Angle.degrees 100 } in Scene3d.sunny { entities = [ entity ] , camera = camera , upDirection = Direction3d.z , sunlightDirection = Direction3d.yz (Angle.degrees -120) , background = Scene3d.transparentBackground , clipDepth = Length.centimeters 1 , shadows = False , dimensions = ( Pixels.int (round (vw model 60)), Pixels.int (round (vh model 100)) ) } ) view3DTower : Model -> Element msg view3DTower model = Element.html (let entity : Entity Obj.Decode.ObjCoordinates entity = case model.mesh of Nothing -> Scene3d.mesh (Material.matte (Color.rgb255 173 111 101)) pyramidMesh Just mesh -> case model.textures of Nothing -> Scene3d.mesh (Material.matte (Color.rgb255 173 111 101)) (Mesh.texturedFacets mesh) Just textures -> Scene3d.mesh textures (Mesh.texturedFacets mesh) camera : Camera3d.Camera3d Length.Meters coordinates camera = Camera3d.perspective { viewpoint = Viewpoint3d.lookAt { focalPoint = Point3d.origin , eyePoint = let theta : Angle.Angle theta = Angle.degrees 90 in Point3d.meters (model.radius * Angle.cos theta) model.elevation (model.radius * Angle.sin theta) , upDirection = Direction3d.xy (Angle.degrees 90) } , verticalFieldOfView = Angle.degrees 60 } in Scene3d.sunny { entities = [ entity ] , camera = camera , upDirection = Direction3d.z , sunlightDirection = Direction3d.yz (Angle.degrees -120) , background = Scene3d.transparentBackground , clipDepth = Length.centimeters 1 , shadows = False , dimensions = ( Pixels.int (round (vw model 60)), Pixels.int (round (vh model 100)) ) } ) crossfadeIn : Animation crossfadeIn = Animation.fromTo { duration = 2017 , options = [ Animation.yoyo, Animation.loop ] } [ P.opacity 0 ] [ P.opacity 1 ] crossfadeOut : Animation crossfadeOut = Animation.fromTo { duration = 2027 , options = [ Animation.yoyo, Animation.loop ] } [ P.opacity 1 ] [ P.opacity 0 ]