JosephFerano/pqtorusknot
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Stop animating and use keyboard to increase P and Q. Fix issue with missing segment.

Browse Source
This commit is contained in:
Joseph Ferano 2023-08-15 16:28:17 +07:00
parent 354ed1a1b7
commit 6a3dda13f7
3 changed files with 53 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
README.org
View File

@ -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

75
Torus.elm
View File

@ -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,21 +109,17 @@ 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
@ -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);
}
|]

1
elm-package.json
View File

@ -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"