\ constant & variable declarations

decimal

defer quit-spread  ' abort is quit-spread

100 constant row_max			\ # of spreadsheet rows
 26 constant col_max			\ # of spreadsheet columns
 13 constant column-width		\ Distance from one column to the next
  8 constant menu-column-width
  3 constant row_org			\ row origin of data on display

 20 constant row_name_len		\ Longest row name we will allow
 12 constant col_name_len		\ max length of column name
/cell 2* constant bytes/cell		\ # of bytes per cell

\ The basic fixed sizes are:
\ 1) the width and height of the screen
\ 2) The height of the top border - 3 lines
\ 3) The height of the bottom echo/status area - 4 lines + border = 5
\ 4) The number of data columns (cols/page)
\ 5) The width of the menu column - 6 characters
\ 6) The width of a data column - 13 character columns
\ From these parameters, the number of rows and the width of the row labels
\ is calculated.

: from-bottom	( offset -- line# )	#lines swap -  ;
: from-right	( offset -- col# )	#columns swap -  ;
: cols/page	( -- cols )
	#columns  row_name_len - menu-column-width - row_org  - column-width / ;

: row_org+	( n -- n' )		row_org +  ;
: rows/page	( -- n )		5 from-bottom row_org -  ;
: column*	( column# -- position )	column-width *  ;
: col_org+	( offset -- n )
	menu-column-width  cols/page column* +  from-right  + ;

\ constant & variable declarations

variable mode_flag	\ auto calculate flag
variable order_flag	\ calculation order flag
variable format_flag	\ number output format flag

variable cur_col	\ top left display col #
variable cur_row	\ top left display row #
variable col_disp	\ col displacement from
			\ cur_col on display
variable row_disp	\ row displacement from
			\ cur_row on display


: column	( -- n )	cur_col @  ;
: row		( -- n )	cur_row @  ;
: col-disp	( -- n )	col_disp @  ;
: row-disp	( -- n )	row_disp @  ;

\ high-level array definitions

\ create 2d array depth bytes deep, - hs 32bit cell allocation
:  array	\ ( #rows #cols depth -- )        compile time
		\ ( row#  col# -- element-addr )  run time
	create	aligned 2dup swap  , ,  * *  dup here
		swap erase  allot
	does>	dup @ 3 roll *  2 roll +  over
		cell+ @  *  + cell+ cell+ ;

\ create id string array depth characters deep
: $array	\ ( #rows depth -- )        compile time
		\ ( row#  -- string-addr )   run time
	create	dup ,  *  dup here  swap erase  allot
	does>	dup @ rot *  + cell+  ;

\ define a 2d array for spreadsheet data structure
\ each spcell contains 2 cells
\ 1 for formula execution address (if any)
\ 1 for double-number value storage.

row_max col_max  bytes/cell  array spcells

	\ define a string array for holding the row names
row_max row_name_len 2 + $array row_names

	\ define a string array for holding the col names
col_max col_name_len 2 + $array col_names

	\ misc word definitions

: d#in	\ input double # from keyboard ( -- d)
	begin	pad 1+ 20 expect  span @ pad c!
		pad number?
	until ;

:  #in	d#in drop ;			\ input single # from keyboard
					\ ( -- n)

: pos1					\ position cursor on cmd line
	0  3 from-bottom  2dup at  0 blot  at  ;

: pos2					\ position cursor on cmd line
	0  2 from-bottom  2dup at  0 blot  at  ;

: y/n                    		\ ( -- t if yes f if no )
	pos1 ." are you sure ? "	\ display msg
	skey upc [char] Y = ;		\ return flag

: mark_cell				\ mark cell on display
	2dup at  [char] < emit		\ ( row# col# -- )
	swap column-width + 2 - swap at
	[char] > emit ;			\ mark like "<      >"

: unmark_cell		\ unmark cell on display
	2dup at   space			\ ( row# col# -- )
	swap column-width + 2 - swap at  space ;	\ remove    "<      >"

: cell_ptr		\ returns address of cell pointed
	row row-disp +			\ at by <  > display marker
	column col-disp +		\ ( -- cell addr)
	spcells  ;

: cal_cell_disp_loc     		\ calculation location on display
	col-disp column* col_org+	\ of cell display markers
	row-disp  row_org+  ;		\ ( -- col row )

: place_cell_marker			\ place cell marker around cell
	cal_cell_disp_loc  mark_cell  ;

: erase_cell_marker			\ erase cell marker around cell
	cal_cell_disp_loc  unmark_cell  ;

: (fd.)
	tuck dabs			\ dollar/cents formatting word
	<# # # [char] . hold #s rot	\ formats double # on tos
	sign  [char] $ hold #> ;	\ prints leading $

: fd.r                                  \ ( d width -- )
	>r  (fd.)  r>			\ format d# in dollars/cents in
	over - spaces type  ;		\ right-justified field width w
                         

: format#				\ format double number in one of
	format_flag @			\ two formats
	if    10 fd.r			\ dollars/cents
	else  10  d.r			\ integer
	then  ;

\  display word definitions

: dis_data				\ display all cell data
	column cols/page bounds			\ Column bounds
	do	i col_max = ?leave		\ if past last possible column
		row rows/page bounds		\ Row bounds
		do	i row_max = ?leave	\ if past last possible row
			j column - column* col_org+ 1+
			i row -  row_org+ at
			i j spcells cell+ @ s>d format#
		loop				\ loop for all data displayed
	loop ;

\ display spreadsheet borders on the screen

: dis_border					\ display spreadsheet borders
	rows/page 0
	do	-1 col_org+ i row_org+ at  cols/page 0
		do	[char] | emit  column-width 1- spaces
		loop	[char] | emit
	loop
	0  -1 row_org + at	#columns 0  ?do  [char] - emit  loop
	0 rows/page row_org+ at	#columns 0  ?do  [char] - emit  loop  ;

\ display spreadsheet menu of options on right side of display

: next-row	( col row -- col row+1 )	2dup at  1+ ;
: dis_menu
	menu-column-width from-right  0 row_org+
	next-row ." menu:"
	next-row ." C)ol"    next-row ." A)gain"
	next-row ." D)ata"   next-row ." E)qu"
	next-row ." F)orm"   next-row ." G)oto"
	next-row ." M)ode"   next-row ." N)ew"
	next-row ." O)rder"  next-row ." P)erf"
	next-row ." Q)uit"   next-row ." R)ow"
        next-row ." S)pread"
	2drop ;

: dis_row_labels				\ label the rows on display
	row rows/page bounds			\ label from cur_row
	do	i row_max = ?leave		\ for rows/page lines or until row_max
		-3 col_org+ i row - row_org+ at	\ format in decimal #s
		i 2 .r
	loop  ;

: dis_row_names					\ label row names from array
	row rows/page bounds			\ only show names that fit on
	do	i row_max = ?leave		\ display
		0 i row - row_org+ at		\ place cursor at location
		i row_names			\ type required characters
		count dup >r type  row_name_len r> - spaces
	loop ;

: dis_col_labels				\ label the columns on display
	column cols/page bounds			\ label from cur_col
	do	i col_max = ?leave		\ for cols/page cols   or until col_max
						\ format in alphabetic chars
		i column - column*  col_org+ column-width 2/ +
		-1 row_org+  at  i [char] a + emit
	loop ;

: dis_col_names					\ label row names from array
	1 1 at ." title"			\ only show names that fit on
	column cols/page bounds			\ display
	do	i col_max = ?leave
		i column - column* col_org+	\ place cursor at location
		1 at  i col_names ".		\ type required # of characters
	loop ;

: dis_status					\ display spread sheet status
	60 from-right  4 from-bottom at ." position: "
	row row-disp + 2 .r  column col-disp + [char] a + emit
	30 from-right  4 from-bottom at ." mode: " mode_flag @
	if ." auto  " else ." normal"  then
	10 from-right  4 from-bottom at ." order: " order_flag @
	if ." c/r"    else ." r/c"     then
	pos2  place_cell_marker			\ place cell marker on display
	pos1  ." command: " ;			\ output command prompt

: dis_row_change				\ display into that changes with
	dis_row_names				\ a row change
	dis_row_labels				\ row names, labels and data
	dis_data ;

: dis_col_change				\ display into that changes with
	dis_col_names				\ a col change
	dis_col_labels				\ col names, labels and data
	dis_data ;

create application-name here  20 allot 20 erase
	p" noname" application-name "copy

: dis_screen		\ display spreadsheet screen
	erase-screen  31 0 at
	." Forth Spreadsheet"	\ display title
	3 spaces application-name ". 10 spaces
	dis_border		\ draw borders
	dis_menu		\ display operation menu
	dis_col_labels		\ label columns (a-z)
	dis_col_names		\ display column names
	dis_row_labels		\ label rows    (0-99)
	dis_row_names		\ display row names
	dis_data		\ display appropriate data
				\ for data window on display
	dis_status  ;		\ display status

\ cell calculation words

: calculate			\ calc formula of cell if it has one
	@ ?dup if execute then  ; ( cell addr --)

: calc_c/r			\ calc column then rows
	row_max 0
	do	col_max 0
		do	j i spcells calculate
		loop		\ get and execute formula
	loop  ;

: calc_r/c			\ calc rows then columns
	col_max 0
	do	row_max 0
		do	i j spcells calculate
		loop		\ get and execute formula
	loop  ;

: calc_cells			\ determine which to cal first
	order_flag @		\ by state of order_flag
	if calc_c/r else calc_r/c then ;

: calc_order			\ prompt user for calc order
	pos1 ." specify calculation order"
	pos2 ." row/col(0) or col/row(1): "
	skey  [char] 1 =  order_flag ! ;

\ cell marker positioning words

: left_arrow				\ move cell marker left 1 cell
	col-disp 0=			\ cell mark at left of display ?
	if	column 0<>		\ if so is it at first column  ?
		if	-1 cur_col +!	\ move display column left once
			dis_col_change	\ scroll display left
		then			\ if at first column ignore
	else				\ cell mark not at left column
		erase_cell_marker	\ erase current mark
		-1 col_disp +!		\ move left without scroll
	then				\ of display
	place_cell_marker ;		\ draw new cell marker

: right_arrow				\ move cell marker right 1 cell
	col-disp cols/page 1- =		\ marker in rightmost cell ?
	if	column cols/page + col_max <>	\ if so is it the last cell (z)?
		if	1 cur_col +!	\ move display column right once
			dis_col_change	\ scroll right
		then			\ if mark at col z   ignore
	else				\ if mark not rightmost
		erase_cell_marker	\ column of display move it
		1 col_disp +!		\ right one cell without
	then				\ scroll
	place_cell_marker ;		\ draw new cell marker

: up_arrow				\ move cell marker up 1 cell
	row-disp 0=			\ is cell at top display pos.  ?
	if	row 0<>			\ if so are we at the top of
		if	-1 cur_row +!	\ the spreadsheet ?
					\ if not move up a
			dis_row_change	\ cell and scroll upwards
		then			\ if already at top  ignore
	else				\ if mark not at top of display
		erase_cell_marker       \ erase mark
		-1 row_disp +!          \ move up one cell
	then
	place_cell_marker ;             \ draw new cell marker

: down_arrow				\ move cell marker down 1 cell
	row-disp rows/page 1- =		\ are we at bottom of display ?
	if	row rows/page + row_max <>	\ if so are we on last row  ?
		if	1 cur_row +!	\ if not move down one cell
			dis_row_change	\ scroll downwards
		then			\ if at last row     ignore
	else				\ if not at bottom of display
		erase_cell_marker	\ erase cell mark
		1 row_disp +!		\ move down one cell
	then
	place_cell_marker ;             \ draw new cell marker

fload spread/algebra.fth



\ input words
: input_row_names			\ input row names
	pos1 ." input row names"	\ display command prompt
	pos2 ." starting with row: "	\ get starting row#
	#in  0 max  row_max 1- min  cur_row !
	dis_row_change
	row_max row			\ store in cur_row.  from there
	do	pos2			\ till last row input names
		." row "  i 2 .r ." : "	\ display row #
		i row_names dup char+ row_name_len expect
		span @ swap c!
		span @ 0= ?leave	\ if just <cr> then exit loop
		i 5 mod 0=		\ every 5 names scroll display
		if	i cur_row !	\ new cur_row change display
			dis_row_change	\ else only change the
		else	dis_row_names
		then			\ display row names
	loop  ;

: input_col_names			\ input col names
 	pos1 ." input col names"		\ display command prompt
 	pos2 ." starting with col: "	\ get starting col#
 	skey upc [char] A -  0 max  col_max 1- min  cur_col !
 	dis_col_change
 	col_max column			\ store in cur_col.  from there
 	do	pos2			\ till last col input names
		." col " i [char] a + emit ." : "	\ display col #
		i col_names dup char+ col_name_len	\ get address in col_name array
		expect span @ swap c!		\ clear it and then input
		span @ 0= ?leave		\ if just <cr> then exit loop
		i cols/page mod 0=		\ every cols/page names scroll display
		if	i cur_col !		\ new cur_col change display
			dis_col_change
		else	dis_col_names
		then
	loop  ;

: get#					\ get # scale if needed
	#in				\ get int from operator
	format_flag @			\ dollars/cents format ?
	if	dpl @ 3 min		\ if so scale accordingly
		case	-1 of 100 *	endof
			 0 of 100 *	endof
			 1 of 10 *	endof
			 2 of		endof
			 3 of 10 /	endof
		endcase
	then ;
     
: input_cell_data			\ input data to cell
	pos1 ." input cell data"	\ prompt for data entry
	pos2 ." data: "  get#		\ get data
	cell_ptr cell+ !		\ and store it
	mode_flag @			\ get mode flag
	if	pos2 ." calculating"	\ if auto-calculate mode
		calc_cells		\ selected then calculate
	then				\ all cell data
	dis_data ;			\ show the new data

\ create linebuf   256 allot
\ create input-buf 256 allot
: input_equ	( -- )
	astring astring locals| linebuf input-buf |
	pos1  ." Input Cell Equation - Example:  3 d + 5 f"
	pos2  ." Equation: "
	p" : equation a[ " linebuf "copy
	input-buf char+  #columns 10 - 200 min  expect  span @ input-buf c!	input-buf linebuf "cat
	p"  ]a [ cell_ptr cell+ ] literal ! ;  last @ name> cell_ptr !" 	linebuf "cat
	algebra linebuf count 2dup lower eval forth ;

fload spread.commands.fth

\ main program

forth definitions

: spreadsheet			\ main program word
	also spread also
	warning off
	dis_screen		\ show screen
	begin			\ execute control or command key
		skey upc
		kill-screen
		dispatch
		dis_status	\ display new status
	again ;			\ do forever

here marker token!
	\ Remember the address of the end of the dictionary
	\ formulas are constructed as headerless colon
	\ definitions beyond this point.
	\ new uses forget_to_mark to forget back to
	\ this point.

only forth also definitions
