feat: add routing, 404 page

elm.json

@@ -10,6 +10,7 @@
       "elm/http": "2.0.0",
       "elm/json": "1.1.3",
       "elm/time": "1.0.0",
+      "elm/url": "1.0.0",
       "ianmackenzie/elm-3d-camera": "3.1.0",
       "ianmackenzie/elm-3d-scene": "1.0.2",
       "ianmackenzie/elm-geometry": "3.11.0",
@@ -24,7 +25,6 @@
       "elm/bytes": "1.0.8",
       "elm/file": "1.0.5",
       "elm/random": "1.0.0",
-      "elm/url": "1.0.0",
       "elm/virtual-dom": "1.0.3",
       "ianmackenzie/elm-1d-parameter": "1.0.1",
       "ianmackenzie/elm-float-extra": "1.1.0",

src/Main.elm

@@ -1,18 +1,23 @@
-module Main exposing (Flags, Model, Msg, Object3d, main)
+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
@@ -30,6 +35,7 @@ import Simple.Animation.Property as P
 import Task
 import Time
 import TriangularMesh exposing (TriangularMesh)
+import Url
 import Viewpoint3d
 import WebGL.Texture
 
@@ -68,24 +74,24 @@ animatedEl =
 
 main : Program Flags Model Msg
 main =
-    Browser.document { init = init, update = update, subscriptions = subscribe, view = view }
+    Browser.application { init = init, update = update, subscriptions = subscribe, view = view, onUrlRequest = Request, onUrlChange = Load }
 
 
 type alias Model =
-    { w : Int, h : Int, last : String, mesh : Maybe Object3d, textures : Maybe (Material.Textured Obj.Decode.ObjCoordinates), angle : Float }
+    { 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 -> ( Model, Cmd Msg )
+init : Flags -> Url.Url -> Nav.Key -> ( Model, Cmd Msg )
-init flags =
+init flags url key =
     let
         ( width, height ) =
             flags
     in
-    ( { w = width, h = height, last = "", mesh = Nothing, textures = Nothing, angle = 0 }, Cmd.batch [ getMesh, getTexture ] )
+    ( { 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 =
@@ -94,6 +100,8 @@ type alias Object3d =
 
 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
@@ -127,6 +135,17 @@ update msg model =
         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 _ ->
@@ -148,7 +167,12 @@ update msg model =
                         }
 
         Rotate time ->
-            wrap { model | angle = canonicalize (model.angle + 2 * (2 + sin (toFloat (Time.posixToMillis time) / 1000))) }
+            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 ) )
@@ -307,15 +331,73 @@ inlineLink disp addr =
         }
 
 
+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 =
+    , body = loadUrl model
+    }
+
+
+pageHome : Model -> List (Html Msg)
+pageHome model =
     [ Element.layout
         [ width fill
         ]
@@ -501,7 +583,84 @@ view model =
             ]
         )
     ]
+
+
+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
@@ -603,6 +762,55 @@ view3D model =
         )
 
 
+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