home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / GRUMCALC.PRG < prev    next >
Encoding:
Text File  |  1991-08-26  |  34.6 KB  |  1,004 lines
  1. /*
  2.    Function:  GrumpCalc()
  3.    Purpose:   Pop-up Spreadsheet
  4.    Author:    Greg Lief
  5.    Copyright (c) 1991 Greg Lief
  6.    Dialect:   Clipper 5.01
  7.    Syntax:    GrumpCalc( [<cfile>] )
  8.    Compile:   clipper grumcalc /n /w
  9.  
  10.    Parameter: <cfile> is the name of a presaved spreadsheet file to
  11.               load immediately.  If <cfile> is not used, GrumpCalc
  12.               will start you out with a blank spreadsheet.  If you
  13.               have already visited GrumpCalc, your previous spreadsheet
  14.               will be restored exactly as you left it.
  15.  
  16.    Hot-key:   You can also configure GrumpCalc() to be called by a
  17.               hot key with the command:
  18.                  SET KEY <whatever> TO grumpcalc
  19.               If you do this, GrumpCalc() will detect the presence
  20.               of the three default Clipper parameters (proc, line,
  21.               var) and will therefore neither attempt to load a
  22.               pre-saved spreadsheet file NOR prompt you to save it.
  23.               The reasoning here is that such use would be to
  24.               paste the result of a calculation into a pending GET.
  25.  
  26.    Paste:     If you have configure GrumpCalc() as a hot-key and
  27.               pop it up while you are GETting a numeric, the contents of
  28.               the current cell will be pasted into the GET upon exit.
  29. */
  30.  
  31. //───── NOTE: if you don't need Grumpcalc's context-specific help screen,
  32. //───── remove the following line of source code and recompile this file
  33. #define HELPSCREEN
  34.  
  35. //───── required header files
  36. #include "dbstruct.ch"
  37. #include "inkey.ch"
  38. #include "box.ch"
  39. #include "grump.ch"
  40. #include "setcurs.ch"
  41.  
  42. //───── basic global parameters
  43. #define COLUMNS        26             // maximum columns in spreadsheet
  44. #define ROWS           maxrow() - 4   // maximum rows in spreadsheet
  45. #define CURR_COLUMN    b:colPos - 1   // current column in spreadsheet
  46. #define CURR_CELL      nums_[ele, CURR_COLUMN]   // current cell
  47. #define NEXT_CELL      nums_[ele, b:colPos]      // cell to right of current
  48.  
  49. //───── structure of three-dimensional NUMS_ array
  50. #define CONTENTS       1
  51. #define FORMULA        2
  52. #define LINKS          3
  53. #define DEPENDENCIES   4
  54.  
  55. //───── structure of linked cell subarrays
  56. #define ROW            1
  57. #define COLUMN         2
  58. #define OPERATOR       3
  59.  
  60. //───── manifest constants for coordinates when highlighting cells
  61. #define TOP            highlight_[1]
  62. #define LEFT           highlight_[2]
  63. #define BOTTOM         highlight_[3]
  64. #define RIGHT          highlight_[4]
  65. #define HIGHLIGHTED    highlight_[5]
  66.  
  67. //───── shorthand for character strings that spill over into adjacent columns
  68. #translate SpillOver( <r>, <c> ) => valtype(nums_\[<r>, <c>, FORMULA]) == "B"
  69.  
  70. static nums_                          // master spreadsheet array
  71. static ele                            // pointer into the array
  72. static b                              // TBrowse object for spreadsheet
  73.  
  74. function GrumpCalc(cfile, nline, cvar)
  75. local bspill, c, key := 0, x, y, oldscore := set(_SET_SCOREBOARD, .f.)
  76. local nrow, ncol, nval, tagging := .f., highlight_ := { , , , , {} }
  77. local links_, ptr, coop, ccell, cbuffer    // for direct cell references
  78. local plaincolor := 'w/b', hilitecolor := 'i'  // for highlighting headings
  79. local refreshhilite := .f.
  80. local oldf10 := setkey(K_F10, NIL)         // turn off F10 key, save status
  81. local curr_get := getactive()              // for pasting into... see below
  82.  
  83. #ifdef HELPSCREEN
  84.  
  85. local oldf1 := setkey(K_F1, { || helpme() } )
  86.  
  87. #endif
  88.  
  89. default cfile to ''
  90.  
  91. //───── if only the filename was passed, attempt to load spreadsheet
  92. if cfile != NIL .and. file(cfile) .and. nline == NIL
  93.    waiton( { 'Loading from ' + cfile + '... please wait' }, .f.)
  94.    nums_ := gloadarray(cfile)
  95.    waitoff()
  96.  
  97. //───── load spreadsheet on first pass only
  98. elseif nums_ == NIL
  99.    nums_ := array(ROWS + 1, COLUMNS)
  100.    for x = 1 to ROWS
  101.       for y = 1 to COLUMNS
  102.          nums_[x, y] := { NIL, NIL, {}, {} }
  103.       next
  104.    next
  105.    //───── the last row of the array will be used to save column widths
  106.    for y = 1 to COLUMNS
  107.       nums_[ROWS + 1, y] := 10
  108.    next
  109. endif
  110. gfsaveenv(.t., 0 , 'w/b')
  111. @ 0, 0, maxrow(), maxcol() box B_DOUBLE+' '
  112.  
  113. #ifdef HELPSCREEN
  114.  
  115. @ maxrow(), maxcol() - 10 say "F1 = Help"
  116.  
  117. #endif
  118.  
  119. ele := 1
  120.  
  121. //───── configure TBrowse object on first pass only
  122. if b == NIL
  123.    b := TBrowseNew(2, 1, maxrow()-1, maxcol()-1)
  124.    b:headSep    := chr(205)
  125.    b:colSep     := ''
  126.    b:colorSpec  := "w/b, i, +w/rb, +w/r"
  127.    b:skipBlock  := { | SkipCnt | AwSkipIt(@ele, SkipCnt, ROWS) }
  128.  
  129.    //───── create initial column for letter -- non-editable
  130.    c := TBColumnNew(, { || str(ele, 2) })
  131.    c:width := 2
  132.    b:AddColumn( c )
  133.  
  134.    for x := 1 to 26
  135.       c := TBColumnNew(space(4) + chr(x + 64) + space(5), makecolumn(x))
  136.       //───── grab width from last row of the main array
  137.       c:width := nums_[ROWS + 1, x]
  138.       b:addColumn(c)
  139.    next
  140.  
  141.    //───── double-line column separator between row letter & first editable row
  142.    b:getColumn(2):colSep := chr(186)
  143.    b:autoLite := .f.
  144.    b:freeze := 1
  145.    b:colPos := 1
  146. else
  147.    //───── if already configured, force a redisplay
  148.    b:refreshAll()
  149. endif
  150.  
  151. //───── generic code block used by cells that contain spilled-over characters
  152. bspill := { |r,c| substr(nums_[r, c - 1, CONTENTS], b:getColumn(c):width + 1) }
  153. do while key != K_ESC
  154.    //───── if in first column, move them to second column
  155.    if b:colPos <= b:freeze
  156.       b:colPos := b:freeze + 1
  157.    endif
  158.    dispbegin()
  159.    do while ! b:stabilize()
  160.    enddo
  161.    nrow := row()
  162.    ncol := col()
  163.  
  164.    //───── highlight column letter at top for quick reference
  165.    @ b:ntop, col() say b:getColumn(b:colPos):heading color hilitecolor
  166.  
  167.    //───── if we just edited a cell that was on the same row as a
  168.    //───── highlighted region, we must now refresh that highlight
  169.    //───── because otherwise the current row will be dehighlighted
  170.    if refreshHilite
  171.       refreshHilite := .f.
  172.       b:colorRect( { TOP, LEFT, BOTTOM, RIGHT }, {3, 2} )
  173.    endif
  174.  
  175.    //───── higlight row number on left for quick reference
  176.    b:colorRect( { b:rowPos, 1, b:rowPos, 1 }, {2, 2} )
  177.  
  178.    //───── display current position at top left corner
  179.    @ 1,1 say "(" + chr(b:colPos + 63) + ltrim(str(ele)) + ") "
  180.  
  181.    //───── now display column width if it has been changed
  182.    if b:getColumn(b:colPos):width != 10
  183.       dispout("[W" + ltrim(str(b:getColumn(b:colPos):width)) + "] ")
  184.    endif
  185.  
  186.    //───── now display cell formula
  187.    if ! empty(CURR_CELL[FORMULA])
  188.       dispout(CURR_CELL[FORMULA])
  189.    endif
  190.  
  191.    //───── now display contents
  192.    if valtype(CURR_CELL[FORMULA]) != "B" .and. ;
  193.             ! empty(CURR_CELL[CONTENTS]) .and. ;
  194.             (empty(CURR_CELL[FORMULA]) .or. trim(CURR_CELL[FORMULA]) $ ['"^])
  195.       if valtype(CURR_CELL[CONTENTS]) == "C"
  196.          dispout(substr(CURR_CELL[CONTENTS], 1, maxcol() - col() - 1))
  197.       else
  198.          dispout(CURR_CELL[CONTENTS])
  199.       endif
  200.    endif
  201.    scroll(1, col(), 1, maxcol() - 1, 0)
  202.    setpos(nrow, ncol)
  203.    b:hiLite()                          // highlight current cell
  204.    dispend()
  205.    key := ginkey(0, "KEY")
  206.  
  207.    //───── dehighlight column letter
  208.    @ b:ntop, col() say b:getColumn(b:colPos):heading color plaincolor
  209.    //───── dehighlight row number
  210.    b:colorRect( { b:rowPos, 1, b:rowPos, 1 }, {1, 2} )
  211.    b:deHilite()                        // current cell
  212.    do case
  213.  
  214.       case key == K_UP .and. ele > 1
  215.          if tagging
  216.             dispbegin()
  217.             //───── if rectangle has shrunk, redraw in old color and
  218.             //───── alter bottom row
  219.             if b:rowPos == TOP
  220.                TOP--
  221.             elseif b:rowPos == BOTTOM .and. BOTTOM > TOP
  222.                b:colorRect( { TOP, LEFT, BOTTOM--, RIGHT }, {1, 2} )
  223.             endif
  224.          endif
  225.          b:up()
  226.  
  227.       case key == K_DOWN .and. ele < ROWS
  228.          if tagging
  229.             dispbegin()
  230.             if b:rowPos == BOTTOM
  231.                BOTTOM++
  232.             elseif b:rowPos == TOP .and. TOP < BOTTOM
  233.                b:colorRect( { TOP++, LEFT, BOTTOM, RIGHT }, {1, 2} )
  234.             endif
  235.          endif
  236.          b:down()
  237.  
  238.       case key == K_LEFT
  239.          if tagging .and. CURR_COLUMN > 1
  240.             dispbegin()
  241.             //───── if rectangle has shrunk, redraw in old color and
  242.             //───── alter right column
  243.             if b:colPos == RIGHT
  244.                if RIGHT > LEFT
  245.                   b:colorRect( { TOP, LEFT, BOTTOM, RIGHT-- }, {1, 2} )
  246.                else
  247.                   RIGHT := b:colPos
  248.                   LEFT--
  249.                endif
  250.             else
  251.                LEFT--
  252.             endif
  253.          endif
  254.          b:left()
  255.  
  256.       case key == K_RIGHT
  257.          if tagging
  258.             dispbegin()
  259.             if b:colPos == LEFT .and. LEFT < RIGHT
  260.                b:colorRect( { TOP, LEFT++, BOTTOM, RIGHT }, {1, 2} )
  261.             elseif b:colPos < b:colCount
  262.                RIGHT++
  263.             endif
  264.          endif
  265.          b:right()
  266.  
  267.       case key == K_TAB .and. ! tagging
  268.          //───── if rightmost column is within sight, go to it now
  269.          if b:rightvisible == b:colCount
  270.             b:colPos := b:colCount
  271.          else
  272.             //───── pan from leftmost to rightmost
  273.             x := b:leftvisible
  274.             y := b:rightvisible
  275.             for c = x to y
  276.                b:panRight()
  277.             next
  278.          endif
  279.  
  280.       case key == K_SH_TAB .and. ! tagging
  281.          //───── if leftmost editable column is within reach, go to it now
  282.          if b:leftvisible - (b:rightvisible - b:leftvisible) < 1
  283.             b:colPos := 2
  284.          else
  285.             //───── loop from right to left
  286.             x := b:leftvisible
  287.             y := b:rightvisible
  288.             for c = x to y
  289.                b:left()
  290.             next
  291.          endif
  292.  
  293.       case key == K_CTRL_LEFT .and. ! tagging
  294.          b:panHome()
  295.  
  296.       case key == K_CTRL_RIGHT .and. ! tagging
  297.          b:panEnd()
  298.  
  299.       case key == K_PGUP .and. ! tagging
  300.          b:pageUp()
  301.  
  302.       case key == K_PGDN .and. ! tagging
  303.          b:pageDown()
  304.  
  305.       case key == K_HOME .and. ( b:colPos != 2 .or. ele != 1 )
  306.          b:colPos := 2
  307.          b:pageUp()
  308.  
  309.       case key == K_END .and. ( b:colPos != COLUMNS + 1 .or. ele != ROWS)
  310.          b:colPos := COLUMNS + 1
  311.          b:pageDown()
  312.  
  313.       case key == K_F10
  314.          do case
  315.             //───── if an array of highlighted cells already exists, load
  316.             //───── it as links to the currently selected cell...
  317.             case ! empty(HIGHLIGHTED)
  318.                //───── must verify that current cell is not part of
  319.                //───── the highlighted cells to preclude circularity
  320.                if ascan(HIGHLIGHTED, { | a | a[ROW] == ele .and. ;
  321.                                 a[COLUMN] == b:colPos - 1 } ) > 0
  322.                   err_msg({ "This cell is part of the highlighted region", ;
  323.                             "Therefore you cannot paste the sum here" })
  324.                else
  325.                   CellLinks(HIGHLIGHTED)
  326.  
  327.                   //───── store this in the formula slot
  328.                   CURR_CELL[FORMULA] := "@SUM(" + chr(64 + HIGHLIGHTED[1,2]) + ;
  329.                             ltrim(str(HIGHLIGHTED[1,1])) + ".."              + ;
  330.                             chr(64 + atail(HIGHLIGHTED)[2])                  + ;
  331.                             ltrim(str(atail(HIGHLIGHTED)[1])) + ")"
  332.                   HIGHLIGHTED := {}
  333.                   b:refreshCurrent()
  334.  
  335.                   //───── are there any dependencies from this cell?
  336.                   if ! empty(CURR_CELL[DEPENDENCIES])
  337.                      Recalc(ele, CURR_COLUMN)
  338.                   endif
  339.  
  340.                   //───── now get rid of the highlight
  341.                   dispbegin()
  342.                   b:colorRect( { TOP, LEFT, BOTTOM, RIGHT }, {1, 2} )
  343.                   dispend()
  344.                endif
  345.  
  346.             //───── if we were highlighting, build array of highlighted cells
  347.             case tagging
  348.                for x = TOP to BOTTOM
  349.                   //───── note: must subtract one from column: 1st column locked
  350.                   for y = LEFT to RIGHT
  351.                      //───── plus sign in the next statement is the operator
  352.                      aadd(HIGHLIGHTED, { x, y - 1, '+' })
  353.                   next
  354.                next
  355.                tagging := .f.
  356.  
  357.                //───── change highlight color
  358.                dispbegin()
  359.                b:colorRect( { TOP, LEFT, BOTTOM, RIGHT }, {3, 2} )
  360.                dispend()
  361.  
  362.             //───── start tagging: establish anchors for the rectangle
  363.             otherwise
  364.                TOP := BOTTOM := b:rowPos
  365.                LEFT := RIGHT := b:colPos
  366.                tagging := .t.      // set TAGGING flag on
  367.          endcase
  368.  
  369.       case key == K_ALT_P              // print
  370.          //───── if there is a highlighted region, allow user to print that
  371.          x := yes_no2("Spreadsheet Print Options", maxrow() / 2, ;
  372.                       if(! empty(HIGHLIGHTED), " Entire ", " OK "), ;
  373.                       if(! empty(HIGHLIGHTED), " Highlight ", " Cancel "))
  374.          if lastkey() != K_ESC
  375.             if x
  376.                printit(1, 1, ROWS, COLUMNS)
  377.             elseif ! x .and. ! empty(HIGHLIGHTED)
  378.                printit(TOP, LEFT - 1, BOTTOM, RIGHT - 1)
  379.             endif
  380.          endif
  381.  
  382.       case key == K_ALT_W              // change column width
  383.          changewidth()
  384.  
  385.       case key == K_ENTER .or. key == K_F2 .or. ( key > 31 .and. key < 255 )
  386.          if key > 31
  387.             keyboard chr(key)
  388.          endif
  389.  
  390.          //───── highlight current cell for clarity
  391.          b:hiLite()
  392.          //───── F2 indicates not to allow left/right arrow to exit the GET
  393.          EditCell(lastkey() != K_F2)
  394.          b:dehiLite()
  395.  
  396.          //──── force redisplay of current row
  397.          b:refreshCurrent()
  398.  
  399.          //───── if this cell is on a row that also contains a highlighted
  400.          //───── region, we must set a flag to redisplay the highlight after
  401.          //───── stabilizing the TBrowse above
  402.          if ! empty(HIGHLIGHTED)
  403.             if ascan(HIGHLIGHTED, { | a | a[ROW] == ele } ) > 0
  404.                refreshHilite := .t.
  405.             endif
  406.          endif
  407.          if valtype(CURR_CELL[CONTENTS]) == "C" .and. ;
  408.                   (valtype(CURR_CELL[FORMULA]) != "C" .or. ;
  409.                    left(CURR_CELL[FORMULA], 1) != "@")
  410.  
  411.             //───── check for direct cell references, which would begin
  412.             //───── with "+" and be followed by other characters
  413.             if left(CURR_CELL[CONTENTS], 1) == "+" .and. ;
  414.                     len(trim(CURR_CELL[CONTENTS])) > 1
  415.                links_ := {}
  416.  
  417.                //───── if there were already direct cell references in this
  418.                //───── cell, we must clear them out before adding new ones!
  419.                if ( y := len(CURR_CELL[LINKS])) > 0
  420.                   RemoveLink(y)
  421.                endif
  422.  
  423.                //───── first convert to uppercase for comparative purposes
  424.                CURR_CELL[CONTENTS] := upper(CURR_CELL[CONTENTS])
  425.  
  426.                //───── store this in the formula slot
  427.                CURR_CELL[FORMULA] := trim(CURR_CELL[CONTENTS])
  428.  
  429.                do while ! empty(CURR_CELL[CONTENTS])
  430.                   ptr := 1
  431.                   ccell := []
  432.                   coop := substr(CURR_CELL[CONTENTS], ptr++, 1)
  433.                   while ! (c := substr(CURR_CELL[CONTENTS], ptr++, 1)) $ "+-/* "
  434.                      ccell += c
  435.                   enddo
  436.  
  437.                   //───── trim contents of cell
  438.                   CURR_CELL[CONTENTS] := substr(CURR_CELL[CONTENTS], ptr - 1)
  439.  
  440.                   //───── derive row and column of referred cell
  441.                   ncol := asc(left(ccell, 1)) - 64
  442.                   nrow := val(substr(ccell, 2))
  443.  
  444.                   //───── basic error trapping here; in case user entered
  445.                   //───── "+A1+B1+" or any other extraneous stuff at end
  446.                   if ncol > 0 .and. nrow > 0
  447.                      aadd(links_, { nrow, ncol, coop } )
  448.                   endif
  449.                enddo
  450.  
  451.                //───── if there was an entry error, the buffer may not be
  452.                //───── empty -- test for it now
  453.                if empty(CURR_CELL[CONTENTS])
  454.                   CellLinks(links_)
  455.                else
  456.  
  457.                   //───── clear out the formula, which is now a moot point
  458.                   CURR_CELL[CONTENTS] := CURR_CELL[FORMULA] := NIL
  459.                endif
  460.             else
  461.                //───── see if this character string is too wide for the column
  462.                //───── if so, and if the cell to the right is empty, then we
  463.                //───── embed a code block as the formula in the columns
  464.                //───── to the right and change their contents accordingly
  465.                //───── so as to display the entire character string
  466.                x := len(trim(CURR_CELL[CONTENTS]))
  467.                if x > b:getColumn(b:colPos):width .and. ;
  468.                       b:colPos < COLUMNS .and. empty(NEXT_CELL[CONTENTS])
  469.                   c := b:colPos       // tracks the current column
  470.                   y := 0              // accumulates total width
  471.  
  472.                   //───── note that loop can be broken by a non-empty cell
  473.                   do while y < x .and. empty(nums_[ele, c, CONTENTS])
  474.                      nums_[ele, c, FORMULA] := bspill
  475.                      nums_[ele, c, CONTENTS] := eval(bspill, ele, c)
  476.                      y += b:getColumn(c++):width
  477.                   enddo
  478.                endif
  479.             endif
  480.  
  481.          //───── otherwise, clear out any links that may exist
  482.          //───── necessary step because this cell may have contained
  483.          //───── a formula which just got obliterated by a constant
  484.          elseif ( y := len(CURR_CELL[LINKS])) > 0
  485.             RemoveLink(y)
  486.  
  487.  
  488.          endif
  489.  
  490.          //───── check next cell formula for a code block, which indicates
  491.          //───── a spillover -- this may no longer be necessary if the
  492.          //───── character string has been shortened or changed to a numeric.
  493.          if b:colPos < COLUMNS .and. valtype(NEXT_CELL[FORMULA]) == "B" .and. ;
  494.               (valtype(CURR_CELL[CONTENTS]) != "C" .or. ;
  495.               (valtype(CURR_CELL[CONTENTS]) == "C" .and. ;
  496.                len(trim(CURR_CELL[CONTENTS])) <= b:getColumn(b:colPos):width))
  497.             c := b:colPos
  498.             do while SpillOver(ele, c)
  499.                nums_[ele, c, CONTENTS] := NIL
  500.                nums_[ele, c++, FORMULA] := NIL
  501.             enddo
  502.          endif
  503.  
  504.          //───── are there any dependencies from this cell?
  505.          if ! empty(CURR_CELL[DEPENDENCIES])
  506.             Recalc(ele, CURR_COLUMN)
  507.          endif
  508.    endcase
  509.    if tagging
  510.       b:colorRect( { TOP, LEFT, BOTTOM, RIGHT }, {4, 3} )
  511.       dispend()
  512.    endif
  513. enddo
  514. //───── only prompt user to save spreadsheet if not called as hot-key
  515. //───── in which case variable nLine would equal NIL
  516. if nline == NIL .and. yes_no("Save this spreadsheet")
  517.    cfile := padr(cfile,12)
  518.    boxget cfile prompt "Enter filename:" picture "@!" boxcolor 'w/rb' ;
  519.           color '+w/rb,+w/rb'
  520.    if lastkey() != K_ESC .and. ! empty(cfile)
  521.       cfile := trim(cfile)
  522.       waiton( { 'Saving to ' + cfile + '... please wait' }, .f.)
  523.       gsavearray(nums_, cfile)
  524.       waitoff()
  525.    endif
  526. endif
  527. gfrestenv()
  528. set(_SET_SCOREBOARD, oldscore)
  529. setkey(K_F10, oldf10)
  530. #ifdef HELPSCREEN
  531.    setkey(K_F1, oldf1)
  532. #endif
  533.  
  534. //───── if there is a numeric GET currently active, paste
  535. //───── contents of current cell into it
  536. if curr_get != NIL .and. curr_get:type == "N" .and. ;
  537.                             valtype(CURR_CELL[CONTENTS]) == "N"
  538.    curr_get:varPut(CURR_CELL[CONTENTS])
  539. endif
  540. return nil
  541.  
  542. // end function GrumpCalc()
  543. //────────────────────────────────────────────────────────────────────//
  544.  
  545.  
  546. /*
  547.    Function: PrintIt()
  548.    Purpose:  Print entire spreadsheet or highlighted region
  549. */
  550. static function printit(ntop, nleft, nbottom, nright)
  551. local x, y, c
  552. GFSaveSets()
  553. set(_SET_PRINTFILE, "blah.txt")
  554. set(_SET_PRINTER, .T.)
  555. set(_SET_CONSOLE, .F.)
  556. for x = ntop to nbottom
  557.    for y = nleft to nright
  558.       c := b:getColumn(y + 1)
  559.       if nums_[x, y, CONTENTS] == NIL
  560.          qqout(space(c:width))
  561.       else
  562.          qqout(alignment(nums_[x, y, CONTENTS], nums_[x, y, FORMULA], c))
  563.       endif
  564.    next
  565.    qout()
  566. next
  567. GFRestSets()
  568. return nil
  569.  
  570. // end static function PrintIt()
  571. //────────────────────────────────────────────────────────────────────//
  572.  
  573.  
  574. /*
  575.    Function: AwSkipIt()
  576.    Purpose:  Custom skip function for TBrowsing arrays
  577. */
  578. static function AwSkipIt(ele, skip_cnt, maxval)
  579. local movement := 0
  580. /* moving forward */
  581. if skip_cnt > 0
  582.    do while ele + movement < maxval .and. movement < skip_cnt
  583.       movement++
  584.    enddo
  585. /* moving backward */
  586. elseif skip_cnt < 0
  587.    do while ele + movement > 1 .and. movement > skip_cnt
  588.       movement--
  589.    enddo
  590. endif
  591. ele += movement
  592. return movement
  593.  
  594. // end static function AwSkipIt()
  595. //────────────────────────────────────────────────────────────────────//
  596.  
  597.  
  598. /*
  599.    Function: EditCell()
  600.    Purpose:  Edit current cell
  601. */
  602.  
  603. #define GETWIDTH   maxcol() - 7
  604.  
  605. static function editcell(arrows)
  606. local contents := CURR_CELL[CONTENTS], key, getlist := {}
  607.  
  608. //──── set insert key to toggle both insert mode & cursor
  609. local oldins := setkey( K_INS, {|| setcursor( ;
  610.          if(readinsert(! readInsert()), SC_NORMAL, SC_INSERT))} )
  611. local lreadexit := readexit(.t.)
  612. local oldleft, oldright
  613.  
  614. //───── set left & right arrow keys to exit READ if specified
  615. if arrows
  616.    oldleft  := setkey(K_LEFT,  { || stuffkeys(chr(K_ENTER)+chr(K_LEFT)) })
  617.    oldright := setkey(K_RIGHT, { || stuffkeys(chr(K_ENTER)+chr(K_RIGHT)) })
  618. endif
  619.  
  620. //───── if current cell is blank (indicating NIL), change to character
  621. //───── note: if formula is a code-block, it is a character spill-over
  622. //───── and must be treated as if it was empty
  623. if contents == NIL .or. valtype(CURR_CELL[FORMULA]) == "B"
  624.    contents := space(GETWIDTH)
  625. //───── check for any other formulae besides @..SUMs
  626. elseif ! empty(CURR_CELL[FORMULA]) .and. left(CURR_CELL[FORMULA], 1) != "@"
  627.    //───── if there is a justification formula, append it to front of text
  628.    if trim(CURR_CELL[FORMULA]) $ ['"^]
  629.       contents := trim(CURR_CELL[FORMULA]) + contents
  630.    else
  631.       contents := padr(CURR_CELL[FORMULA], GETWIDTH)
  632.    endif
  633. //───── if current cell is numeric, must convert to character
  634. //───── so that the user can switch types at will
  635. elseif valtype(contents) == "N"
  636.    contents := padr(ltrim(str(contents)), GETWIDTH)
  637. endif
  638.  
  639. @ 1, 6 get contents picture '@K'
  640. //──── initial cursor setting based on current mode
  641. setcursor( if(readInsert(), SC_INSERT, SC_NORMAL) )
  642. read
  643. setcursor(0)
  644.  
  645. //───── if empty, blank out this cell once again
  646. if empty(contents)
  647.    CURR_CELL[CONTENTS] := CURR_CELL[FORMULA] := NIL
  648. //───── convert to numeric if it contains a numeric value
  649. elseif ( val(contents) != 0 .or. contents = "0" )
  650.    CURR_CELL[CONTENTS] := val(trim(contents))
  651.    CURR_CELL[FORMULA] := NIL
  652. else
  653.    //───── check for justification formulae
  654.    if left(contents, 1) $ ['"^]
  655.       CURR_CELL[FORMULA] := left(contents, 1)
  656.       //───── must trim the character data to the width of this column
  657.       CURR_CELL[CONTENTS] := substr(contents, 2, b:getColumn(b:colPos):width)
  658.    else
  659.       CURR_CELL[CONTENTS] := contents
  660.       //───── if this was a formula and you just entered a character
  661.       //───── string, time to trash the formula
  662.       if ! empty(CURR_CELL[FORMULA]) .and. left(contents, 1) != "+"
  663.          CURR_CELL[FORMULA] := NIL
  664.       endif
  665.    endif
  666. endif
  667.  
  668. setkey(K_INS, oldins)           // reset INS key
  669. //───── reset left and right arrows if we changed them
  670. if arrows
  671.    setkey(K_LEFT, oldleft)
  672.    setkey(K_RIGHT, oldright)
  673. endif
  674. readexit(lreadexit)       // reset READEXIT status
  675.  
  676. //───── if we exited with an arrow key, pass it through
  677. key := lastkey()
  678. if key == K_UP .or. key == K_DOWN
  679.    keyboard chr(key)
  680. endif
  681. return NIL
  682.  
  683. // end static function EditCell()
  684. //────────────────────────────────────────────────────────────────────//
  685.  
  686. /*
  687.    Function: StuffKeys( <cstring> )
  688.    Purpose:  Used to allow left/right arrow keys to exit the GET
  689. */
  690. static function StuffKeys(c)
  691. keyboard c
  692. return nil
  693.  
  694. // end static function EditCell()
  695. //────────────────────────────────────────────────────────────────────//
  696.  
  697.  
  698. /*
  699.    Function: CellLinks()
  700.    Purpose:  Establish links/dependencies based on formula in current cell
  701. */
  702. static function CellLinks(links_)
  703. local nrow, ncol, nval := 0, x
  704.  
  705. //───── loop through links array
  706. for x = 1 to len(links_)
  707.    nrow := links_[x, ROW]
  708.    ncol := links_[x, COLUMN]
  709.  
  710.    //───── do not allow circular references!!
  711.    if nrow != ele .or. ncol != CURR_COLUMN
  712.  
  713.       //───── verify that this cell is not already in the links array
  714.       if ascan(CURR_CELL[LINKS], ;
  715.               { | cell | cell[ROW] == nrow .and. cell[COLUMN] == ncol} ) == 0
  716.  
  717.          //───── add this cell to the links array
  718.          aadd(CURR_CELL[LINKS], links_[x] )
  719.  
  720.          //───── add current cell to dependencies array for linked cell
  721.          aadd(nums_[nrow, ncol, DEPENDENCIES], { ele, CURR_COLUMN } )
  722.       endif
  723.       CalcGuts(nrow, ncol, links_[x, OPERATOR], @nval)
  724.    endif
  725. next
  726. CURR_CELL[CONTENTS] := nval
  727. return nil
  728.  
  729. // end static function CellLinks()
  730. //────────────────────────────────────────────────────────────────────//
  731.  
  732.  
  733. /*
  734.    Function: Recalc()
  735.    Purpose:  Self-explanatory
  736. */
  737. static function Recalc(nrow, ncol)
  738. local ncells := len(nums_[nrow, ncol, DEPENDENCIES])
  739. local trow, tcol, x, nsum, oldrowpos := b:rowPos
  740. for x = 1 to ncells
  741.    trow := nums_[nrow, ncol, DEPENDENCIES, x, 1]
  742.    tcol := nums_[nrow, ncol, DEPENDENCIES, x, 2]
  743.    nsum := 0
  744.  
  745.    //───── perform summation on links array
  746.    aeval(nums_[trow, tcol, LINKS], { | cell | ;
  747.          calcguts(cell[ROW], cell[COLUMN], cell[OPERATOR], @nsum) } )
  748.    nums_[trow, tcol, CONTENTS] := nsum
  749.  
  750.    //───── switch to this row to force selective refresh
  751.    b:rowPos := trow
  752.    b:refreshCurrent()
  753.  
  754.    //───── recurse to resolve any dependencies from this cell
  755.    if ! empty(nums_[trow, tcol, DEPENDENCIES])
  756.       Recalc(trow, tcol)
  757.    endif
  758. next
  759.  
  760. //───── reset row pointer in TBrowse window
  761. b:rowPos := oldrowpos
  762. return nil
  763.  
  764. // end static function Recalc()
  765. //────────────────────────────────────────────────────────────────────//
  766.  
  767.  
  768. /*
  769.    Function: CalcGuts()
  770.    Purpose:  The guts of the recalculation
  771.              Accepts row, column, operator, and counter
  772. */
  773. static function CalcGuts(nrow, ncol, coperator, ncounter)
  774. if valtype(nums_[nrow, ncol, CONTENTS]) == "N"
  775.    do case
  776.       case coperator == "+"
  777.          ncounter += nums_[nrow, ncol, CONTENTS]
  778.       case coperator == "-"
  779.          ncounter -= nums_[nrow, ncol, CONTENTS]
  780.       case coperator == "/"
  781.          ncounter /= nums_[nrow, ncol, CONTENTS]
  782.       case coperator == "*"
  783.          ncounter *= nums_[nrow, ncol, CONTENTS]
  784.    endcase
  785. endif
  786. return nil
  787.  
  788. // end static function CalcGuts()
  789. //────────────────────────────────────────────────────────────────────//
  790.  
  791.  
  792. /*
  793.    Function: Alignment()
  794.    Purpose:  Allow left/right-justified or centered character data
  795.              Called from within each TBColumn data retrieval block
  796. */
  797. static function alignment(data, formula, column)
  798. local ret_val := data, width := column:width
  799. if valtype(formula) == "C"
  800.  
  801.    //───── look for justification formulae
  802.    do case
  803.       case formula == [']             // right justified
  804.          ret_val := padr(trim(data), width)
  805.       case formula == ["]             // left justified
  806.          ret_val := padl(trim(data), width)
  807.       case formula = [^]             // centered
  808.          ret_val := padc(trim(data), width)
  809.       otherwise                      // non-justification formula (@SUM, etc)
  810.          ret_val := padl(ltrim(str(data)), width)
  811.    endcase
  812. elseif valtype(data) == "N"
  813.    ret_val := padl(ltrim(str(data)), width)
  814. endif
  815. return ret_val
  816.  
  817. // end static function Alignment()
  818. //────────────────────────────────────────────────────────────────────//
  819.  
  820.  
  821. /*
  822.    Function: ChangeWidth()
  823.    Purpose:  Change a column's width
  824. */
  825. static function changewidth()
  826. local c := b:getColumn(b:colPos), x, y
  827. x := c:width
  828. boxget x prompt "Enter new width:" picture '###' boxcolor 'w/rb' ;
  829.        valid x > 0 .and. x < maxcol() - 10
  830. if lastkey() != K_ESC
  831.  
  832.    //───── change width instance variable
  833.    c:width := x
  834.  
  835.    //───── change placeholder in last row of array to reflect new width
  836.    nums_[ROWS + 1, CURR_COLUMN] := x
  837.  
  838.    //───── change heading so as to keep the letter centered
  839.    c:heading := padc(chr(63 + b:colPos), x)
  840.    b:configure()
  841.    b:invalidate()
  842.  
  843.    //───── loop through all columns looking for spill-overs
  844.    //───── if any are found, re-evaluate the formula code block
  845.    //───── for all columns to the right so that the entire
  846.    //───── character string continues to be properly displayed
  847.    for x = 1 to ROWS
  848.       if SpillOver(x, ( y := b:colPos - 1) )
  849.          do while SpillOver(x, y)
  850.             nums_[x, y++, CONTENTS] := eval(nums_[x, y, FORMULA], x, y)
  851.          enddo
  852.       endif
  853.    next
  854. endif
  855. return nil
  856.  
  857. // end static function ChangeWidth()
  858. //────────────────────────────────────────────────────────────────────//
  859.  
  860.  
  861. #ifdef HELPSCREEN
  862.  
  863. /*
  864.    HelpMe(): GrumpCalc() help screen
  865. */
  866. static function helpme
  867. local oldf1 := setkey(K_F1, NIL)
  868. gfsaveenv(.t., 0)                           // shut off cursor
  869. colorset(C_APICK_TAGGED)
  870. @ 0, 0, maxrow(), maxcol() box BOXFRAMES[5]
  871. SCRNCENTER(2, "Spreadsheet Help Screen")
  872. colorset(C_APICK_BOXOUTLINE)
  873. @ 4, 28 ssay "Move up a row unless already at top"
  874. @ 5, 28 ssay "Move down a row unless already at bottom"
  875. @ 6, 28 ssay "Move left a column"
  876. @ 7, 28 ssay "Move right a column"
  877. @ 8, 28 ssay "Move to top row of spreadsheet"
  878. @ 9, 28 ssay "Move to bottom row of spreadsheet"
  879. @10, 28 ssay "Move to top left cell of spreadsheet"
  880. @11, 28 ssay "Move to bottom right cell of spreadsheet"
  881. @12, 28 ssay "Move to leftmost column"
  882. @13, 28 ssay "Move to rightmost column"
  883. @14, 28 ssay "Pan right one screen"
  884. @15, 28 ssay "Pan left one screen"
  885. @16, 28 ssay "Change column width"
  886. @17, 28 ssay "Print all or part of spreadsheet"
  887. @18, 28 ssay "Enable or disable highlighting"
  888. @19, 28 ssay "Edit current cell"
  889. @20, 28 ssay "Edit current cell"
  890. SCRNCENTER(22, "Press spacebar for next help screen")
  891. colorset(C_APICK_CURRENT)
  892. @ 4, 13 ssay "Up Arrow"
  893. @ 5, 13 ssay "Down Arrow"
  894. @ 6, 13 ssay "Left Arrow"
  895. @ 7, 13 ssay "Right Arrow"
  896. @ 8, 13 ssay "PgUp"
  897. @ 9, 13 ssay "PgDn"
  898. @10, 13 ssay "Home"
  899. @11, 13 ssay "End"
  900. @12, 13 ssay "Ctrl-Left"
  901. @13, 13 ssay "Ctrl-Right"
  902. @14, 13 ssay "Tab"
  903. @15, 13 ssay "Shift-Tab"
  904. @16, 13 ssay "Alt-W"
  905. @17, 13 ssay "Alt-P"
  906. @18, 13 ssay "F10"
  907. @19, 13 ssay "Enter/F2"
  908. @20, 13 ssay "Letter/number"
  909. ginkey(0)
  910. colorset(C_APICK_BOXOUTLINE)
  911. scroll(1, 1, maxrow() - 1, maxcol() - 1, 0)
  912. @ 1, 5 ssay "You can specially justify character data with any of the following"
  913. @ 2, 5 ssay [three special characters: " to left-justify, ' to right-justify, or ^]
  914. @ 3, 5 ssay "to center the text in that column."
  915. @ 5,20 ssay ": A cell can refer to two or more other cells.  To do"
  916. @ 6, 5 ssay "so, simply enter the addresses of the cells, being certain to precede"
  917. @ 7, 5 ssay [the first cell address by a plus sign ("+").  For example, "+A1+A2"]
  918. @ 8, 5 ssay "would contain the sum of cells A1 and A2."
  919. @10,34 ssay ": You may highlight a group of cells by"
  920. @11, 5 ssay "locating the beginning of the region and pressing F10.  Then use the"
  921. @12, 5 ssay "arrow keys to move the cursor to the end of the region and press F10"
  922. @13, 5 ssay "again.  You may then either print that highlighted region or paste the"
  923. @14, 5 ssay "sum of all its cells into a different cell. To paste the sum of the"
  924. @15, 5 ssay "region into a different cell, move to the target cell and press F10"
  925. @16, 5 ssay "for a third time."
  926. @18,13 ssay ": You may print either the entire spreadsheet, or the"
  927. @19, 5 ssay "highlighted region (if there is one), by pressing Alt-P."
  928. @21,17 ssay ": You may change the width of the current column by"
  929. @22, 5 ssay "pressing Alt-W. The default column width is 10.  If the current column"
  930. @23, 5 ssay "has a width other than 10, it will be displayed at the top left corner."
  931. colorset(C_APICK_CURRENT)
  932. @ 5, 5 ssay "Cell References"
  933. @10, 5 ssay "Highlighting a Group of Cells"
  934. @18, 5 ssay "Printing"
  935. @21, 5 ssay "Column Width"
  936. inkey(0)
  937. gfrestenv()
  938. setkey(K_F1, oldf1)
  939. return nil
  940.  
  941. * end static function HelpMe()
  942. *--------------------------------------------------------------------*
  943.  
  944. #endif
  945.  
  946. /*
  947.     Function: MakeColumn()
  948.     Author:   Greg Lief
  949.     Syntax:   MakeColumn( <nCol> )
  950.     Params:   <nCol> is the appropriate column number
  951.     Returns:  Codeblock to serve as TBColumn:block instance variable
  952.     Notes:    This function takes advantage of Clipper 5.01's
  953.               "detached locals".  Detached locals are local variables
  954.               in function that have been called by higher-level
  955.               functions.  If the lower-level function initializes a code
  956.               block that refers to those local variables, the variables
  957.               will remain alive as long as the code block remains alive,
  958.               EVEN IF THE FUNCTION IS NOT IN THE CALLSTACK.  In this
  959.               situation, it means that we do not have to resort to
  960.               macro substitution nor convoluted preprocessor directives.
  961. */
  962. static function makecolumn(num)
  963. return { || if(nums_[ele, num, CONTENTS] == NIL, '',       ;
  964.                Alignment(nums_[ele, num, CONTENTS],        ;
  965.                          nums_[ele, num, FORMULA],         ;
  966.                            b:getColumn( num + 1) )) }
  967.  
  968. * end static function MakeColumn()
  969. *--------------------------------------------------------------------*
  970.  
  971.  
  972. /*
  973.     Function: RemoveLink()
  974.     Author:   Greg Lief
  975.     Syntax:   RemoveLink( <loop> )
  976.     Params:   <loop> is the length of the links array to be traversed
  977.     Returns:  Nada
  978. */
  979. static function removelink(count)
  980. local nrow, ncol, nval, x
  981. CURR_CELL[FORMULA] := NIL
  982. for x = 1 to count
  983.    //───── determine coordinate of this linked cell
  984.    nrow := CURR_CELL[LINKS, x, ROW]
  985.    ncol := CURR_CELL[LINKS, x, COLUMN]
  986.  
  987.    //───── scan dependencies array for that cell
  988.    nval := ascan(nums_[nrow, ncol, DEPENDENCIES], { | cell | ;
  989.            cell[ROW] == ele .and. cell[COLUMN] == CURR_COLUMN} )
  990.  
  991.    //───── trash the now-bogus reference
  992.    adel(nums_[nrow, ncol, DEPENDENCIES], nval)
  993.    asize(nums_[nrow, ncol, DEPENDENCIES], ;
  994.          len(nums_[nrow, ncol, DEPENDENCIES]) - 1 )
  995. next
  996. //───── trash the links for current cell
  997. asize(CURR_CELL[LINKS], 0)
  998. return nil
  999.  
  1000. * end static function RemoveLink()
  1001. *--------------------------------------------------------------------*
  1002.  
  1003. * eof grumcalc.prg
  1004.