#lang racket/gui

;;; multi-dimensional arrays
(require srfi/25)

(define cell-editor-admin%
  (class editor-admin%
    (init-field grid row column editor)
    
    (super-new)

    (define/public (redraw-editor)
      (send editor
	    refresh
	    0 0
	    (send grid get-cell-pixel-width) (send grid get-cell-pixel-height) 
            (if (eq? this (get-field active-admin grid))
		'show-caret
		'no-caret)
            #f))
    
    (define/override (get-dc (x #f) (y #f))
      (when x (set-box! x (- -2 (send grid column->x column))))
      (when y (set-box! y (- -2 (send grid row->y row))))
      (send grid get-dc) )
    
    (define/override (get-max-view x y w h (full? #f))
      (get-view x y w h full?))
    
    (define/override (get-view x y w h (full? #f))
      (when x (set-box! x 0))
      (when y (set-box! y 0))
      (when w (set-box! w (send grid get-cell-pixel-width)))
      (when h (set-box! h (send grid get-cell-pixel-height))) )

    ))

(define grid%
  (class canvas%
    (init parent)
    (init-field nr-rows nr-columns width height)
    
    (define (cell-char-width) 5)
    (define (cell-char-height) 1)
    
    (super-new (parent parent) (stretchable-width #f) (stretchable-height #f))
    
    (define dc (send this get-dc))
    
    (define char-width-scale 1)
    (define char-height-scale 1.3)
    (define (char-width) (inexact->exact (ceiling (* (send dc get-char-width) char-width-scale))))
    (define (char-height) (inexact->exact (ceiling (* (send dc get-char-height) char-height-scale))))
    
    (display "char-width: ") (displayln (char-width))
    (display "char-height: ") (displayln (char-height))
    
    (define (cell-pixel-width) (* (cell-char-width) (char-width)))
    (define (cell-pixel-height) (* (cell-char-height) (char-height)))
    (define (cell+border-pixel-width) (+ (cell-pixel-width) 1))
    (define (cell+border-pixel-height) (+ (cell-pixel-height) 1))
    
    (define/public (get-cell-pixel-width) cell-pixel-width)
    (define/public (get-cell-pixel-height) cell-pixel-height)
    
    (define window-width (+ 1 (* width (cell+border-pixel-width))))
    (define window-height (+ 1 (* height (cell+border-pixel-height))))
    
    (display "window-width: ") (displayln window-width)
    (display "window-height: ") (displayln window-height)
    
    ;;; set window size
    (send this min-width window-width)
    (send this min-height window-height)
    
    (define (x->column x)
      (inexact->exact (floor (/ x cell+border-pixel-width))))
    (define (y->row y)
      (inexact->exact (floor (/ y cell+border-pixel-height))))
    (define/public (column->x column)
      (* column (cell+border-pixel-width)))
    (define/public (row->y row)
      (* row (cell+border-pixel-height)))

    (define/override (on-paint)
      ;;; draw grid contents
      (for* ((h (in-range 0 height))
             (w (in-range 0 width)) )
        (send (array-ref admins h w) redraw-editor) ) )

    (define admins (make-array (shape 0 height 0 width)))
    
    (for* ((h (in-range 0 height))
           (w (in-range 0 width)) )
      (define editor (new text%))
      (define admin (new cell-editor-admin% (grid this) (editor editor) (row h) (column w)))
      (array-set! admins h w admin)
      (send editor set-admin admin) )
    
    (field (active-admin (array-ref admins 0 0)))

    ))

(define root (new frame% (label "Grid Test")))

(define grid
  (new grid%
       (parent root)
       (nr-rows 4) (nr-columns 5)
       (width 5) (height 1)
       ))

(send root show #t)