Commit Diff

Commit:
2d24bf60e7f8889b738e3b3cc64d2c73dfabbf0c
From:
James Cook <falsifian@falsifian.org>
Date:
Message:
Don't suppress non-arrow keys. Now on Firefox ctrl-r to reload works again.
Actions:
Patch | Tree
commit - 7cdb9e10304ebc957c4b0341ff14d24fa978d84f
commit + 2d24bf60e7f8889b738e3b3cc64d2c73dfabbf0c
blob - e8ab39124bd0030966bca2f9105917694a3182c7
blob + 4c4c687b2cbfcd1b6d31bb7a9e1c332b80a83dab
--- src/S3D/WebUI.idr
+++ src/S3D/WebUI.idr
@@ -3,6 +3,7 @@ module S3D.WebUI
 import Data.IORef
 import Data.Vect
 import Data.SortedSet
+import Data.String
 import JS
 import Math.LinearAlgebra
 import S3D.DomExtras
@@ -46,16 +47,16 @@ getGl2Context canvas =
 
 handleKeyDown : IORef UIState -> Event -> JSIO ()
 handleKeyDown stateRef event =
-  do preventDefault event
-     keyboardEvent <- unMaybe "cast keyboard event" $ pure (safeCast event)
+  do keyboardEvent <- unMaybe "cast keyboard event" $ pure (safeCast event)
      theKey <- Web.Raw.UIEvents.KeyboardEvent.key keyboardEvent
+     when (isPrefixOf "Arrow" theKey) $ preventDefault event
      modifyIORef stateRef $ { keysDown $= insert theKey }
 
 handleKeyUp : IORef UIState -> Event -> JSIO ()
 handleKeyUp stateRef event =
-  do preventDefault event
-     keyboardEvent <- unMaybe "cast keyboard event" $ pure (safeCast event)
+  do keyboardEvent <- unMaybe "cast keyboard event" $ pure (safeCast event)
      theKey <- Web.Raw.UIEvents.KeyboardEvent.key keyboardEvent
+     when (isPrefixOf "Arrow" theKey) $ preventDefault event
      modifyIORef stateRef $ { keysDown $= delete theKey }
 
 handleFocusout : IORef UIState -> Event -> JSIO ()