diff options
| -rw-r--r-- | bytepusher.scm | 74 |
1 files changed, 53 insertions, 21 deletions
diff --git a/bytepusher.scm b/bytepusher.scm index fde6230..81682da 100644 --- a/bytepusher.scm +++ b/bytepusher.scm @@ -1,39 +1,55 @@ (define-module (bytepusher) - #:use-module (rnrs bytevectors) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-60) #:use-module (ice-9 binary-ports) - #:use-module (sdl2) + #:use-module (rnrs bytevectors) + #:use-module (sdl2 events) + #:use-module (sdl2 image) + #:use-module (sdl2 rect) #:use-module (sdl2 render) #:use-module (sdl2 surface) - #:use-module (sdl2 events) #:use-module (sdl2 video) - #:use-module (sdl2 rect) - #:use-module (sdl2 image)) + #:use-module (sdl2) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-60)) (define width 256) (define height 256) (define scale 2) -(define keys (make-bitvector 16 #f)) +(define key-ids (make-hash-table 16)) +(hashq-set! key-ids 'x 0) +(hashq-set! key-ids '1 1) +(hashq-set! key-ids '2 2) +(hashq-set! key-ids '3 3) +(hashq-set! key-ids 'q 4) +(hashq-set! key-ids 'w 5) +(hashq-set! key-ids 'e 6) +(hashq-set! key-ids 'a 7) +(hashq-set! key-ids 's 8) +(hashq-set! key-ids 'd 9) +(hashq-set! key-ids 'z #xA) +(hashq-set! key-ids 'c #xB) +(hashq-set! key-ids '4 #xC) +(hashq-set! key-ids 'r #xD) +(hashq-set! key-ids 'f #xE) +(hashq-set! key-ids 'v #xF) (define memory (make-bytevector (* 1024 1024 16))) ;; key control ---- -(define (set-key! index) - (bitvector-set-bit! keys index)) - -(define (clear-keys!) - (bitvector-clear-all-bits! keys)) - -(define (keys->half) - (let loop ((i 0) - (acc 0)) - (if (= i (bitvector-length keys)) - acc - (loop (+ 1 i) - (+ acc (if (bitvector-bit-set? keys i) (expt 2 i) 0)))))) +(define (get-keys) + (+ (ash (get-byte (+ 1 0)) 0) + (ash (get-byte 0) 8))) + +(define (set-keys! keys) + (set-byte! 1 (ash keys 0)) + (set-byte! 0 (ash keys -8))) + +(define (press-key! index) + (set-keys! (copy-bit index (get-keys) #t))) + +(define (release-key! index) + (set-keys! (copy-bit index (get-keys) #f))) ;; ---- key control @@ -173,11 +189,27 @@ (execute! (get-pc)) (unless (= count 0) (loop (- count 1))))) +(define (handle-key! action! key) + (let ((index (hashq-ref key-ids key))) + (when index (action! index)))) + +(define (handle-events!) + (let ((event (poll-event))) + (cond + ((keyboard-down-event? event) + (handle-key! press-key! (keyboard-event-key event))) + ((keyboard-up-event? event) + (handle-key! release-key! (keyboard-event-key event))) + ((quit-event? event) + (exit 0))) + (when event (handle-events!)))) + (define (loop! renderer) (define texture (make-display-texture renderer)) (set-renderer-scale! renderer scale scale) (let loop () (let ((t0 (sdl-ticks))) + (handle-events!) (loop-frame!) (clear-renderer renderer) (load-display! texture) |