'===========================================================================
' Subject: SIMPLE PB CALCULATOR              Date: 06-24-96 (08:56)       
' Author:  Alexander Podkolzin               Code: PB32                   
' Origin:  APP@nw.sbank.e-burg.su          Packet: ALGOR.ABC
'===========================================================================
$IF 0
   /---------------------------------------------------------------------\
   |                          PowerBASIC 3.2+                            |
   |                         Simple Calculator.                          |
   |                                                                     |
   |   Author:.............Alexander Podkolzin <App@nw.sbank.e-burg.su>  |
   |   This  SUB ( written in TB )  was tested by many different users.  |
   |   Extracted from my old TurboBASIC library and converted to PB3.2.  |
   |   Use it, as you want and enjoy.................................:)  |
   |                                                                     |
   |                        Happy calculations !                         |
   |                                                                     |
   \---------------------------------------------------------------------/
$ENDIF
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Num Lock on Your keyboard has to be "ON".
' Simple test for calclators: 123456789 * 9 + 10 = 1111111111
'
  DEFINT A-Z
  CALL Calculator
  END
'
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Note : I do not test case "Overflow".
'
  SUB Calculator()
     wx%=POS
     wy%=CSRLIN
     IF wx%=1 then wx%=2
     iattr%=pbvScrnTxtAttr
     ct%=iattr% and 15
     cb%=iattr% \ 16
     CALL SaveScreen(wc$,59,1,79,23,0)
