macgregor/src/Main.elm

module Main exposing (Flags, Model, Msg, Object3d, main)

import Angle
import Array
import Browser
import Browser.Events as Events
import Camera3d
import Clipboard exposing (copyToClipboard)
import Color
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 Http
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 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 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.document { init = init, update = update, subscriptions = subscribe, view = view }


type alias Model =
    { w : Int, h : Int, mesh : Maybe Object3d, textures : Maybe (Material.Textured Obj.Decode.ObjCoordinates), angle : Float }


type alias Flags =
    ( Int, Int )


init : Flags -> ( Model, Cmd Msg )
init flags =
    let
        ( width, height ) =
            flags
    in
    ( { w = width, h = height, mesh = Nothing, textures = Nothing, angle = 0 }, Cmd.batch [ getMesh, getTexture ] )


type alias Object3d =
    TriangularMesh { position : Point3d Length.Meters Obj.Decode.ObjCoordinates, uv : ( Float, Float ) }


type Msg
    = Resize Int Int
    | GotMesh (Result Http.Error Object3d)
    | GotTexture (Result WebGL.Texture.Error (Material.Texture Color.Color))
    | Rotate Time.Posix
    | Copy String


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 }

        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 = model.angle + 2 * (2 + sin (toFloat (Time.posixToMillis time) / 1000)) }

        Copy text ->
            ( model, copyToClipboard text )


subscribe : Model -> Sub Msg
subscribe _ =
    Sub.batch
        [ Events.onResize Resize
        , Time.every (1000 / 30) Rotate
        ]


htmlify : List (Element Msg) -> List (Html Msg)
htmlify =
    List.map (Element.layout [])


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 (rgb255 255 255 255)
    , 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) }


view : Model -> Browser.Document Msg
view model =
    { title = "MacGregor House"
    , body =
        htmlify
            [ column
                [ width fill
                , height fill
                , spacing (round (vh model -100))
                ]
                [ el
                    [ width fill
                    , height (px (round (vh model 100)))
                    , Background.color (rgb255 0 0 0)
                    ]
                    Element.none
                , animatedEl crossfadeIn
                    [ width fill
                    , height (px (round (vh model 100)))
                    , Background.gradient { angle = 45, steps = [ rgb255 200 0 100, rgb255 100 0 200 ] }
                    ]
                    Element.none
                , animatedEl crossfadeOut
                    [ width fill
                    , height (px (round (vh model 100)))
                    , Background.gradient { angle = 45, steps = [ rgb255 0 100 200, rgb255 0 200 100 ] }
                    ]
                    Element.none
                , el
                    [ alignLeft
                    , alignTop
                    , width (px (round (vw model 50)))
                    , height (px (round (vh model 100)))
                    , paddingEach
                        { top = round (vh model 50) - 96
                        , bottom = 0
                        , left = round (vw model 10)
                        , right = 0
                        }
                    , Font.color (rgb255 255 255 255)
                    , Font.family [ Font.typeface "Imbue" ]
                    , Font.size 96
                    ]
                    (column
                        [ spacing 20
                        ]
                        [ text "MacGregor House"
                        , row
                            [ spacing 20
                            ]
                            [ linkBtn "Events" "https://calendar.google.com/calendar/embed?src=c_c9fb13003264d5becb74cf9ba42a087d8a4a180d927441994458a07ac146eb88%40group.calendar.google.com&ctz=America%2FNew_York"
                            , linkBtn "Space" "https://forms.gle/KxFAG65TQuPxdYak8"
                            , btn "iCal" (Copy "https://calendar.google.com/calendar/ical/c_c9fb13003264d5becb74cf9ba42a087d8a4a180d927441994458a07ac146eb88%40group.calendar.google.com/public/basic.ics")
                            ]
                        ]
                    )
                , el
                    [ alignRight
                    , alignTop
                    , width (px (round (vw model 60)))
                    , height (px (round (vh model 100)))
                    , paddingEach
                        { top = round (vh model 25)
                        , bottom = round (vh model 25)
                        , left = 0
                        , right = 0
                        }
                    ]
                    (view3D 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)) )
            }
        )


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 ]