commit 388ebd57548f5437bef752b02a095eafe1afa9aa from: James Cook date: Mon Jan 17 22:07:43 2022 UTC Add a checkbox that hides the floor. Also, use an existing canvas element from the document instead of appending one. commit - 3629a6632c3cb654683a2a8e9572c664806fee3d commit + 388ebd57548f5437bef752b02a095eafe1afa9aa blob - 7bcb33375e6cdccdd3220b06a00515c9c77d5b62 blob + 0ef58fc6f8d22efd3dab6800a48d0d18ecb1ac67 --- Main.html +++ Main.html @@ -5,5 +5,8 @@ + +
+ 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