public
Created

record full keyboard state in a racket/gui window

  • Download Gist
keystate.rkt
Racket
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
#lang racket/base
(require racket/gui/base
racket/class
racket/pretty)
 
(struct keyboard-state (alt-down? shift-down? control-down? meta-down? caps-down?
keys-down)
#:inspector (make-inspector))
 
;; Try to record the state of the keymap by watching on-subwindow-char
(define (capturing-keystate window%)
(class window%
(super-new)
(define alt-down? #f)
(define shift-down? #f)
(define control-down? #f)
(define meta-down? #f)
(define caps-down? #f)
(define keys-down (make-hash))
(define/public (get-keyboard-state)
(keyboard-state alt-down? shift-down? control-down? meta-down? caps-down? keys-down))
;; Monitor each event, and keep track in our own personal keymap.
(define/override (on-subwindow-char receiver key-event)
(define keycode (send key-event get-key-code))
(cond
[(eq? keycode 'release)
(define released-key (send key-event get-key-release-code))
(hash-remove! keys-down released-key)]
[else
(hash-set! keys-down keycode #t)])
(set! alt-down? (send key-event get-alt-down))
(set! caps-down? (send key-event get-caps-down))
(set! control-down? (send key-event get-control-down))
(set! meta-down? (send key-event get-meta-down))
(set! shift-down? (send key-event get-shift-down))
(super on-subwindow-char receiver key-event))))
 
 
(define (test)
(define myframe (new (capturing-keystate frame%)
[label "Testing"]
[width 500]
[height 500]))
(define textarea (new text%))
(define canvas (new editor-canvas% [parent myframe] [editor textarea]))
(send myframe show #t)
(thread (lambda ()
(let loop ()
(send textarea begin-edit-sequence)
(send textarea erase)
(send textarea insert (pretty-format (send myframe get-keyboard-state)))
(send textarea end-edit-sequence)
(sleep 0.1)
(loop))))
(void))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.