'
'''' This peace of code makes screen image of calculator: '''''''''''''''''''
'
     CALL Win(1,59,10,79,23,8,0)
     CALL Win(1,60,11,78,23,7,0)
     CALL ClWin(61,12,77,12,0,3)
     FOR i%=62 to 74 step 4
        FOR j%=14 to 22 step 2
           CALL ClWin(i%,j%,i%+2,j%,0,3)
        NEXT j%
     NEXT i%
     CALL ClWin(74,17,76,17,0,3)
     CALL ClWin(74,21,76,21,0,3)
     CALL ClWin(62,22,66,22,0,3)
     CALL ClWin(62,14,64,14,0,2)
     CALL PutString(62,14,"NLK  /   *   -")
     CALL PutString(62,16," 7   8   9")
     CALL PutString(62,18," 4   5   6")
     CALL PutString(62,20," 1   2   3")
     CALL PutString(62,22," 0       .")
     CALL PutString (75,17,"+")
     CALL PutString (75,21,"=")
     COLOR 29,0 : LOCATE 13,77 : PRINT "^"
     CALL Win(1,61,2,77,10,0,7)
     CALL ClWin(63,5,63,9,14,7)
     CALL ClWin(62,3,76,3,14,7)
     CALL PutString(64, 3,"Calculator:")
     CALL PutString(63, 5,"+.........Add")
     CALL PutString(63, 6,"-....Subtract")
     CALL PutString(63, 7,"*... Multiply")
     CALL PutString(63, 8,"/......Divide")
     CALL PutString(63, 9,"p....Percents")
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
     Summator#  =  0
     Result#    =  0
     Operation$ = "="
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
  DO
     s$ = "0"
     DO WHILE ASC(s$) >= 48 AND ASC(s$) <= 57 OR ASC(s$) = 46
        WHILE NOT INSTAT:WEND
        s$=INKEY$
        k% = ASC(s$)
        IF k%=13 THEN                   ' Enter
           s$ = "="
        ELSEIF k%=96 OR k%=112 THEN     ' P,p (%)
           s$ = "%"
        END IF
        IF LEN(s$)=1 AND k%<>8 AND k%<>9 THEN
           CALL PutString(77,12,s$)
           CALL DisplayShiftLeft(62,12,16)
        END IF
     LOOP
     IF LEN(s$)=2 OR k%=8 OR k%=9 THEN ITERATE LOOP
     IF k% = 27 THEN                    ' Esc
        CALL RestoreScreen(wc$,59,1)
        COLOR  ct%,cb%
        LOCATE wy%,wx%
        EXIT SUB
     END IF
     GOSUB GetSummator
     CALL ScrollTape(60,1,76,9)
     CALL MoveLine(61,12,62,10,16)
     IF s$="=" THEN
        GOSUB CalculateResult
        GOSUB PrintResult
        Summator# = 0
        Result#   = 0
        ITERATE LOOP
     ELSE
        GOSUB CalculateResult
        Operation$ = s$
     END IF
'
  LOOP
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

CalculateResult:
     SELECT CASE Operation$
        CASE "+"
           Result# = Result# + Summator#
        CASE "-"
           Result# = Result# - Summator#
        CASE "*"
           Result# = Result# * Summator#
        CASE "/"
           IF Summator#=0 then
              Call PutString(77,10," ") ' Scratch "=" on "paper"
              CALL PutString(62,12,"Division by zero")
              SOUND 880,.5
              WHILE NOT INSTAT: WEND
              w$=INKEY$
              CALL ClWin(61,12,77,12,0,3)
              EXIT SELECT
           ELSE
              Result# = Result# / Summator#
           END IF
        CASE "%"
           Result# = (Result# * Summator#) / 100.
        CASE ELSE
           Result# = Summator#
     END SELECT
     Summator#=0
     Operation$=s$
     RETURN
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

GetSummator:
     st$=""
     FOR i%=0 TO 15
        st$=st$+CHR$(SCREEN(12,61+i%))
     next i%
     Summator#=VAL(st$)
     RETURN
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

PrintResult:                      ' Two digits after decimal point
     CALL ScrollTape (60,1,76,9)
     CALL ScrollTape (60,1,76,9)
     CALL PutString(62,9,STRING$(15,196))
     Res$ = USING$("#############.##",Result#)
     n = INSTR(Res$,".00")
     IF n THEN Res$="   "+LEFT$(Res$,n-1)
     PutString 61,10,Res$
     RETURN
'
  END SUB    ' End of SUB Calculator
'
'
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB DisplayShiftLeft(x%,y%,l%)
     LOCAL i%
     FOR i%=x% to x%+l%-1
        ch$= CHR$(SCREEN(y%,i%,0))
        CALL PutString(i%-1,y%,ch$)
     NEXT i%
     CALL PutString(77,12," ")
  END SUB
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB MoveLine(x%,y%,xn%,yn%,l%)
     s$=GetString$(x%,y%,l%)
     CALL PutString(x%,y%,SPACE$(l%))
     CALL PutString(xn%,yn%,s$)
  END SUB
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  FUNCTION GetString$(x%,y%,n%)
    s$=""
    FOR  i%=0 TO n%-1
      s$=s$+CHR$(SCREEN(y%,x%+i%,0))
    NEXT
    GetString$ = s$
  END FUNCTION
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB ScrollTape(xb%,yb%,xe%,ye%)
     REG 1,&H0601
     REG 2,&H7000
     REG 3,yb%*256+xb%
     REG 4,ye%*256+xe%
     CALL INTERRUPT &H10
  END SUB
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB Win(t%,xb%,yb%,xe%,ye%,ct%,cb%)
'
     OldColor% = PBVSCRNTXTATTR   ' Internal PB variable
     SELECT CASE t%               ' Window types
'                                 ' (you can make as much types,
'                                 ' as you want).
        CASE 1
           a%=218:b%=196:c%=191   ' Single frame,
           h%=179:      :d%=179   '
           g%=192:f%=196:e%=217   '
        CASE 2
           a%=201:b%=205:c%=187   ' double frame,
           h%=186:      :d%=186   '
           g%=200:f%=205:e%=188   '
        CASE ELSE
           a%=032:b%= a%:c%= a%   '
           h%= a%:      :d%= a%   ' blanks only.
           g%= a%:f%= a%:e%= a%   '
'
     END SELECT
     COLOR ct%,cb%
     LOCATE yb%,xb%
     PRINT    CHR$(a%) + REPEAT$(xe%-xb%-1,CHR$(b%)) + CHR$(c%)
     FOR i%=yb%+1 TO ye%-1
        LOCATE i%,xb%
        PRINT CHR$(h%) + SPACE$(xe%-xb%-1)           + CHR$(d%)
     NEXT
     LOCATE ye%,xb%
     PRINT    CHR$(g%) + REPEAT$(xe%-xb%-1,CHR$(f%)) + CHR$(e%)
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''     FOR i%=yb%+1 TO ye%+1                      '''
'''        PutAttribute xe%+1,i%,8,0 ' Making      '''  Don't use here
'''     NEXT                         ' shadows     '''
'''     FOR i%=xb%+1 TO xe%+1        '             '''
'''        PutAttribute i%,ye%+1,8,0               '''
'''     NEXT                                       '''
''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
     ct%=OldColor% AND 15         ' Restore colors
     cb%=OldColor%\16
     COLOR ct%,cb%
  END SUB
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB PutString(x%,y%,st$)        ' Puts string to video memory
     DIM Cell AS BYTE PTR
     DIM TextPtr AS BYTE PTR
