Stop animating P and Q and use keyboard shortcuts instead

Torus.elm

@@ -3,6 +3,7 @@ module Torus exposing (..)
 import Html exposing (Html)
 import Html.Attributes exposing (width, height, style)
 import AnimationFrame
+import Keyboard exposing (..)
 import Time exposing (Time)
 import Math.Matrix4 as Mat4 exposing (Mat4)
 import Math.Vector2 as Vec2 exposing (vec2, Vec2)
@@ -25,12 +26,13 @@ type alias Attributes = { position : Vec3 , normal : Vec3 }
 
 type Msg
     = Animate Time
+    | KeyChange Bool Keyboard.KeyCode
     | WindowResized Window.Size
 
 type alias Model =
     { p : Float
     , q : Float
---    , mesh : Mesh Attributes
+    , torus : Mesh Attributes
     , time : Float
     , winSize : Window.Size }
 
@@ -41,8 +43,9 @@ knotScale = 0.2
 
 init: ( Model , Cmd Msg )
 init =
-    -- ( { p = 1 , q = 0 , time = 0.0 , winSize = (Window.Size 1 1)
-   ( { p = 12 , q = 29 , time = 0.0 , winSize = (Window.Size 1 1)
+    ( { p = 2 , q = 9 , time = 0.0 , winSize = (Window.Size 1 1)
+      , torus = constructTorus 2 9
+   -- ( { p = 8 , q = 9 , time = 0.0 , winSize = (Window.Size 1 1)
 --    , mesh = (torusPoints 2 15 |> torusShell)
     }
     , Cmd.batch [ Task.perform WindowResized Window.size ] )
@@ -52,14 +55,25 @@ subscriptions: Model -> Sub Msg
 subscriptions _ =
     Sub.batch
         [ AnimationFrame.diffs Animate
+        , Keyboard.downs (KeyChange True)
         , Window.resizes WindowResized ]
 
 update: Msg -> Model -> (Model , Cmd Msg)
 update msg model =
     let m = case msg of
+            KeyChange b k ->
+                let (p,q) = case (b, k) of
+                        -- pq / wo
+                        (True, 80) -> (model.p+1, model.q  )
+                        (True, 81) -> (model.p  , model.q+1)
+                        (True, 79) -> (model.p-1, model.q  )
+                        (True, 87) -> (model.p  , model.q-1)
+                        _ -> (model.p, model.q)
+                    _ = Debug.log "P Q: " (p, q)
+                in { model | torus = constructTorus p q , p = p , q = q }
             Animate dt ->
---                { model | time = model.time + dt * 0.001 }
-                { model | time = model.time + dt * 0.001 , p = model.p + 0.008 , q = model.q + 0.004}
+               { model | time = model.time + dt * 0.001 }
+                -- { model | time = model.time + dt * 0.001 , p = model.p + 0.008 , q = model.q + 0.004}
 --            Animate dt -> model
 
             WindowResized size -> { model | winSize = size }
@@ -75,8 +89,8 @@ view model =
             diffuseVS
             diffuseFS
 --            model.mesh
---            (constructTorus model)
-            (constructTorus2 model)
+            -- (constructTorusMesh model)
+            model.torus
             (DiffuseColor
                 (Mat4.makePerspective
                     50
@@ -84,10 +98,10 @@ view model =
                     0.01
                     1000)
                 (Mat4.makeLookAt (vec3 0 0 5) (vec3 0 0 0) (vec3 0 1 0))
-                (Mat4.makeRotate (model.time * 0.5) (vec3 1 1 1 ) )
+                (Mat4.makeRotate (model.time * 0.9) (vec3 1 1 1 ) )
 --                (Mat4.makeRotate (pi) (vec3 0.3 0.5 1 ) )
 --                Mat4.identity
-                (colorToVec3 Color.red)
+                (colorToVec3 Color.green)
 --                (colorToVec3 Color.darkGrey)
 --                (colorToVec3 Color.white)
                 (vec3 1 1 1)
@@ -95,26 +109,22 @@ view model =
                 (vec3 1 1 1)
                 1.0) ] )
 
-totalLinePoints = 100
-ringRadius = 0.15
-ringVerts = 18
-
-constructTorus: Model -> Mesh Attributes
-constructTorus model =
+constructTorusMesh: Model -> Mesh Attributes
+constructTorusMesh model =
     let points = torusPoints model.p model.q |> makePairs
         rings = torusRings points |> List.concatMap makePairs
     in points ++ rings |> toLines
 --    in points |> toLines
 
 
-constructTorus2: Model -> Mesh Attributes
-constructTorus2 model =
-    torusPoints model.p model.q
+constructTorus: Float -> Float -> Mesh Attributes
+constructTorus p q =
+    torusPoints p q
     |> makePairs
     |> torusRings
     |> torusTris
     |> withTris
---    |> wireframe |> List.map (\ x -> toAttributes x Vec3.i) |> WebGL.lineStrip
+-- |> wireframe |> List.map (\ x -> toAttributes x Vec3.i) |> WebGL.lineStrip
 
 withTris: List (Vec3 , Vec3 , Vec3) -> Mesh Attributes
 withTris tris =

elm-package.json

@@ -13,6 +13,7 @@
         "elm-lang/animation-frame": "1.0.1 <= v < 2.0.0",
         "elm-lang/core": "5.1.1 <= v < 6.0.0",
         "elm-lang/window": "1.0.1 <= v < 2.0.0",
+        "elm-lang/keyboard": "1.0.1 <= v < 2.0.0",
         "elm-lang/html": "2.0.0 <= v < 3.0.0"
     },
     "elm-version": "0.18.0 <= v < 0.19.0"