(require "Tk-classes")
(require "Canvas")
(require "balloon")
(require "matrix-frame")

;----------------------------------------------------------------------
; *link:matrix-view-table*:global hash table used to look up <matrix-view> 
;			  objects by name
;
(define *link:matrix-view-table* (make-hash-table))
;----------------------------------------------------------------------

(define *link:default-matrix-view-title* "LINK: matrix view")
(define *link:current-matrix-view* #f)

(define (create-matrix-rows m mv)
	  (create-matrix-rows-aux m mv 0)
)

(define (create-matrix-rows-aux m mv rnum)
	(cond ((= rnum (matrix-rows m)) '())
	       (#t (cons (make <matrix-frame> 
				:matrix m 
				:parent (slot-ref mv 'matrix-toplevel)
				:row-or-col 'row
				:index rnum)
			  (create-matrix-rows-aux m mv (+ rnum 1))))))

(define-class <matrix-view> (<Tk-composite-widget>)
  ((matrix-toplevel)   ;the <toplevel> object associated with this <matrix-view>
   (name		:accessor name)
   (rows		:accessor rows)
   (matrix		:accessor matrix :init-keyword :matrix)
   (title			:accessor title
				:init-keyword :title
				:allocation :propagated
				:propagate-to (matrix-toplevel))
))

(define-method initialize ((self <matrix-view>) initargs)
  (next-method)
  (let* ((m2         (get-keyword :matrix initargs ""))
	 (m          (matrix-copy m2))
         (rows       (matrix-rows m))
         (cols       (matrix-cols m)))
    (slot-set! self 'matrix m)
    (slot-set! self 'matrix-toplevel (make <toplevel> 
			:title *link:default-matrix-view-title*))
    (slot-set! self 'name (my-gensym "matrix-view"))
    (hash-table-put! *link:matrix-view-table* (slot-ref self 'name) self)
    (hash-table-put! *link:matrix-view-table* m self)
    (slot-set! self 'rows (create-matrix-rows m self))
    (map pack (slot-ref self 'rows))
    (set! *link:current-matrix-view* self)
    )
)

(define (current-matrix-view) *link:current-matrix-view*)

(define-generic matrix-view?)
(define-method matrix-view? ((v <matrix-view>)) #t)
(define-method matrix-view? ((v <top>)) #f)

(define-generic show-matrix)
(define-method show-matrix ((m <matrix<double>>))
	(let ((mv (make <matrix-view> :matrix m)))
		mv))

(define (update-element mv i j)
	(let*((f (list-ref (slot-ref mv 'rows) i))
	      (s (list-ref (slot-ref f 'square-list) j)))
	   (slot-ref s 'value)))

(define (get-row mv i) 
	(list-ref (slot-ref mv 'rows) i))

(define (get-matrix-square mv i j) 
	(get-square (get-row mv i) j))

(define (update-row mv i)
	(update-row-aux mv i 0)
)

(define (update-row-aux mv i j)
	(cond ((= j (matrix-cols (slot-ref mv 'matrix))) '())
	      (#t (update-element mv i j) (update-row-aux mv i (+ j 1)))))

(define (update-matrix-view mv)
	(update-matrix-view-aux mv 0)
)

(define (update-matrix-view-aux mv i)
	(cond ((= i (matrix-rows (slot-ref mv 'matrix))) '())
	      (#t (update-row mv i) (update-matrix-view-aux mv (+ i 1)))))

(provide "matrix-view")
