home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l180 / 2.ddi / QCAL.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-02-07  |  11.8 KB  |  352 lines
  1.   ' ************************************************
  2.   ' **  Name:          QCAL                       **
  3.   ' **  Type:          Program                    **
  4.   ' **  Module:        QCAL.BAS                   **
  5.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  6.   ' ************************************************
  7.   '
  8.   ' USAGE:           QCAL [number] [function] [...]
  9.   ' .MAK FILE:       QCAL.BAS
  10.   '                  QCALMATH.BAS
  11.   ' PARAMETERS:      [number]      Numbers to be placed on the stack
  12.   '                  [function]    Operations to be performed on the stack
  13.   '                                contents
  14.   ' VARIABLES:       cmd$          Working copy of COMMAND$
  15.   '                  stack#()      Array representing the numeric stack
  16.   '                  ptr%          Index into the stack
  17.   '                  parm$         Each number of command extracted from cmd$
  18.   
  19.   ' Constants
  20.     CONST PI = 3.141592653589793#
  21.   
  22.   ' Functions
  23.     DECLARE FUNCTION AbsoluteX# (x#)
  24.     DECLARE FUNCTION Add# (y#, x#)
  25.     DECLARE FUNCTION ArcCosine# (x#)
  26.     DECLARE FUNCTION ArcHypCosine# (x#)
  27.     DECLARE FUNCTION ArcHypSine# (x#)
  28.     DECLARE FUNCTION ArcHypTangent# (x#)
  29.     DECLARE FUNCTION ArcSine# (x#)
  30.     DECLARE FUNCTION ArcTangent# (x#)
  31.     DECLARE FUNCTION Ceil# (x#)
  32.     DECLARE FUNCTION ChangeSign# (x#)
  33.     DECLARE FUNCTION Cosine# (x#)
  34.     DECLARE FUNCTION Divide# (y#, x#)
  35.     DECLARE FUNCTION Exponential# (x#)
  36.     DECLARE FUNCTION FractionalPart# (x#)
  37.     DECLARE FUNCTION HypCosine# (x#)
  38.     DECLARE FUNCTION HypSine# (x#)
  39.     DECLARE FUNCTION HypTangent# (x#)
  40.     DECLARE FUNCTION IntegerPart# (x#)
  41.     DECLARE FUNCTION LogBase10# (x#)
  42.     DECLARE FUNCTION LogBaseN# (y#, x#)
  43.     DECLARE FUNCTION LogE# (x#)
  44.     DECLARE FUNCTION Modulus# (y#, x#)
  45.     DECLARE FUNCTION Multiply# (y#, x#)
  46.     DECLARE FUNCTION NextParameter$ (cmd$)
  47.     DECLARE FUNCTION OneOverX# (x#)
  48.     DECLARE FUNCTION Sign# (x#)
  49.     DECLARE FUNCTION Sine# (x#)
  50.     DECLARE FUNCTION SquareRoot# (x#)
  51.     DECLARE FUNCTION Subtract# (y#, x#)
  52.     DECLARE FUNCTION Tangent# (x#)
  53.     DECLARE FUNCTION Xsquared# (x#)
  54.     DECLARE FUNCTION YRaisedToX# (y#, x#)
  55.   
  56.   ' Subprograms
  57.     DECLARE SUB QcalHelp ()
  58.     DECLARE SUB Process (parm$, stack#(), ptr%)
  59.     DECLARE SUB DisplayStack (stack#(), ptr%)
  60.     DECLARE SUB SwapXY (stack#(), ptr%)
  61.   
  62.   ' Get the command line
  63.     cmd$ = COMMAND$
  64.   
  65.   ' First check if user is asking for help
  66.     IF cmd$ = "" OR cmd$ = "HELP" OR cmd$ = "?" THEN
  67.         QcalHelp
  68.         SYSTEM
  69.     END IF
  70.   
  71.   ' Create a pseudo stack
  72.     DIM stack#(1 TO 20)
  73.     ptr% = 0
  74.   
  75.   ' Process each part of the command line
  76.     DO UNTIL cmd$ = ""
  77.         parm$ = NextParameter$(cmd$)
  78.         Process parm$, stack#(), ptr%
  79.         IF ptr% < 1 THEN
  80.             PRINT "Not enough stack values"
  81.             SYSTEM
  82.         END IF
  83.     LOOP
  84.   
  85.   ' Display results
  86.     DisplayStack stack#(), ptr%
  87.   
  88.   ' All done
  89.     END
  90.  
  91.   ' ************************************************
  92.   ' **  Name:          DisplayStack               **
  93.   ' **  Type:          Subprogram                 **
  94.   ' **  Module:        QCAL.BAS                   **
  95.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  96.   ' ************************************************
  97.   '
  98.   ' Displays the value(s) left on the stack when QCAL
  99.   ' is finished processing the command line.
  100.   '
  101.   ' EXAMPLE OF USE:  DisplayStack stack#(), ptr%
  102.   ' PARAMETERS:      stack#()   Array of numbers representing the stack
  103.   '                  ptr%       Index into the stack
  104.   ' VARIABLES:       i%         Looping index
  105.   ' MODULE LEVEL
  106.   '   DECLARATIONS:  DECLARE SUB DisplayStack (stack#(), ptr%)
  107.   '
  108.     SUB DisplayStack (stack#(), ptr%) STATIC
  109.         PRINT
  110.         IF ptr% > 1 THEN
  111.             PRINT "Stack ... ",
  112.         ELSE
  113.             PRINT "Result... ",
  114.         END IF
  115.         FOR i% = 1 TO ptr%
  116.             PRINT stack#(i%),
  117.         NEXT i%
  118.         PRINT
  119.     END SUB
  120.  
  121.   ' ************************************************
  122.   ' **  Name:          NextParameter$             **
  123.   ' **  Type:          Function                   **
  124.   ' **  Module:        QCAL.BAS                   **
  125.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  126.   ' ************************************************
  127.   '
  128.   ' Extracts parameters from the front of the
  129.   ' command line.  Parameters are groups of any
  130.   ' characters separated by spaces.
  131.   '
  132.   ' EXAMPLE OF USE:  parm$ = NextParameter$(cmd$)
  133.   ' PARAMETERS:      cmd$       The working copy of COMMAND$
  134.   ' VARIABLES:       parm$      Each number or command from cmd$
  135.   ' MODULE LEVEL
  136.   '   DECLARATIONS:  DECLARE FUNCTION NextParameter$ (cmd$)
  137.   '
  138.     FUNCTION NextParameter$ (cmd$) STATIC
  139.         parm$ = ""
  140.         DO WHILE LEFT$(cmd$, 1) <> " " AND cmd$ <> ""
  141.             parm$ = parm$ + LEFT$(cmd$, 1)
  142.             cmd$ = MID$(cmd$, 2)
  143.         LOOP
  144.         DO WHILE LEFT$(cmd$, 1) = " " AND cmd$ <> ""
  145.             cmd$ = MID$(cmd$, 2)
  146.         LOOP
  147.         NextParameter$ = parm$
  148.     END FUNCTION
  149.  
  150.   ' ************************************************
  151.   ' **  Name:          Process                    **
  152.   ' **  Type:          Subprogram                 **
  153.   ' **  Module:        QCAL.BAS                   **
  154.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  155.   ' ************************************************
  156.   '
  157.   ' Processes each command parameter for the QCAL
  158.   ' program.
  159.   '
  160.   ' EXAMPLE OF USE:  Process parm$, stack#(), ptr%
  161.   ' PARAMETERS:      parm$      The command line parameter to be processed
  162.   '                  stack#()   Array of numbers representing the stack
  163.   '                  ptr%       Index pointing to last stack entry
  164.   ' VARIABLES:       (none)
  165.   ' MODULE LEVEL
  166.   '   DECLARATIONS:  DECLARE SUB Process (parm$, stack#(), ptr%)
  167.   '
  168.     SUB Process (parm$, stack#(), ptr%) STATIC
  169.         SELECT CASE parm$
  170.         CASE "+"
  171.             ptr% = ptr% - 1
  172.             IF ptr% > 0 THEN
  173.                 stack#(ptr%) = Add#(stack#(ptr%), stack#(ptr% + 1))
  174.             END IF
  175.         CASE "-"
  176.             ptr% = ptr% - 1
  177.             IF ptr% > 0 THEN
  178.                 stack#(ptr%) = Subtract#(stack#(ptr%), stack#(ptr% + 1))
  179.             END IF
  180.         CASE "*"
  181.             ptr% = ptr% - 1
  182.             IF ptr% > 0 THEN
  183.                 stack#(ptr%) = Multiply#(stack#(ptr%), stack#(ptr% + 1))
  184.             END IF
  185.         CASE "/"
  186.             ptr% = ptr% - 1
  187.             IF ptr% > 0 THEN
  188.                 stack#(ptr%) = Divide#(stack#(ptr%), stack#(ptr% + 1))
  189.             END IF
  190.         CASE "CHS"
  191.             IF ptr% > 0 THEN
  192.                 stack#(ptr%) = ChangeSign#(stack#(ptr%))
  193.             END IF
  194.         CASE "ABS"
  195.             IF ptr% > 0 THEN
  196.                 stack#(ptr%) = AbsoluteX#(stack#(ptr%))
  197.             END IF
  198.         CASE "SGN"
  199.             IF ptr% > 0 THEN
  200.                 stack#(ptr%) = Sign#(stack#(ptr%))
  201.             END IF
  202.         CASE "INT"
  203.             IF ptr% > 0 THEN
  204.                 stack#(ptr%) = IntegerPart#(stack#(ptr%))
  205.             END IF
  206.         CASE "MOD"
  207.             ptr% = ptr% - 1
  208.             IF ptr% > 0 THEN
  209.                 stack#(ptr%) = Modulus#(stack#(ptr%), stack#(ptr% + 1))
  210.             END IF
  211.         CASE "FRC"
  212.             IF ptr% > 0 THEN
  213.                 stack#(ptr%) = FractionalPart#(stack#(ptr%))
  214.             END IF
  215.         CASE "1/X"
  216.             IF ptr% > 0 THEN
  217.                 stack#(ptr%) = OneOverX#(stack#(ptr%))
  218.             END IF
  219.         CASE "SQR"
  220.             IF ptr% > 0 THEN
  221.                 stack#(ptr%) = SquareRoot#(stack#(ptr%))
  222.             END IF
  223.         CASE "X2"
  224.             IF ptr% > 0 THEN
  225.                 stack#(ptr%) = Xsquared#(stack#(ptr%))
  226.             END IF
  227.         CASE "SIN"
  228.             IF ptr% > 0 THEN
  229.                 stack#(ptr%) = Sine#(stack#(ptr%))
  230.             END IF
  231.         CASE "COS"
  232.             IF ptr% > 0 THEN
  233.                 stack#(ptr%) = Cosine#(stack#(ptr%))
  234.             END IF
  235.         CASE "TAN"
  236.             IF ptr% > 0 THEN
  237.                 stack#(ptr%) = Tangent#(stack#(ptr%))
  238.             END IF
  239.         CASE "ASN"
  240.             IF ptr% > 0 THEN
  241.                 stack#(ptr%) = ArcSine#(stack#(ptr%))
  242.             END IF
  243.         CASE "ACS"
  244.             IF ptr% > 0 THEN
  245.                 stack#(ptr%) = ArcCosine#(stack#(ptr%))
  246.             END IF
  247.         CASE "ATN"
  248.             IF ptr% > 0 THEN
  249.                 stack#(ptr%) = ArcTangent#(stack#(ptr%))
  250.             END IF
  251.         CASE "HSN"
  252.             IF ptr% > 0 THEN
  253.                 stack#(ptr%) = HypSine#(stack#(ptr%))
  254.             END IF
  255.         CASE "HCS"
  256.             IF ptr% > 0 THEN
  257.                 stack#(ptr%) = HypCosine#(stack#(ptr%))
  258.             END IF
  259.         CASE "HTN"
  260.             IF ptr% > 0 THEN
  261.                 stack#(ptr%) = HypTangent#(stack#(ptr%))
  262.             END IF
  263.         CASE "AHS"
  264.             IF ptr% > 0 THEN
  265.                 stack#(ptr%) = ArcHypSine#(stack#(ptr%))
  266.             END IF
  267.         CASE "AHC"
  268.             IF ptr% > 0 THEN
  269.                 stack#(ptr%) = ArcHypCosine#(stack#(ptr%))
  270.             END IF
  271.         CASE "AHT"
  272.             IF ptr% > 0 THEN
  273.                 stack#(ptr%) = ArcHypTangent#(stack#(ptr%))
  274.             END IF
  275.         CASE "LOG"
  276.             IF ptr% > 0 THEN
  277.                 stack#(ptr%) = LogE#(stack#(ptr%))
  278.             END IF
  279.         CASE "LOG10"
  280.             IF ptr% > 0 THEN
  281.                 stack#(ptr%) = LogBase10#(stack#(ptr%))
  282.             END IF
  283.         CASE "LOGN"
  284.             ptr% = ptr% - 1
  285.             IF ptr% > 0 THEN
  286.                 stack#(ptr%) = LogBaseN#(stack#(ptr%), stack#(ptr% + 1))
  287.             END IF
  288.         CASE "EXP"
  289.             IF ptr% > 0 THEN
  290.                 stack#(ptr%) = Exponential#(stack#(ptr%))
  291.             END IF
  292.         CASE "CEIL"
  293.             IF ptr% > 0 THEN
  294.                 stack#(ptr%) = Ceil#(stack#(ptr%))
  295.             END IF
  296.         CASE "Y^X"
  297.             ptr% = ptr% - 1
  298.             IF ptr% > 0 THEN
  299.                 stack#(ptr%) = YRaisedToX#(stack#(ptr%), stack#(ptr% + 1))
  300.             END IF
  301.         CASE "PI"
  302.             ptr% = ptr% + 1
  303.             stack#(ptr%) = PI
  304.         CASE "SWAP"
  305.             SwapXY stack#(), ptr%
  306.         CASE "DUP"
  307.             IF ptr% > 0 THEN
  308.                 stack#(ptr% + 1) = stack#(ptr%)
  309.                 ptr% = ptr% + 1
  310.             END IF
  311.         CASE ELSE
  312.             ptr% = ptr% + 1
  313.             stack#(ptr%) = VAL(parm$)
  314.         END SELECT
  315.     END SUB
  316.  
  317.   ' ************************************************
  318.   ' **  Name:          QcalHelp                   **
  319.   ' **  Type:          Subprogram                 **
  320.   ' **  Module:        QCAL.BAS                   **
  321.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  322.   ' ************************************************
  323.   '
  324.   ' Displays a help screen when QCAL is run with no
  325.   ' parameters or with a parameter of ? or HELP.
  326.   '
  327.   ' EXAMPLE OF USE:  QcalHelp
  328.   ' PARAMETERS:      (none)
  329.   ' VARIABLES:       (none)
  330.   ' MODULE LEVEL
  331.   '   DECLARATIONS:  DECLARE SUB QcalHelp ()
  332.   '
  333.     SUB QcalHelp STATIC
  334.         PRINT
  335.         PRINT "Usage:  QCAL [number] [function] [...] <Enter>"
  336.         PRINT
  337.         PRINT "Numbers are placed on an RPN stack, and functions operate"
  338.         PRINT "on the stacked quantities.  When the program is finished,"
  339.         PRINT "whatever is left on the stack is displayed."
  340.         PRINT
  341.         PRINT "List of available functions..."
  342.         PRINT
  343.         PRINT "Two numbers:     +  -  *  /"
  344.         PRINT "One number:      CHS ABS SGN INT MOD FRC CHS 1/X SQR X2 CEIL"
  345.         PRINT "Trigonometric:   SIN COS TAN ASN ACS ATN"
  346.         PRINT "Hyperbolic:      HSN HCS HTN AHS AHC AHT"
  347.         PRINT "Logarithmic:     LOG LOG10 LOGN EXP Y^X"
  348.         PRINT "Constants:       PI"
  349.         PRINT "Stack:           SWAP DUP"
  350.     END SUB
  351.  
  352.