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)))