diff --git a/scmvm.scm b/scmvm.scm
index 7325574..d88bc15 100755
--- a/scmvm.scm
+++ b/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 "~:@(~2'0x~) " 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 "~a~a "
+ (format-nibble val 0)
+ (format-nibble val 1))]
+ [(= offset 1)
+ (format #f "~a~a "
+ (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
#:focusable #t))
(define buffer-controller (make ))
@@ -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 ))
(append box (make ))
@@ -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)))