Artifact c8ac5896f5e9bb5da98b212048b597745eec127f:
- File sdl2/extras.ss — part of check-in [27a45ffaf8] at 2016-12-08 01:27:14 on branch trunk — eqv? or zero? instead of eq? somewhere (user: aldo size: 1014)
0000: 0a 0a 28 64 65 66 69 6e 65 20 28 73 64 6c 2d 65 ..(define (sdl-e 0010: 76 65 6e 74 2d 6b 65 79 62 6f 61 72 64 2d 6b 65 vent-keyboard-ke 0020: 79 73 79 6d 2d 73 79 6d 20 65 29 0a 20 20 28 6c ysym-sym e). (l 0030: 65 74 2a 20 28 5b 6b 65 79 62 6f 61 72 64 20 28 et* ([keyboard ( 0040: 66 74 79 70 65 2d 26 72 65 66 20 73 64 6c 2d 65 ftype-&ref sdl-e 0050: 76 65 6e 74 2d 74 20 28 6b 65 79 29 20 65 29 5d vent-t (key) e)] 0060: 0a 09 20 5b 6b 65 79 73 79 6d 20 28 66 74 79 70 .. [keysym (ftyp 0070: 65 2d 26 72 65 66 20 73 64 6c 2d 6b 65 79 62 6f e-&ref sdl-keybo 0080: 61 72 64 2d 65 76 65 6e 74 2d 74 20 28 6b 65 79 ard-event-t (key 0090: 73 79 6d 29 20 6b 65 79 62 6f 61 72 64 29 5d 0a sym) keyboard)]. 00a0: 09 20 5b 73 79 6d 20 28 66 74 79 70 65 2d 72 65 . [sym (ftype-re 00b0: 66 20 73 64 6c 2d 6b 65 79 73 79 6d 2d 74 20 28 f sdl-keysym-t ( 00c0: 73 79 6d 29 20 6b 65 79 73 79 6d 29 5d 29 0a 09 sym) keysym)]).. 00d0: 20 73 79 6d 29 29 0a 0a 28 64 65 66 69 6e 65 20 sym))..(define 00e0: 28 73 64 6c 2d 65 76 65 6e 74 2d 6b 65 79 62 6f (sdl-event-keybo 00f0: 61 72 64 2d 6b 65 79 73 79 6d 2d 6d 6f 64 20 65 ard-keysym-mod e 0100: 29 0a 20 20 28 6c 65 74 2a 20 28 5b 6b 65 79 62 ). (let* ([keyb 0110: 6f 61 72 64 20 28 66 74 79 70 65 2d 26 72 65 66 oard (ftype-&ref 0120: 20 73 64 6c 2d 65 76 65 6e 74 2d 74 20 28 6b 65 sdl-event-t (ke 0130: 79 29 20 65 29 5d 0a 09 20 5b 6b 65 79 73 79 6d y) e)].. [keysym 0140: 20 28 66 74 79 70 65 2d 26 72 65 66 20 73 64 6c (ftype-&ref sdl 0150: 2d 6b 65 79 62 6f 61 72 64 2d 65 76 65 6e 74 2d -keyboard-event- 0160: 74 20 28 6b 65 79 73 79 6d 29 20 6b 65 79 62 6f t (keysym) keybo 0170: 61 72 64 29 5d 0a 09 20 5b 6d 6f 64 20 28 66 74 ard)].. [mod (ft 0180: 79 70 65 2d 72 65 66 20 73 64 6c 2d 6b 65 79 73 ype-ref sdl-keys 0190: 79 6d 2d 74 20 28 6d 6f 64 29 20 6b 65 79 73 79 ym-t (mod) keysy 01a0: 6d 29 5d 29 0a 09 20 6d 6f 64 29 29 0a 0a 28 64 m)]).. mod))..(d 01b0: 65 66 69 6e 65 20 28 73 64 6c 2d 65 76 65 6e 74 efine (sdl-event 01c0: 2d 6d 6f 75 73 65 2d 62 75 74 74 6f 6e 20 65 29 -mouse-button e) 01d0: 0a 20 20 28 6c 65 74 2a 20 28 5b 62 75 74 74 6f . (let* ([butto 01e0: 6e 20 28 66 74 79 70 65 2d 26 72 65 66 20 73 64 n (ftype-&ref sd 01f0: 6c 2d 65 76 65 6e 74 2d 74 20 28 62 75 74 74 6f l-event-t (butto 0200: 6e 29 20 65 29 5d 0a 09 20 5b 62 75 74 74 6f 6e n) e)].. [button 0210: 2a 20 28 66 74 79 70 65 2d 72 65 66 20 73 64 6c * (ftype-ref sdl 0220: 2d 6d 6f 75 73 65 2d 62 75 74 74 6f 6e 2d 65 76 -mouse-button-ev 0230: 65 6e 74 2d 74 20 28 62 75 74 74 6f 6e 29 20 62 ent-t (button) b 0240: 75 74 74 6f 6e 29 5d 29 0a 09 20 62 75 74 74 6f utton)]).. butto 0250: 6e 2a 29 29 0a 0a 28 64 65 66 69 6e 65 2d 66 74 n*))..(define-ft 0260: 79 70 65 20 63 68 61 72 2d 61 72 72 61 79 20 28 ype char-array ( 0270: 61 72 72 61 79 20 30 20 63 68 61 72 29 29 0a 0a array 0 char)).. 0280: 3b 3b 20 54 48 49 53 20 49 53 20 46 4f 52 20 44 ;; THIS IS FOR D 0290: 45 43 4f 44 49 4e 47 20 73 64 6c 2d 74 65 78 74 ECODING sdl-text 02a0: 2d 69 6e 70 75 74 2d 65 76 65 6e 74 20 74 65 78 -input-event tex 02b0: 74 0a 28 64 65 66 69 6e 65 20 28 63 68 61 72 2a t.(define (char* 02c0: 2d 61 72 72 61 79 2d 3e 73 74 72 69 6e 67 20 70 -array->string p 02d0: 74 72 20 6d 61 78 29 0a 20 20 28 6c 65 74 20 6c tr max). (let l 02e0: 6f 6f 70 20 28 5b 69 20 30 5d 20 5b 72 20 27 28 oop ([i 0] [r '( 02f0: 29 5d 29 0a 20 20 20 20 28 6c 65 74 20 28 5b 78 )]). (let ([x 0300: 20 28 66 74 79 70 65 2d 72 65 66 20 63 68 61 72 (ftype-ref char 0310: 2d 61 72 72 61 79 20 28 69 29 20 0a 09 09 09 28 -array (i) ....( 0320: 6d 61 6b 65 2d 66 74 79 70 65 2d 70 6f 69 6e 74 make-ftype-point 0330: 65 72 20 63 68 61 72 2d 61 72 72 61 79 20 0a 09 er char-array .. 0340: 09 09 09 09 20 20 20 20 28 66 74 79 70 65 2d 70 .... (ftype-p 0350: 6f 69 6e 74 65 72 2d 61 64 64 72 65 73 73 20 70 ointer-address p 0360: 74 72 29 29 29 5d 29 0a 20 20 20 20 20 20 28 69 tr)))]). (i 0370: 66 20 28 6f 72 20 28 65 71 76 3f 20 78 20 23 5c f (or (eqv? x #\ 0380: 6e 75 6c 29 20 28 3e 3d 20 69 20 6d 61 78 29 29 nul) (>= i max)) 0390: 0a 09 20 20 28 75 74 66 38 2d 3e 73 74 72 69 6e .. (utf8->strin 03a0: 67 20 28 75 38 2d 6c 69 73 74 2d 3e 62 79 74 65 g (u8-list->byte 03b0: 76 65 63 74 6f 72 20 28 72 65 76 65 72 73 65 20 vector (reverse 03c0: 72 29 29 29 0a 09 20 20 28 6c 6f 6f 70 20 28 2b r))).. (loop (+ 03d0: 20 69 20 31 29 20 28 63 6f 6e 73 20 28 63 68 61 i 1) (cons (cha 03e0: 72 2d 3e 69 6e 74 65 67 65 72 20 78 29 20 72 29 r->integer x) r) 03f0: 29 29 29 29 29 0a ))))).