This is an alternative site for discovering Elm packages. You may be looking for the official Elm package site instead.

Here4.Object

We did not parse any module docs.
module Here4.Object
    exposing
        ( create
        , texturedObj
        , texturedObjWith
        , reflectiveObj
        , reflectiveObjWith
        )

import Here4.App as App exposing (..)
import Here4.App.Types exposing (..)
import Here4.Appearance exposing (Appearance)
import Here4.Body exposing (..)
import Here4.Dispatch exposing (..)
import Here4.Location exposing (Scale(..))
import Here4.Orientation as Orientation exposing (Orientation)
import Here4.Setter exposing (..)
import Here4.Object.Attributes exposing (..)
import Here4.Object.ReflectiveObj as ReflectiveObj exposing (ReflectiveObjAttributes)
import Here4.Object.TexturedObj as TexturedObj exposing (TexturedObjAttributes)
import Here4.Object.Types exposing (Load(..))
import Here4.Object.Util exposing (scaleToVec3)
import Here4.Object.Wrapper exposing (..)
import Html exposing (Html)
import Html.Attributes as Html
import Math.Vector3 as V3 exposing (Vec3, vec3)


type alias Model vehicle =
    { motion : Moving {}
    , rotation : Maybe Orientation
    , action : Action vehicle
    , body : Maybe (Moving Body)
    , object : Load ObjectResult
    , dimensions : Vec3
    }


type alias Msg =
    ObjectMsg


texturedObj : String -> String -> String -> ObjectAttributes
texturedObj meshPath diffuseTexturePath normalTexturePath =
    TexturedObj.texturedObj meshPath diffuseTexturePath normalTexturePath
        |> TexturedObj


texturedObjWith :
    String
    -> String
    -> String
    -> List (Update TexturedObjAttributes)
    -> ObjectAttributes
texturedObjWith meshPath diffuseTexturePath normalTexturePath updates =
    TexturedObj.texturedObj meshPath diffuseTexturePath normalTexturePath
        |> applyUpdates updates
        |> TexturedObj


reflectiveObj : String -> String -> ObjectAttributes
reflectiveObj meshPath reflectionTexturePath =
    ReflectiveObj.reflectiveObj meshPath reflectionTexturePath
        |> ReflectiveObj


reflectiveObjWith :
    String
    -> String
    -> List (Update ReflectiveObjAttributes)
    -> ObjectAttributes
reflectiveObjWith meshPath reflectionTexturePath updates =
    ReflectiveObj.reflectiveObj meshPath reflectionTexturePath
        |> applyUpdates updates
        |> ReflectiveObj


create : List (Update (Attributes vehicle Msg)) -> ( App, Cmd AppMsg )
create updates =
    let
        create_ attributes =
            App.create (init attributes)
                { id = always attributes.id
                , label = always attributes.label
                , update = update attributes.scale attributes.action
                , animate = animate attributes.canFloat
                , bodies = bodies
                , framing = framing
                , focus = focus
                , overlay = always attributes.overlay
                , reposition = reposition
                }
    in
        create_ (applyUpdates updates defaultAttributes)


applyMotion : Model vehicle -> Model vehicle
applyMotion model =
    let
        orientation o =
            model.rotation
                |> Maybe.map (Orientation.unwind o)
                |> Maybe.withDefault o

        apply motion thing =
            { thing
                | position = motion.position
                , orientation = orientation motion.orientation
                , velocity = motion.velocity
            }
    in
        { model | body = Maybe.map (apply model.motion) model.body }


setMotion : Moving {} -> Model vehicle -> Model vehicle
setMotion motion model =
    applyMotion { model | motion = motion }


loadBody :
    Scale
    -> ( Load ObjectResult, Cmd ObjectMsg )
    -> Model vehicle
    -> ( Model vehicle, Cmd (CtrlMsg Msg) )
loadBody scale ( newObject, newMsg ) model =
    let
        ( mBody, dimensions ) =
            case newObject of
                Loading _ ->
                    ( Nothing, vec3 1 1 1 )

                Ready appear dimensions ->
                    ( Just
                        { anchor = AnchorGround
                        , scale = scaleToVec3 dimensions scale
                        , position = vec3 0 0 0
                        , orientation = Orientation.initial
                        , appear = appear
                        , velocity = vec3 0 0 0
                        }
                    , dimensions
                    )
    in
        ( applyMotion
            { model
                | object = newObject
                , body = mBody
                , dimensions = dimensions
            }
        , Cmd.map Self newMsg
        )


init : Attributes vehicle Msg -> ( Model vehicle, Cmd (CtrlMsg Msg) )
init attributes =
    let
        ( object, objectCmds ) =
            objectInit attributes.object
    in
        loadBody attributes.scale
            ( object, objectCmds )
            { motion =
                { position = attributes.position
                , orientation = Orientation.initial
                , velocity = vec3 0 0 0
                }
            , rotation = attributes.rotation
            , action = attributes.action
            , body = Nothing
            , object = object
            , dimensions = vec3 1 1 1
            }


update :
    Scale
    -> Action vehicle
    -> CtrlMsg Msg
    -> Model vehicle
    -> ( Model vehicle, Cmd (CtrlMsg Msg) )
update scale action msg model =
    case msg of
        Self m ->
            loadBody scale (objectUpdate m model.object) model

        Ctrl (Enter partyKey) ->
            case action of
                Portal location ->
                    ( model, teleport partyKey location )

                _ ->
                    ( model, Cmd.none )

        Ctrl (Move dp) ->
            -- ( mapBody (translate dp), Cmd.none)
            ( model, Cmd.none )

        Ctrl (Drive ground inputs) ->
            case action of
                Vehicle v ->
                    ( setMotion (v.drive v.vehicle model.dimensions ground inputs model.motion) model
                    , Cmd.none
                    )

                _ ->
                    ( model, Cmd.none )

        _ ->
            ( model, Cmd.none )


animate : Bool -> Ground -> Time -> Model vehicle -> ( Model vehicle, Cmd (CtrlMsg Msg) )
animate canFloat ground dt model =
    let
        aboveGround pos =
            let
                minY =
                    if canFloat then
                        max ground.seaLevel (ground.elevation pos)
                    else
                        ground.elevation pos
            in
                if V3.getY pos > minY then
                    pos
                else
                    V3.setY minY pos

        motion =
            model.motion

        newMotion =
            { motion
                | position = aboveGround motion.position
            }
    in
        ( setMotion newMotion model, Cmd.none )


bodies : Model vehicle -> Vec3 -> List Body
bodies model pos =
    case model.body of
        Just body ->
            [ toBody body ]

        Nothing ->
            []


reposition : Maybe AppPosition -> Model vehicle -> Model vehicle
reposition mPos model =
    case mPos of
        Just pos ->
            let
                motion =
                    model.motion

                newMotion =
                    { motion
                        | position = pos.position
                        , orientation = pos.orientation
                    }
            in
                setMotion newMotion model

        Nothing ->
            model


framing : PartyKey -> Model vehicle -> Maybe Framing
framing _ model =
    Maybe.map (always (toFraming model.motion)) model.body


focus : Model vehicle -> Maybe Focus
focus model =
    Maybe.map appToFocus model.body



{-
   overlay : Model vehicle -> Html msg
   overlay model =
       let
           textLeft =
               Html.style [ ( "text-align", "left" ) ]
       in
           Html.div []
               [ Html.h2 []
                   [ Html.text model.label ]
               , Html.text "A statue"
               ]
-}