Better control over buffer label, select by nibble not byte

scmvm.scm

@@ -4,6 +4,7 @@ exec guile -L . -e main -s "$0" "$@"
 (use-modules (rnrs bytevectors)
              (ice-9 binary-ports)
              (ice-9 format)
+             (srfi srfi-11)
              (srfi srfi-26)
              (srfi srfi-43)
              (scmvm vm)
@@ -40,7 +41,19 @@ exec guile -L . -e main -s "$0" "$@"
 (define %vm (make-vm #:memory-size 100))
 (define %program #f)
 (define %buffer-label #f)
-(define %selected-byte 0)
+(define %selected-nibble 0)
+
+(define (nibble->byte+offset x)
+  (values (quotient x 2)
+          (remainder x 2)))
+
+(define (format-nibble val offset)
+  (string-upcase
+   (number->string
+    (if (zero? offset)
+        (ash val -4)
+        (logand val #x0F))
+    16)))
 
 (define (load-binary port)
   (set! %program port))
@@ -49,15 +62,25 @@ exec guile -L . -e main -s "$0" "$@"
   (when %buffer-label
     (define ram (vm-memory %vm))
     (define text
-      (vector-fold
-       (lambda (i s byte)
-         (string-append
-          s
-          (if (and (is-focus (get-parent %buffer-label)) (= %selected-byte i))
-              (format #f "<span background=\"lightblue\">~:@(~2'0x~)</span> " byte)
-              (format #f "~:@(~2'0x~) " byte))))
-       ""
-       ram))
+      (let-values ([(byte offset) (nibble->byte+offset %selected-nibble)])
+       (vector-fold
+        (lambda (i s val)
+          (string-append
+           s
+           (cond
+            [(or (not (is-focus (get-parent %buffer-label)))
+                 (not (= i byte)))
+             (format #f "~:@(~2'0x~) " val)]
+            [(= offset 0)
+             (format #f "<span background=\"lightblue\">~a</span>~a "
+                     (format-nibble val 0)
+                     (format-nibble val 1))]
+            [(= offset 1)
+             (format #f "~a<span background=\"lightblue\">~a</span> "
+                     (format-nibble val 0)
+                     (format-nibble val 1))])))
+        ""
+        ram)))
     (set-markup %buffer-label text)))
 
 (define (open-file win cb)
@@ -106,7 +129,7 @@ exec guile -L . -e main -s "$0" "$@"
                         #:wrap #t
                         #:focusable #t))
   (set-can-focus %buffer-label #t)
-  (set! %selected-byte 0)
+  (set! %selected-nibble 0)
   (define frame (make <gtk-frame>
                   #:focusable #t))
   (define buffer-controller (make <gtk-event-controller-key>))
@@ -114,9 +137,8 @@ exec guile -L . -e main -s "$0" "$@"
   (connect buffer-controller 'key-pressed handle-key-event)
   (set-child frame %buffer-label)
   (append box frame)
+  (grab-focus frame)
   (update-memory-view!)
-  ;(connect win 'move-focus move-focus) ; TODO needs some sort of return value
-
   
   (append box (make <gtk-button>))
   (append box (make <gtk-button>))
@@ -129,13 +151,26 @@ exec guile -L . -e main -s "$0" "$@"
   #t)
 
 (define (handle-key-event e val code mod)
-  (if
-   (case (string->symbol (gdk-keyval-name val))
-     [(Left) (set! %selected-byte (max (1- %selected-byte) 0)) #t]
-     [(Right) (set! %selected-byte (min (1+ %selected-byte) 99)) #t]
-     [else #f])
-   (begin (update-memory-view!) #t)
-   #f))
+  (let ([val (gdk-keyval-name val)])
+    (if
+     (cond
+       [(string= val "Left")
+        (set! %selected-nibble (max (1- %selected-nibble) 0))
+        #t]
+       [(string= val "Right")
+        (set! %selected-nibble (min (1+ %selected-nibble) 199))
+        #t]
+       [(string->number val 16)
+        (let-values ([(byte offset) (nibble->byte+offset %selected-nibble)]
+                     [(val) (string->number val 16)])
+          (vm-memory-set! %vm byte
+                          (if (zero? offset)
+                              (+ (logand (vm-memory-ref %vm byte) #x0f) (ash val 4))
+                              (+ (logand (vm-memory-ref %vm byte) #xf0) val))))
+        #t]
+       [else #f])
+     (begin (update-memory-view!) #t)
+     #f)))