!*************************************************************************
!
! AMUS DESKTOP CALCULATOR (ADC.BAS)
!
! by Dave Heyliger - AMUS Staff
!
! Notes: The ADC simulates a cheap calculator and is good only for
!        quick math functions. Directions are printed to the screen
!        during runtime, and the keys allowed are displayed via the
!        "calculator".
!
!        You will need a subroutine called INKEY.M68 in the [100,52]
!        subroutine account.
!
!        For fast access to the ADC, place the .RUN and the .SBR into
!        the BAS: account - DSK0:[7,6], then create in the .CMD account
!        the file called ADC.CMD:
!                       :R
!                       LOAD BAS:ADC.RUN
!                       LOAD BAS:INKEY.SBR
!                       RUN ADC
!
!*************************************************************************

MAP1 clearsp,s,33,"                                 "
MAP1 f'number,f
MAP1 function,s,1
MAP1 s'number,f
MAP1 continue,s,30,"Enter math function or any key"
MAP1 clearsts,s,31,"                               "


!  create calculator
!________________________

       ? tab (-1,0)
       ? tab (-1,29)
       ? tab (2,20) "+---------------------------------------+"
       ? tab (3,20) "|                                       |"
       ? tab (4,20) "|  +----------------------------------+ |"
       ? tab (5,20) "|  |                                  | |"
       ? tab (6,20) "|  +----------------------------------+ |"
       ? tab (7,20) "|                                       |"
       ? tab (8,20) "|     +---+   +---+   +---+   +---+     |"
       ? tab (9,20) "|     | 7 |   | 8 |   | 9 |   | * |     |"
       ? tab (10,20)"|     +---+   +---+   +---+   +---+     |"
       ? tab (11,20)"|                                       |"
       ? tab (12,20)"|     +---+   +---+   +---+   +---+     |"
       ? tab (13,20)"|     | 4 |   | 5 |   | 6 |   | / |     |"
       ? tab (14,20)"|     +---+   +---+   +---+   +---+     |"
       ? tab (15,20)"|                                       |"
       ? tab (16,20)"|     +---+   +---+   +---+   +---+     |"
       ? tab (17,20)"|     | 1 |   | 2 |   | 3 |   | - |     |"
       ? tab (18,20)"|     +---+   +---+   +---+   +---+     |"
       ? tab (19,20)"|                                       |"
       ? tab (20,20)"|     +---+   +---+   +---+   +---+     |"
       ? tab (21,20)"|     | Q |   | ! |   | ^ |   | % |     |"
       ? tab (22,20)"|     +---+   +---+   +---+   +---+     |"
       ? tab (23,20)"+---------------------------------------+"
       ? tab (-1,28);

! Main Loop
!__________
main:
       function = ""
       ? tab (3,26) clearsts
       ? tab (3,33) "enter number"
       ? tab (5,25);
       input,f'number
       ? tab (3,26) clearsts
       ? tab (3,33) "enter function"
wait1:  ? tab (5,54);
       xcall inkey,function
       if function = "" then goto wait1
parsem: call parse
       goto parsem
       end

! PARSE subroutine
!_________________
parse:
       if function = "*" then call multiply : return
       if function = "/" then call divide : return
       if function = "+" then call add : return
       if function = "-" then call subtract : return
       if ucs(function) = "Q" then ? tab (-1,0) : end
       if function = "^" then call power : return
       if function = "!" then call factorial : return
       if function = "%" then call percent : return
       goto main

! MULTIPLY subroutine
!____________________
multiply:
       ? tab (5,25) clearsp
       ? tab (5,55) "*"
       ? tab (3,26) clearsts
       ? tab (3,33) "enter number"
       ? tab (5,25);
       input,s'number
       result = f'number * s'number
       ? tab (5,25) clearsp
       ? tab (5,25) result
       call anykey
       f'number = result
       return

! DIVIDE subroutine
!____________________
divide:
       ? tab (5,25) clearsp
       ? tab (5,55) "/"
       ? tab (3,26) clearsts
       ? tab (3,33) "enter number"
       ? tab (5,25);
       input,s'number
       result = f'number / s'number
       ? tab (5,25);
       ? clearsp
       ? tab (5,25) result
       call anykey
       f'number = result
       return

! ADD subroutine
!____________________
add:
       ? tab (5,25) clearsp
       ? tab (5,55) "+"
       ? tab (3,26) clearsts
       ? tab (3,33) "enter number"
       ? tab (5,25);
       input,s'number
       result = f'number + s'number
       ? tab (5,25);
       ? clearsp
       ? tab (5,25) result
       call anykey
       f'number = result
       return

! SUBTRACT subroutine
!____________________
subtract:
       ? tab (5,25) clearsp
       ? tab (5,55) "-"
       ? tab (3,26) clearsts
       ? tab (3,33) "enter number"
       ? tab (5,25);
       input,s'number
       result = f'number - s'number
       ? tab (5,25);
       ? clearsp
       ? tab (5,25) result
       call anykey
       f'number = result
       return

! POWER subroutine
!____________________
power:
       ? tab (5,25) clearsp
       ? tab (5,55) "^"
       ? tab (3,26) clearsts
       ? tab (3,33) "enter number"
       ? tab (5,25);
       input,s'number
       result = f'number ** s'number
       ? tab (5,25);
       ? clearsp
       ? tab (5,25) result
       call anykey
       f'number = result
       return

! FACTORIAL  subroutine
!____________________
factorial:
       ? tab (5,25) clearsp
       ? tab (5,55) "!"
       ? tab (3,26) clearsts
       result = fact(f'number)
       ? tab (5,25);
       ? clearsp
       ? tab (5,25) result
       call anykey
       f'number = result
       return

! PERCENT subroutine
!____________________
percent:
       ? tab (5,25) clearsp
       ? tab (5,55) "%"
       ? tab (3,26) clearsts
       result = f'number / 100
       ? tab (5,25);
       ? clearsp
       ? tab (5,25) result
       call anykey
       f'number = result
       return

! ANYKEY subroutine
!_________________
anykey:
       function = ""
       ? tab (-1,29)
wait2:  ? tab (3,26) continue
       xcall inkey,function
       if function = "" then goto wait2
       ? tab (3,26) clearsts
       ? tab (5,25) clearsp
       ? tab (-1,28)
       return

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.