[ new ] wheel events

stefan-hoeck · Jul 21, 2023 · c561e18 · c561e18
1 parent 2517a5e
commit c561e18
Show file tree

Hide file tree

Showing 3 changed files with 21 additions and 0 deletions.
diff --git a/src/Text/HTML/Event.idr b/src/Text/HTML/Event.idr
@@ -8,6 +8,14 @@ import Data.Maybe
 --          Event Info Types
 --------------------------------------------------------------------------------
 
+public export
+record WheelInfo where
+  constructor MkWheelInfo
+  deltaMode : Bits32
+  deltaX    : Double
+  deltaY    : Double
+  deltaZ    : Double
+
 public export
 record MouseInfo where
   constructor MkMouseInfo
@@ -85,3 +93,6 @@ data DOMEvent : Type -> Type where
 
   -- Routing
   HashChange : a -> DOMEvent a
+
+  -- Wheel
+  Wheel      : (WheelInfo -> Maybe a) -> DOMEvent a
diff --git a/src/Web/MVC/Cmd.idr b/src/Web/MVC/Cmd.idr
@@ -79,6 +79,7 @@ parameters {0 e    : Type}
     MouseOut f   => inst "mouseout" mouseInfo f
     MouseMove f  => inst "mousemove" mouseInfo f
     HashChange v => inst "hashchange" {t = Event} (const $ pure v) Just
+    Wheel f      => inst "wheel" wheelInfo f
 
     where
       inst :

diff --git a/src/Web/MVC/Event.idr b/src/Web/MVC/Event.idr
@@ -60,3 +60,12 @@ changeInfo e =
   [| MkInputInfo
        (primIO (prim__input e))
        ((1 ==) <$> primIO (prim__checked e)) |]
+
+export
+wheelInfo : WheelEvent -> JSIO WheelInfo
+wheelInfo e =
+  [| MkWheelInfo
+     (deltaMode e)
+     (deltaX e)
+     (deltaY e)
+     (deltaZ e) |]