Commit Diff

Commit:
388ebd57548f5437bef752b02a095eafe1afa9aa
From:
James Cook <falsifian@falsifian.org>
Date:
Message:
Add a checkbox that hides the floor. Also, use an existing canvas element from the document instead of appending one.
Actions:
Patch | Tree
commit - 3629a6632c3cb654683a2a8e9572c664806fee3d
commit + 388ebd57548f5437bef752b02a095eafe1afa9aa
blob - 7bcb33375e6cdccdd3220b06a00515c9c77d5b62
blob + 0ef58fc6f8d22efd3dab6800a48d0d18ecb1ac67
--- Main.html
+++ Main.html
@@ -5,5 +5,8 @@
     <script src="build/exec/Main.js"></script>
   </head>
   <body>
+    <canvas id="s3d_canvas" width=300 height=300></canvas>
+    <br>
+    <input type="checkbox" id="hide_floor"><label for="hide_floor">hide floor</label>
   </body>
 </html>
blob - f7f80dc46b1d2d5ef549bf751427292b6c2be85f
blob + 79c3ef7a52dc0574a97475acea7528f95385c907
--- src/Main.idr
+++ src/Main.idr
@@ -31,6 +31,8 @@ record Context where
   constructor MkContext
   ui : UIContext
   drawables : List Drawable
+  ||| The floor
+  floorDrawables : List Drawable
   obstacles : Obstacles
 
 -- The compiler seems to have trouble if I just directly say makeProgram.
@@ -82,7 +84,10 @@ mainLoop context physicalState time =
   do let gl = context.ui.gl
      (physicalState', viewMatrix) <-
        stepState context.obstacles time context.ui.state physicalState
-     drawUniverse gl viewMatrix context.drawables
+     let drawables = if !(floorEnabled context.ui)
+                     then context.drawables ++ context.floorDrawables
+                     else context.drawables
+     drawUniverse gl viewMatrix drawables
      requestAnimationFrame (runJS . mainLoop context physicalState')
 
 partial
@@ -96,6 +101,9 @@ mainAfterLoad =
      scene <- theHouse
      drawables <- compileFigure gl colourTextureProgram simpleColourProgram
                   scene.figure
+     floorDrawables <-
+       compileFigure gl colourTextureProgram simpleColourProgram
+       theFloor
 
      makeTheTexture gl TEXTURE0
      useProgram gl (Just colourTextureProgram.program)
@@ -105,6 +113,7 @@ mainAfterLoad =
            MkContext
            { ui = ui
            , drawables = drawables
+           , floorDrawables = floorDrawables
            , obstacles = scene.obstacles
            }
      requestAnimationFrame (runJS . mainLoop context initialState)
blob - 93c07be1fac9ace00cd19f6b349273e8591aa721
blob + a6b7020ccb3f719844f1214b35abd471ccbee6bc
--- src/S3D/Scenes/House.idr
+++ src/S3D/Scenes/House.idr
@@ -123,11 +123,11 @@ theHouse =
   { figure =
       concatFigures
       [ physicalPolyhedraFigure
-      , floorLines floorColours
       , transform (rotateAxes 2 3) !yard
       ]
   , obstacles = physicalPolyhedraObstacles
   }
 
-
-
+export
+theFloor : Figure
+theFloor = floorLines floorColours
blob - 789216569320ec6817459648edf4441dda880d6e
blob + b91fc2a4262b55c619ae046d2e475f7324c30256
--- src/S3D/WebUI.idr
+++ src/S3D/WebUI.idr
@@ -33,17 +33,10 @@ public export
 record UIContext where
   constructor MkUIContext
   canvas : HTMLCanvasElement
+  hideFloorCheckbox : HTMLInputElement
   gl : WebGL2RenderingContext
   state : IORef UIState
 
-makeCanvas : JSIO HTMLCanvasElement
-makeCanvas =
-  do canvas <- createElement Canvas
-     ignore (appendChild (!body) canvas)
-     width canvas .= 300
-     height canvas .= 300
-     pure canvas
-
 getGl2Context : HTMLCanvasElement -> JSIO WebGL2RenderingContext
 getGl2Context canvas =
   do context <- unMaybe "getContext" $ Html.HTMLCanvasElement.getContext canvas "webgl2" Undef
@@ -116,7 +109,9 @@ handleTouchMove stateRef event =
 export
 init : JSIO UIContext
 init =
-  do canvas <- makeCanvas
+  do theDocument <- document
+     Just canvas <- htmlElementById Canvas "s3d_canvas"
+      | Nothing => throwError $ Caught "s3d_canvas not found, or isn't a canvas element"
      gl <- getGl2Context canvas
      state <- newIORef $
               MkUIState
@@ -124,7 +119,6 @@ init =
               , touchCentre = [0, 0]
               , touchDeltas = replicate _ [0, 0]
               }
-     theDocument <- document
      -- Keyboard events
      addEventListener' theDocument "keydown" (Just !(callback (handleKeyDown state)))
      addEventListener' theDocument "keyup" (Just !(callback (handleKeyUp state)))
@@ -134,9 +128,16 @@ init =
      addEventListener' canvas "touchend" (Just !(callback (handleTouchStartEnd state)))
      addEventListener' canvas "touchcancel" (Just !(callback (handleTouchStartEnd state)))
      addEventListener' canvas "touchmove" (Just !(callback (handleTouchMove state)))
+     Just hideFloorCheckbox <- htmlElementById Input "hide_floor"
+      | Nothing => throwError $ Caught "hide_floor not found, or isn't an input element"
      pure $
        MkUIContext
        { canvas = canvas
+       , hideFloorCheckbox = hideFloorCheckbox
        , gl = gl
        , state = state
        }
+
+export
+floorEnabled : UIContext -> JSIO Bool
+floorEnabled ui = map not $ get ui.hideFloorCheckbox checked