'
     TextPtr = STRPTR32( st$ )
     Cell = PBVSCRNBUFF + ( y% - 1 ) * 160 + ( x% - 1 ) * 2
     FOR i% = 1 TO LEN( st$ )
        @Cell = @TextPtr
        INCR TextPtr
        INCR Cell, 2
     NEXT
  END SUB
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Special thanks to Eric Olson for his public domain SUBs SaveScreen and   '
'  RestoreScreen (I'v rewrote them using pointers).                         '
'
  SUB SaveScreen(w$,xb%,yb%,xe%,ye%,sh%)
     DIM temp AS BYTE PTR
     DIM WinPtr AS BYTE PTR
     DIM TextPtr AS BYTE PTR
     lx% = (xe% - xb% + 1) * 2
     ly% = ye% - yb% + 1
     IF sh% THEN
        INCR lx%,2
        INCR ly%
     END IF
     l$ = RIGHT$(" " + STR$(lx%), 3 )
     w$ = l$ + SPACE$( lx% * ly% )
     WinPtr = PBVSCRNBUFF + (yb%-1)*160 + (xb%-1)*2
     TextPtr = STRPTR32(w$) + 3
     FOR i%=1 TO ly%
        temp = WinPtr
        FOR k%=1 TO lx%
           @TextPtr = @temp
           INCR TextPtr
           INCR temp
        NEXT
        INCR WinPtr,160
     NEXT
  END SUB
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB RestoreScreen(w$,xb%,yb%)
     DIM temp AS BYTE PTR
     DIM WinPtr AS BYTE PTR
     DIM TextPtr AS BYTE PTR
     l$ = LEFT$(w$,3)
     w$ = LTRIM$(w$,l$)
     lx% = VAL(l$)
     ly% = LEN(w$) \ lx%
     TextPtr = STRPTR32(w$)
     WinPtr = PBVSCRNBUFF + (yb%-1)*160 + (xb%-1)*2
     FOR i%=1 TO ly%
        temp = WinPtr
        FOR k%=1 TO lx%
           @temp = @TextPtr
           INCR TextPtr
           INCR temp
        NEXT
        INCR WinPtr,160
     NEXT
'   w$ = ""
  END SUB
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  SUB ClWin(xb%,yb%,xe%,ye%,ct%,cb%)    ' Clears text window
     REG 1,&H0600
     REG 2,cb%*4096+ct%*256
     REG 3,(yb%-1)*256+(xb%-1)
     REG 4,(ye%-1)*256+(xe%-1)
     CALL INTERRUPT &H10
  END SUB
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'