;;; -*- Mode:LISP; Package:USER; Base:10; Readtable:ZL -*-

;; hack spreadsheet
;; bobp

#|
The world consists of a set of two-dimensional arrays, segments
of which may be displayed in individual windows.  Each array cell
may contain an expression, which may be a numeric or string constant
or function.  

Cells are globally named by an array name and a cell local name or cell
relative or absolute array index, or locally named by a cell name or
array index.  Cell local names map into single cells, vectors, or
two-dimensional subsets of arrays.

Cell expression contents:
  Numeric constant, any valid lispm data type:
    Evaluates to itself; required for use in numeric expressions.
  String constant (art-string array):
    Evaluates to itself; causes error if referenced by numeric expression.
    Intended primarly for display of spreadsheet labels, but can also
    be referenced in expressions that expect a string.
  List:
    Eval is called.  May contain any valid Lisp expression that evaluates
    to a number or string.  
  FEF:
    Funcall.
  Forwarding:
    May reference an expression from another cell, as opposed to
    copying a value computed by another cell.

Referencing spreadsheet data:
simplest:
  (aref foo-array indices ...)
  Not capable of returning a sub-array (anything bigger than one cell).
better:
  (sref foo-array row-range col-range)
  Foo-array may be an array name, or nil for self.
  Row-range and col-range may be numbers, which may be integer constants
   or symbols that evaluate to constants, or a list of (from-index to-index),
   where from-index and to-index evaluate to constants or NIL for the
   lower and upper limits of the array, or the constant NIL for both
   limits of the array.
