module Main exposing (main) -- Yig - The crazy bouncing line, now in a color cube. import Browser import Browser.Events as E import Html exposing (Html, div) import Html.Attributes exposing (height, style, width) import Json.Decode as D exposing (Decoder, field, int, map2) import List exposing (drop, length, map) import Math.Matrix4 as Mat4 exposing (Mat4) import Math.Vector2 as Vec2 exposing (Vec2, vec2) import Math.Vector3 as Vec3 exposing (Vec3, fromRecord, vec3) import Random exposing (Seed, float, initialSeed, map3, maxInt, minInt) import WebGL exposing (Mesh, Shader) opts = { numTrails = 150 -- number of lines visible at once. , maxV = 0.03 -- max speed point moves , maxDV = 0.0003 -- maxiumim change to velocity , mouseScale = 200 -- how many mouse pixels to one radian of rotation. , initial = vec2 -10 12 -- initial rotation of cube , cameraFov = 15 -- degrees field of view , cameraDistance = 10 -- camera distance from origin , drag = 0.1 -- amount of friction to cube rotation } origin = vec3 0 0 0 vGenerator = map3 vec3 (float -opts.maxV opts.maxV) (float -opts.maxV opts.maxV) (float -opts.maxV opts.maxV) dvGenerator = float -opts.maxDV opts.maxDV type alias Line = { p1 : Vec3, p2 : Vec3 } type alias State = { seed : Seed -- random seed , p1 : Vec3 -- position of point 1 , p2 : Vec3 -- position of point 2 , oldLines : List Line -- array of trails , v1 : Vec3 -- velocity of point 1 , v2 : Vec3 -- velocity of point 2 , rotation : Vec2 -- rotation , velocity : Vec2 -- rotation velocity } type alias Model = Maybe State type Msg = Diff Float | Seed Int | MouseMoved MouseMovement {-| Add a little randomness to v -} addRand : Seed -> Float -> ( Seed, Float ) addRand seed v = let ( newV, newSeed ) = Random.step dvGenerator seed in ( newSeed, v + newV ) {-| Max/min location and velocity of a single dimension. -} capPositionComponent : Seed -> Float -> Float -> ( Seed, Float, Float ) capPositionComponent seed p v = let -- invert v & add randomness if hitting a wall. ( newSeed, newV ) = if p > 1 || p < -1 then addRand seed -v else ( seed, v ) -- "bounce" position off the wall. newP = if p > 1 then 2 - p else if p < -1 then -p - 2 else p in ( newSeed , newP -- cap velocity , if newV > opts.maxV then opts.maxV else if newV < -opts.maxV then -opts.maxV else newV ) {-| Max/min location and velocity, keeps line inside box, and moving slowly. -} capPosition : Seed -> Vec3 -> Vec3 -> ( Seed, Vec3, Vec3 ) capPosition seed p v = let -- expand position and velocity into separate components. pr = Vec3.toRecord p vr = Vec3.toRecord v -- cap/invert each component individually. ( seed2, newPx, newVx ) = capPositionComponent seed pr.x vr.x ( seed3, newPy, newVy ) = capPositionComponent seed2 pr.y vr.y ( seed4, newPz, newVz ) = capPositionComponent seed3 pr.z vr.z in ( seed4 , Vec3.fromRecord { x = newPx, y = newPy, z = newPz } , Vec3.fromRecord { x = newVx, y = newVy, z = newVz } ) {-| When we get the initial seed use it to create an initial state. -} gotSeed : Int -> State gotSeed seedInt = let seed = initialSeed seedInt ( v1, seed2 ) = Random.step vGenerator seed ( v2, seed3 ) = Random.step vGenerator seed2 in { seed = seed3 , p1 = origin , p2 = origin , v1 = v1 , v2 = v2 , oldLines = [] , rotation = opts.initial , velocity = vec2 0 0 } {-| Add some drag to the cube rotation in one dimension. -} addDrag : Float -> Float addDrag v = if v > 0 then v - min opts.drag v else if v < 0 then v + min opts.drag -v else v {-| Add some drag to the cube rotation in both directions. -} addDrag2 : Vec2 -> Vec2 addDrag2 vec = let rec = Vec2.toRecord vec in Vec2.fromRecord { x = addDrag rec.x, y = addDrag rec.y } {-| One animation step - add velocity to position, cap position & velocity, add drag to velocity. -} step : State -> State step state = let -- Add velocity to position, handle out-of-bounds. ( seed2, newP1, newV1 ) = capPosition state.seed (Vec3.add state.p1 state.v1) state.v1 ( seed3, newP2, newV2 ) = capPosition state.seed (Vec3.add state.p2 state.v2) state.v2 numLines = length state.oldLines in { state | p1 = newP1 , p2 = newP2 , v1 = newV1 , v2 = newV2 , seed = seed3 -- Keep trails array bounded. , oldLines = (if numLines > opts.numTrails then drop (numLines - opts.numTrails) state.oldLines else state.oldLines ) -- Add current points to trails array. ++ [ { p1 = newP1, p2 = newP2 } ] , rotation = Vec2.add state.rotation state.velocity , velocity = addDrag2 state.velocity } {-| Respond to events - Seed, NewDiff, MoseMoved. -} update : Msg -> Model -> ( Model, Cmd Msg ) update msg model = case msg of Seed seedInt -> ( Just <| gotSeed seedInt , Cmd.none ) Diff dt -> case model of Nothing -> ( model, Cmd.none ) Just state -> ( Just <| step state, Cmd.none ) MouseMoved { dx, dy, buttons } -> case model of Nothing -> ( model, Cmd.none ) Just state -> ( Just <| { state | velocity = if buttons == 1 then vec2 (toFloat dx) (toFloat dy) else state.velocity } , Cmd.none ) {-| Ask for a random seed. -} seedCmd : Cmd Msg seedCmd = Random.generate Seed (Random.int Random.maxInt Random.minInt) type alias MouseMovement = { dx : Int, dy : Int, buttons : Int } {-| Decode mouse movements from the environement. -} mouseDecode : Decoder MouseMovement mouseDecode = D.map3 MouseMovement (field "movementX" int) (field "movementY" int) (field "buttons" int) {-| Start up - ask for a random seed, subscribe to mouse movements and animation frames. -} main : Program () Model Msg main = Browser.element { init = \_ -> ( Nothing , seedCmd ) , view = view , subscriptions = \_ -> Sub.batch [ E.onAnimationFrameDelta Diff , E.onMouseMove <| D.map MouseMoved mouseDecode ] , update = update } {-| Display our canvas once we have a non-null model (random seed recieved). -} view : Model -> Html msg view model = case model of Nothing -> div [] [] Just state -> let r = Vec2.toRecord state.rotation in WebGL.toHtml [ width 800, height 800 ] [ WebGL.entity vertexShader fragmentShader (lineMesh state.oldLines) (uniforms r.x r.y) , WebGL.entity vertexShader noirShader cubeMesh (uniforms r.x r.y) ] type alias Uniforms = { perspective : Mat4 , camera : Mat4 , rotationX : Mat4 , rotationY : Mat4 } uniforms : Float -> Float -> Uniforms uniforms xr yr = { perspective = Mat4.makePerspective opts.cameraFov 1 0.01 100 , camera = Mat4.makeLookAt (vec3 0 0 -opts.cameraDistance) origin Vec3.j , rotationX = Mat4.makeRotate (xr / opts.mouseScale) Vec3.j , rotationY = Mat4.makeRotate (-yr / opts.mouseScale) Vec3.i } -- Mesh type alias Vertex = { position : Vec3 } lineToVertex : Line -> ( Vertex, Vertex ) lineToVertex { p1, p2 } = ( Vertex p1, Vertex p2 ) lineMesh : List Line -> Mesh Vertex lineMesh lines = map lineToVertex lines |> WebGL.lines -- lbt(1,1,1) +================+ (-1,1,1) rbt -- /| ^ /| -- lft / | | 7 / | -- (1,1,-1)+================+(-1,1,-1)rft -- | | | / | | -- | | |/ | | -- lbb | | <---+ | | rbb -- (1,-1,1|) +--(0,0,0)----|--+ (-1,-1,1) -- | / | / -- |/ |/ -- +================+ -- (1,-1,-1)lfb (-1,-1,-1)rfb cubeMesh : Mesh Vertex cubeMesh = -- left(l)/right(r) + front(f)/back(b) + top(t)/bottom(b) let rbt = vec3 -1 1 1 lbt = vec3 1 1 1 lft = vec3 1 1 -1 rft = vec3 -1 1 -1 rfb = vec3 -1 -1 -1 rbb = vec3 -1 -1 1 lbb = vec3 1 -1 1 lfb = vec3 1 -1 -1 in [ ( Vertex rft, Vertex lft ) -- front top , ( Vertex rft, Vertex rfb ) -- right front , ( Vertex rft, Vertex rbt ) -- right top , ( Vertex lbb, Vertex lbt ) -- left back , ( Vertex lbb, Vertex rbb ) -- back bottom , ( Vertex lbb, Vertex lfb ) -- left bottom , ( Vertex lfb, Vertex lft ) -- left front , ( Vertex rbt, Vertex rbb ) -- right back , ( Vertex rfb, Vertex lfb ) -- front bottom , ( Vertex rbt, Vertex lbt ) -- back top , ( Vertex lft, Vertex lbt ) -- left top , ( Vertex rfb, Vertex rbb ) -- right bottom ] |> WebGL.lines -- Shaders type alias Varyings = { fragmentPosition : Vec3 } vertexShader : Shader Vertex Uniforms Varyings vertexShader = [glsl| precision mediump float; varying vec3 fragmentPosition; attribute vec3 position; uniform mat4 perspective; uniform mat4 camera; uniform mat4 rotationX; uniform mat4 rotationY; void main () { vec4 transformedPosition = perspective * camera * rotationX * rotationY * vec4(position, 1.0); gl_Position = transformedPosition; fragmentPosition = position.xyz; } |] fragmentShader : Shader {} Uniforms Varyings fragmentShader = [glsl| precision mediump float; varying vec3 fragmentPosition; void main () { gl_FragColor = vec4((fragmentPosition + vec3(1.0)) * .5, 1.); } |] noirShader : Shader {} Uniforms Varyings noirShader = [glsl| precision mediump float; varying vec3 fragmentPosition; void main () { gl_FragColor = vec4(1, 1, 1, 1.); } |]