path: root/2d/input.scm

;;; guile-2d
;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu>
;;;
;;; Guile-2d is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; Guile-2d is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this program.  If not, see
;;; <http://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; Keyboard and mouse input.
;;
;;; Code:

(define-module (2d input)
  #:use-module (srfi srfi-1)
  #:use-module (figl runtime) ;; For the define-enumeration macro
  #:export (keycode
            any-keycode?
            keymod
            all-keymods?
            mouse-button))

;;;
;;; Keyboard
;;;

;; Keycodes
(define-enumeration
  keycode
  (backspace 8)
  (tab 9)
  (clear 12)
  (return 13)
  (pause 19)
  (escape 27)
  (space 32)
  (exclaim 33)
  (quotedbl 34)
  (hash 35)
  (dollar 36)
  (ampersand 38)
  (quote 39)
  (leftparen 40)
  (rightparen 41)
  (asterisk 42)
  (plus 43)
  (comma 44)
  (minus 45)
  (period 46)
  (slash 47)
  (0 48)
  (1 49)
  (2 50)
  (3 51)
  (4 52)
  (5 53)
  (6 54)
  (7 55)
  (8 56)
  (9 57)
  (colon 58)
  (semicolon 59)
  (less 60)
  (equals 61)
  (greater 62)
  (question 63)
  (at 64)
  (leftbracket 91)
  (backslash 92)
  (rightbracket 93)
  (caret 94)
  (underscore 95)
  (backquote 96)
  (a 97)
  (b 98)
  (c 99)
  (d 100)
  (e 101)
  (f 102)
  (g 103)
  (h 104)
  (i 105)
  (j 106)
  (k 107)
  (l 108)
  (m 109)
  (n 110)
  (o 111)
  (p 112)
  (q 113)
  (r 114)
  (s 115)
  (t 116)
  (u 117)
  (v 118)
  (w 119)
  (x 120)
  (y 121)
  (z 122)
  (delete 127)
  (world-0 160)
  (world-1 161)
  (world-2 162)
  (world-3 163)
  (world-4 164)
  (world-5 165)
  (world-6 166)
  (world-7 167)
  (world-8 168)
  (world-9 169)
  (world-10 170)
  (world-11 171)
  (world-12 172)
  (world-13 173)
  (world-14 174)
  (world-15 175)
  (world-16 176)
  (world-17 177)
  (world-18 178)
  (world-19 179)
  (world-20 180)
  (world-21 181)
  (world-22 182)
  (world-23 183)
  (world-24 184)
  (world-25 185)
  (world-26 186)
  (world-27 187)
  (world-28 188)
  (world-29 189)
  (world-30 190)
  (world-31 191)
  (world-32 192)
  (world-33 193)
  (world-34 194)
  (world-35 195)
  (world-36 196)
  (world-37 197)
  (world-38 198)
  (world-39 199)
  (world-40 200)
  (world-41 201)
  (world-42 202)
  (world-43 203)
  (world-44 204)
  (world-45 205)
  (world-46 206)
  (world-47 207)
  (world-48 208)
  (world-49 209)
  (world-50 210)
  (world-51 211)
  (world-52 212)
  (world-53 213)
  (world-54 214)
  (world-55 215)
  (world-56 216)
  (world-57 217)
  (world-58 218)
  (world-59 219)
  (world-60 220)
  (world-61 221)
  (world-62 222)
  (world-63 223)
  (world-64 224)
  (world-65 225)
  (world-66 226)
  (world-67 227)
  (world-68 228)
  (world-69 229)
  (world-70 230)
  (world-71 231)
  (world-72 232)
  (world-73 233)
  (world-74 234)
  (world-75 235)
  (world-76 236)
  (world-77 237)
  (world-78 238)
  (world-79 239)
  (world-80 240)
  (world-81 241)
  (world-82 242)
  (world-83 243)
  (world-84 244)
  (world-85 245)
  (world-86 246)
  (world-87 247)
  (world-88 248)
  (world-89 249)
  (world-90 250)
  (world-91 251)
  (world-92 252)
  (world-93 253)
  (world-94 254)
  (world-95 255)
  (kp0 256)
  (kp1 257)
  (kp2 258)
  (kp3 259)
  (kp4 260)
  (kp5 261)
  (kp6 262)
  (kp7 263)
  (kp8 264)
  (kp9 265)
  (kp-period 266)
  (kp-divide 267)
  (kp-multiply 268)
  (kp-minus 269)
  (kp-plus 270)
  (kp-enter 271)
  (kp-equals 272)
  (up 273)
  (down 274)
  (right 275)
  (left 276)
  (insert 277)
  (home 278)
  (end 279)
  (pageup 280)
  (pagedown 281)
  (f1 282)
  (f2 283)
  (f3 284)
  (f4 285)
  (f5 286)
  (f6 287)
  (f7 288)
  (f8 289)
  (f9 290)
  (f10 291)
  (f11 292)
  (f12 293)
  (f13 294)
  (f14 295)
  (f15 296)
  (numlock 300)
  (capslock 301)
  (scrollock 302)
  (rshift 303)
  (lshift 304)
  (rctrl 305)
  (lctrl 306)
  (ralt 307)
  (lalt 308)
  (rmeta 309)
  (lmeta 310)
  (lsuper 311)
  (rsuper 312)
  (mode 313)
  (compose 314)
  (help 315)
  (print 316)
  (sysreq 317)
  (break 318)
  (menu 319)
  (power 320)
  (euro 321)
  (undo 322))

(define (any-keycode? keycode . keycodes)
  "Returns true if keycode equals any of the keycodes provided and
returns false otherwise."
  (any (lambda (key) (= keycode key)) keycodes))

;; Modifier keys
(define-enumeration
  keymod
  (none 0)
  (shift 3)
  (ctrl 192)
  (alt 768)
  (meta 3072)
  (num 4096 )
  (caps 8192))

(define (all-keymods? mod . expected)
  "Returns true if all expected modifier bits are set and returns
false otherwise."
  (not (zero? (apply logand mod expected))))

;;;
;;; Mouse
;;;

(define-enumeration
  mouse-button
  (left 1)
  (middle 2)
  (right 4))