From ce8b5828ce57496efc971aec4416693a27e5bb57 Mon Sep 17 00:00:00 2001
From: Ekaitz Zarraga <ekaitz@elenq.tech>
Date: Thu, 14 Jul 2022 22:08:20 +0200
Subject: Key handling support

---
 bytepusher.scm | 74 +++++++++++++++++++++++++++++++++++++++++-----------------
 1 file 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)
-- 
cgit v1.2.3