home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / ECO_PCLC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-08  |  11.5 KB  |  287 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   Unit was conceived, designed and written         ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  21. *)
  22. {$O+}
  23. unit eco_pclc;
  24.  
  25. interface
  26. uses
  27.   dos, crt, eco_lib
  28.  
  29.   ;
  30.  
  31.  
  32.   procedure __setcalc(x,y,f,b:integer);
  33.   function  __popcalc: real;
  34.  
  35.  
  36.  
  37. implementation
  38.  
  39.  
  40. const
  41.   fore: byte = lightgray;
  42.   back: byte =     black;
  43.  
  44.  
  45. var
  46.   operand     :       char;
  47.   chin        :       char;
  48.   displaynum  :       real;
  49.   storagenum  :       real;
  50.   memory      :       real;
  51.   tempst      : string[15];
  52.   shiftst     : string[15];
  53.   clearmem    :    boolean;
  54.   justop      :    boolean;
  55.   justnum     :    boolean;
  56.   decch       :       char;
  57.   ndec        :    integer;
  58.   err         :    integer;
  59.   exitcalc    :    boolean;
  60.   xpos,ypos   :    integer;
  61.   saveattr    :       byte;
  62.  
  63.  
  64.  
  65.   procedure beep;
  66.   begin
  67.     sound(1600); delay(30); sound(1300); delay(50); nosound;
  68.   end;
  69.  
  70.  
  71.   procedure __setcalc(x,y,f,b:integer);    { sets position of calculator }
  72.   begin
  73.     xpos := x;
  74.     ypos := y;
  75.     if xpos > 60 then xpos := 60;        { make sure calculator is on screen }
  76.     if ypos > 19 then ypos := 19;
  77.     if xpos < 1 then xpos := 1;
  78.     if ypos < 1 then ypos := 1;
  79.     fore := f; back := b;
  80.   end;
  81.  
  82.  
  83.  
  84.   function readfromscr(x,y,len:integer): string;
  85.   var
  86.     tempstr : string;
  87.     ii,l    : integer;
  88.     coff    : boolean;
  89.     r       : registers;
  90.  
  91.   begin
  92.     coff := false;           { set true if cursor is already off }
  93.                              { turn off the cursor }
  94.     r.ax := $0300;           { service 3 }
  95.     intr($10,r);             { interrupt 10 to get cursor scan lines}
  96.     if (r.cx and $2000) = $2000 then coff := true;
  97.     r.cx := r.cx or $2000;   { set bit 5 of top scan line to 1 }
  98.     r.ax := $0100;           { service 1 }
  99.     intr($10,r);             { interrupt 10 to turn off }
  100.     l := 0;
  101.     for ii := 1 to len do begin
  102.       gotoxy(x+ii-1,y);      { locate cursor }
  103.                             { read a character from the screen }
  104.       r.ax := $0800;         { service 8 }
  105.       r.bh := 0;             { screen 0 }
  106.       intr($10,r);           { interrupt 10 }
  107.       tempstr[ii] := chr(r.al);            { char returned in al }
  108.       if tempstr[ii] <> ' ' then l := ii   { if non blank remember length }
  109.     end;
  110.     if not coff then begin
  111.                               { flip the cursor back on }
  112.       r.ax := $0300;           { service 3 again }
  113.       intr($10,r);             { interrupt 10 to get scan lines }
  114.       r.cx := r.cx and $dfff;  { flip bit 5 of top scan line to 0 }
  115.       r.ax := $0100;           { service 1 }
  116.       intr($10,r);             {interrupt 10 to turn on cursor }
  117.     end;
  118.  
  119.     tempstr[0] := chr(l);    { set the string length to last non blank char. }
  120.     readfromscr := tempstr;  { set function result to temporary string }
  121.   end;
  122.  
  123.  
  124.  
  125.  
  126.   procedure operate;   { here's where we do the arithmetic }
  127.   begin
  128.  
  129.    { if a number string was just entered get it and turn it into a real value }
  130.     if justnum then begin
  131.       val(readfromscr(xpos+3,ypos+2,15),displaynum,err);
  132.       justnum := false;
  133.     end;
  134.  
  135.     case operand of
  136.       '+' : displaynum := storagenum + displaynum;  { addition }
  137.       '-' : displaynum := storagenum - displaynum;  { subtraction }
  138.       '*' : displaynum := storagenum * displaynum;  { multiplication }
  139.       '/' : displaynum := storagenum / displaynum;  { division }
  140.                                         { add more stuff here if you wish }
  141.     end; {case}
  142.  
  143.     str(displaynum:15:ndec,tempst); __write(xpos+3,ypos+2,fore,back,tempst);
  144.     justop := true; __write(xpos+19,ypos+2,fore,back,' ');
  145.   end;
  146.  
  147.  
  148.  
  149.   function __popcalc : real;  { pocketcalc returns the value in the display }
  150.   var sav : _scnimageptr;
  151.   begin
  152.     new(sav); __savscn(sav);
  153.     exitcalc := false; justop := true; justnum := false;
  154.     clearmem := false; operand := ' ';
  155.     __bandwin(true, xpos,ypos,xpos+22,ypos+18, fore, back, sh_default, bt_single);
  156.     __betwscn(xpos, xpos+22,ypos,fore,back,' Pocket Calculator ');
  157.     __write(xpos+2,ypos+4,fore,back, '┌─────────┐ ┌───┐');
  158.     __write(xpos+2,ypos+5,fore,back, '│ 7  8  9 │ │ / │');
  159.     __write(xpos+2,ypos+6,fore,back, '│ 4  5  6 │ │ * │');
  160.     __write(xpos+2,ypos+7,fore,back, '│ 1  2  3 │ │ - │');
  161.     __write(xpos+2,ypos+8,fore,back, '│         │ │ + │');
  162.     __write(xpos+2,ypos+9,fore,back, '│    0  . │ │ = │');
  163.     __write(xpos+2,ypos+10,fore,back,'└─────────┘ └───┘');
  164.     __write(xpos+2,ypos+11,fore,back,'┌───────────────┐');
  165.     __write(xpos+2,ypos+12,fore,back,'│ C Clear       │');
  166.     __write(xpos+2,ypos+13,fore,back,'│ D Decimal Pl. │');
  167.     __write(xpos+2,ypos+14,fore,back,'│ M Mem. +-*/=R │');
  168.     __write(xpos+2,ypos+15,fore,back,'└───────────────┘');
  169.     str(displaynum:15:ndec,tempst);       { display default number }
  170.     __write(xpos+3,ypos+2,fore,back,tempst);        { if first time this is zero }
  171.     gotoxy(xpos+17,ypos+2);
  172.     repeat                           { start of big keystroke reading loop }
  173.       chin := upcase(readkey);
  174.       case chin of
  175.         '0'..'9','.' : begin            { process a number keystroke }
  176.           justnum := true;              { if 1st digit clear display }
  177.           if justop then __write(xpos+3,ypos+2,fore,back,'               ');
  178.           justop := false;  { clear memory line at bottom }
  179.           if clearmem then begin
  180.             __write(xpos+2,ypos+17,fore,back,'                   ');
  181.             clearmem := false;
  182.           end;                       { read existing numbers from screen }
  183.           shiftst := readfromscr(xpos+3,ypos+2,15);
  184.          { add a zero to front of string if user entered decimal because turbo }
  185.          { val function won't recognize a number that begins with a decimal    }
  186.           if (chin = '.') and (shiftst = '') then shiftst := '              0';
  187.           delete(shiftst,1,1); { delete leftmost digit (ususally blank )}
  188.                                    { write out the shifted number string }
  189.           __write(xpos+3,ypos+2,fore,back,shiftst);
  190.                                    { finally write out the digit read in }
  191.           __write(xpos+17,ypos+2,fore,back,chin);
  192.         end;
  193.  
  194.         '+','-','*','/' : begin     {           process an operator keystroke }
  195.                                     { first handle the messy case of negative }
  196.                                     { numbers rather than the minus operator. }
  197.                                     { test for negative number conditions     }
  198.           if justop and (chin in ['-','+']) and (operand <> ' ') then begin
  199.             __write(xpos+3,ypos+2,fore,back,'               ');
  200.               { and write a - or + sign on display }
  201.             __write(xpos+17,ypos+2,fore,back,chin);
  202.             justop := false;
  203.           end else begin       { ok now we got a real operator }
  204.                                { first clean up the last operation }
  205.             operate; justnum := false;  { store the results }
  206.             storagenum := displaynum;
  207.             { put the operator in the hopper for next time }
  208.             operand := chin;
  209.             __write(xpos+20,ypos+2,fore,back,operand);
  210.           end;
  211.         end;
  212.  
  213.         '=',#13 : begin   {    process enter key or = key }
  214.           operate;        { first clean up last operation }
  215.           operand := ' ';
  216.           __write(xpos+20,ypos+2,fore,back,'=');
  217.         end;
  218.  
  219.         'C' : begin         { process a "clear" instruction }
  220.           displaynum := 0; storagenum := 0; operand := '!';
  221.           justop := true; __write(xpos+3,ypos+2,fore,back,'               ');
  222.         end;
  223.  
  224.         'D' : begin       { change number of decimal places displayed }
  225.           __write(xpos+2,ypos+17,fore,back,'Decimal Places ?  ');
  226.           repeat
  227.             decch := readkey;
  228.             if not (decch in ['0'..'9',#27]) then beep;
  229.           until decch in ['0'..'9',#27];
  230.           if decch <> #27 then begin
  231.             val(decch,ndec,err);            { convert the string  to a number }
  232.             str(displaynum:15:ndec,tempst); { and rewrite the display }
  233.             __write(xpos+3,ypos+2,fore,back,tempst);
  234.           end;                              { blank the decimal places prompt }
  235.           __write(xpos+2,ypos+17,fore,back,'                ');
  236.         end;
  237.  
  238.         'M' : begin      { process memory stuff here }
  239.           if justnum then begin
  240.             val(readfromscr(xpos+3,ypos+2,15),displaynum,err);
  241.             justnum := false;
  242.           end;
  243.           __write(xpos+2,ypos+17,fore,back,'Mem');
  244.           gotoxy(xpos+6,ypos+17);
  245.           write(memory:14:2);
  246.           { get the second memory keystroke }
  247.           { +, -, c(lear), r(ecall), =, enter, escape }
  248.           repeat
  249.             decch := upcase(readkey);
  250.             if not (decch in ['+','-','C','R','=',#13,#27]) then beep;
  251.           until decch in ['+','-','C','R','=',#13,#27];
  252.  
  253.           if decch <> #27 then begin
  254.             if decch = #13 then decch := '=';
  255.             __write(xpos+6,ypos+17,fore,back,decch);
  256.             case decch of
  257.               '+' : memory := memory + displaynum; { add to memory }
  258.               '-' : memory := memory - displaynum; { subtract from memory }
  259.               'C' : memory := 0;                   { clear memory }
  260.               'R' : begin                          { recall memory to display }
  261.                 str(memory:15:ndec,tempst);
  262.                 __write(xpos+3,ypos+2,fore,back,tempst);
  263.                 displaynum := memory;
  264.               end;
  265.               '=' : memory := displaynum;          { move display into memory }
  266.             end; {case}
  267.             justop := true; gotoxy(xpos+6,ypos+17);
  268.             write(memory:14:2);     { write out contents of memory }
  269.             clearmem := true;       { set switch to clear mem display }
  270.           end else __write(xpos+2,ypos+17,fore,back,'                   ');
  271.         end;
  272.  
  273.         #27 : exitcalc := true;     { user hit escape -- set switch to exit }
  274.         else beep;                  { illegal key }
  275.       end; {case}
  276.     until exitcalc;         { end of big keystroke loop }
  277.     __resscn(sav); dispose(sav);
  278.     __popcalc := displaynum;
  279.   end;
  280.  
  281.  
  282.  
  283. begin
  284.   xpos := 10; ypos := 5; displaynum := 0; storagenum := 0;
  285.   memory := 0; ndec := 2;
  286. end.
  287.