0 | module Web.Async.Event
  1 |
  2 | import JS
  3 | import Text.HTML.Event
  4 | import Syntax.T1
  5 | import Web.Internal.DomPrim
  6 | import Web.Internal.GeometryPrim
  7 | import Web.Internal.Types
  8 | import Web.Internal.UIEventsPrim
  9 |
 10 | %default total
 11 |
 12 | --------------------------------------------------------------------------------
 13 | -- FFI
 14 | --------------------------------------------------------------------------------
 15 |
 16 | %foreign "browser:lambda:x=>x.target.value || x.target.innerHTML || ''"
 17 | prim__input : Event -> String
 18 |
 19 | %foreign "browser:lambda:x=>x.target.checked?1:0"
 20 | prim__checked : Event -> Bool
 21 |
 22 | %foreign "browser:lambda:x=>x.target.files || []"
 23 | prim__files : Event -> FileList
 24 |
 25 | %foreign "browser:lambda:x=>x.length"
 26 | prim__length : FileList -> Bits32
 27 |
 28 | %foreign "browser:lambda:(x,y)=>x[y]"
 29 | prim__item : FileList -> Bits32 -> File
 30 |
 31 | files : Event -> List File
 32 | files e =
 33 |  let fs := prim__files e
 34 |   in case prim__length fs of
 35 |        0 => []
 36 |        x => prim__item fs <$> [0..x-1]
 37 |
 38 | --------------------------------------------------------------------------------
 39 | -- Event Readers
 40 | --------------------------------------------------------------------------------
 41 |
 42 | export
 43 | toRect : DOMRect -> IO1 Rect
 44 | toRect r = T1.do
 45 |   x <- ffi $ DOMRectReadOnly.prim__x (up r)
 46 |   y <- ffi $ DOMRectReadOnly.prim__y (up r)
 47 |   h <- ffi $ DOMRectReadOnly.prim__height (up r)
 48 |   w <- ffi $ DOMRectReadOnly.prim__width (up r)
 49 |   t <- ffi $ DOMRectReadOnly.prim__top (up r)
 50 |   b <- ffi $ DOMRectReadOnly.prim__bottom (up r)
 51 |   l <- ffi $ DOMRectReadOnly.prim__left (up r)
 52 |   r <- ffi $ DOMRectReadOnly.prim__right (up r)
 53 |   pure (MkRect x y h w t b l r)
 54 |
 55 | %inline
 56 | bool : PrimIO Boolean -> IO1 Bool
 57 | bool act t = let b # t := ffi act t in eqv b true # t
 58 |
 59 | export
 60 | mouseInfo : MouseEvent -> IO1 MouseInfo
 61 | mouseInfo e = T1.do
 62 |   b  <- ffi $ prim__button e
 63 |   bs <- ffi $ prim__buttons e
 64 |   cx <- ffi $ prim__clientX e
 65 |   cy <- ffi $ prim__clientY e
 66 |   ox <- ffi $ prim__offsetX e
 67 |   oy <- ffi $ prim__offsetY e
 68 |   px <- ffi $ prim__pageX e
 69 |   py <- ffi $ prim__pageY e
 70 |   sx <- ffi $ prim__screenX e
 71 |   sy <- ffi $ prim__screenY e
 72 |   a  <- bool $ prim__altKey e
 73 |   c  <- bool $ prim__ctrlKey e
 74 |   m  <- bool $ prim__metaKey e
 75 |   s  <- bool $ prim__shiftKey e
 76 |   pure (MkMouseInfo b bs cx cy ox oy px py sx sy a c m s)
 77 |
 78 | export
 79 | keyInfo : KeyboardEvent -> IO1 KeyInfo
 80 | keyInfo e = T1.do
 81 |   k  <- ffi $ prim__key e
 82 |   cd <- ffi $ prim__code e
 83 |   l  <- ffi $ prim__location e
 84 |   ic <- bool $ prim__isComposing e
 85 |   a  <- bool $ prim__altKey e
 86 |   c  <- bool $ prim__ctrlKey e
 87 |   m  <- bool $ prim__metaKey e
 88 |   s  <- bool $ prim__shiftKey e
 89 |   pure (MkKeyInfo k cd l ic a c m s)
 90 |
 91 | export
 92 | changeInfo : Event -> IO1 InputInfo
 93 | changeInfo e t =
 94 |   MkInputInfo (prim__input e) (files e) (prim__checked e) # t
 95 |
 96 | export %inline
 97 | inputInfo : InputEvent -> IO1 InputInfo
 98 | inputInfo e = changeInfo $ up e
 99 |
100 | export
101 | elemScrollInfo : Element -> IO1 ScrollInfo
102 | elemScrollInfo x = T1.do
103 |   st <- ffi $ prim__scrollTop x
104 |   sh <- ffi $ prim__scrollHeight x
105 |   ch <- ffi $ prim__clientHeight x
106 |   pure (MkScrollInfo st sh ch)
107 |
108 | export
109 | scrollInfo : Event -> IO1 ScrollInfo
110 | scrollInfo e = T1.do
111 |   net <- ffi $ prim__target e
112 |   case nullableToMaybe net >>= castTo Element of
113 |     Nothing => pure $ MkScrollInfo 0 0 0
114 |     Just t  => elemScrollInfo t
115 |
116 | export
117 | wheelInfo : WheelEvent -> IO1 WheelInfo
118 | wheelInfo e = T1.do
119 |   dm <- ffi $ prim__deltaMode e
120 |   dx <- ffi $ prim__deltaX e
121 |   dy <- ffi $ prim__deltaY e
122 |   dz <- ffi $ prim__deltaZ e
123 |   pure (MkWheelInfo dm dx dy dz)
124 |