home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PROGRAMS / SPREDSHT / QSOLVE11.LBR / QS.PZS / QS.PAS
Pascal/Delphi Source File  |  2000-06-30  |  4KB  |  193 lines
  1. Program QuickSolver;
  2.  
  3. {       by Howard Dutton          }
  4. {    Genie: XJM23622 H.DUTTON     }
  5.  
  6. {         version 1.1             }
  7.  
  8. {          changes:               }
  9. { 1: moved help out to disk to    }
  10. {    save on memory.              }
  11. { 2: corrected bug that prevented }
  12. {    program from running on non- }
  13. {    H19 terms.                   }
  14.  
  15. label
  16.   Start;
  17. type
  18.   str3   = string[3];
  19.   str5   = string[5];
  20.   str14  = string[14];
  21.   str80  = string[80];
  22.   str255 = string[255];
  23. const
  24.   SI = '#';
  25. var
  26.   Bdos:     integer absolute $6;
  27.   Temp,
  28.   MemStart,
  29.   MemEnd,
  30.   MemPos,
  31.   FreeOfs:  integer;
  32.   CWidth:   array[1..26]       of byte;
  33.   CA:       array[1..26,1..99] of integer;  { Cell Address table }
  34.   L,
  35.   CAddr,
  36.   CType,
  37.   CForm,
  38.  
  39.   TC,TR,
  40.   Col,Row,
  41.   CC,CR,
  42.   SC,SR,
  43.   FC,FR,
  44.   DC,DR:    integer;
  45.   CText,
  46.   CFor,
  47.   S,TS:     str80;
  48.   CVal:     real;
  49.  
  50.   T,Code:   integer;
  51.   Result:   real;
  52.   Token:    str80;
  53.   Prog:     str255;
  54.   TokType:  (Delimiter,Funct,Number);
  55.  
  56.   InsertOn,
  57.   Finished,
  58.   Hide,
  59.   CalcOn:   boolean;
  60.   LastCalc,
  61.   ThisCalc,
  62.   Err:      integer;
  63.   Ch,Ch1:   char;
  64.  
  65. procedure ShowCells; forward;
  66.  
  67. {$I QSMISC.INC}
  68.  
  69. {$I QS1.INC}
  70. {$I QS2.INC}
  71. {$I QS3.INC}
  72. {$I QS4.INC}
  73. {$I QS5.INC}
  74. {$I QS6.INC}
  75.  
  76. procedure Help;
  77. var
  78.   F: text;
  79. begin
  80.   gotoxy(1,1);
  81.   assign(F,'QS.HLP');
  82.   if not Exist('QS.HLP') then
  83.   begin
  84.     Bell;
  85.     HighVideo;
  86.     message('help file not found');
  87.     LowVideo;
  88.     delay(2000);
  89.     message('');
  90.   end else
  91.   begin
  92.     reset(F);
  93.     gotoxy(1,1);
  94.     while not eof(F) do
  95.     begin
  96.       readln(F,Prog);
  97.       clreol;
  98.       writeln(Prog);
  99.     end;
  100.     message('press <RET> to continue?');
  101.     read(kbd,Ch);
  102.     ShowBorder;
  103.     ShowIndex;
  104.     ShowCells;
  105.   end;
  106. end;
  107.  
  108. begin
  109.   CrtInit;
  110.   delay(100);
  111.   clrscr;
  112.   MemStart:=$A800;       { start of free Memory          }
  113.   MemEnd  :=Bdos-7;      { end   of free Memory          }
  114.   MemPos  :=MemStart;    { pointer to current pos in Mem }
  115.   FreeOfs :=0;           { offset for true memory free   }
  116.   for TC:=1 to 26 do
  117.     for TR:=1 to 99 do CA[TC,TR]:=0;
  118.   CC:=1;
  119.   CR:=1;
  120.   Col:=1;
  121.   Row:=1;
  122.   for L:=1 to 26 do CWidth[L]:=11;
  123.   ShowBorder;
  124.   SC:=1;
  125.   SR:=1;
  126.   FC:=0;
  127.   FR:=0;
  128.   ThisCalc:=1;
  129.   CalcOn  :=True;
  130.   Hide    :=False;
  131.   InsertOn:=True;
  132.   Finished:=False;
  133.   Start:
  134.   repeat
  135.     ShowIndex;
  136.     HighVideo;
  137.     TS:=CellText(Col,Row);
  138.     ShowStr(Col,Row,TS);
  139.     GotoCell(Col,Row);
  140.     LowVideo;
  141.     BlkCur;
  142.     CurOn;
  143.     read(kbd,Ch);
  144.     Ch:=UpCase(Ch);
  145.     CurOff;
  146.     UlCur;
  147.     ShowStr(Col,Row,TS);
  148.     case Ch of
  149.       '/',
  150.       '?': Help;
  151.       ^E: UpRow;
  152.       ^R: UpPage;
  153.       ^X: DownRow;
  154.       ^C: DownPage;
  155.       ^D: RightCol;
  156.       ^F: RightPage;
  157.       ^S: LeftCol;
  158.       ^A: LeftPage;
  159.       'Q': begin
  160.             if CalcOn then CalcOn:=False else CalcOn:=True;
  161.             LookUpCells;
  162.             if CalcOn then ShowCells;
  163.           end;
  164.       ^K: Block;
  165.       '`',
  166.       '~': ReadText;
  167.       '=': ReadFor;
  168.       'S': SetWidth;
  169.       'M': MoveToCell;
  170.       'D': begin
  171.              DelCell(Col,Row);
  172.              LookUpCells;
  173.              ShowCells;
  174.            end;
  175.       'W': WriteSheet;
  176.       'R': ReadSheet;
  177.       ^[ : Finished:=True;
  178.     end;
  179.   until Finished;
  180.   gotoxy(1,24);
  181.   clreol;
  182.   write('save file <Y>/N ? ');
  183.   repeat read(kbd,Ch); Ch:=UpCase(Ch); until Ch in ['Y','N',#13];
  184.   if Ch=#13 then
  185.   begin
  186.     Finished:=False;
  187.     goto Start;
  188.   end;
  189.   if Ch='Y' then WriteSheet;
  190.   CrtExit;
  191.   delay(100);
  192. end.
  193.