private/gc-gui.ss
#lang scheme/gui
(provide heap-viz%)

(define row-size 10)

(define heap-viz<%> (interface () update-view))

(define font (make-object font% 14 'default))

(define dummy-string "undefined")

(define cell%
  (class message%
    (init-field [value 'undefined])
    (inherit set-label)
    (define/public (set-value v)
      (set! value v)
      (set-label (format "~a" v)))
    (define/public (get-value) value)
    (super-new [label dummy-string])
    (set-label (format "~a" value))))

(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"])))
    
    (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] [stretchable-width #t]))))
    
    (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] [stretchable-width #t])]
                [header (new message% [parent pane] [label dummy-string]
                             [stretchable-width #t])])
           (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))]
                                          [stretchable-width #t]))))
    
    (new grow-box-spacer-pane% [parent frame])
    (send frame show true)
    
    (define/public (update-view #:location loc)
      (send (vector-ref heap  loc) set-value (vector-ref heap-vec loc)))
    
    
    (super-new)))