0 | module NCurses.Core.SpecialKey
  1 |
  2 | import NCurses.Core
  3 | import Data.List
  4 | import Data.List.Elem
  5 | import Data.Either
  6 |
  7 | %default total
  8 |
  9 | %foreign libncurses "keypad"
 10 | prim__keypad : AnyPtr -> Int -> PrimIO ()
 11 |
 12 | %foreign libhelper "keyF0"
 13 | prim__keyF0 : PrimIO Int
 14 |
 15 | %foreign libhelper "keyF1"
 16 | prim__keyF1 : PrimIO Int
 17 |
 18 | %foreign libhelper "keyF2"
 19 | prim__keyF2 : PrimIO Int
 20 |
 21 | %foreign libhelper "keyF3"
 22 | prim__keyF3 : PrimIO Int
 23 |
 24 | %foreign libhelper "keyF4"
 25 | prim__keyF4 : PrimIO Int
 26 |
 27 | %foreign libhelper "keyF5"
 28 | prim__keyF5 : PrimIO Int
 29 |
 30 | %foreign libhelper "keyF6"
 31 | prim__keyF6 : PrimIO Int
 32 |
 33 | %foreign libhelper "keyF7"
 34 | prim__keyF7 : PrimIO Int
 35 |
 36 | %foreign libhelper "keyF8"
 37 | prim__keyF8 : PrimIO Int
 38 |
 39 | %foreign libhelper "keyF9"
 40 | prim__keyF9 : PrimIO Int
 41 |
 42 | %foreign libhelper "keyF10"
 43 | prim__keyF10 : PrimIO Int
 44 |
 45 | %foreign libhelper "keyF11"
 46 | prim__keyF11 : PrimIO Int
 47 |
 48 | %foreign libhelper "keyF12"
 49 | prim__keyF12 : PrimIO Int
 50 |
 51 | %foreign libhelper "keyUp"
 52 | prim__keyUp : PrimIO Int
 53 |
 54 | %foreign libhelper "keyDown"
 55 | prim__keyDown : PrimIO Int
 56 |
 57 | %foreign libhelper "keyLeft"
 58 | prim__keyLeft : PrimIO Int
 59 |
 60 | %foreign libhelper "keyRight"
 61 | prim__keyRight : PrimIO Int
 62 |
 63 | %foreign libhelper "keyBackspace"
 64 | prim__keyBackspace : PrimIO Int
 65 |
 66 | ||| Keys that can be used when keypad is turned on.
 67 | ||| See @keypad@ and @keypad'@.
 68 | public export
 69 | data Key = F0
 70 |          | F1
 71 |          | F2
 72 |          | F3
 73 |          | F4
 74 |          | F5
 75 |          | F6
 76 |          | F7
 77 |          | F8
 78 |          | F9
 79 |          | F10
 80 |          | F11
 81 |          | F12
 82 |          | Up
 83 |          | Down
 84 |          | Left
 85 |          | Right
 86 |          | Backspace
 87 |
 88 | allKeys : List Key
 89 | allKeys = [ Up
 90 |           , Down
 91 |           , Left
 92 |           , Right
 93 |           , Backspace
 94 |           , F0
 95 |           , F1
 96 |           , F2
 97 |           , F3
 98 |           , F4
 99 |           , F5
100 |           , F6
101 |           , F7
102 |           , F8
103 |           , F9
104 |           , F10
105 |           , F11
106 |           , F12
107 |           ]
108 |
109 | allKeysCover : (k : Key) -> Elem k SpecialKey.allKeys
110 | allKeysCover F0        = %search
111 | allKeysCover F1        = %search
112 | allKeysCover F2        = %search
113 | allKeysCover F3        = %search
114 | allKeysCover F4        = %search
115 | allKeysCover F5        = %search
116 | allKeysCover F6        = %search
117 | allKeysCover F7        = %search
118 | allKeysCover F8        = %search
119 | allKeysCover F9        = %search
120 | allKeysCover F10       = %search
121 | allKeysCover F11       = %search
122 | allKeysCover F12       = %search
123 | allKeysCover Up        = %search
124 | allKeysCover Down      = %search
125 | allKeysCover Left      = %search
126 | allKeysCover Right     = %search
127 | allKeysCover Backspace = %search
128 |
129 |
130 | ||| Turn a Key into a Char that can be used to compare against
131 | ||| the results of getCh. This only applies if you have enabled
132 | ||| keypad for the given window.                                               
133 | ||| See @keypad@ and @keypad'@.
134 | export
135 | fnKeyChar : HasIO io => Key -> io Char
136 | fnKeyChar F0        = cast <$> (primIO prim__keyF0)
137 | fnKeyChar F1        = cast <$> (primIO prim__keyF1)
138 | fnKeyChar F2        = cast <$> (primIO prim__keyF2)
139 | fnKeyChar F3        = cast <$> (primIO prim__keyF3)
140 | fnKeyChar F4        = cast <$> (primIO prim__keyF4)
141 | fnKeyChar F5        = cast <$> (primIO prim__keyF5)
142 | fnKeyChar F6        = cast <$> (primIO prim__keyF6)
143 | fnKeyChar F7        = cast <$> (primIO prim__keyF7)
144 | fnKeyChar F8        = cast <$> (primIO prim__keyF8)
145 | fnKeyChar F9        = cast <$> (primIO prim__keyF9)
146 | fnKeyChar F10       = cast <$> (primIO prim__keyF10)
147 | fnKeyChar F11       = cast <$> (primIO prim__keyF11)
148 | fnKeyChar F12       = cast <$> (primIO prim__keyF12)
149 | fnKeyChar Up        = cast <$> (primIO prim__keyUp)
150 | fnKeyChar Down      = cast <$> (primIO prim__keyDown)
151 | fnKeyChar Left      = cast <$> (primIO prim__keyLeft)
152 | fnKeyChar Right     = cast <$> (primIO prim__keyRight)
153 | fnKeyChar Backspace = cast <$> (primIO prim__keyBackspace)
154 |
155 | fnKeyPairing : HasIO io => Key -> (io Char, Key)
156 | fnKeyPairing k = (fnKeyChar k, k)
157 |
158 | -- hopefully sorted such that more common keys come
159 | -- earlier on, roughly.
160 | keyMap' : HasIO io => (List (io Char, Key))
161 | keyMap' = (fnKeyPairing {io}) <$> allKeys
162 |
163 | keyMapCovers : HasIO io => Builtin.snd <$> SpecialKey.keyMap' {io} = SpecialKey.allKeys
164 | keyMapCovers = Refl
165 |
166 | ||| A Map from Chars to Keys that can be used to look characters up when
167 | ||| keypad is enabled.
168 | export
169 | keyMap : HasIO io => io (List (Char, Key))
170 | keyMap = traverse (\(ch, k) => [ (ch', k) | ch' <- ch ]) (keyMap' {io})
171 |
172 | lookup' : HasIO io => Eq a => a -> List (io a, b) -> io (Maybe b)
173 | lookup' x [] = pure Nothing
174 | lookup' x ((y, z) :: xs) = do
175 |   y' <- y
176 |   if x == y'
177 |      then pure $ Just z
178 |      else lookup' x xs
179 |
180 | fromChar : HasIO io => Char -> io (Either Char Key)
181 | fromChar ch = maybeToEither ch <$> lookup' ch keyMap'
182 |
183 | ||| Turn keypad mode on or off for the given window.
184 | ||| When on, function keys (F0, F1, ...) and arrow keys are
185 | ||| transformed into single chars that can be compared against
186 | ||| the result of passing a particular key to the fnKeyChar
187 | ||| function.
188 | export
189 | keypad' : HasIO io => Window -> (enable : Bool) -> io ()
190 | keypad' (Win win) enable = primIO $ prim__keypad win (boolToInt enable)
191 |
192 | ||| Turn keypad mode on or off for the std window.
193 | ||| When on, function keys (F0, F1, ...) and arrow keys are
194 | ||| transformed into single chars that can be compared against
195 | ||| the result of passing a particular key to the fnKeyChar
196 | ||| function.
197 | export
198 | keypad : HasIO io => (enable : Bool) -> io ()
199 | keypad enable = keypad' !stdWindow enable
200 |
201 |