;;; -*-Scheme-*-
;;;
-;;; $Id: key-w32.scm,v 1.1 1994/10/25 01:46:12 adams Exp $
+;;; $Id: key-w32.scm,v 1.2 1995/04/13 23:27:21 cph Exp $
;;;
-;;; Copyright (c) 1991-1992 Massachusetts Institute of Technology
+;;; Copyright (c) 1991-95 Massachusetts Institute of Technology
;;;
;;; This material was developed by the Scheme project at the
;;; Massachusetts Institute of Technology, Department of
;;; Package: (edwin win32-keys)
(declare (usual-integrations))
+\f
+(define (initialize-package!)
+ (set! end (make-special-key 'END 0))
+ unspecific)
-;; This constructs a vector mapping VK_* codes (integers 0..255) to special key
-;; names (symbols).
-;; It doesn not include keys that are affected by the Win32 API TranslateMessage,
-;; which are: any printing character, backspace, enter, escape, tab
-
-(let-syntax
- ((make-translation-vector
- (lambda ()
- (let ((v (make-vector 256 #F)))
- (for-each (lambda (def)
- (if (not (null? (cddr def)))
- (vector-set! v (second def) (third def))))
- '(;;VK_name code special-key name
- (VK_LBUTTON #x01)
- (VK_RBUTTON #x02)
- (VK_CANCEL #x03)
- (VK_MBUTTON #x04)
-
- (VK_BACK #x08)
- (VK_TAB #x09)
-
- (VK_CLEAR #x0C)
- (VK_RETURN #x0D)
-
- (VK_SHIFT #x10)
- (VK_CONTROL #x11)
- (VK_MENU #x12)
- (VK_PAUSE #x13 stop)
- (VK_CAPITAL #x14)
-
- (VK_ESCAPE #x1B)
-
- (VK_SPACE #x20)
- (VK_PRIOR #x21 prior)
- (VK_NEXT #x22 next)
- (VK_END #x23 end)
- (VK_HOME #x24 home)
- (VK_LEFT #x25 left)
- (VK_UP #x26 up)
- (VK_RIGHT #x27 right)
- (VK_DOWN #x28 down)
- (VK_SELECT #x29 select)
- (VK_PRINT #x2A print)
- (VK_EXECUTE #x2B)
- (VK_SNAPSHOT #x2C)
- (VK_INSERT #x2D insertchar)
- (VK_DELETE #x2E deletechar)
- (VK_HELP #x2F)
-
- (VK_NUMPAD0 #x60)
- (VK_NUMPAD1 #x61)
- (VK_NUMPAD2 #x62)
- (VK_NUMPAD3 #x63)
- (VK_NUMPAD4 #x64)
- (VK_NUMPAD5 #x65)
- (VK_NUMPAD6 #x66)
- (VK_NUMPAD7 #x67)
- (VK_NUMPAD8 #x68)
- (VK_NUMPAD9 #x69)
- (VK_MULTIPLY #x6A)
- (VK_ADD #x6B)
- (VK_SEPARATOR #x6C)
- (VK_SUBTRACT #x6D)
- (VK_DECIMAL #x6E)
- (VK_DIVIDE #x6F)
- (VK_F1 #x70 f1)
- (VK_F2 #x71 f2)
- (VK_F3 #x72 f3)
- (VK_F4 #x73 f4)
- (VK_F5 #x74 f5)
- (VK_F6 #x75 f6)
- (VK_F7 #x76 f7)
- (VK_F8 #x77 f8)
- (VK_F9 #x78 f9)
- (VK_F10 #x79 f10)
- (VK_F11 #x7A f11)
- (VK_F12 #x7B f12)
- (VK_F13 #x7C f13)
- (VK_F14 #x7D f14)
- (VK_F15 #x7E f15)
- (VK_F16 #x7F f16)
- (VK_F17 #x80 f17)
- (VK_F18 #x81 f18)
- (VK_F19 #x82 f19)
- (VK_F20 #x83 f20)
- (VK_F21 #x84 f21)
- (VK_F22 #x85 f22)
- (VK_F23 #x86 f23)
- (VK_F24 #x87 f24)
-
- (VK_NUMLOCK #x90)
- (VK_SCROLL #x91)
-
- (VK_LSHIFT #xA0)
- (VK_RSHIFT #xA1)
- (VK_LCONTROL #xA2)
- (VK_RCONTROL #xA3)
- (VK_LMENU #xA4)
- (VK_RMENU #xA5)
-
- (VK_ATTN #xF6)
- (VK_CRSEL #xF7)
- (VK_EXSEL #xF8)
- (VK_EREOF #xF9)
- (VK_PLAY #xFA)
- (VK_ZOOM #xFB)
- (VK_NONAME #xFC)
- (VK_PA1 #xFD)
- (VK_OEM_CLEAR #xFE)))
- v))))
-
- (define win32-key-translation-vector (make-translation-vector)))
-
-(define (vk-code->name vk-code)
- (vector-ref win32-key-translation-vector vk-code))
+(define end)
(define (win32-make-special-key keysym bucky-bits)
(cond ((vk-code->name keysym)
(make-special-key name bucky-bits)))
(else #F)))
-(define end)
+(define (vk-code->name vk-code)
+ (vector-ref win32-key-translation-vector vk-code))
-(define (initialize-package!)
- (set! end (make-special-key 'end 0))
- unspecific)
+;; This constructs a vector mapping VK_* codes (integers 0..255) to
+;; special key names (symbols). It doesn not include keys that are
+;; affected by the Win32 API TranslateMessage, which are: any printing
+;; character, backspace, enter, escape, tab
+
+(define win32-key-translation-vector
+ (let ((v (make-vector 256 #f)))
+ (for-each (lambda (def)
+ (if (not (null? (cddr def)))
+ (vector-set! v (second def) (third def))))
+ '(;;VK_name code special-key name
+ (VK_LBUTTON #x01)
+ (VK_RBUTTON #x02)
+ (VK_CANCEL #x03)
+ (VK_MBUTTON #x04)
+
+ (VK_BACK #x08)
+ (VK_TAB #x09)
+
+ (VK_CLEAR #x0C)
+ (VK_RETURN #x0D)
+
+ (VK_SHIFT #x10)
+ (VK_CONTROL #x11)
+ (VK_MENU #x12)
+ (VK_PAUSE #x13 stop)
+ (VK_CAPITAL #x14)
+
+ (VK_ESCAPE #x1B)
+
+ (VK_SPACE #x20)
+ (VK_PRIOR #x21 prior)
+ (VK_NEXT #x22 next)
+ (VK_END #x23 end)
+ (VK_HOME #x24 home)
+ (VK_LEFT #x25 left)
+ (VK_UP #x26 up)
+ (VK_RIGHT #x27 right)
+ (VK_DOWN #x28 down)
+ (VK_SELECT #x29 select)
+ (VK_PRINT #x2A print)
+ (VK_EXECUTE #x2B)
+ (VK_SNAPSHOT #x2C)
+ (VK_INSERT #x2D insertchar)
+ (VK_DELETE #x2E deletechar)
+ (VK_HELP #x2F)
+
+ (VK_NUMPAD0 #x60)
+ (VK_NUMPAD1 #x61)
+ (VK_NUMPAD2 #x62)
+ (VK_NUMPAD3 #x63)
+ (VK_NUMPAD4 #x64)
+ (VK_NUMPAD5 #x65)
+ (VK_NUMPAD6 #x66)
+ (VK_NUMPAD7 #x67)
+ (VK_NUMPAD8 #x68)
+ (VK_NUMPAD9 #x69)
+ (VK_MULTIPLY #x6A)
+ (VK_ADD #x6B)
+ (VK_SEPARATOR #x6C)
+ (VK_SUBTRACT #x6D)
+ (VK_DECIMAL #x6E)
+ (VK_DIVIDE #x6F)
+ (VK_F1 #x70 f1)
+ (VK_F2 #x71 f2)
+ (VK_F3 #x72 f3)
+ (VK_F4 #x73 f4)
+ (VK_F5 #x74 f5)
+ (VK_F6 #x75 f6)
+ (VK_F7 #x76 f7)
+ (VK_F8 #x77 f8)
+ (VK_F9 #x78 f9)
+ (VK_F10 #x79 f10)
+ (VK_F11 #x7A f11)
+ (VK_F12 #x7B f12)
+ (VK_F13 #x7C f13)
+ (VK_F14 #x7D f14)
+ (VK_F15 #x7E f15)
+ (VK_F16 #x7F f16)
+ (VK_F17 #x80 f17)
+ (VK_F18 #x81 f18)
+ (VK_F19 #x82 f19)
+ (VK_F20 #x83 f20)
+ (VK_F21 #x84 f21)
+ (VK_F22 #x85 f22)
+ (VK_F23 #x86 f23)
+ (VK_F24 #x87 f24)
+
+ (VK_NUMLOCK #x90)
+ (VK_SCROLL #x91)
+
+ (VK_LSHIFT #xA0)
+ (VK_RSHIFT #xA1)
+ (VK_LCONTROL #xA2)
+ (VK_RCONTROL #xA3)
+ (VK_LMENU #xA4)
+ (VK_RMENU #xA5)
+
+ (VK_ATTN #xF6)
+ (VK_CRSEL #xF7)
+ (VK_EXSEL #xF8)
+ (VK_EREOF #xF9)
+ (VK_PLAY #xFA)
+ (VK_ZOOM #xFB)
+ (VK_NONAME #xFC)
+ (VK_PA1 #xFD)
+ (VK_OEM_CLEAR #xFE)))
+ v))
\ No newline at end of file
projects / mit-scheme.git / commitdiff