home *** CD-ROM | disk | FTP | other *** search
/ CD/PC Actual 15 / CDACTUAL15.iso / cdactual / program / basic / QBNWS104.ZIP / CALC.ZIP / LSRGCALC.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-08-29  |  32.1 KB  |  831 lines
  1. '               +===========================================+
  2. '               |               LSRGCALC.BAS                |
  3. '               |    "LS-1.0 Plus Scientific Calculator"    |
  4. '               |                Version 1.0                |
  5. '               |          Written and Developed by         |
  6. '               |              Lawrence Stone               |
  7. '               |            Copyright (C) 1990             |
  8. '               |       Lawrence Stone Research Group       |
  9. '               +-------------------------------------------+
  10.  
  11. '               +===========================================+
  12. '               |       Purpose: TSR pop-up calculator      |
  13. '               +-------------------------------------------+
  14.  
  15. '               +===========================================+
  16. '               |               Pre-processor               |
  17. '               +-------------------------------------------+
  18.  
  19. '#LinkSwitches: '/noe/exe'
  20. '#CompileSwitches: '/FPi/Ot/S/X/O'
  21. '#EXEName: 'LSRGCALC'
  22. '#LeadingObject: 'd:\qb\obj\STAYQB4'
  23. '#TrailingObject: 'f:\CALCMOD'
  24. '#TrailingObject: 'd:\qb\obj\MHGETCHR'
  25. '#TrailingObject: 'd:\bc7\lib\SMALLERR'
  26. '#TrailingObject: 'd:\qb\qbpro\pro7\obj\XREDIR70'
  27. '#TrailingObject: 'd:\qb\obj\MHMISCP'
  28. '#Libraries: 'd:\qb\bin\MHLIB2'
  29. '#Libraries: 'd:\qb\bin\MHPRO1'
  30. '#Libraries: 'd:\qb\bin\MHPRO2'
  31. '#Libraries: 'd:\qb\bin\MHPRO4'
  32. '#Libraries: 'd:\qb\bin\MHPRO7'
  33. '#ObjectPath: 'F:'
  34. '#EXEpath: 'F:'
  35. '#WorkPath: 'F:'
  36.  
  37. ' ============================================================================
  38. ' Subprogram and Function Declarations Go Here (If using QB4 / BC6)
  39. ' ----------------------------------------------------------------------------
  40.  
  41. DECLARE SUB Complex2String (a AS ANY, x$)
  42. DECLARE SUB ComplexAdd (a AS ANY, b AS ANY, c AS ANY)
  43. DECLARE SUB ComplexDiv (a AS ANY, b AS ANY, c AS ANY, Ecode%)
  44. DECLARE SUB ComplexExp (a AS ANY, c AS ANY, Ecode%)
  45. DECLARE SUB ComplexLog (a AS ANY, c AS ANY, Ecode%)
  46. DECLARE SUB ComplexMul (a AS ANY, b AS ANY, c AS ANY, Ecode%)
  47. DECLARE SUB ComplexPower (a AS ANY, b AS ANY, c AS ANY, t AS ANY, t1 AS ANY, t2 AS ANY, Ecode%)
  48. DECLARE SUB ComplexReciprocal (a AS ANY, c AS ANY, t3 AS ANY, Ecode%)
  49. DECLARE SUB ComplexRoot (a AS ANY, b AS ANY, c AS ANY, t AS ANY, t1 AS ANY, t2 AS ANY, t3 AS ANY, Ecode%)
  50. DECLARE SUB ComplexSub (a AS ANY, b AS ANY, c AS ANY)
  51. DECLARE SUB ComplxIntRoot (a AS ANY, c AS ANY, Root!, Ecode%)
  52. DECLARE SUB ConvertNum (num#, DispNum$, hexOn%, octOn%)
  53. DECLARE SUB DoShowRed ()
  54. DECLARE SUB FixDisplay ()
  55. DECLARE SUB GetKeysRowCol (scanCode%, Row%, Col%)
  56. DECLARE SUB HiLowSounds ()
  57. DECLARE SUB InverseVideo (Row%, Col%, Monitor%)
  58. DECLARE SUB KeyResponce (scanCode%, asci%, shiftStat%)
  59. DECLARE SUB MainMenu (GoSleep%, terminate%, Row%, Col%, Monitor%, CalcFunction%, tableOn%, hstOn%)
  60. DECLARE SUB ProcessTable (Operation%, choice%, maxTable%)
  61. DECLARE SUB ProcessTheHit (Row%, Col%, GoSleep%, terminate%)
  62. DECLARE SUB RandShuffle (RandArray&())
  63. DECLARE SUB ResetOperators ()
  64. DECLARE SUB ScrLine (Lin$, Row%, Col%, Clr%)
  65. DECLARE SUB ScrollHistory ()
  66. DECLARE SUB SelectMathOp ()
  67. DECLARE SUB ShowHist (temp$)
  68. DECLARE SUB ShowIndicators ()
  69. DECLARE SUB ShowNumber ()
  70. DECLARE SUB String2Complex (x$, a AS ANY, Ecode%)
  71. DECLARE SUB StuffKey (stuff$)
  72. DECLARE SUB TickPause (Ticks%)
  73.  
  74. DECLARE FUNCTION ArithMean# (StatArray#())
  75. DECLARE FUNCTION BinToStr$ (Bin%)
  76. DECLARE FUNCTION Combinations# (items#, rate#)
  77. DECLARE FUNCTION DateDiff& (D0$, D1$)
  78. DECLARE FUNCTION DayShort$ (Day%)
  79. DECLARE FUNCTION DayMath$ (D0$, Days&)
  80. DECLARE FUNCTION DayOfWeek% (Month%, Day%, Year%)
  81. DECLARE FUNCTION FloatNum# (DispNum$)
  82. DECLARE FUNCTION FromJulian$ (JulianNumber&)
  83. DECLARE FUNCTION FromSeconds$ (Seconds&)
  84. DECLARE FUNCTION GeoMean# (StatArray#())
  85. DECLARE FUNCTION GoodDate% (dat$)
  86. DECLARE FUNCTION HarmMean# (StatArray#())
  87. DECLARE FUNCTION HoursMath$ (T0$, Hours!)
  88. DECLARE FUNCTION MinutesMath$ (T0$, Minutes!)
  89. DECLARE FUNCTION MonthLong$ (Month%)
  90. DECLARE FUNCTION MonthMath$ (D0$, Months&)
  91. DECLARE FUNCTION Permutations# (items#, rate#)
  92. DECLARE FUNCTION QuadMean# (StatArray#())
  93. DECLARE FUNCTION Rand& (RandArray&())
  94. DECLARE FUNCTION RandExp# (mean#, RandArray&())
  95. DECLARE FUNCTION RandFrac! (RandArray&())
  96. DECLARE FUNCTION RandNormal# (mean#, stdDev#, RandArray&())
  97. DECLARE FUNCTION RandRange# (num1#, num2#, RandArray&())
  98. DECLARE FUNCTION Round# (N#, decimal%)
  99. DECLARE FUNCTION SecondsMath$ (T0$, Seconds&)
  100. DECLARE FUNCTION StrToBin% (b$)
  101. DECLARE FUNCTION TimeDiff$ (T0$, t1$)
  102. DECLARE FUNCTION ToJulian& (D0$)
  103. DECLARE FUNCTION ToSeconds& (T0$)
  104. DECLARE FUNCTION YearMath$ (D0$, Years&)
  105.  
  106. TYPE Complex
  107.     r AS SINGLE
  108.     i AS SINGLE
  109. END TYPE
  110.  
  111. DEFINT A-Z
  112.  
  113.     '--------------------------------------------------------------------
  114.     'Defining Your Hot Key - Refer to Appendix A of the Stay-Res manual
  115.     '                        for the proper values of Kscan% and Kshift%.
  116.     '--------------------------------------------------------------------
  117.  
  118.     Kscan% = 57              'Define a Hot Key of Right Shift plus Spacebar
  119.     Kshift% = 1
  120.  
  121.     '---------------------------------------------------------------------
  122.     'Dynamic Arrays          Note: because we use SrAutoSetBlock, we will use
  123.     '                        this section to define as much as possible.  -LS
  124.     '---------------------------------------------------------------------
  125.  
  126. '   ---- Define the data segment for screen writes.
  127.     REM $DYNAMIC
  128.     DIM CalcScrn%(5632)           ' 11,264 bytes of memory is reserved
  129.     DIM Windmem%(4000)            ' 8,000 bytes reserved for orig screen
  130.  
  131.     '   ---- Background screen arrays needed for holding the original screen
  132.     '        at the right side of each calculator screen.  These arrays provide
  133.     '        smooth animation.
  134.     '
  135.     '        Note that because this TSR could pop-up over a variety of
  136.     '        screen (text) modes at any time, we must dimension our arrays
  137.     '        to handle the largest text screen possible which is 80 x 50.
  138.     '
  139.     '   Array calculation: area% = ((lastCol - startCol) + 1) * 50
  140.     '   area 41 = 2000              ' area% = ((80 - 41) + 1) * 50
  141.     '   area 42 = 1950              ' area% = ((80 - 42) + 1) * 50
  142.     '   area 59 = 1100              ' area% = ((80 - 59) + 1) * 50
  143.  
  144.     DIM Area41%(2000)               ' The calculator is closed.
  145.     DIM Area42%(1950)               ' The calculator half open.
  146.     DIM Area59%(1100)               ' The calculator 3/4 open.
  147.  
  148.     DIM SHARED TheScreen%(4001)     ' Used to hold right side of calc when
  149.                                     ' lookup table is covering it.
  150.  
  151.     '   ---- Statistics array and Random Table array
  152.     DIM SHARED StatArray#(500), RandArray&(1 TO 100)
  153.  
  154.     '   ---- Keystroke History Log and the calculator Table array
  155.     DIM SHARED HistLog(1 TO 100) AS STRING * 29
  156.     DIM SHARED CalcTable(1 TO 512) AS STRING * 29
  157.     REM $STATIC
  158.  
  159.     ' Establish array for Row & column coordinates to calculator functions.
  160.     DIM SHARED CalOps%(7 TO 23, 10 TO 70)
  161.  
  162.     '   ---- Establish various arrays to handle parenthesis operations
  163.     DIM SHARED parenNum1#(1 TO 8), parenMath%(1 TO 8), parenNum2#(1 TO 8)
  164.  
  165.     '   ---- Set various aliases for the Complex TYPE
  166.     DIM SHARED a AS Complex, b AS Complex, c AS Complex, t AS Complex
  167.     DIM SHARED t1 AS Complex, t2 AS Complex, t3 AS Complex
  168.  
  169.     DIM SHARED maxTable%, Monitor%, CalcFunction AS INTEGER, scrolPos%
  170.     DIM SHARED false  AS INTEGER, true AS INTEGER, zero AS INTEGER, hstBound
  171.     DIM SHARED hexOn  AS INTEGER, binOn AS INTEGER, octOn AS INTEGER
  172.     DIM SHARED degOn  AS INTEGER, complxOn AS INTEGER, statsOn AS INTEGER
  173.     DIM SHARED dateOn AS INTEGER, timeOn AS INTEGER, lptOn AS INTEGER
  174.     DIM SHARED diskFile AS INTEGER, realNum AS INTEGER, parens AS INTEGER
  175.     DIM SHARED fixedPoint AS INTEGER, hstOn AS INTEGER, memOn AS INTEGER
  176.     DIM SHARED radOn AS INTEGER, gradOn AS INTEGER, makedate AS INTEGER
  177.     DIM SHARED makeArray%, DosBusy%, makePower%, makeRoot%, Power$, Root$
  178.     DIM SHARED PermComb%, stdDev#, decimal%, mean#, items#, UserError%
  179.     DIM SHARED makeNum%, setValue%, num#, num1#, num2#, N#, mathOp AS INTEGER
  180.  
  181.     DIM SHARED fixedFlag$, LogN$, rate$, DispNumber$, hstCount AS INTEGER
  182.     DIM SHARED PowerFlag$, RootFlag$, Root1$, makeHr$, DispNum$, ProgName$
  183.     DIM SHARED Root2$, goof$, makeYr$, makeMo$, makeDy$, dateDisp$, CalcDisp$
  184.     DIM SHARED makeMin$, makeSec$, mean$, stdDev$, DosBusy$, timeDisp$
  185.     DIM SHARED OutPutFile$, cmmd$, stuff$, LogBaseN$, tableOn, screenArea%
  186.     DIM SHARED CaptureLog0$, CaptureLog1$, CaptureLog2$, arcOn%, hypOn%
  187.     
  188.     CONST pi# = 3.141592653589#, L10# = 2.30258509299405#
  189.     CONST angFactor# = 57.2957795130823#
  190.  
  191. '   ---- Define the program's name.
  192.     ProgName$ = "LSRGCALC"
  193.  
  194. '   ---- Define a string to inform the user what the hot keys are
  195.     HotKeys$ = "Use <Right Shift> + <SpaceBar> Key Combination to Awaken."
  196.  
  197.     false = 0: true = NOT false: zero = false
  198.     degOn = true: realNum = true
  199.  
  200.     fixedPoint = true: fixedFlag$ = "Fixed = ": LogN$ = "Base n = "
  201.     PowerFlag$ = "Power = ": RootFlag$ = "Root = ": Root1$ = "r√ = "
  202.     Root2$ = "j√ = ": goof$ = " Error": makeYr$ = "Years = "
  203.     makeMo$ = "Months = ": makeDy$ = "Days = ": rate$ = "Rate = "
  204.     ProgTerminate$ = " - Program Terminated!": makeHr$ = "Hours = "
  205.     makeMin$ = "Minutes = ": makeSec$ = "Seconds = ": mean$ = "ñ = "
  206.     stdDev$ = "sd = ": DosBusy$ = "DOS is Busy" + SPACE$(14)
  207.     OutPutFile$ = ProgName$ + ".FIL" + CHR$(0)
  208.  
  209.     '   ---- Set a fixed length string for displaying the keyed numbers
  210.     DispNumber$ = SPACE$(25)
  211.  
  212.     '   ---- Define a string for the date and time template
  213.     dateDisp$ = "mm/dd/yyyy": timeDisp$ = "hh:mm:ss"
  214.     
  215. '   ---- Have this program reserve a block of DOS memory and have it
  216. '        contiguous - starting at the top of QB's stack address.
  217.     
  218.     HeapMem& = FRE(-1)
  219.     HeapMem& = HeapMem& - (4096)
  220.     MemNeeded& = SETMEM(-HeapMem&)
  221.     
  222.     CALL SrAutoSetBlock(Paragraphs%, Ecode%)
  223.  
  224.     IF HeapMem& < 65536 OR Ecode% <> zero THEN
  225.         ScrLine SPACE$(2000), 1, 1, 7
  226.         ScrLine "Not enough memory to run " + ProgName$ + ".", 1, 1, 7
  227.         ScrLine "Execution of " + ProgName$ + " terminated.", 2, 1, 7
  228.         HiLowSounds
  229.         END
  230.     END IF
  231.     
  232.     '---------------------------------------------------------------------
  233.     'Set Up Automatic Screen Save/Restore Parameters
  234.     '---------------------------------------------------------------------
  235.  
  236. '   ---- Don't use StayRes automatic screen save option - we will be
  237. '        handling all screen save/restore ourselves.
  238.     Bytes% = 0
  239.     CALL SrUseDynScreenMem(Bytes%)
  240.     CALL SrDontRestoreScreen
  241.  
  242.     '---------------------------------------------------------------------
  243.     'Stay-Res Plus Options
  244.     '---------------------------------------------------------------------
  245.  
  246. '   ---- Get the command line argument.
  247.     Lin$ = SPACE$(128)
  248.     CALL MhCommand(Lin$, Length%)
  249.     cmmd$ = UCASE$(LEFT$(Lin$, Length%))
  250.  
  251.     IF cmmd$ = "DISK" THEN
  252.         UseDiskSwap% = -1
  253.     ELSEIF cmmd$ = "DOS" THEN
  254.         DontUseEMS = -1
  255.     ELSEIF cmmd$ <> "EMS" THEN
  256.         cmmd$ = ""
  257.         GOTO InitParams    'Program loaded without options so skip to InitParams
  258.     END IF
  259.  
  260. '   ---- Check to see if LSRGCALC is already installed.
  261.     IDNumber = 7667
  262.     CALL SrSetId(ProgName$, IDNumber, Ecode)
  263.     IF Ecode THEN
  264.         ScrLine SPACE$(2000), 1, 1, 7
  265.         ScrLine ProgName$ + " Already Installed in Memory.", 1, 1, 7
  266.         ScrLine HotKeys$, 2, 1, 7
  267.         HiLowSounds
  268.         END
  269.     END IF
  270.  
  271. '   ---- Set the File's initials to "C1".
  272.     Initials$ = "C1"
  273.     CALL SrSetFileInitials(Initials$)
  274.  
  275.     IF UseDiskSwap% THEN            'User requested Disk Swapping
  276.         CALL SrForceFile0           'Allow only two swap files to accumalate
  277.         CALL SrDiskSwap("", Ecode%)
  278.         IF Ecode% THEN
  279.             ScrLine SPACE$(2000), 1, 1, 7
  280.             ScrLine ProgName$ + " Error" + STR$(SwapEcode%) + " During Disk-Swapping Initialization!", 1, 1, 7
  281.             HiLowSounds
  282.             END
  283.         END IF
  284.     ELSE
  285.         IF DontUseEMS THEN          'User requested DOS RAM-residency
  286.             CALL SrIgnoreEMS
  287.         ELSE                        'User requested EMS swapping
  288.             CALL SrCheckEMS(Ecode%)
  289.             IF Ecode% THEN
  290.                 ScrLine SPACE$(2000), 1, 1, 7
  291.                 ScrLine "EMS Memory not available.  Using DOS Memory.", 1, 1, 7
  292.                 HiLowSounds
  293.                 TickPause 36
  294.             END IF
  295.         END IF
  296.     END IF
  297.  
  298.  
  299. ' ============================================================================
  300. ' Initialization Section 2 - Your program can use this section to set up all
  301. '                            of its constants, dimension any STATIC arrays
  302. '                            it will need and perform any processing that is
  303. '                            needed before entering the main program logic.
  304. '                            DO NOT delete the "GOSUB BecomeResident" below.
  305. '
  306. '                            Note:  because SrAutoSetBlock was used in lieu
  307. '                            of SrSetBlock, dimensioning static arrays and
  308. '                            constants was already performed.  Hence, this
  309. '                            section is only used to perform any processing
  310. '                            needed before entering the main program logic. -LS
  311. ' ----------------------------------------------------------------------------
  312.  
  313. InitParams:
  314. '   ---- Get the screen paramaters
  315.     GOSUB ScreenParams
  316.  
  317.     '   ---- Initialize the random table
  318.     RandShuffle RandArray&()
  319.  
  320.     '   ---- Just in case we're dealing with a weird screen mode
  321.     IF screenArea > 8000 THEN END
  322.  
  323.     '   ---- Open the calculator's appropriate screen file for reading.
  324.     CALL MhFile(zero, CalcScrn$ + CHR$(zero), zero, zero, Handle%, Ecode%)
  325.     IF Ecode% GOTO Handler
  326.  
  327.     '   ---- Read the calc screen directly into the CalcScrn%() array
  328.     Operation% = zero
  329.     Offset% = zero: Bytes% = 11 * 1024
  330.     Dtaseg% = VARSEG(CalcScrn%(zero))
  331.     CALL MhRwSub(Handle%, Operation%, RwPointer&, Dtaseg%, Offset%, Bytes%, Ecode%)
  332.     IF Ecode% GOTO Handler
  333.     CALL MhFile(zero, "", zero, zero, Handle%, Ecode%)      'Close this file.
  334.  
  335.     '---- Open and read the Table file into the table array
  336.     Lin$ = SPACE$(512)
  337.     temp$ = ProgName$ + ".TBL" + CHR$(0)
  338.  
  339.     FOR i% = 1 TO 512       'Input up to 512 lines from the file
  340.         CALL MhLineInput(temp$, Lin$, Length%, Ecode%)
  341.         IF Ecode% THEN EXIT FOR
  342.         maxTable% = i%
  343.         LSET CalcTable(i%) = LEFT$(Lin$, Length%)  'Put it into the array
  344.     NEXT
  345.  
  346.     temp$ = "": Lin$ = ""
  347.     CALL MhCloseFile       'Close this file
  348.     
  349.     '---- Build the array that correlates function numbers to row/col location
  350.     GOSUB BuildArray
  351.  
  352. '   ---- Inform the user that we are now memory resident and going to sleep.
  353.     IF cmmd$ <> "" THEN
  354.         ScrLine SPACE$(2000), 1, 1, 7
  355.         ScrLine ProgName$ + " is Loaded into Memory and is Going to Sleep.", 1, 1, 7
  356.         ScrLine HotKeys$, 2, 1, 7
  357.     END IF
  358.  
  359.     '   ---- Turn off snow checking for faster video display.
  360.     CALL MhVideo(&HFFFF)
  361.  
  362.     '   ---- Initialize the mouse.
  363.     CALL MhMouseReset(sn1%, sn2%)
  364.  
  365.     IF cmmd$ = "" THEN          'If program was loaded without options...
  366.         GOSUB GetCursorPosition
  367.         Visible% = false        'We want an invisible cursor
  368.         GOSUB DoCursor
  369.     ELSE                        'If program loaded for RAM residency...
  370.         Ecode% = 0
  371.         GOSUB BecomeResident    'Become memory-resident for the first time.
  372.     END IF
  373.  
  374.  
  375. ' ============================================================================
  376. ' Main Program Section - This is the point where your program should be
  377. '                        entered on each pop up.
  378. ' ----------------------------------------------------------------------------
  379.  
  380. MainLoop:
  381.     CALL MhMouseHide            'Hide the rodent
  382.     GoSleep% = false
  383.     terminate% = false
  384.  
  385.     '   ---- Store the screen as it existed before the calculator pops up
  386.     WindSeg = VARSEG(Windmem%(zero))
  387.     CALL MhMove(Monitor%, zero, screenArea, WindSeg, zero)
  388.  
  389.     '   ---- Save the panels to the right of the calculator panels.
  390.     Dtaseg% = VARSEG(Area41%(zero))
  391.     CALL MhSavePartScreen(ScrnCols%, 1, 41, ScrnRows%, ScrnCols%, Dtaseg%, zero)
  392.     Dtaseg% = VARSEG(Area42%(zero))
  393.     CALL MhSavePartScreen(ScrnCols%, 1, 42, ScrnRows%, ScrnCols%, Dtaseg%, zero)
  394.     Dtaseg% = VARSEG(Area59%(zero))
  395.     CALL MhSavePartScreen(ScrnCols%, 1, 59, ScrnRows%, ScrnCols%, Dtaseg%, zero)
  396.  
  397.     GOSUB FastKey                      'Set the cursor speed
  398.     GOSUB OpenCalc                     'Open the calc like a wallet
  399.  
  400.     ShowIndicators                     'Display inicators in Indicator window
  401.     ScrLine CaptureLog0$, 4, 42, 10    'Display special info in indicator window
  402.  
  403.     ScrLine DispNumber$, 3, 12, 14     'Display the number in primary window
  404.     ScrLine CalcDisp$, 9, 42, 14       'Display lookup info in lookup window
  405.     ScrLine CaptureLog1$, 6, 42, 15    'Display history line number one
  406.     ScrLine CaptureLog2$, 7, 42, 15    'Display history line number two
  407.     
  408.     '   ---- Establish the enter key as default starting point on first pass.
  409.     IF CalcFunction = zero OR CalcFunction = 40 THEN
  410.         prevHit = 28
  411.         Col = 34
  412.         FOR Row = 21 TO 23
  413.             InverseVideo Row%, Col%, Monitor%
  414.         NEXT
  415.         Row = 23
  416.     ELSE
  417.         InverseVideo Row%, Col%, Monitor%
  418.     END IF
  419.  
  420.     '   ---- All calculator operations are selected & processed from this loop
  421.     DO
  422.         MainMenu GoSleep%, terminate%, Row%, Col%, Monitor, CalcFunction, tableOn, hstOn%
  423.         IF GoSleep% THEN
  424.             CalcFunction = 10
  425.             Row% = 9: Col% = 34
  426.             EXIT DO
  427.         ELSEIF terminate% THEN
  428.             CalcFunction = 15
  429.             Row% = 11: Col% = 34
  430.             EXIT DO
  431.         END IF
  432.         ProcessTheHit Row%, Col%, GoSleep%, terminate%
  433.     LOOP UNTIL GoSleep% OR terminate%
  434.  
  435.     '   ---- If we loaded without options then Sleep is the same as End
  436.     IF LEN(cmmd$) = 0 AND GoSleep% = true THEN GoSleep% = false
  437.  
  438.     '   ---- If we were printing to lpt or disk then print the last number
  439.     IF lptOn OR diskFile THEN ShowHist temp$
  440.  
  441.     '   ---- If we were outputting to a disk file then close the file.
  442.     CALL MhCloseOFile(Ecode%)
  443.  
  444.     '   ---- Establish variables to redisplay when we pop back up
  445.     CaptureLog0$ = SPACE$(29)
  446.     CaptureLog1$ = CaptureLog0$
  447.     CaptureLog2$ = CaptureLog0$
  448.  
  449.     '   ---- Fill these variables with info read from the monitor
  450.     CALL MhRscr(CaptureLog0$, Page%, 4, 42, 29)
  451.     CALL MhRscr(CaptureLog1$, Page%, 6, 42, 29)
  452.     CALL MhRscr(CaptureLog2$, Page%, 7, 42, 29)
  453.     
  454.     IF GoSleep% THEN
  455.         GOSUB GotoSleep
  456.         GOTO MainLoop
  457.     END IF
  458.  
  459.     GOTO ReleaseMem
  460.  
  461.  
  462. ' ============================================================================
  463. '                         S U B R O U T I N E S
  464. ' ----------------------------------------------------------------------------
  465.  
  466.  
  467. '   ---- Set the cursor
  468. DoCursor:
  469.     CALL MhLocate(Page%, CursorRow%, CursorCol%, Visible%, CursorStartScan%, CursorEndScan%)
  470. RETURN
  471.  
  472. '   ---- Open the calculator
  473. OpenCalc:
  474.     Operation% = 2'     tells the routine to restore the window
  475.     topRow% = 1
  476.     BottomRow% = 24
  477.     LeftCol% = 8
  478.  
  479.     FOR x = 1 TO 5
  480.         IF x = 1 THEN
  481.             RightCol% = 40
  482.         ELSEIF x = 2 THEN
  483.             RightCol% = 40
  484.         ELSEIF x = 3 THEN
  485.             RightCol% = 41
  486.         ELSEIF x = 4 THEN
  487.             RightCol% = 58
  488.         ELSEIF x = 5 THEN
  489.             RightCol% = 72
  490.         END IF
  491.  
  492.         Buffer.number% = x
  493.         Dtaseg% = VARSEG(CalcScrn%(zero))
  494.         CALL Mhwind(Colr%, Dtaseg%, Operation%, Page%, topRow%, LeftCol%, BottomRow%, RightCol%, Buffer.number%, Box%, Ecode%)
  495.         IF Ecode% GOTO Handler
  496.  
  497.         '   ---- Shadow the side of the calculator.
  498.         IF x <> 2 THEN            'Prevent re-shadowing the first shadow created
  499.             FOR ShadeRow% = 2 TO 24
  500.                 FOR Z = 1 TO 2
  501.                     IF x = 3 THEN Z = 2   'Prevent shadowing previous shadows!
  502.                     ShadeCol% = RightCol% + Z
  503.                     GOSUB CalcShade
  504.                 NEXT
  505.             NEXT
  506.         END IF
  507.  
  508.         '   ---- Shadow below the calculator.
  509.         ShadeRow% = 25
  510.         IF x <> 2 THEN          'Prevents re-shadowing the first shadow created
  511.             IF x = 1 THEN
  512.                 Z = 10
  513.             ELSEIF x = 3 THEN
  514.                 Z = 43
  515.             ELSEIF x = 4 THEN
  516.                 Z = 44
  517.             ELSEIF x = 5 THEN
  518.                 Z = 61
  519.             END IF
  520.             FOR ShadeCol% = Z TO RightCol% + 2
  521.                 GOSUB CalcShade
  522.             NEXT
  523.         END IF
  524.  
  525.         IF x = 1 THEN
  526.             TickPause 45        'Approx 2 1/2 second delay (hold the copyright)
  527.         ELSE
  528.             TickPause 3         'Minor delay between animated frames
  529.         END IF
  530.     NEXT
  531.  
  532.     TickPause 5                 'Slight pause after the calculator is opened
  533. RETURN
  534.  
  535. '   ---- Close the calculator
  536. CloseCalc:
  537.     FOR x = 4 TO 1 STEP -1    'First, restore original screens to right of calc
  538.         IF x = 1 THEN
  539.             RightCol% = 40
  540.         ELSEIF x = 2 THEN
  541.             RightCol% = 40
  542.             Dtaseg% = VARSEG(Area41%(zero))
  543.             CALL MhRestorePartScreen(ScrnCols%, 1, 41, ScrnRows%, ScrnCols%, Dtaseg%, zero)
  544.         ELSEIF x = 3 THEN
  545.             RightCol% = 41
  546.             Dtaseg% = VARSEG(Area42%(zero))
  547.             CALL MhRestorePartScreen(ScrnCols%, 1, 42, ScrnRows%, ScrnCols%, Dtaseg%, zero)
  548.         ELSEIF x = 4 THEN
  549.             RightCol% = 58
  550.             Dtaseg% = VARSEG(Area59%(zero))
  551.             CALL MhRestorePartScreen(ScrnCols%, 1, 59, ScrnRows%, ScrnCols%, Dtaseg%, zero)
  552.         END IF
  553.  
  554.         '   ---- Re-display calc screens in reverse order
  555.         Buffer.number% = x
  556.         Dtaseg% = VARSEG(CalcScrn%(zero))
  557.         CALL Mhwind(Colr%, Dtaseg%, Operation%, Page%, topRow%, LeftCol%, BottomRow%, RightCol%, Buffer.number%, Box%, Ecode%)
  558.         IF Ecode% GOTO Handler
  559.  
  560.         '   ---- Reshadow the side of the calculator as it closes.
  561.         IF x <> 1 THEN            'Prevent shadowing previous shadows!
  562.             FOR ShadeRow% = 2 TO 25
  563.                 FOR Z = 1 TO 2
  564.                     ShadeCol% = RightCol% + Z
  565.                     GOSUB CalcShade
  566.                 NEXT
  567.             NEXT
  568.         END IF
  569.  
  570.         IF x = 1 THEN
  571.             TickPause 30          'Delay the copyright screen about 1.67 seconds
  572.         ELSE
  573.             TickPause 3           'Slight pause between animated frames
  574.         END IF
  575.     NEXT
  576. RETURN
  577.  
  578. '   ---- Get the color attributes from the monitor.
  579. GetChar:
  580.     CALL MhGetChar(ShadeRow%, ShadeCol%, Char%, Attr%)
  581. RETURN
  582.  
  583. '   ---- Restore the original screen that existed before the pop up
  584. RestoreDefaultScrn:
  585.     WindSeg = VARSEG(Windmem%(zero))
  586.     CALL MhMove(WindSeg, zero, screenArea, Monitor%, zero)
  587. RETURN
  588.  
  589. '   ---- Change the color attributes on the monitor at specified locations.
  590. ScattAttrib:
  591.     CALL MhScatt(Page%, ShadeRow%, ShadeCol%, Attr%, 1) ' Set new color Attr%
  592. RETURN
  593.  
  594. '   ---- Set the cursor typmatic and delay rates.
  595. FastKey:
  596.     CALL MhKeyboardSpeed(4, 1, 1, zero)
  597. RETURN
  598.  
  599. '   ---- Return the cursor speed to it's original values.
  600. KeySpeedOff:
  601.     CALL MhTurnOffKeyboardSpeed
  602. RETURN
  603.  
  604. '   ---- Create a dual dimmensioned array that correlates row/col position
  605. '        with integers representing various calculator functions.
  606. BuildArray:
  607.     '---- Establish function numbers for the left half of the calculator.
  608.     choice% = 1
  609.     FOR x = 7 TO 23
  610.         IF x MOD 2 THEN
  611.             check% = zero
  612.             FOR Y = 10 TO 38
  613.                 check% = check% + 1
  614.                 IF check% < 6 THEN
  615.                     CalOps%(x, Y) = choice%
  616.                 END IF
  617.                 IF check% MOD 5 = zero THEN choice% = choice% + 1
  618.                 IF check% = 6 THEN check% = zero
  619.             NEXT
  620.         END IF
  621.     NEXT
  622.     '---- Correct the "=" key so that all its rows and cols = function 40.
  623.     FOR x = 21 TO 23
  624.         FOR Y = 34 TO 38
  625.             CalOps%(x, Y) = 40
  626.         NEXT
  627.     NEXT
  628.  
  629.     '---- Establish function numbers for the right half of the calculator.
  630.     choice% = 45
  631.     FOR x = 12 TO 22
  632.         IF x MOD 2 = zero THEN
  633.             check% = zero
  634.             FOR Y = 42 TO 70
  635.                 check% = check% + 1
  636.                 IF check% < 6 THEN
  637.                     CalOps%(x, Y) = choice%
  638.  
  639.                     '---- Adjust for blank space before the "Deg" key
  640.                     IF check1% = false AND choice% = 60 THEN CalOps%(x, Y) = zero
  641.  
  642.                     '---- Adjust for blank space after the "Grad" key
  643.                     IF check2% = false AND choice% = 63 THEN CalOps%(x, Y) = zero
  644.                 END IF
  645.  
  646.                 '---- Adjust the "Deg" key to equal function 60.
  647.                 IF choice% = 60 AND check% = 5 AND check1% = false THEN
  648.                     check1% = true
  649.                     choice% = choice% - 1
  650.                 END IF
  651.  
  652.                 '---- Adjust the "Float" key to equal function 63.
  653.                 IF choice% = 63 AND check% = 5 AND check2% = false THEN
  654.                     check2% = true
  655.                     choice% = choice% - 1
  656.                 END IF
  657.  
  658.                 IF check% MOD 5 = zero THEN choice% = choice% + 1
  659.                 IF check% = 6 THEN check% = zero
  660.             NEXT
  661.         END IF
  662.     NEXT
  663.     '   ---- Zero out the temporary check integers.
  664.     check% = zero: check1% = zero: check2% = zero
  665. RETURN
  666.  
  667. '   ---- Set a shadow color attribute.
  668. CalcShade:
  669.     GOSUB GetChar
  670.     '   ---- The above call is EQV to Attr% = SCREEN(ShadeRow%, ShadeCol%, -1)
  671.  
  672.     Attr% = Attr% AND 15              ' Strip the background color from Attr%
  673.     Attr% = Attr% - 8                 ' Remove bright from the color
  674.     IF Attr% < 1 THEN Attr% = 8       ' If color wasn't bright - make it grey
  675.     GOSUB ScattAttrib
  676. RETURN
  677.  
  678. GotoSleep:
  679.     GOSUB CloseCalc                       'Close the calculator
  680.     GOSUB RestoreDefaultScrn              'Restore the original screen
  681.     
  682.     IF Mode% <> Kscan% THEN               'If we changed the video mode when
  683.         CALL SrSetVideoMode(Kscan%)       'we popped up, change it back to
  684.     END IF                                'the original mode.
  685.     
  686.     Visible% = CursorOn%                  'Reset cursor to original on/off mode
  687.     GOSUB DoCursor                        'Now, restore the original cursor
  688.     GOSUB KeySpeedOff                     'Reset the original typmatic speed
  689.     
  690.     IF LEN(stuff$) THEN StuffKey stuff$   'Do we stuff the keyboard buffer?
  691.     
  692. BecomeResident:
  693.     HeapMem& = FRE("")                    'Garbage collection
  694.     
  695.     CALL StayResident(Kscan%, Kshift%, Ecode%)   'Time to snooze
  696.     CALL MhMouseReset(sn1%, sn2%)
  697.  
  698.     stuff$ = ""
  699.     DosBusy% = zero
  700.  
  701.     IF Ecode% = 1 THEN                'Check for any errors
  702.         DosBusy% = -1                 'This flag can be checked by your prog-
  703.                                       'ram before using any DOS functions.
  704.     ELSEIF Ecode% = 2 THEN            'Not enough memory to become resident.
  705.         ScrLine SPACE$(screenArea / 2), 1, 1, 7
  706.         ScrLine "Not Enough Memory.  Program not loaded.", 2, 1, 7
  707.         HiLowSounds
  708.         END
  709.  
  710.     ELSEIF Ecode% <> zero THEN              'Other error occured
  711.         ScrLine SPACE$(screenArea / 2), 1, 1, 7
  712.         ScrLine ProgName$ + " Error" + STR$(Ecode%) + ProgTerminate$, 2, 1, 7
  713.         HiLowSounds
  714.         END
  715.     END IF
  716.  
  717.     '   ---- Check the monitor type and video mode.
  718.     GOSUB ScreenParams
  719.  
  720.     IF NOT (Kscan% = 2 OR Kscan% = 3 OR Kscan% = 7) THEN    'Check video mode.
  721.         GOTO BecomeResident            'If it is too high, pop down.
  722.  
  723.     '   ---- Do we need to reset video mode?
  724.     ELSEIF ((Kscan% = 7 AND Monitor = &HB000) OR ((Kscan% = 3 OR Kscan% = 2) AND Monitor = &HB800)) THEN
  725.         Mode% = Kscan%
  726.         GOTO GetCursorPosition         'No changes so don't reset video mode.
  727.     ELSE                               'Screen mode is different - so process it
  728.         IF Monitor = &HB000 THEN
  729.             Mode% = 7                  'If color, set mode 7 (text mode).
  730.         ELSE
  731.             Mode% = 3                  'If mono, set mode 3
  732.         END IF
  733.     END IF
  734.  
  735.     CALL SrSetVideoMode(Mode%)         'Reset video mode
  736.  
  737. GetCursorPosition:
  738.     '   ---- Get the state of the cursor.
  739.     DEF SEG = zero
  740.     CursorEndScan% = PEEK(&H460)                'Find end scan line
  741.     CursorStartScan% = PEEK(&H461) AND &H1F     'Find start scan line
  742.     IF NOT ((PEEK(&H461) AND 32) = 32) THEN     'Determine the state of the
  743.         CursorOn% = 1                           'cursor (on/off).
  744.     ELSE
  745.         CursorOn% = zero
  746.     END IF
  747.     DEF SEG
  748.  
  749.     Visible% = false        'Set cursor's visibility to off
  750.     GOSUB DoCursor
  751. RETURN
  752.  
  753. ScreenParams:
  754.     CALL MhDisplay(Mode%, ScrnCols%, ScrnRows%, Mem%, DisplayType%)
  755.     IF DisplayType% >= 128 THEN
  756.         Monitor% = &HB800
  757.         CalcScrn$ = "CALCSCRN.CLR"
  758.     ELSE
  759.         Monitor% = &HB000
  760.         CalcScrn$ = "CALCSCRN.MON"
  761.     END IF
  762.     screenArea = ScrnCols% * ScrnRows% * 2
  763. RETURN
  764.  
  765. '   ---- Come here when you want to "unload" your program from memory.
  766. ReleaseMem:
  767.     IF ScreenError <> zero THEN END       'Error during program initialization
  768.     GOSUB CloseCalc                       'Close the calculator
  769.     GOSUB KeySpeedOff                     'Restore typmatic & delay rate
  770.     GOSUB RestoreDefaultScrn              'Restore original screen
  771.     Visible% = CursorOn%                  'Reset cursor's on/off mode
  772.     GOSUB DoCursor                        'Restore original cursor
  773.     IF LEN(stuff$) THEN StuffKey stuff$   'Do we stuff keyboard buffer?
  774.  
  775.     IF cmmd$ = "" THEN END                'Not RAM resident so END
  776.     
  777.     CALL SrReleaseMem(RelEcode%)          'Release the memory
  778.     
  779.     IF RelEcode <> zero THEN
  780.         ScrLine SPACE$(screenArea / 2), 1, 1, 7
  781.         IF RelEcode = 7 THEN            'Must be over DOS to terminate
  782.             ScrLine "Go to the DOS Command Line.  Try again later.", 1, 1, 15
  783.             HiLowSounds
  784.             DO                          'Clear the keyboard
  785.                 KeyResponce sn1%, sn2%, sn3%
  786.             LOOP WHILE sn1% <> zero OR sn2% <> zero OR sn3% <> zero
  787.             TickPause 36                'Two second pause
  788.             stuff$ = ""
  789.             GOSUB RestoreDefaultScrn
  790.         ELSE                            'Critical error encountered
  791.             ScrLine MID$(goof$, 2) + STR$(RelEcode) + " releasing memory.  You MUST Reboot!" + CHR$(13), 1, 1, 15
  792.             HiLowSounds
  793.             WHILE 1 = 1         'An infinite loop forces user to re-boot!
  794.             WEND
  795.         END IF
  796.  
  797.         '   ---- We tried to remove memory over another application.  This is
  798.         '        a no-no.  So, we restore everything and return to main loop.
  799.         Visible% = false                'Make the cursor invisible
  800.         GOSUB DoCursor
  801.         GOTO MainLoop                   'Go back to the main logic code
  802.     END IF
  803.  
  804.     END
  805.  
  806. '   ---- Error catch during file handling while initializing program.
  807. Handler:
  808.     ScrLine SPACE$(screenArea / 2), 1, 1, 7
  809.     IF Ecode% = 258 THEN
  810.         Lin$ = CalcScrn$ + " Not Found" + ProgTerminate$
  811.     ELSE
  812.         Lin$ = MID$(goof$, 2) + STR$(Ecode%) + ProgTerminate$
  813.     END IF
  814.     ScrLine Lin$, 1, 1, 7
  815.     ScreenError = -1
  816.     GOTO ReleaseMem
  817.  
  818.  
  819. ' ============================================================================
  820. ' Data Section         - This is the point where the program should go
  821. '                        to initialize the DATA statements.
  822. ' ----------------------------------------------------------------------------
  823.  
  824. ' This program does not use DATA statements
  825.  
  826. ' ============================================================================
  827. '                          Subprograms And Functions
  828. ' ----------------------------------------------------------------------------
  829.  
  830. ' There are numerous subprograms and functions in this and one other module.
  831.