From 6a3dda13f7b2e8fd1f1fd866d24dcfd9d7b6864d Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Tue, 15 Aug 2023 16:28:17 +0700 Subject: [PATCH] Stop animating and use keyboard to increase P and Q. Fix issue with missing segment. --- README.org | 13 ++------ Torus.elm | 77 +++++++++++++++++++++++++++++++----------------- elm-package.json | 1 + 3 files changed, 53 insertions(+), 38 deletions(-) diff --git a/README.org b/README.org index fe8cb2c..e598272 100644 --- a/README.org +++ b/README.org @@ -6,17 +6,8 @@ [[https://ferano.io/3d-fp/][Live Link]] -This is an attempt to implement the [[https://en.wikipedia.org/wiki/Torus_knot][PQ Torus Knot]] in the Elm programming language. - -Either open up `torus.html`, or use the command `elm-reactor`, if you want to be able to modify the source file and compile; - -https://guide.elm-lang.org/install.html - -Alternatively, here's the Ellie link - -https://ellie-app.com/vVTgpBj77ra1 - -![alt text](screenshots/elm-knot.png "PQ Torus Knot") +This is an attempt to implement the [[https://en.wikipedia.org/wiki/Torus_knot][PQ Torus Knot]] in the Elm programming +language. ** Showcase diff --git a/Torus.elm b/Torus.elm index 959c03e..afee236 100644 --- a/Torus.elm +++ b/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,19 +26,26 @@ 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 } +totalLinePoints = 250 +ringRadius = 0.1 +ringVerts = 40 +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 ] ) @@ -47,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 } @@ -70,8 +89,8 @@ view model = diffuseVS diffuseFS -- model.mesh --- (constructTorus model) - (constructTorus2 model) + -- (constructTorusMesh model) + model.torus (DiffuseColor (Mat4.makePerspective 50 @@ -79,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) @@ -90,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 = @@ -124,10 +139,10 @@ torusPoints p q = interpolatedCircle totalLinePoints |> List.map (\ t -> - let r = 0.5 * (2 + sin (q * t)) + let r = 2 + sin (q * t) in vec3 (cos (t * p) * r) - (cos (t * q) * r * 0.5) + (cos (t * q) * r * 0.25) (sin (t * p) * r) ) @@ -136,9 +151,11 @@ torusRings verts = verts |> List.map (\ (p1, p2)-> - (List.map circlePoint <| interpolatedCircle ringVerts) + ringVerts + |> interpolatedCircle + |> List.map circlePoint |> List.map (\ p -> - let (mid , dir) = (Vec3.add p1 p2 |> Vec3.scale 0.5 , Vec3.sub p2 p1 |> Vec3.normalize) + let (mid , dir) = (Vec3.add p1 p2 |> Vec3.scale knotScale , Vec3.sub p2 p1 |> Vec3.normalize) p_ = Vec3.toRecord p dir_ = Vec3.toRecord dir u = Vec3.cross dir Vec3.j |> Vec3.normalize @@ -168,7 +185,12 @@ circlePoint: Float -> Vec3 circlePoint x = vec3 (cos x) (sin x) 0 makePairs: List a -> List (a ,a) -makePairs ps = List.map2 (,) ps (List.drop 1 ps) +makePairs ps1 = + case ps1 of + [] -> [] + h::tail -> + let ps2 = tail ++ [h] + in List.map2 (,) ps1 ps2 closedPairs: List a -> List (a ,a) closedPairs xs = @@ -197,6 +219,10 @@ colorToVec3 color = c = Color.toRgb color in vec3 (to01 c.red) (to01 c.green) (to01 c.blue) +------------- +-- Shaders +------------- + type alias DiffuseColor = { projection : Mat4 , view : Mat4 @@ -248,6 +274,3 @@ diffuseFS = gl_FragColor = vec4(color * vlightWeight, 1.0); } |] - - - diff --git a/elm-package.json b/elm-package.json index 85715a5..ee732cd 100644 --- a/elm-package.json +++ b/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"