home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / ME494-6.ZIP / CALC.SRC < prev    next >
Encoding:
Text File  |  1990-05-05  |  34.4 KB  |  1,231 lines
  1. $MACRO_FILE CALC;
  2. {******************************************************************************
  3.                                                      MULTI-EDIT MACRO FILE CALC
  4. CALC - The calculator
  5. PASTECALC - Pastes the current calculator value in at the current cursor position
  6.  
  7.                              (C) Copyright 1989 by American Cybernetics, Inc.
  8. ******************************************************************************}
  9.  
  10. $MACRO CALC;
  11. {*******************************MULTI-EDIT MACRO******************************
  12.  
  13. Name:  CALC
  14.  
  15. Description:  The pop-up calculator.
  16.  
  17. Parameters:
  18.                             /NT= If 1, disables the tape.
  19.                             /TL= Determines the tape length.  Defaults to 10.
  20.                             /STR= If 1, tells the calc to not actually invoke the calculator,
  21.                                         but instead return a string representing a certain value
  22.                                         passed to it in a certain base passed to it.  Primarily
  23.                                         created for pasting in the calculator result to the current
  24.                                         window.  The following parameters are only pertinent to the
  25.                                         existance of this parameter:
  26.                                         /RS= The string representation in decimal of the real value.
  27.                                         /BASE= The desired base.
  28.                                         /DPO= If 1, then there is a fraction behind the decimal
  29.                                                     point.  Only applicable if /BASE=10.
  30.                                         /DPL= Amount of decimal places of accuracy desired.  Only
  31.                                                     applicable if /BASE=10 and /DPO=1.
  32.  
  33.                              (C) Copyright 1989 by American Cybernetics, Inc.
  34. ******************************************************************************}
  35.  
  36.     Def_Int(Word_Length,Base,T_Int,Dec,Bin,Oct,Hex,Decimal_Places,Decimal_Point,
  37.                     Shift_Places,Function_Pending,Calc_X,Calc_Y,T_Explosions,Which_One,
  38.                     Word_Length_Mask,T_Lock_Stat,Visable_Tape_Length,Tape_On,Last_Key_Type,
  39.                     Actual_Tape_Length,Legal_Count,Error_Flag,Tape_Length,T_Flag,Ev_Count);
  40.     Def_Real(T_Real,Accumulator,Entry,Memory,Max_Pos,Min_Neg);
  41.     Def_Str(Numeric_Chars[16],T_Str,Func_Str1[3],Func_Str2[3],Disp_Str[39],
  42.                     T_Tape[60]);
  43.     Def_Char(Input_Char,T_Char);
  44.  
  45. {
  46. Last_Key_Type is used as a flag to tell what was done before the present
  47. keystroke.  Here are the legal values and their meanings:
  48. 0 = Clear
  49. 1 = Numeric input
  50. 2 = Operation
  51. 3 = Result
  52. }
  53. {These are variables used as constants}
  54.     Refresh := False;
  55.     Numeric_Chars := '0123456789ABCDEF';
  56.     Max_Pos := 2147483647.0;
  57.     Min_Neg := -2147483647.0;
  58. {Need to investigate if it is possible for INT_R to work with this value.
  59.     Min_Neg := -2147483648.0;
  60. }
  61.     Bin := 2;
  62.     Oct := 8;
  63.     Dec := 10;
  64.     Hex := 16;
  65.     Ev_Count := 3;
  66. {Word_Length is a constant here.  I've allowed for the possibility of saving
  67. into a global variable.  In this case, Word_Length_Mask must be calculated.}
  68.     Word_Length := 32;
  69.     IF (Word_Length < 32) THEN
  70.         Word_Length_Mask := ($FFFFFFFF Shr (32 - Word_Length));
  71.     ELSE
  72.         Word_Length_Mask := $FFFFFFFF;
  73.     END;
  74.     Set_Global_Str('Calc_Base_Display2',' Bin ');
  75.     Set_Global_Str('Calc_Base_Display8',' Oct ');
  76.     Set_Global_Str('Calc_Base_Display10',' Dec ');
  77.     Set_Global_Str('Calc_Base_Display16',' Hex ');
  78.  
  79. {initialize calculator variables according to Calc_Params and check and correct
  80. for anything out of range}
  81.     Tape_On := Parse_Int('/NT=',MParm_Str) = 0;
  82.     Tape_Length := Parse_Int('/TL=',MParm_Str);
  83.     IF (Tape_Length = 0) THEN
  84.         Tape_Length := 10;
  85.     END;
  86.     Calc_X := Parse_Int('/X=',Global_Str('Calc_Params'));
  87.     Calc_Y := Parse_Int('/Y=',Global_Str('Calc_Params'));
  88.     IF (Calc_X < 1) THEN
  89.         Calc_X := 20;
  90.     END;
  91.     IF (Calc_Y = 0) THEN
  92.         Calc_Y := Min_Window_Row + 12;
  93.     END;
  94.     Return_Int := Min_Window_Row + 2;
  95.     IF (Calc_Y < Return_Int) THEN
  96.         Calc_Y := Return_Int;
  97.     END;
  98.     Return_Int := Screen_Width - 44;
  99.     IF (Calc_X > Return_Int) THEN
  100.         Calc_X := Return_Int;
  101.     END;
  102.     Return_Int := Max_Window_Row - 9;
  103.     IF (Calc_Y > Return_Int) THEN
  104.         Calc_Y := Return_Int;
  105.     END;
  106.     Which_One := Parse_Int('/WO=',Global_Str('Calc_Params'));
  107.     IF ((Which_One > 1) or (Which_One < 0)) THEN
  108.         Which_One := 0;
  109.     END;
  110.     Last_Key_Type := Parse_Int('/LK=',Global_Str('Calc_Params'));
  111.     IF ((Last_Key_Type > 3) or (Last_Key_Type < 0)) THEN
  112.         Last_Key_Type := 0;
  113.     END;
  114.     Decimal_Places := Parse_Int('/DPL=',Global_Str('Calc_Params'));
  115.     IF ((Decimal_Places > 10) or (Decimal_Places < 0)) THEN
  116.         Decimal_Places := 0;
  117.     END;
  118.     Decimal_Point := Parse_Int('/DPO=',Global_Str('Calc_Params'));
  119.     IF ((Decimal_Point > 1) or (Decimal_Point < 0)) THEN
  120.         Decimal_Point := 0;
  121.     END;
  122.     Func_Str1 := Parse_Str('/FS1=',Global_Str('Calc_Params'));
  123.     Func_Str2 := Parse_Str('/FS2=',Global_Str('Calc_Params'));
  124.     Function_Pending := Parse_Int('/FP=',Global_Str('Calc_Params'));
  125.     IF ((Function_Pending > 1) or (Function_Pending < 0)) THEN
  126.         Function_Pending := 0;
  127.     END;
  128.     IF (RVal(Memory,Parse_Str('/MEM=',Global_Str('Calc_Params')))) THEN
  129.         Memory := 0.0;
  130.     END;
  131.     IF (RVal(Accumulator,Parse_Str('/ACC=',Global_Str('Calc_Params')))) THEN
  132.         Accumulator := 0.0;
  133.     END;
  134.     IF (RVal(Entry,Parse_Str('/ENT=',Global_Str('Calc_Params')))) THEN
  135.         Entry := 0.0;
  136.     END;
  137.     Base := Parse_Int('/BASE=',Global_Str('Calc_Params'));
  138.     IF (XPos(' ' + Str(Base) + ' ',' 2 8 10 16 ',1) = 0) THEN
  139.         Base := 10;
  140.     END;
  141.  
  142. {This is the part for paste in of calculator result.  Actually, it is more
  143. generic than that.  You actually pass as parameters the string representation
  144. of the real value and the base, and it will return a string based on that.  So
  145. it does not neccesarily have to be what's in the calculator.}
  146.     IF (Parse_Int('/STR=',MParm_Str)) THEN
  147.         IF (RVal(T_Real,Parse_Str('/RS=',MParm_Str))) THEN
  148.             T_Real := 0.0;
  149.         END;
  150.         Base := Parse_Int('/BASE=',MParm_Str);
  151.         IF (XPos(' ' + Str(Base) + ' ',' 2 8 10 16 ',1) = 0) THEN
  152.             Base := 10;
  153.         END;
  154.         Decimal_Places := Parse_Int('/DPL=',MParm_Str);
  155.         IF ((Decimal_Places > 10) or (Decimal_Places < 0)) THEN
  156.             Decimal_Places := 0;
  157.         END;
  158.         Decimal_Point := Parse_Int('/DPO=',MParm_Str);
  159.         IF ((Decimal_Point > 1) or (Decimal_Point < 0)) THEN
  160.             Decimal_Point := 0;
  161.         END;
  162.         Call PASTE_IN;
  163.         Goto SPECIAL_EXIT;
  164.     END;
  165.  
  166. {Save some stuff into variables so we can restore them later}
  167.     T_Explosions := Explosions;
  168.     T_Lock_Stat := Peek(0,$417);
  169.  
  170.     Push_Labels;
  171.     Flabel('Help  ',1,All);
  172.     Flabel('Clear ',2,All);
  173.     Flabel('ClrEnt',3,All);
  174.     Flabel('And   ',4,All);
  175.     Flabel('Or    ',5,All);
  176.     Flabel('Xor   ',6,All);
  177.     Flabel('Base  ',7,All);
  178.     Flabel('+/-   ',8,All);
  179.     Flabel('Memory',9,All);
  180.     Flabel('Tape',10,All);
  181.     Flabel('Paste',12,All);
  182.     Flabel('ClrTap',13,All);
  183.     Call MAKE_FACEPLATE;
  184.  
  185.     Explosions := False;
  186.     Visable_Tape_Length := 0;
  187.     Call NUM_LOCK_ON;
  188.  
  189.     IF (Which_One = 1) THEN
  190.         T_Real := Accumulator;
  191.     ELSE
  192.         T_Real := Entry;
  193.     END;
  194.  
  195.     Save_Box(Calc_X,Calc_Y - 2,Calc_X + 44,Calc_Y - 1);
  196.     Call DISPLAY_TAPE;
  197.     IF (Function_Pending) THEN
  198.         IF (Which_One) THEN
  199.             Write(Func_Str1,Calc_X + 37,Calc_Y + 1,0,M_T_Color);
  200.         END;
  201.         Call MAKE_DISPLAY;
  202.         Call WRITE_TO_DISPLAY;
  203.         T_Real := 0.0;
  204.         Goto GET_KEY;
  205.     END;
  206.  
  207. DISPLAY_AND_GET_KEY:
  208.     Call MAKE_DISPLAY;
  209.     Call WRITE_TO_DISPLAY;
  210. GET_KEY:
  211. {
  212. Call DISPLAY_VARS;
  213. }
  214.     Read_Key;
  215.     IF (Key1 = 0) THEN
  216.         IF (Key2 = 250) THEN
  217.             RM('USERIN^CHECKEVENTS /M=1/G=CALCEV/#=' + Str(Ev_Count));
  218.  
  219.             IF (Return_Int) THEN
  220.  
  221.                 RM('USERIN^CHECKEVENTS /M=2/G=CALCEV/#=' + Str(Ev_Count));
  222.                 Return_Int := Parse_Int('/R=',Return_Str);
  223.                 IF (Return_Int > 127) THEN
  224.                     Key2 := Return_Int - 128;
  225.                     Goto MOUSE_KEY2;
  226.                 ELSE
  227.                     Key1 := Return_Int;
  228.                     Goto MOUSE_KEY1;
  229.                 END;
  230.             END;
  231. {Mouse event}
  232. {
  233. ┌─────────────────────────────────────────╖
  234. ├───────────────Calculator────────────────╢
  235. │╔ Dec <F7>══════════════════════════════╕║▒▒
  236. │║                                      0│║▒▒
  237. │╙───────────────────────────────────────┘║▒▒
  238. │And<F4>   A   B    7   8   9     Clr<F2> ║▒▒
  239. │Or <F5>   C   D    4   5   6     *   /   ║▒▒
  240. │Xor<F6>   E   F    1   2   3     +   -   ║▒▒
  241. │Mem<F9>   CE<F3>   0   .  ±<F8>  =<ENTER>║▒▒
  242. ╘ClrTape<ShftF3>══Done<ESC>══Paste<ShftF2>╝▒▒
  243.     ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒
  244. }
  245.             IF (Mou_Last_Y = (Calc_Y + 4)) THEN
  246. {First row of "buttons"
  247. And<F4>   A   B    7   8   9     Clr<F2>
  248. }
  249.                 IF ((Mou_Last_X > (Calc_X)) and (Mou_Last_X < (Calc_X + 8))) THEN
  250.                     Key2 := 62;
  251.                     Goto MOUSE_KEY2;
  252.                 END;
  253.                 IF (Mou_Last_X = (Calc_X + 11)) THEN
  254.                     Key1 := 65;
  255.                     Goto MOUSE_KEY1;
  256.                 END;
  257.                 IF (Mou_Last_X = (Calc_X + 15)) THEN
  258.                     Key1 := 66;
  259.                     Goto MOUSE_KEY1;
  260.                 END;
  261.                 IF (Mou_Last_X = (Calc_X + 20)) THEN
  262.                     Key1 := 55;
  263.                     Goto MOUSE_KEY1;
  264.                 END;
  265.                 IF (Mou_Last_X = (Calc_X + 24)) THEN
  266.                     Key1 := 56;
  267.                     Goto MOUSE_KEY1;
  268.                 END;
  269.                 IF (Mou_Last_X = (Calc_X + 28)) THEN
  270.                     Key1 := 57;
  271.                     Goto MOUSE_KEY1;
  272.                 END;
  273.                 IF ((Mou_Last_X > (Calc_X + 33)) and (Mou_Last_X < (Calc_X + 41))) THEN
  274.                     Key2 := 60;
  275.                     Goto MOUSE_KEY2;
  276.                 END;
  277.             END;
  278.             IF (Mou_Last_Y = (Calc_Y + 5)) THEN
  279. {Second row of "buttons"
  280. Or <F5>   C   D    4   5   6     *   /
  281. }
  282.                 IF ((Mou_Last_X > (Calc_X)) and (Mou_Last_X < (Calc_X + 8))) THEN
  283.                     Key2 := 63;
  284.                     Goto MOUSE_KEY2;
  285.                 END;
  286.                 IF (Mou_Last_X = (Calc_X + 11)) THEN
  287.                     Key1 := 67;
  288.                     Goto MOUSE_KEY1;
  289.                 END;
  290.                 IF (Mou_Last_X = (Calc_X + 15)) THEN
  291.                     Key1 := 68;
  292.                     Goto MOUSE_KEY1;
  293.                 END;
  294.                 IF (Mou_Last_X = (Calc_X + 20)) THEN
  295.                     Key1 := 52;
  296.                     Goto MOUSE_KEY1;
  297.                 END;
  298.                 IF (Mou_Last_X = (Calc_X + 24)) THEN
  299.                     Key1 := 53;
  300.                     Goto MOUSE_KEY1;
  301.                 END;
  302.                 IF (Mou_Last_X = (Calc_X + 28)) THEN
  303.                     Key1 := 54;
  304.                     Goto MOUSE_KEY1;
  305.                 END;
  306.                 IF (Mou_Last_X = (Calc_X + 34)) THEN
  307.                     Key1 := 42;
  308.                     Goto MOUSE_KEY1;
  309.                 END;
  310.                 IF (Mou_Last_X = (Calc_X + 38)) THEN
  311.                     Key1 := 47;
  312.                     Goto MOUSE_KEY1;
  313.                 END;
  314.             END;
  315.             IF (Mou_Last_Y = (Calc_Y + 6)) THEN
  316. {Third row of "buttons"
  317. Xor<F6>   E   F    1   2   3     +   -
  318. }
  319.                 IF ((Mou_Last_X > (Calc_X)) and (Mou_Last_X < (Calc_X + 8))) THEN
  320.                     Key2 := 64;
  321.                     Goto MOUSE_KEY2;
  322.                 END;
  323.                 IF (Mou_Last_X = (Calc_X + 11)) THEN
  324.                     Key1 := 69;
  325.                     Goto MOUSE_KEY1;
  326.                 END;
  327.                 IF (Mou_Last_X = (Calc_X + 15)) THEN
  328.                     Key1 := 70;
  329.                     Goto MOUSE_KEY1;
  330.                 END;
  331.                 IF (Mou_Last_X = (Calc_X + 20)) THEN
  332.                     Key1 := 49;
  333.                     Goto MOUSE_KEY1;
  334.                 END;
  335.                 IF (Mou_Last_X = (Calc_X + 24)) THEN
  336.                     Key1 := 50;
  337.                     Goto MOUSE_KEY1;
  338.                 END;
  339.                 IF (Mou_Last_X = (Calc_X + 28)) THEN
  340.                     Key1 := 51;
  341.                     Goto MOUSE_KEY1;
  342.                 END;
  343.                 IF (Mou_Last_X = (Calc_X + 34)) THEN
  344.                     Key1 := 43;
  345.                     Goto MOUSE_KEY1;
  346.                 END;
  347.                 IF (Mou_Last_X = (Calc_X + 38)) THEN
  348.                     Key1 := 45;
  349.                     Goto MOUSE_KEY1;
  350.                 END;
  351.             END;
  352.             IF (Mou_Last_Y = (Calc_Y + 7)) THEN
  353. {Fourth row of "buttons"
  354. Mem<F9>   CE<F3>   0   .  ±<F8>  =<ENTER>
  355. }
  356.                 IF ((Mou_Last_X > (Calc_X)) and (Mou_Last_X < (Calc_X + 8))) THEN
  357.                     Key2 := 67;
  358.                     Goto MOUSE_KEY2;
  359.                 END;
  360.                 IF ((Mou_Last_X > (Calc_X + 10)) and (Mou_Last_X < (Calc_X + 17))) THEN
  361.                     Key2 := 61;
  362.                     Goto MOUSE_KEY2;
  363.                 END;
  364.                 IF (Mou_Last_X = (Calc_X + 20)) THEN
  365.                     Key1 := 48;
  366.                     Goto MOUSE_KEY1;
  367.                 END;
  368.                 IF (Mou_Last_X = (Calc_X + 24)) THEN
  369.                     Key1 := 46;
  370.                     Goto MOUSE_KEY1;
  371.                 END;
  372.                 IF ((Mou_Last_X > (Calc_X + 26)) and (Mou_Last_X < (Calc_X + 32))) THEN
  373.                     Key2 := 66;
  374.                     Goto MOUSE_KEY2;
  375.                 END;
  376.                 IF ((Mou_Last_X > (Calc_X + 33)) and (Mou_Last_X < (Calc_X + 42))) THEN
  377.                     Key1 := 13;
  378.                     Goto MOUSE_KEY1;
  379.                 END;
  380.             END;
  381.             IF (Mou_Last_Y = Fkey_Row) THEN
  382. {
  383.                 RM('MOUSE^MOUSEFKEY');
  384. }
  385.                 RM('USERIN^MOUSEFKEY');
  386.                 Goto GET_KEY;
  387.             END;
  388.  
  389.             IF (Mou_Last_Y = (Calc_Y + 1)) THEN
  390.                 IF ((Mou_Last_X > (Calc_X + 18)) and    (Mou_Last_X < (Calc_X + 22))) THEN
  391.                     IF (Memory <> 0.0) THEN
  392.                         Key2 := 67;
  393.                         Goto MOUSE_KEY2;
  394.                     END;
  395.                 END;
  396.                 IF ((Mou_Last_X > (Calc_X + 2)) and (Mou_Last_X < (Calc_X + 11))) THEN
  397.                     Key2 := 65;
  398.                     Goto MOUSE_KEY2;
  399.                 END;
  400.             END;
  401. {
  402.             IF ((Mou_Last_Y = (Calc_Y + 2)) and ((Mou_Last_X > (Calc_X + 1)) and
  403.                     (Mou_Last_X < (Calc_X + 41)))) THEN
  404.                 Key2 := 85;
  405.                 Goto MOUSE_KEY2;
  406.             END;
  407. }
  408.             IF (((Mou_Last_Y < Calc_Y) and (Mou_Last_Y >= (Calc_Y - Visable_Tape_Length))) and ((Mou_Last_X > (Calc_X + 1)) and
  409.                     (Mou_Last_X < (Calc_X + 42)))) THEN
  410.                 Push_Key(key1,key2);
  411.                 Key2 := 68;
  412.                 Goto MOUSE_KEY2;
  413.             END;
  414.  
  415.             IF (Mou_Last_Y = Calc_Y) THEN
  416.                 IF ((Mou_Last_X >= Calc_X) and (Mou_Last_X < (Calc_X + 43))) THEN
  417.                     Call MOUSE_MOVE;
  418.                     Goto DISPLAY_AND_GET_KEY;
  419.                 END;
  420.             END;
  421. {
  422.             IF ((Mou_Last_X = Calc_X) or (Mou_Last_X = (Calc_X + 42))) THEN
  423.                 IF ((Mou_Last_Y >= Calc_Y) and (Mou_Last_Y < (Calc_Y + 9))) THEN
  424.                     Call MOUSE_MOVE;
  425.                     Goto DISPLAY_AND_GET_KEY;
  426.                 END;
  427.             END;
  428.             IF ((Mou_Last_Y = Calc_Y) or (Mou_Last_Y = (Calc_Y + 8))) THEN
  429.                 IF ((Mou_Last_X >= Calc_X) and (Mou_Last_X < (Calc_X + 43))) THEN
  430.                     Call MOUSE_MOVE;
  431.                     Goto DISPLAY_AND_GET_KEY;
  432.                 END;
  433.             END;
  434. }
  435. {
  436.             IF (((Mou_Last_Y = Calc_Y) and ((Mou_Last_X = Calc_X) or (Mou_Last_X = Calc_X + 1)))
  437.                     or ((Mou_Last_Y = (Calc_Y + 1)) and (Mou_Last_X = Calc_X))) THEN
  438.                 Call MOUSE_MOVE;
  439.                 Goto DISPLAY_AND_GET_KEY;
  440.             END;
  441. }
  442. {if mouse was clicked outside the boundry of the calculator, exit}
  443.             IF ((Mou_Last_X < Calc_X) or (Mou_Last_X > (Calc_X + 44)) or
  444.                     (Mou_Last_Y < (Calc_Y - Visable_Tape_Length - 1)) or
  445.                     (Mou_Last_Y > (Calc_Y + 9))) THEN
  446.                 Push_Key(Key1,Key2);
  447.                 Goto GO_BYE_BYE;
  448.             END;
  449.             Goto GET_KEY;
  450.         END;
  451. MOUSE_KEY2:
  452.         IF (Key2 = 244) THEN
  453.             Goto GO_BYE_BYE;
  454.         END;
  455.         IF (Key2 = 86) THEN
  456.             Call CLEAR_TAPE;
  457.             Goto GET_KEY;
  458.         END;
  459.         IF (Key2 = 85) THEN
  460.             Kill_Box;
  461.             Kill_Box;
  462.             Return_Int := 1;
  463.             Goto EXIT;
  464.         END;
  465.         IF (Key2 = 59) THEN
  466.             Help('CA');
  467.             Goto GET_KEY;
  468.         END;
  469.         IF (Key2 = 60) THEN
  470.             Call CLEAR;
  471.             Goto DISPLAY_AND_GET_KEY;
  472.         END;
  473.         IF (Key2 = 61) THEN
  474.             Entry := 0.0;
  475.             T_Real := 0.0;
  476.             Decimal_Places := 0;
  477.             Decimal_Point := False;
  478.             Goto DISPLAY_AND_GET_KEY;
  479.         END;
  480.         IF (Key2 = 62) THEN
  481.             Func_Str2 := 'And';
  482.             Input_Char := 'A';
  483.             Goto MATH_OPERATION;
  484.         END;
  485.         IF (Key2 = 63) THEN
  486.             Func_Str2 := 'Or ';
  487.             Input_Char := 'O';
  488.             Goto MATH_OPERATION;
  489.         END;
  490.         IF (Key2 = 64) THEN
  491.             Func_Str2 := 'Xor';
  492.             Input_Char := 'X';
  493.             Goto MATH_OPERATION;
  494.         END;
  495.         IF (Key2 = 65) THEN
  496.             IF (Base = Bin) THEN
  497.                 Base := Oct;
  498.                 Goto DISPLAY_AND_GET_KEY;
  499.             END;
  500.             IF (Base = Oct) THEN
  501.                 Base := Dec;
  502.                 Goto DISPLAY_AND_GET_KEY;
  503.             END;
  504.             IF (Base = Dec) THEN
  505.                 Base := Hex;
  506.                 Goto DISPLAY_AND_GET_KEY;
  507.             END;
  508.             IF (Base = Hex) THEN
  509.                 Base := Bin;
  510.                 Goto DISPLAY_AND_GET_KEY;
  511.             END;
  512.         END;
  513.         IF (Key2 = 66) THEN
  514.             Entry := 0.0 - Entry;
  515.             T_Real := Entry;
  516.             Goto DISPLAY_AND_GET_KEY;
  517.         END;
  518.         IF (Key2 = 67) THEN
  519.             Call MEMORY_MENU;
  520.             Goto DISPLAY_AND_GET_KEY;
  521.         END;
  522.         IF (Key2 = 68) THEN
  523.             Call TAPE_MENU;
  524.             Goto DISPLAY_AND_GET_KEY;
  525.         END;
  526.  
  527.         IF (XPos(Char(Key2),'|72|80|75|77|240|241|242|243',1)) THEN
  528. {Cursor keys}
  529.             IF ((Key2 = 72) or (Key2 = 240)) THEN
  530. {Up}
  531.                 IF (Calc_Y > (Min_Window_Row + 2)) THEN
  532.                     --Calc_Y;
  533.                 END;
  534.             END;
  535.             IF ((Key2 = 80) or (Key2 = 241)) THEN
  536. {Down}
  537.                 IF (Calc_Y < (Max_Window_Row - 10)) THEN
  538.                     ++Calc_Y;
  539.                 END;
  540.             END;
  541.             IF ((Key2 = 75) or (Key2 = 242)) THEN
  542. {Left}
  543.                 IF (Calc_X > 1) THEN
  544.                     --Calc_X;
  545.                 END;
  546.             END;
  547.             IF ((Key2 = 77) or (Key2 = 243)) THEN
  548. {Right}
  549.                 IF (Calc_X < (Screen_Width - 44)) THEN
  550.                     ++Calc_X;
  551.                 END;
  552.             END;
  553.  
  554.             Kill_Box;
  555.             Kill_Box;
  556.             Call MAKE_FACEPLATE;
  557.             Save_Box(Calc_X,Calc_Y - 2,Calc_X + 44,Calc_Y - 1);
  558.             Call DISPLAY_TAPE;
  559.             Goto DISPLAY_AND_GET_KEY;
  560.         END;
  561.     ELSE
  562. MOUSE_KEY1:
  563.         IF (Key1 = 27) THEN
  564. GO_BYE_BYE:
  565.             Kill_Box;
  566.             Kill_Box;
  567.             Return_Int := 0;
  568.             Goto EXIT;
  569.         END;
  570.         Input_Char := Caps(Char(Key1));
  571.         IF (Base = Dec) THEN
  572.             IF ((Input_Char = '.') and ((Decimal_Point = False) or (Last_Key_Type = 3))) THEN
  573.                 Decimal_Point := True;
  574.                 Goto NUMERIC_CHAR;
  575.             END;
  576.         END;
  577.         IF (XPos(Input_Char,Copy(Numeric_Chars,1,Base) + '|8',1)) THEN
  578. NUMERIC_CHAR:
  579.             Func_Str2 := '';
  580. {Be sure that we are not about to exceed the amount of significant digits}
  581.             IF ((Input_Char <> '|8') and (Last_Key_Type = 1)) THEN
  582.                 Call CHECK_WORD_LENGTH;
  583.                 IF (Return_Int) THEN
  584.                     Goto GET_KEY;
  585.                 END;
  586.             END;
  587.             IF (Last_Key_Type <> 1) THEN
  588.                 Entry := 0.0;
  589.                 T_Real := 0.0;
  590.                 IF (Input_Char <> '.') THEN
  591.                     Decimal_Point := 0;
  592.                 END;
  593.                 Decimal_Places := 0;
  594.                 Disp_Str := '0';
  595.             END;
  596.             Write('═══',Calc_X + 37,Calc_Y + 1,0,M_B_Color);
  597.             Which_One := 0;
  598.             Call INPUT_NUMERIC;
  599.             IF (Error_Flag) THEN
  600.                 Goto ERROR;
  601.             END;
  602.             Entry := T_Real;
  603.             Last_Key_Type := 1;
  604.             Goto DISPLAY_AND_GET_KEY;
  605.         END;
  606.         IF (XPos(Input_Char,'+-*/',1)) THEN
  607.                 Func_Str2 := ' ' + Input_Char + ' ';
  608. MATH_OPERATION:
  609.             T_Real := Entry;
  610.             Return_Str := Input_Char;
  611.             Call PUSH_TAPE;
  612.             IF (Function_Pending) THEN
  613.                 T_Real := Accumulator;
  614.                 Call DO_FUNCTION;
  615.                 IF (Error_Flag) THEN
  616.                     Goto ERROR;
  617.                 END;
  618.                 Accumulator := T_Real;
  619.                 Call MAKE_DISPLAY;
  620.                 Call WRITE_TO_DISPLAY;
  621.             ELSE
  622.                 Function_Pending := True;
  623.                 Accumulator := Entry;
  624.             END;
  625.             Which_One := 1;
  626.             Decimal_Point := False;
  627.             Decimal_Places := 0;
  628.             Func_Str1 := Func_Str2;
  629.             Entry := 0.0;
  630.             T_Real := 0.0;
  631.             Write(Func_Str1,Calc_X + 37,Calc_Y + 1,0,M_T_Color);
  632.             Last_Key_Type := 2;
  633.             Goto GET_KEY;
  634.         END;
  635.         IF (XPos(Input_Char,'=|13',1)) THEN
  636.             IF (Func_Str2 <> '') THEN
  637.                 Write('═══',Calc_X + 37,Calc_Y + 1,0,M_B_Color);
  638.                 Entry := Accumulator;
  639.             END;
  640.             Which_One := 1;
  641.             Return_Str := '=';
  642.             Call PUSH_TAPE;
  643.  
  644.             IF ((Func_Str1 <> '') and (Function_Pending = True)) THEN
  645.  
  646.                 T_Real := Accumulator;
  647.                 Function_Pending := False;
  648.                 Call DO_FUNCTION;
  649.                 IF (Error_Flag) THEN
  650.                     Goto ERROR;
  651.                 END;
  652.  
  653.             ELSE
  654.                 T_Real := Entry;
  655.             END;
  656.  
  657.             Accumulator := T_Real;
  658.             Entry := T_Real;
  659.             Call MAKE_DISPLAY;
  660.             Return_Str := ' ';
  661.             Call PUSH_TAPE;
  662.             Return_Str := '─';
  663.             Call PUSH_TAPE;
  664.             Func_Str2 := ' = ';
  665.             Last_Key_Type := 3;
  666.             Goto DISPLAY_AND_GET_KEY;
  667.  
  668.         END;
  669.     END;
  670.     Goto GET_KEY;
  671.  
  672. ERROR:
  673.     Write('               Error!  Press any key...',Calc_X + 2,Calc_Y + 2,0,M_S_Color);
  674.     Read_Key;
  675.     Call CLEAR;
  676.     Goto DISPLAY_AND_GET_KEY;
  677.  
  678. {********************************** SUBROUTINES ******************************}
  679. {
  680. DISPLAY_VARS:
  681. {For debugging only!}
  682. {
  683. Write('Last_Key_Type= [' + Str(Last_Key_Type) + ']                      ',1,1,0,Error_Color);
  684. Write('Which_One=     [' + Str(Which_One) + ']                       ',1,2,0,Error_Color);
  685. }
  686.  
  687. Write('Decimal_Point=      [' + Str(Decimal_Point) + ']                      ',1,1,0,Error_Color);
  688. Write('Decimal_Places=      [' + Str(Decimal_Places) + ']                      ',1,2,0,Error_Color);
  689. Write('T_REAL=      [' + RSTR(T_Real,10,10) + ']                      ',1,3,0,Error_Color);
  690. Write('ACCUMULATOR= [' + RSTR(Accumulator,10,10) + ']                 ',1,4,0,Error_Color);
  691. Write('ENTRY=       [' + RSTR(Entry,10,10) + ']                       ',1,5,0,Error_Color);
  692. Write('MEMORY=      [' + RSTR(Memory,10,10) + ']                       ',1,6,0,Error_Color);
  693. Write('Func_Str2=  [' + Func_Str2 + ']                       ',1,7,0,Error_Color);
  694. Write('Func_Str1=  [' + Func_Str1 + ']                       ',1,8,0,Error_Color);
  695. Write('Function_Pending=[' + Str(Function_Pending) + ']                       ',1,9,0,Error_Color);
  696. Write('Which_One=   [' + Str(Which_One) + ']                       ',1,10,0,Error_Color);
  697. {
  698. T_Int := 0;
  699. WHILE (T_Int < Tape_Length) DO
  700. ++T_Int;
  701. Write('Calc_Tape' + Str(T_Int) + '=[' + Global_Str('Calc_Tape' + Str(T_Int)) + ']                      ',1,T_Int,0,Error_Color);
  702. END;
  703. }
  704. RET;
  705. }
  706. MOUSE_MOVE:
  707.     RM('WINDOW^MOVE_WIN /X1=' + str(calc_x) +
  708.             '/Y1=' + str(calc_y) +
  709.             '/X2=' + str(calc_x + 42) +
  710.             '/Y2=' + str(calc_y + 8) +
  711.             '/MX1=1/MY1=' + str(min_window_row + 1) +
  712.             '/MX2=' + str(screen_width) + '/MY2=' + Str(Max_window_row - 2) );
  713.     calc_x := parse_int('/X1=',return_str);
  714.     calc_y := parse_int('/Y1=',return_str);
  715.     kill_box;
  716.     kill_box;
  717.     Call MAKE_FACEPLATE;
  718.     Save_Box(Calc_X,Calc_Y - 2,Calc_X + 44,Calc_Y - 1);
  719.     Call DISPLAY_TAPE;
  720.     RET;
  721.  
  722. NUM_LOCK_ON:
  723.  
  724.     Poke(0,$417,Peek(0,$417) or $20);
  725.     RET;
  726.  
  727. NUM_LOCK_OFF:
  728.     Poke(0,$417,Peek(0,$417) and $DF);
  729.     RET;
  730.  
  731. CHECK_WORD_LENGTH:
  732.     IF (Base = Dec) THEN
  733.         T_Real := Entry;
  734.         Call GET_DECIMAL_PLACES;
  735.         Return_Str := RStr(Entry,0,Return_Int);
  736.         Return_Int := ((Length(Return_Str) - (XPos('.',Return_Str,1) > 0) -
  737.             (Entry < 1.0)) > 9);
  738.     ELSE
  739.         Return_Int := (Copy(Remove_Space(Disp_Str),1,1) <> '0');
  740.     END;
  741.     RET;
  742.  
  743. TAPE_MENU:
  744. {Build global strings for DVMENU}
  745.     T_Int := 0;
  746.     Legal_Count := 0;
  747.     WHILE (T_Int < Actual_Tape_Length) DO
  748.         ++T_Int;
  749.         T_Tape := Global_Str('Calc_Tape' + Str(T_Int));
  750.         T_Char := Parse_Str('/OP=',T_Tape);
  751.         Return_Int := XPos(T_Char,'─C',1);
  752.         IF (Return_Int = False) THEN
  753.             ++Legal_Count;
  754.         END;
  755.         Set_Global_Str('Calc_Tape_Dv' + Str(Actual_Tape_Length - T_Int + 1),
  756.             Copy(Parse_Str('/DS=',T_Tape) + '                                       '
  757.             ,((Return_Int = 2) * 39) + 1,39) + Copy(' ─',(Return_Int = 1) + 1,1) + Copy(T_Char + ' ─|254 |254 ',
  758.             ((Return_Int) * 2) + 1,2));
  759.     END;
  760.     IF (Legal_Count = 0) THEN
  761.         Ret;
  762.     END;
  763.     Call NUM_LOCK_OFF;
  764.     IF (Tape_On = False) THEN
  765.         Put_Box(Calc_X,Calc_Y - Visable_Tape_Length - 1,Calc_X + 42,Calc_Y,0,M_B_Color,'',False);
  766.     END;
  767. {
  768.     Write(' = select <Enter> = recall <Esc> = exit',Calc_X + 1,Calc_Y - Visable_Tape_Length - 1,0,M_T_Color);
  769. }
  770.     Write('╞═════════════════════════════════════════╣',Calc_X,Calc_Y,0,M_B_Color);
  771.  
  772.     RM('USERIN^DVMENU /P=CALC_TAPE_DV/H=CA/NR=1/I=%/WW=41/SK=1/#=' +
  773.         Str(Actual_Tape_Length) + '/X=' + Str(Calc_X) + '/Y=' +
  774.         Str(Calc_Y - Visable_Tape_Length - 1) + '/SN=' + Str(Actual_Tape_Length) +
  775.         '/MH=' + Str(Visable_Tape_Length));
  776.  
  777.     IF (Tape_On = False) THEN
  778.         Kill_Box;
  779.     END;
  780.     IF (Return_Int) THEN
  781. {Turn the string into a real value, then stuff it into the entry}
  782.         Return_Int := Actual_Tape_Length - Global_Int('DVINT') + 1;
  783.         Return_Str := Remove_Space(Copy(Parse_Str('/DS=',Global_Str('Calc_Tape' +
  784.             Str(Return_Int))),1,39));
  785.         T_Int := Parse_Int('/B=',Global_Str('Calc_Tape' + Str(Return_Int)));
  786.         IF (T_Int = Bin) THEN
  787.             Call STRIP_SPACES;
  788.         END;
  789.         Return_Int := T_Int;
  790.         IF (Base = Dec) THEN
  791.             Decimal_Point := XPos('.',Return_Str,1);
  792.             IF (Decimal_Point) THEN
  793.                 Decimal_Places := Length(Return_Str) - Decimal_Point;
  794.                 Decimal_Point := True;
  795.             END;
  796.         END;
  797.         Call STRING_TO_REAL;
  798.         Entry := T_Real;
  799.         Which_One := 0;
  800.         Func_Str2 := '';
  801.     END;
  802.     Call NUM_LOCK_ON;
  803.     Kill_Box;
  804.     Kill_Box;
  805.     Call MAKE_FACEPLATE;
  806.     Save_Box(Calc_X,Calc_Y - 2,Calc_X + 44,Calc_Y - 1);
  807.     Call DISPLAY_TAPE;
  808.     RET;
  809.  
  810. CLEAR_TAPE:
  811.     T_Int := Tape_Length;
  812.     WHILE (T_Int) DO
  813.         Set_Global_Str('Calc_Tape' + Str(T_Int),'');
  814.         --T_Int;
  815.     END;
  816.     Call DISPLAY_TAPE;
  817.     RET;
  818.  
  819. PUSH_TAPE:
  820.     T_Int := Tape_Length - 1;
  821.     WHILE (T_Int) DO
  822.         Set_Global_Str('Calc_Tape' + Str(T_Int + 1),Global_Str('Calc_Tape' + Str(T_Int)));
  823.         --T_Int;
  824.     END;
  825.     IF (Return_Str = '/') THEN
  826.         Return_Str := '//';
  827.     END;
  828.     IF (Return_Str = 'C') THEN
  829.         Set_Global_Str('Calc_Tape1','/DS=                                      0/OP=' + Return_Str + '/B=' + Str(Base));
  830.     ELSE
  831.         IF (Return_Str = '─') THEN
  832.             Set_Global_Str('Calc_Tape1','/DS=───────────────────────────────────────/OP=' + Return_Str + '/B=' + Str(Base));
  833.         ELSE
  834.             Set_Global_Str('Calc_Tape1','/DS=' + Disp_Str + '/OP=' + Return_Str + '/B=' + Str(Base));
  835.         END;
  836.     END;
  837.     Call DISPLAY_TAPE;
  838.     RET;
  839.  
  840. DISPLAY_TAPE:
  841. {First, determine how long the tape is currently}
  842.     T_Int := Tape_Length;
  843.     WHILE (((Remove_Space(Parse_Str('/DS=',Global_Str('Calc_Tape' + Str(T_Int)))) = '') or (Parse_Str('/OP=',Global_Str('Calc_Tape' + Str(T_Int))) = 'C'))
  844.         and
  845.         (T_Int > 0)) DO
  846.         --T_Int;
  847.     END;
  848.     Actual_Tape_Length := T_Int;
  849. {Determine if the position of the calculator will restrict displaying all of
  850. tape}
  851.     Return_Int := Calc_Y - Min_Window_Row - 1;
  852.     IF (T_Int > Return_Int) THEN
  853.         T_Int := Return_Int;
  854.     END;
  855.     Visable_Tape_Length := T_Int;
  856. {Redraw the box around the tape}
  857.     Kill_Box;
  858.     Save_Box(Calc_X,Calc_Y - Visable_Tape_Length - 1,Calc_X + 44,Calc_Y - 1);
  859.     IF (Tape_On = False) THEN
  860.         Ret;
  861.     END;
  862.     T_Int := 0;
  863.     WHILE (T_Int < Visable_Tape_Length) DO
  864.         ++T_Int;
  865.         Write('│                                         ║',Calc_X,Calc_Y - T_Int,0,M_B_Color);
  866.         IF (Parse_Str('/OP=',Global_Str('Calc_Tape' + Str(T_Int))) = 'C') THEN
  867.             Write('                                         ',Calc_X + 1,
  868.                 Calc_Y - T_Int,0,M_T_Color);
  869.         ELSE
  870.             IF (Parse_Str('/OP=',Global_Str('Calc_Tape' + Str(T_Int))) = '─') THEN
  871.                 Write('─────────────────────────────────────────',
  872.                     Calc_X + 1,Calc_Y - T_Int,0,M_T_Color);
  873.             ELSE
  874.                 Write(Parse_Str('/DS=',Global_Str('Calc_Tape' + Str(T_Int))) + ' ' +
  875.                     Parse_Str('/OP=',Global_Str('Calc_Tape' + Str(T_Int)))
  876.                     ,Calc_X + 1,Calc_Y - T_Int,0,M_T_Color);
  877.             END;
  878.         END;
  879.     END;
  880.     Write('┌─────────────────────────────────────────╖',Calc_X,Calc_Y - T_Int - 1,0,M_B_Color);
  881.     RET;
  882.  
  883. MEMORY_MENU:
  884. {
  885.     Write('MEM: <CR>=MIn  +=M+  R=MRec <ESC>=Exit',Calc_X + 2,Calc_Y + 1,0,M_T_Color);
  886. }
  887.     Write('MEM:',Calc_X + 2,Calc_Y + 1,0,M_T_Color);
  888.     Set_Global_Str('MEMEV1','/T=MIn/KC=<ENTER>/W=10/K1=13/K2=28/R=13/Y=' +
  889.             Str(Calc_Y + 1) + '/X=' + Str(Calc_X + 7));
  890.     Set_Global_Str('MEMEV2','/T=M+/KC=<+>/W=5/K1=43/K2=78/R=43/Y=' +
  891.             Str(Calc_Y + 1) + '/X=' + Str(Calc_X + 18));
  892.     Set_Global_Str('MEMEV3','/T=MRec/KC=<R>/W=7/K1=82/K2=19/R=82/Y=' +
  893.             Str(Calc_Y + 1) + '/X=' + Str(Calc_X + 24));
  894.     Set_Global_Str('MEMEV4','/T=Exit/KC=<ESC>/W=9/K1=27/K2=1/R=27/Y=' +
  895.             Str(Calc_Y + 1) + '/X=' + Str(Calc_X + 32));
  896.     RM('USERIN^CHECKEVENTS /M=2/G=MEMEV/#=4');
  897.  
  898.     Read_Key;
  899.     IF ((Key1 = 0) and (key2 = 250)) THEN
  900.         RM('USERIN^CHECKEVENTS /M=1/G=MEMEV/#=4');
  901.         IF (Return_Int) THEN
  902.             Key1 := Parse_Int('/R=',Global_Str('MEMEV' + Str(Return_Int)));
  903.         ELSE
  904.             Push_Key(Key1,Key2);
  905.             Goto MEMORY_EXIT;
  906.         END;
  907.     END;
  908.     IF (Key1 = 27) THEN
  909.         Goto MEMORY_EXIT;
  910.     END;
  911.     IF (Key1 = 13) THEN
  912.         IF (Which_One = 1) THEN
  913.             Memory := Accumulator;
  914.         ELSE
  915.             Memory := Entry;
  916.         END;
  917.         Goto MEMORY_EXIT;
  918.     END;
  919.     IF (Key1 = 43) THEN
  920.         IF (Which_One = 1) THEN
  921.             Memory := Memory + Accumulator;
  922.         ELSE
  923.             Memory := Memory + Entry;
  924.         END;
  925.         Goto MEMORY_EXIT;
  926.     END;
  927.     IF ((Key1 = 114) or (Key1 = 82)) THEN
  928.         Entry := Memory;
  929.         T_Real := Memory;
  930.         Which_One := 0;
  931.         Func_Str2 := '';
  932.         Goto MEMORY_EXIT;
  933.     END;
  934.     Goto MEMORY_MENU;
  935.  
  936. MEMORY_EXIT:
  937.     Write('<F7>══════════════════════════════',Calc_X + 7,Calc_Y + 1,0,M_B_Color);
  938.     RET;
  939.  
  940. MAKE_FACEPLATE:
  941.     set_virtual_display;
  942.  
  943.         Put_Box(Calc_X,Calc_Y,Calc_X + 44,Calc_Y + 9,0,M_B_Color,'Calculator',True);
  944.         IF (Tape_On) THEN
  945.             Write('├',Calc_X,Calc_Y,0,M_B_Color);
  946.             Write('╢',Calc_X + 42,Calc_Y,0,M_B_Color);
  947.         END;
  948.         Write('╔     <F7> ═════════════════════════════╕',Calc_X + 1,Calc_Y + 1,0,M_B_Color);
  949.         Write('║                                       │',Calc_X + 1,Calc_Y + 2,0,M_B_Color);
  950.         Write('╙───────────────────────────────────────┘',Calc_X + 1,Calc_Y + 3,0,M_B_Color);
  951.         Write('And<F4>   A   B    7   8   9     Clr<F2>',Calc_X + 1,Calc_Y + 4,0,M_B_Color);
  952.         Write('Or <F5>   C   D    4   5   6     *   /',Calc_X + 1,Calc_Y + 5,0,M_B_Color);
  953.         Write('Xor<F6>   E   F    1   2   3     +   -',Calc_X + 1,Calc_Y + 6,0,M_B_Color);
  954.         Write('Mem<F9>   CE<F3>   0   .  ±<F8>  =<ENTER>',Calc_X + 1,Calc_Y + 7,0,M_B_Color);
  955.  
  956.         Set_Global_Str('CALCEV1','/T=Done/KC=<ESC>/W=9/K1=27/K2=1/R=27/Y=' +
  957.             Str(Calc_Y + 8) + '/X=' + Str(Calc_X + 18));
  958.         Set_Global_Str('CALCEV2','/T=ClrTape/KC=<ShftF3>/W=15/K1=0/K2=86/R=214/Y=' +
  959.             Str(Calc_Y + 8) + '/X=' + Str(Calc_X + 1));
  960.         Set_Global_Str('CALCEV3','/T=Paste/KC=<ShftF2>/W=13/K1=0/K2=85/R=213/Y=' +
  961.             Str(Calc_Y + 8) + '/X=' + Str(Calc_X + 29));
  962.  
  963.         RM('USERIN^CHECKEVENTS /M=2/G=CALCEV/#=' + Str(Ev_Count));
  964.     update_virtual_display;
  965.     reset_virtual_display;
  966.     RET;
  967.  
  968. WRITE_TO_DISPLAY:
  969. {
  970.     Write(Global_Str('Calc_Base_Display' + Str(Base)) + Copy('══M ',
  971.                         ((Memory <> 0.0) * 2) + 1,2),    Calc_X + 2,Calc_Y + 1,0,M_B_Color);
  972. }
  973.         Write(Copy('═══ M ',((Memory <> 0.0) * 3) + 1,3),Calc_X + 19,Calc_Y + 1,0,
  974.                     M_B_Color);
  975.     Write(Global_Str('Calc_Base_Display' + Str(Base)),Calc_X + 2,Calc_Y + 1,0,
  976.                 M_B_Color);
  977.     Write(Disp_Str,Calc_X + 2,Calc_Y + 2,0,M_S_Color);
  978.     GotoXY(Calc_X + 40,Calc_Y + 2);
  979.     RET;
  980.  
  981. CLEAR:
  982.     Which_One := 0;
  983.     Decimal_Places := 0;
  984.     Decimal_Point := False;
  985.     Accumulator := 0.0;
  986.     Entry := 0.0;
  987.     T_Real := 0.0;
  988.     Func_Str1 := '';
  989.     Func_Str2 := '';
  990.     Last_Key_Type := 0;
  991.     Function_Pending := False;
  992.     Write('═══',Calc_X + 37,Calc_Y + 1,0,M_B_Color);
  993.     Return_Str := 'C';
  994.     Call PUSH_TAPE;
  995.     RET;
  996.  
  997. DO_FUNCTION:
  998.     Error_Flag := False;
  999.     IF (Func_Str1 = ' + ') THEN
  1000.         T_Real := T_Real + Entry;
  1001.         IF (T_Real > Max_Pos) THEN
  1002.             Error_Flag := True;
  1003.         END;
  1004.     END;
  1005.     IF (Func_Str1 = ' - ') THEN
  1006.         T_Real := T_Real - Entry;
  1007.         IF (T_Real < Min_Neg) THEN
  1008.             Error_Flag := True;
  1009.         END;
  1010.     END;
  1011.     IF (Func_Str1 = ' * ') THEN
  1012.         T_Real := T_Real * Entry;
  1013.         IF (T_Real > Max_Pos) THEN
  1014.             Error_Flag := True;
  1015.         END;
  1016.     END;
  1017.     IF (Func_Str1 = ' / ') THEN
  1018.         IF (Entry = 0.0) THEN
  1019.             Error_Flag := True;
  1020.             Ret;
  1021.         END;
  1022.         T_Real := T_Real / Entry;
  1023.     END;
  1024. {if we are doing And Or Xor, we need to convert to integer type first,
  1025. do the operation, then convert back to real.}
  1026.     IF (Func_Str1 = 'And') THEN
  1027.         T_Real := Real_I(Int_R(T_Real) and Int_R(Entry));
  1028.     END;
  1029.     IF (Func_Str1 = 'Or ') THEN
  1030.         T_Real := Real_I(Int_R(T_Real) or Int_R(Entry));
  1031.     END;
  1032.     IF (Func_Str1 = 'Xor') THEN
  1033.         T_Real := Real_I(Int_R(T_Real) xor Int_R(Entry));
  1034.     END;
  1035.     IF ((Base = Dec) and (Error_Flag = False)) THEN
  1036. {Adjust decimal_Places}
  1037.         Call GET_DECIMAL_PLACES;
  1038.         Decimal_Places := Return_Int;
  1039.     END;
  1040.     RET;
  1041.  
  1042. GET_DECIMAL_PLACES:
  1043.     Return_Str := RStr(T_Real,0,10);
  1044.     Return_Str := Copy(Return_Str,XPos('.',Return_Str,1),11);
  1045.     T_Int := 11;
  1046.     WHILE (Copy(Return_Str,T_Int,1) = '0') DO
  1047.         --T_Int;
  1048.     END;
  1049.     --T_Int;
  1050.     Return_Int := T_Int;
  1051.     RET;
  1052.  
  1053. STRIP_SPACES:
  1054.     Return_Int := XPos(' ',Return_Str,1);
  1055.     IF (Return_Int) THEN
  1056.         Return_Str := Str_Del(Return_Str,Return_Int,1);
  1057.         Goto STRIP_SPACES;
  1058.     END;
  1059.     RET;
  1060.  
  1061. INPUT_NUMERIC:
  1062.     Call MAKE_DISPLAY;
  1063.     Return_Str := Remove_Space(Disp_Str);
  1064.     IF (Base = Bin) THEN
  1065.         Call STRIP_SPACES;
  1066.     END;
  1067.     IF (Base = Dec) THEN
  1068.         IF ((Decimal_Point = True) and (Input_Char <> '.')) THEN
  1069.             IF (Input_Char = '|8') THEN
  1070.                 IF (Decimal_Places = 0) THEN
  1071.                     Decimal_Point := False;
  1072.                     Goto DELETE_DEC;
  1073.                 END;
  1074.                 --Decimal_Places;
  1075. {
  1076.                 IF (Decimal_Places = 0) THEN
  1077. }
  1078.                     Goto DELETE_DEC;
  1079. {
  1080.                 END;
  1081. }
  1082.             ELSE
  1083.                 ++Decimal_Places;
  1084.             END;
  1085.         ELSE
  1086.             IF (Input_Char = '|8') THEN
  1087. DELETE_DEC:
  1088.                 Return_Str := Copy(Return_Str,1,Length(Return_Str) - 1);
  1089.             END;
  1090.         END;
  1091.     ELSE
  1092.         IF (Input_Char = '|8') THEN
  1093.             Return_Str := Copy('0' + Return_Str,1,Length(Return_Str));
  1094.         ELSE
  1095.             Return_Str := Copy(Return_Str,2,31);
  1096.         END;
  1097.     END;
  1098.     IF (XPos(Input_Char,'.|8',1) = 0) THEN
  1099.         Return_Str := Return_Str + Input_Char;
  1100.     END;
  1101. {now, convert it back to a real}
  1102.     Return_Int := Base;
  1103. {We are storing Base into Return_Int just so we can accomodate a call to the
  1104. following label}
  1105. STRING_TO_REAL:
  1106.     IF (Return_Int = Dec) THEN
  1107.         Return_Int := RVal(T_Real,Return_Str);
  1108.     ELSE
  1109.         T_Real := 0.0;
  1110.         T_Int := Length(Return_Str);
  1111.         WHILE (T_Int > 0) DO
  1112.             T_Real := T_Real + Real_I((XPos(Copy(Return_Str,Length(Return_Str) - T_Int
  1113.                     + 1,1),'0123456789ABCDEF',1) - 1) Shl (Shift_Places * (T_Int - 1)));
  1114.             --T_Int
  1115.         END;
  1116.     END;
  1117.  
  1118.     IF ((T_Real > Max_Pos) or (T_Real < Min_Neg)) THEN
  1119.         Error_Flag := True;
  1120.     ELSE
  1121.         Error_Flag := False;
  1122.     END;
  1123.     RET;
  1124.  
  1125. MAKE_DISPLAY:
  1126. {This routine will change T_Real into a string representation according to the
  1127. base}
  1128.     IF (Base = Dec) THEN
  1129.         Disp_Str := RStr(T_Real,0,Decimal_Places);
  1130.         IF ((Decimal_Point = True) and (Decimal_Places = 0)) THEN
  1131.             Disp_Str := Disp_Str + '.';
  1132.         END;
  1133.     ELSE
  1134.         Return_Int := Int_R(T_Real) and Word_Length_Mask;
  1135.         Disp_Str := '';
  1136.         IF (Base = Bin) THEN
  1137.             Shift_Places := 1;
  1138.         END;
  1139.         IF (Base = Oct) THEN
  1140.             Shift_Places := 3;
  1141.         END;
  1142.         IF (Base = Hex) THEN
  1143.  
  1144.             Shift_Places := 4;
  1145.         END;
  1146.  
  1147.         WHILE (Return_Int <> 0) DO
  1148.             Disp_Str := Copy('0123456789ABCDEF',((Return_Int and (Base - 1)) + 1),1) + Disp_Str;
  1149.             Return_Int := Return_Int shr Shift_Places;
  1150.         END;
  1151.         Return_Int := Svl(Disp_Str);
  1152.         IF (Return_Int < (Word_Length / Shift_Places)) THEN
  1153.             Disp_Str := Copy('00000000000000000000000000000000',1,(Word_Length / Shift_Places) - Return_Int) + Disp_Str;
  1154.         END;
  1155.     END;
  1156.     IF (Base = Bin) THEN
  1157. {Put in spaces every 4 bits for clarity}
  1158.         T_Int := (Word_Length / 4) - 1;
  1159.         WHILE (T_Int) DO
  1160.             Disp_Str := Str_Ins(' ',Disp_Str,(T_Int * 4) + 1);
  1161.             --T_Int;
  1162.         END;
  1163.     END;
  1164.     Disp_Str := Copy('                                       ',1,39 - (Svl(Disp_Str))) + Disp_Str;
  1165.     RET;
  1166.  
  1167. PASTE_IN:
  1168.     Call MAKE_DISPLAY;
  1169.     Return_Str := Remove_Space(Disp_Str);
  1170.     RET;
  1171.  
  1172. {*****************************************************************************}
  1173.  
  1174. EXIT:
  1175. {Save all pertainant stuff into a global}
  1176.     Set_Global_Str('Calc_Params',
  1177.         '/X=' + Str(Calc_X) +
  1178.         '/Y=' + Str(Calc_Y) +
  1179.         '/WO=' + Str(Which_One) +
  1180.         '/LK=' + Str(Last_Key_Type) +
  1181.         '/BASE=' + Str(Base) +
  1182.         '/DPL=' + Str(Decimal_Places) +
  1183.         '/DPO=' + Str(Decimal_Point) +
  1184.         '/FS1=' + Func_Str1 +
  1185.         '/FS2=' + Func_Str2 +
  1186.         '/FP=' + Str(Function_Pending) +
  1187.         '/MEM=' + RStr(Memory,10,10) +
  1188.         '/ACC=' + RStr(Accumulator,10,10) +
  1189.         '/ENT=' + RStr(Entry,10,10)
  1190.     );
  1191. {Restore all altered system vars, etc.}
  1192.     RM('USERIN^CHECKEVENTS /M=3/G=CALCEV/#=' + Str(Ev_Count));
  1193.     RM('USERIN^CHECKEVENTS /M=3/G=MEMEV/#=4');
  1194.     Set_Global_Str('CALCEV1','');
  1195.     Poke(0,$417,(Peek(0,$417) and $DF) or (T_Lock_Stat and $20));
  1196.     Explosions := T_Explosions;
  1197.     Pop_Labels;
  1198.     IF (Return_Int) THEN
  1199. {If they want to paste in the result, do it}
  1200.         Call PASTE_IN;
  1201.         Text(Return_Str);
  1202.     END;
  1203. SPECIAL_EXIT:
  1204.     Return_Int := 1;
  1205. END_MACRO;
  1206.  
  1207. $MACRO PASTE_CALC;
  1208. {*******************************MULTI-EDIT MACRO******************************
  1209.  
  1210. Name:  PASTE_CALC
  1211.  
  1212. Description:  Will place the value last displayed on the calculator at the
  1213.                             current cursor position.
  1214.  
  1215.                              (C) Copyright 1989 by American Cybernetics, Inc.
  1216. ******************************************************************************}
  1217.  
  1218. {Determine if the value last displayed is an entry or a result, then use the
  1219. appropriate value}
  1220.     IF (Parse_Int('/WO=',Global_Str('Calc_Params')) = 1) THEN
  1221.         Return_Str := Parse_Str('/ACC=',Global_Str('Calc_Params'));
  1222.     ELSE
  1223.         Return_Str := Parse_Str('/ENT=',Global_Str('Calc_Params'));
  1224.     END;
  1225.     RM('CALC /STR=1/RS=' + Return_Str + '/BASE=' +
  1226.         Parse_Str('/BASE=',Global_Str('Calc_Params')) + '/DPL=' +
  1227.         Parse_Str('/DPL=',Global_Str('Calc_Params')) + '/DPO=' +
  1228.         Parse_Str('/DPO=',Global_Str('Calc_Params')));
  1229.  
  1230.     Text(Return_Str);
  1231. END_MACRO;