#lang scheme/gui (provide heap-viz%) (define row-size 10) (define heap-viz<%> (interface () update-view)) (define font (make-object font% 14 'default)) (define cell% (class message% [init-field (value 'undefined)] (inherit set-label) (super-new [label (format "~a" value)]) (define/public (set-value v) (set! value v) (set-label (format "~a" v))) (define/public (get-value) value))) (define dummy-string "undefined") (define heap-viz% (class* object% (heap-viz<%>) (init-field heap-vec) (define size (vector-length heap-vec)) (define frame (parameterize ([current-eventspace (make-eventspace)]) (new frame% [width 320] [height 240] [label "Heap"]))) (send frame show true) (define v-pane (new vertical-pane% [parent frame])) (define top (new horizontal-pane% [parent v-pane] [alignment '(center center)])) (define top-labels (build-list (add1 row-size) (lambda (i) (new message% [parent top] [label dummy-string])))) (send (first top-labels) set-label "") (for-each (lambda (m i) (send m set-label (number->string i))) (rest top-labels) (build-list row-size (λ (v) v))) (define h-panes (build-vector (quotient (+ row-size size -1) row-size) (lambda (i) (let* ([pane (new horizontal-pane% [parent v-pane])] [header (new message% [parent pane] [label dummy-string])]) (send header set-label (number->string (* i row-size))) pane)))) (define heap (build-vector size (lambda (i) (new cell% [parent (vector-ref h-panes (quotient i row-size))])))) (define/public (update-view #:location loc) (send (vector-ref heap loc) set-value (vector-ref heap-vec loc))) (super-new)))