From a7a629e45b602d02e258940f6bc5ed7cc7108df7 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 5 Sep 2010 09:29:57 -0600 Subject: [PATCH] showkey as module --- collects/meta/props | 2 +- collects/tests/gracket/showkey.rkt | 77 +++++++++++++++++++++++++++ collects/tests/gracket/showkey.rktl | 81 ----------------------------- 3 files changed, 78 insertions(+), 82 deletions(-) create mode 100644 collects/tests/gracket/showkey.rkt delete mode 100644 collects/tests/gracket/showkey.rktl diff --git a/collects/meta/props b/collects/meta/props index b342dd505c..333ae41972 100755 --- a/collects/meta/props +++ b/collects/meta/props @@ -1469,7 +1469,7 @@ path/s is either such a string or a list of them. "collects/tests/gracket/paramz.rktl" drdr:command-line (gracket "-f" *) "collects/tests/gracket/png.rktl" drdr:command-line #f "collects/tests/gracket/random.rktl" drdr:command-line #f -"collects/tests/gracket/showkey.rktl" drdr:command-line #f +"collects/tests/gracket/showkey.rkt" drdr:command-line #f "collects/tests/gracket/sixlib.rktl" drdr:command-line #f "collects/tests/gracket/test-editor-admin.rkt" drdr:command-line (gracket-text "-t" *) "collects/tests/gracket/testing.rktl" drdr:command-line (gracket "-f" *) diff --git a/collects/tests/gracket/showkey.rkt b/collects/tests/gracket/showkey.rkt new file mode 100644 index 0000000000..64de91552f --- /dev/null +++ b/collects/tests/gracket/showkey.rkt @@ -0,0 +1,77 @@ +#lang racket/base +(require racket/gui/base + racket/class) + +(let () + (define iter 0) + (define c% + (class canvas% + (super-new) + (define/override (on-event ev) + (lambda (ev) + (printf "~a~a MOUSE ~a (~a,~a)\n mods:~a~a~a~a~a\n buttons:~a~a~a~a~a~a~a\n" + (es-check) + iter + (send ev get-event-type) + (send ev get-x) + (send ev get-y) + (if (send ev get-meta-down) " META" "") + (if (send ev get-control-down) " CTL" "") + (if (send ev get-alt-down) " ALT" "") + (if (send ev get-shift-down) " SHIFT" "") + (if (send ev get-caps-down) " CAPS" "") + (if (send ev get-left-down) " LEFT" "") + (if (send ev get-middle-down) " MIDDLE" "") + (if (send ev get-right-down) " RIGHT" "") + (if (send ev dragging?) + " dragging" + "") + (if (send ev moving?) + " moving" + "") + (if (send ev entering?) + " entering" + "") + (if (send ev leaving?) + " leaving" + "")))) + (define/override (on-char ev) + (set! iter (add1 iter)) + (printf "~a~a KEY: ~a\n rel-code: ~a\n other-codes: ~a\n mods:~a~a~a~a~a\n" + (es-check) + iter + (let ([v (send ev get-key-code)]) + (if (symbol? v) + v + (format "~s = ASCII ~a" (string v) (char->integer v)))) + (let ([v (send ev get-key-release-code)]) + (if (symbol? v) + v + (format "~s = ASCII ~a" (string v) (char->integer v)))) + (let ([vs (list (send ev get-other-shift-key-code) + (send ev get-other-altgr-key-code) + (send ev get-other-shift-altgr-key-code) + (send ev get-other-caps-key-code))]) + (map (lambda (v) + (and v + (if (symbol? v) + v + (format "~s = ASCII ~a" (string v) (char->integer v))))) + vs)) + (if (send ev get-meta-down) " META" "") + (if (send ev get-control-down) " CTL" "") + (if (send ev get-alt-down) " ALT" "") + (if (send ev get-shift-down) " SHIFT" "") + (if (send ev get-caps-down) " CAPS" ""))))) + (define f (make-object (class frame% + (inherit accept-drop-files) + (define/override (on-drop-file file) + (printf "Dropped: ~a\n" file)) + (super-make-object "tests" #f 100 100) + (accept-drop-files #t)))) + (define c (make-object c% f)) + (define (es-check) (if (eq? (send f get-eventspace) (current-eventspace)) + "" + ">>WRONG EVENTSPACE<<\n")) + (send c focus) + (send f show #t)) diff --git a/collects/tests/gracket/showkey.rktl b/collects/tests/gracket/showkey.rktl deleted file mode 100644 index c547eb90e8..0000000000 --- a/collects/tests/gracket/showkey.rktl +++ /dev/null @@ -1,81 +0,0 @@ - -(require mzlib/etc - mzlib/class100) - -(let () - (define iter 0) - (define c% - (class100-asi canvas% - (override - [on-event - (lambda (ev) - (printf "~a~a MOUSE ~a (~a,~a)\n mods:~a~a~a~a~a\n buttons:~a~a~a~a~a~a~a\n" - (es-check) - iter - (send ev get-event-type) - (send ev get-x) - (send ev get-y) - (if (send ev get-meta-down) " META" "") - (if (send ev get-control-down) " CTL" "") - (if (send ev get-alt-down) " ALT" "") - (if (send ev get-shift-down) " SHIFT" "") - (if (send ev get-caps-down) " CAPS" "") - (if (send ev get-left-down) " LEFT" "") - (if (send ev get-middle-down) " MIDDLE" "") - (if (send ev get-right-down) " RIGHT" "") - (if (send ev dragging?) - " dragging" - "") - (if (send ev moving?) - " moving" - "") - (if (send ev entering?) - " entering" - "") - (if (send ev leaving?) - " leaving" - "")))] - [on-char - (lambda (ev) - (set! iter (add1 iter)) - (printf "~a~a KEY: ~a\n rel-code: ~a\n other-codes: ~a\n mods:~a~a~a~a~a\n" - (es-check) - iter - (let ([v (send ev get-key-code)]) - (if (symbol? v) - v - (format "~s = ASCII ~a" (string v) (char->integer v)))) - (let ([v (send ev get-key-release-code)]) - (if (symbol? v) - v - (format "~s = ASCII ~a" (string v) (char->integer v)))) - (let ([vs (list (send ev get-other-shift-key-code) - (send ev get-other-altgr-key-code) - (send ev get-other-shift-altgr-key-code) - (send ev get-other-caps-key-code))]) - (map (lambda (v) - (and v - (if (symbol? v) - v - (format "~s = ASCII ~a" (string v) (char->integer v))))) - vs)) - (if (send ev get-meta-down) " META" "") - (if (send ev get-control-down) " CTL" "") - (if (send ev get-alt-down) " ALT" "") - (if (send ev get-shift-down) " SHIFT" "") - (if (send ev get-caps-down) " CAPS" "")))]))) - (define f (make-object (class100 frame% () - (inherit accept-drop-files) - (override - [on-drop-file (lambda (file) - (printf "Dropped: ~a\n" file))]) - (sequence - (super-init "tests" #f 100 100) - (accept-drop-files #t))))) - (define c (make-object c% f)) - (define (es-check) (if (eq? (send f get-eventspace) (current-eventspace)) - "" - ">>WRONG EVENTSPACE<<\n")) - (send c focus) - (send f show #t)) -