Permalink
Browse files

The memory window supports styling, such as underlining the address P…

…C points to

Removed commented out code
  • Loading branch information...
coffeyk committed Apr 10, 2012
1 parent 6c2c2c2 commit b0bb6a610b92a37d00aadddcdde393dcaa5af3c4
Showing with 34 additions and 18 deletions.
  1. +34 −12 main.rkt
  2. +0 −6 memory.rkt
View
@@ -2,17 +2,26 @@
(require racket/cmdline)
(require racket/gui/base)
+(require srfi/13)
(require "cpu.rkt")
(require "memory.rkt")
(require "registers.rkt")
-
-
+(define rows 8)
+;(define (string-pad str width [pad #\space])
+; (define field-width (min width (string-length str)))
+; (define lmargin (- width field-width))
+; (string-append (build-string lmargin (lambda (x) pad))
+; str))
+(define (hex-pad x)
+ (string-pad (format "~x" x) 4 #\0))
+(define (row-header key)
+ (string-append (hex-pad (- key (remainder key rows))) ":"))
; Make a frame by instantiating the frame% class
-(define frame (new frame% [label "Example"]))
+(define frame (new frame% [label "Baby's First DCPU16"]))
@@ -58,12 +67,13 @@
[font (make-object font% 10 'modern)]
[min-width 100]
[min-height 500]))
-(define mem-text (new text-field% [parent text-panel]
- [label "mem"]
- [min-height 500]
- [min-width 500]
- [font (make-object font% 10 'modern)]))
+(define mem-canv-text (new text%))
+(define ed-canv (new editor-canvas% [parent text-panel]
+ [min-width 400]
+ [min-height 500]
+ [style (list 'hide-hscroll)]
+ [editor mem-canv-text]))
; Show the frame by calling its show method
(send frame show #t)
@@ -73,8 +83,9 @@
(define current-mem mem)
(define current-reg reg)
- (send reg-text set-value (reg-pprint current-reg))
- (send mem-text set-value (memory-pprint current-mem))
+
+ (refresh)
+
(super-new)
(define/public (get-mem)
@@ -94,8 +105,19 @@
(define/public (refresh)
- (send reg-text set-value (reg-pprint current-reg))
- (send mem-text set-value (memory-pprint current-mem)))
+ (let ([memory-text (memory-pprint current-mem)]
+ [pc (reg-read current-reg 'PC)])
+ (send reg-text set-value (reg-pprint current-reg))
+ (send mem-canv-text erase)
+ (send mem-canv-text change-style (make-object style-delta% 'change-family 'modern))
+ (send mem-canv-text insert memory-text )
+ (let ([row-idx (string-contains memory-text (row-header pc))])
+ (if row-idx
+ (let ([offset (+ row-idx 6 (* (remainder pc 8)
+ 5))])
+ (send mem-canv-text change-style (make-object style-delta% 'change-toggle-underline)
+ offset (+ 4 offset)))
+ (void)))))
(define/public (tick)
(define mem-reg (step-cpu current-mem current-reg))
View
@@ -99,7 +99,6 @@
[last-key-row (quotient last-key rows)])
(if (empty? keys)
(string-append out-str
- ;" %"
(zero-filler (- rows last-key-idx 1))
"\n"); pad out to end of line
(let* ([key (car keys)]
@@ -114,20 +113,15 @@
(row-header key)
(zero-filler (max 0 (- key-idx 0)))
" "
- ; (hex-pad (memory-read mem key))))]
value-string))]
[(< 1 (- key-idx last-key-idx))
(pprint keys (- key 1) (string-append out-str
" "
(zero-filler (- key-idx last-key-idx 1))
- ;" "
- ;(hex-pad (memory-read mem key))))])))))
- ;(hex-pad key)))
))]
[else
(pprint (cdr keys) key (string-append out-str
" "
- ;(hex-pad (memory-read mem key))))])))))
value-string))])))))
(pprint (sort (hash-keys mem) <) 1 (row-header 0)))

0 comments on commit b0bb6a6

Please sign in to comment.