Examples:
  (+ 3 4) -> 7
  (- (sref gross

Editing / Entry:
  Two paths: cells and zmacs.
    Expressions can be entered as cell contents; the expressions can
    call arbitrary Lisp functions.  The functions are indepently
    managed in a separate editor buffer.
  Creating arrays:
  Creating windows:
  Defining functions:

Internal structure:
  Defstruct for arrays, with header info containing names and sizes.
  Symbol table for each array is attached in array header;
  maps names to zero, one and two-dimensional sub-arrays.
  List of functions from editor buffer.
alt: 3-dim array: 2 dimensions for row/col; 3rd has fixed slots
  for (0) expression, (1) timestamp, (2) names defined here,
    (3) display mode (format string), (4) my-index.

Loading / Saving:
  Arrays are dumped in ASCII list form, the same as in expression mode.
  List for an array has header that specifies names and sizes,
  including symbol table for names defined within.
  LISP functions saved in ASCII format, compiled as loaded?

Display capabilities:

Arbitrary windows, managed by existing system code.  Each window
shows a subset of a spreadsheet array.  For each window, the
contents of the array may be displayed as the unevaluated expressions,
or as the computed values.

Normal display mode is value, where each cell is evaluated and the
result is displayed.  Expression mode displays the cell contents
unevaluated.  Expression editing is normally done in value mode, in
which the expression for the currently selected cell is displayed in an
editor buffer.

Each array may be displayed by an arbitrary number of windows, but
each window may only display a contiguous two-dimentional subset of
one array.

Computation heirachy:

Default: For each cell, if not valid, evaluate it (recursive).
  References to other cells cause them to eval.
  What about recursive references?

Input: When one cell changes, invalidate (recursively) all cells that
  depend on it.  Every reference to a cell attaches a pointer from that
  cell to the cell that references it.  Pointers must be kept consistent
  when editing expressions.

Modes: Evaluate on every cell change vs. eval on command.

|#


(defstruct (cell :conc-name
		 (:type :named-array)
		 (:constructor make-cell
			       (sheet row col))
		 )
  expr          ;;cell expression
  value         ;;value computed from expression
  sheet         ;;sheet (array) this cell is in
  row           ;;index of this cell in its array
  col
  time          ;;timestamp: value is valid if time matches global timestamp
  names         ;;list of names defined here
  (format dfl-format)  	;;display format string (one-shot value, or ptr to a shared value)
  dependents	;;list of cells that reference this one
  )


(defstruct (window (:conc-name "WIN-")
		   (:type :named-array)
		   (:constructor make-window
				 (sheet &optional start-col start-row mode))
		   )
  sheet	  	;;window displays from this array
  (start-col 0)	;;top-left corner starts displaying here
  (start-row 0)	;;
  (mode :value)	;;display mode; :value, :expr or :format
  )

;;only one of these per array
(defstruct (sheet :conc-name
		  (:type :named-array)
		  (:constructor make-empty-sheet))
  name          ;;name of this sheet
  nrows
  ncols
  array         ;;2-dim array for this sheet
  width         ;;array of column widths
  )

(defvar timestamp t)

(defun setup ()
  (setq sheet (make-sheet "world" 20 10))
  (setq window (make-window sheet))
  )

(defvar sheet nil)
(defvar window nil)

(defvar main-window (make-window))

(defvar dfl-width 10.)
(defvar dfl-format "~d")
(defvar format-format "~a")
(defvar expr-format "~a")

;;evaluate a cell
(defun cell-eval (cell)
  (if (eq (cell-time cell)
	  timestamp)
      (cell-value cell))
  (let* ((expr (cell-expr cell))
	 (value
	   (typecase expr
	     (null		;;empty cell is zero
	      0)
	     (number		;;number evaluates to itself
	      expr)
	     (string		;;string evaluates to itself
	      expr)
	     (list		;;list is an expression to apply or eval
	      ;(if (functionp (car expr))
		;  (apply (car expr) (cdr expr))
	      (eval expr))
	     (compiled-function
	      (funcall expr))
	     )
	   ))
    (setf (cell-time cell) timestamp)
    (setf (cell-value cell) value)))

;;display a window into an array
(defun redisplay (w)
  (let ((sheet (win-sheet w)))
    (send sw :clear-screen)

    ;;display command menu
    (print-cmd-menu w)

    ;;display column headers
    (format sw "~&    ")
    (do ((col (win-start-col w) (1+ col)))
	((= col (sheet-ncols sheet)))
      (send sw :item 'column-header (list w col)
	    "~Vd" (or (aref (sheet-width sheet) col) dfl-width) col)
      )
    
    ;;display each row
    (do ((row (win-start-row w) (1+ row)))
	((= row (sheet-nrows sheet)))
      (send sw :item 'row-header (list w row)
	    "~&~3d " row)
      
      ;;display each column
      (do ((col (win-start-col w) (1+ col)))
	  ((= col (sheet-ncols sheet)))
	(let ((cell (aref (sheet-array sheet) row col)))
	  (cond
	    (cell
	     (cell-eval cell)
	     (send sw :item 'cell (list w cell)
		   "~a" (cell-string cell w))
	     )
	    (t
	     (send sw :item 'empty-cell (list w row col)
		   "~V@T" (or (aref (sheet-width sheet) col) dfl-width)))
	    )
	  ))
      )))

(defun print-cmd-menu (w)
  (dolist (c cmd-list)
    (send sw :item (cadr c) (list w)
	  "~20a" (car c))))

;;return the actual string to print, already adjusted to the correct width.
;;the window indicates how long the string should be.
(defun cell-string (cell w)
  (let ((output-string
	  (cond
	    ((null cell)
	     "")
	    (t
	     (selectq (win-mode w)
	       (:value
		(format nil (cell-format cell) (or (cell-value cell) "")))
	       (:expr
		(format nil expr-format (or (cell-expr cell) "")))
	       (:format
		(format nil format-format (or (cell-format cell) "")))
	       (t
		(format nil "win-mode ~s" (win-mode w)))))
	    )))
    (let ((len (length output-string))
	  (max-len (or (aref (sheet-width (win-sheet w)) (cell-col cell)) dfl-width)))
      (if (> len max-len)
	  (substring output-string 0 max-len)
	(format nil "~V@t~a" (- max-len len) output-string))
      )))

;;;;;;;;;;;;;;;;

(defun make-sheet (name nrows ncols)
  (let ((sheet (make-empty-sheet)))
    (setf (sheet-name sheet) name)
    (setf (sheet-nrows sheet) nrows)
    (setf (sheet-ncols sheet) ncols)
    (setf (sheet-array sheet) (make-array `(,nrows ,ncols)))
    (setf (sheet-width sheet) (make-array ncols))
    sheet
    ))

(defun change-sheet-dimensions (sheet nrows ncols)
  (let ((new-array (make-array nrows ncols))
	(new-width (make-array ncols)))
    (dotimes (c (min ncols (sheet-ncols sheet)))
      (dotimes (r (min nrows (sheet-nrows sheet)))
	(setf (aref new-array r c) (aref (sheet-array sheet) r c)))
      (setf (aref new-width c) (aref (sheet-width sheet) c))
      )
    (setf (sheet-array sheet) new-array
	  (sheet-width sheet) new-width
	  (sheet-nrows sheet) nrows
	  (sheet-ncols sheet) ncols)
    ))

;;;;;;;;;;;;;;;;

;;(defflavor ss-window
;;	 ()
;;	 (tv:basic-mouse-sensitive-items
;;	  tv:process-mixin
;;	  tv:window))
;;
;;(defvar sw nil)					;spreadsheet window

(defvar *ss-command-alist* nil)


(defun setup-sw ()
  (if sw
      (send sw :set-item-type-alist *ss-command-alist*)
    (setq sw (make-instance 'ss-window
			    :item-type-alist *ss-command-alist*)))
  nil)
    
;;;;;;;;;;;;;;;;

(defun top-level-loop ()
  (do-forever
    (redisplay window)
    (let ((blip (send sw :any-tyi)))
      (typecase blip
	(list
	 (cond
	   ((eq (car blip) :typeout-execute)
	    (apply (cadr blip) (if (listp (caddr blip)) (caddr blip) (list (caddr blip)))))
	   (t
	    (ferror nil "blip was ~s" blip))
	   ))
	(t
	 (ferror nil "blip was ~s" blip))
	))
    ))

;;;;;;;;;;;;;;;;

;;selecting menu command
;;args: (window command-function)

;;display mode: value, expr, format
;;recompute on, off; recompute
;;page left, right, up, down

(defvar cmd-list '(("Display Values" disp-values)
		   ("Display Expressions" disp-expr)
		   ("Display Formats" disp-format)
		   ("Recompute Off" recomp-off)
		   ("Recompute On" recomp-on)
		   ("Recompute" recomp)
		   ("Home" home)
		   ("Page Left" page-left)
		   ("Page Up" page-up)
		   ))

(tv:add-typeout-item-type *ss-command-alist* disp-values "Display Values"
			  cmd-disp-values t
			  "Display Cell Values")

(defun cmd-disp-values (w)
  (setf (win-mode w) :value))

(tv:add-typeout-item-type *ss-command-alist* disp-expr "Display Expressions"
			  cmd-disp-expr t
			  "Display Cell Expressions")

(defun cmd-disp-expr (w)
  (setf (win-mode w) :expr))

(tv:add-typeout-item-type *ss-command-alist* disp-format "Display Format"
			  cmd-disp-format t
			  "Display Cell Format Strings")

(defun cmd-disp-format (w)
  (setf (win-mode w) :format))


(tv:add-typeout-item-type *ss-command-alist* home "Home"
			  cmd-home t
			  "Home window to top-left")

(defun cmd-home (w)
  (move-window w 0 0))

;;;;;;;;;;;;;;;;

; window -> sheet -> array -> cell
; cell -> sheet

;;selecting existing cell
;;args: (window cell)

(tv:add-typeout-item-type *ss-command-alist* cell "Edit Cell" cell-cmd-edit-cell t
			  "Edit this cell")

(defun cell-cmd-edit-cell (window cell)
  (format t "~&edit cell: row=~d col=~d" (cell-row cell) (cell-col cell))
  (edit-cell cell)
  )

(tv:add-typeout-item-type *ss-command-alist* cell "Recompute Cell" cell-cmd-compute nil
			  "Compute value of this cell")

(defun cell-cmd-compute (window cell)
  (format t "~&compute cell: row=~d col=~d" (cell-row cell) (cell-col cell))
  (cell-eval cell))

(tv:add-typeout-item-type *ss-command-alist* cell "Edit Format" cell-cmd-edit-format nil
			  "Edit format string for this cell")

(defun cell-cmd-edit-format (window cell)
  (format t "~&edit cell format")
  ;;invoke editor on cell format string
  )

(tv:add-typeout-item-type *ss-command-alist* cell "Move Window" cell-cmd-move-window nil
			  "Move window to have this cell in top-left")

(defun cell-cmd-move-window (window cell)
  (move-window window (cell-row cell) (cell-col cell)))

(tv:add-typeout-item-type *ss-command-alist* cell "Blank Cell" cell-cmd-blank nil
			  "Blank this cell")

(defun cell-cmd-blank (window cell)
  (format t "~&blank cell")
  ;;follow refs to do protocol

  ;;setf this cell's array slot to nil
  (setf (aref (sheet-array (cell-sheet cell)) (cell-row cell) (cell-col cell)) nil)
  )

;;;;;;;;;;;;;;;;

;;selecting column header
;;args: (window column)

(tv:add-typeout-item-type *ss-command-alist* column-header "Change Width" col-cmd-width t
			  "Change width of this column")

(tv:add-typeout-item-type *ss-command-alist* column-header "Insert Column" col-cmd-insert nil
			  "Insert a new column here")

(tv:add-typeout-item-type *ss-command-alist* column-header "Delete Column" col-cmd-delete nil
			  "Delete this column")

;;;;;;;;;;;;;;;;

;;selecting row header
;;args: (window row)

(tv:add-typeout-item-type *ss-command-alist* row-header "Row Header" row-cmd-nop t
			  "Do Nothing to this Row")

(defun row-cmd-nop (w row)
  (format t "~&row ~d" row))

;;;;;;;;;;;;;;;;

;;selecting empty cell
;;args: (window row col)

; create new cell and edit it

(tv:add-typeout-item-type *ss-command-alist* empty-cell "Enter New Cell" ec-cmd-empty-cell t
			  "Enter new cell")

(defun ec-cmd-empty-cell (w row col)
  (let* ((array (sheet-array (win-sheet w)))
	 (cell (make-cell (win-sheet w) row col)))
    (setf (aref array row col) cell)
    (edit-cell cell)
    ))

(tv:add-typeout-item-type *ss-command-alist* empty-cell "Move Window" ec-cmd-move-window nil
			  "Move window to have this cell in top-left")

(defun ec-cmd-move-window (w row col)
  (move-window w row col))

;;;;;;;;;;;;;;;;

;;stuff called by commands

(defun edit-cell (cell)
  (format t "~&edit cell")
  ;;invoke editor on expr string for this cell
  )


(defun move-window (window row col)
  (format t "~&move window row=~d col=~d" row col)
  (when row
    (setf (win-start-row window) row))
  (when col
    (setf (win-start-col window) col))
  )