Calculator (group effort)

Discussions related to mathematics, numerical methods, graph plotting etc.
Zaphod
Posts: 78
Joined: Sat 23 Jun 2018, 15:51

Re: Calculator (group effort)

Post by Zaphod »

Here is a better fix for the auto repeat.

Code: Select all

      DEFFNabutton(x,y,size%,c$,com$)
      PRIVATE kd%
      LOCAL _mx,_my,_mb,ret$
      MOUSE _mx,_my,_mb
      IF _mb=0 kd%=FALSE
      IF NOT kd% THEN
        GCOL 5
        RECTANGLE x,y,size%, size%
        IF com$="fill" THEN
          PROCpaint(x+5,y+5,c$)
        ENDIF
        IF _mx>x AND _mx<x+size% AND _my>y AND _my<y+size% THEN
          GCOL(15):RECTANGLE x,y,size%,size%
          IF _mb=4 THEN ret$=com$: kd%=TRUE
        ENDIF
      ENDIF
      =ret$
And for a Delete key all it need do is call LEFT$(n$) to get rid of the last digit.

Even my Dollar Store calculator has Parentheses!

The bug you have is that the new calculation after the equals sign is pressed, tags the next digits up to the next operator onto the end of the top line when the operator is pressed. Then it gets the calculation wrong as it is using part of the previous result as well the new entry or if there is an exponent adds to that and can go over range and cause a program error.

Z
Zaphod
Posts: 78
Joined: Sat 23 Jun 2018, 15:51

Re: Calculator (group effort)

Post by Zaphod »

UPDATED to Version 3

I had a go at using Michael's shell but had comprehension problems using his libraries so wrote it with just BBC BASIC functions so it should still work on SDL versions, but I have not tested that.
It uses the ON MOUSE technique as discussed in another thread. The highlighting of buttons when the mouse is over as in Michael's example is included in part but Remmed. It has to use polling as mouse over does not cause an event. It is left for others to complete that part if they wish. Just look for lines with "REM **". It is a feature that cannot be used on a touch device.

Update to code below. Now includes exponent entry and has a memory button. To clear the memory click "CE" twice.

Code: Select all

      REM Calculator by Zaphod
      REM Mouse Over highlight partially implemented for demo.
      REM Version 3, 14 Sept 2018
      VDU 23,22,240;240;8,15,16,1
      OFF
      VDU 5

      GCOL 128+7 : CLG : REM set background
      GCOL 4 : RECTANGLE FILL 40,400,400,60 :REM LED background
      GCOL 0 : RECTANGLE 2,2,474,474        :REM Window border
      GCOL 7 : RECTANGLE 42,404,394,54     :REM LED border

      ON MOUSE PROCscan(@wparam%,@lparam%) : RETURN

      REM Buttons constants
      X0%=50
      Y0%=40
      Sx%=82          :REM Dist between button origins.
      Sy%=70
      Size%=54
      Ox%=Size%/2-6    :REM to center text on buttons
      Oy%=Size%/2+10
      Os%=4                 :REM Offset in for highlight

      REM Draw the buttons in a rectangular matrix in PROCrf(Column, Row) format.
      REM Adjusts according to constants set above as parameters.
      GCOL 1
      PROCrf(0,4) :REM Clear
      GCOL 8
      PROCrf(0,0) :REM 0
      PROCrf(1,0) :REM .
      PROCrf(2,0) :REM (-)
      REM "=" see later
      PROCrf(0,1) :REM 1
      PROCrf(1,1) :REM 2
      PROCrf(2,1) :REM 3
      PROCrf(3,1) :REM +
      PROCrf(4,1) :REM -
      PROCrf(0,2) :REM 4
      PROCrf(1,2) :REM 5
      PROCrf(2,2) :REM 6
      PROCrf(3,2) :REM X
      PROCrf(4,2) :REM /
      PROCrf(0,3) :REM 7
      PROCrf(1,3) :REM 8
      PROCrf(2,3) :REM 9
      PROCrf(3,3) :REM (
      PROCrf(4,3) :REM )
      PROCrf(1,4) :REM E
      PROCrf(2,4) :REM MR
      PROCrf(3,4) :REM M+
      PROCrf(4,4) :REM <<
      RECTANGLE FILL X0%+3*Sx%,Y0%,Size%+Sx%,Size%   :REM = non-standard size. (Posn 3,0)

      GCOL 15
      REM Legend positions.  PROCm( Column #,  fine adjustment, Row # , fine adjustment, Text$)
      PROCm(0,12,4,Oy%,"CE")
      PROCm(0,Ox%,0,Oy%,"0")
      PROCm(1,Ox%,0,42 ,".")
      PROCm(2,4,0,Oy%,"(-)")
      PROCm(0,Ox%,1,Oy%,"1")
      PROCm(1,Ox%,1,Oy%,"2")
      PROCm(2,Ox%,1,Oy%,"3")
      PROCm(3,Ox%,1,Oy%,"+")
      PROCm(4,Ox%,1,38, "-")
      PROCm(0,Ox%,2,Oy%,"4")
      PROCm(1,Ox%,2,Oy%,"5")
      PROCm(2,Ox%,2,Oy%,"6")
      PROCm(3,Ox%,2,Oy%,"x")
      PROCm(4,Ox%,2,Oy%,"/")
      PROCm(0,Ox%,3,Oy%,"7")
      PROCm(1,Ox%,3,Oy%,"8")
      PROCm(2,Ox%,3,Oy%,"9")
      PROCm(3,Size%+8,0,Oy%,"=")
      PROCm(3,Ox%,3,Oy%,"(")
      PROCm(4,Ox%,3,Oy%,")")
      PROCm(1,Ox%,4,Oy%,"E")
      PROCm(2,12,4,Oy%,"MR")
      PROCm(3,12,4,Oy%,"M+")
      PROCm(4,12,4,Oy%,"<<")
      PROCdisp(0)
      REM Main idle loop waiting for events
      REPEAT
        WAIT 5
        REM ** PROCmouseover
      UNTIL FALSE

      END

      REM Only do mouse over if no mouse button pressed
      REM ** DEF PROCmouseover :LOCAL X%, Y%, B%, w%, A$ : w%=1 :MOUSE X%,Y%,B% : IF B%>0 :ENDPROC: REM force detection of mouse over a button.
      REM Click event comes here.
      DEF PROCscan(w%,l%) :LOCAL X%, Y%, B%, A$: X% = (l% AND &FFFF)*2 - @vdu.o.x% : Y% = (@vdu%!212-1-(l% >>> 16))*2 - @vdu.o.y% :B%=TRUE
      IF w%<>1 : ENDPROC
      REM Determine which button pressed.
      REM Scan by row and col to test for button event.
      CASE TRUE OF
        WHEN FNcol(0): REM 1st Col
          CASE TRUE OF
            WHEN FNrow(0,0): A$="0"
            WHEN FNrow(1,1): A$="."
            WHEN FNrow(2,2):A$="(-)"
            WHEN FNrow(3,4):A$="="  :REM The odd one: extends from row 3 across row 4
          ENDCASE
        WHEN FNcol(1):
          CASE TRUE OF
            WHEN FNrow(0,0):A$="1"
            WHEN FNrow(1,1):A$="2"
            WHEN FNrow(2,2):A$="3"
            WHEN FNrow(3,3):A$="+"
            WHEN FNrow(4,4):A$= "-"
          ENDCASE
        WHEN FNcol(2):
          CASE TRUE OF
            WHEN FNrow(0,0):A$= "4"
            WHEN FNrow(1,1):A$= "5"
            WHEN FNrow(2,2):A$= "6"
            WHEN FNrow(3,3):A$= "X"
            WHEN FNrow(4,4):A$= "/"
          ENDCASE
        WHEN FNcol(3):
          CASE TRUE OF
            WHEN FNrow(0,0):A$= "7"
            WHEN FNrow(1,1):A$= "8"
            WHEN FNrow(2,2):A$= "9"
            WHEN FNrow(3,3):A$= "("
            WHEN FNrow(4,4):A$= ")"
          ENDCASE
        WHEN FNcol(4):
          CASE TRUE OF
            WHEN FNrow(0,0):A$="C"
            WHEN FNrow(1,1):A$="E"
            WHEN FNrow(2,2):A$="MR"
            WHEN FNrow(3,3):A$="M+"
            WHEN FNrow(4,4):A$="<<":REM Delete
          ENDCASE
          REM If you want to put Clear on it's own line up a pitch.
          REM WHEN Y% > (Y0%+5*Sy%) AND Y% < (Y0%+Size%+5*Sy%):
          REM IF X% > X0% AND X% < (X0%+Size%):A$="C"
      ENDCASE
      PROCcalc(A$) :REM ** remove this line if highlight required
      REM ** IF B% PROCcalc(A$) ELSE PROChighlight(A$)
      ENDPROC

      END

      DEF PROCcalc(a$)
      PRIVATE acc, op%, oldacc, oldop%, E%, C%, mem, n$
      CASE a$ OF
        WHEN "0","1","2","3","4","5","6","7","8","9":
          IF op%=5 THEN n$="" :op%=0
          n$+=a$
          E%=FALSE :C%=FALSE
          PROCdisp(VAL(n$))
          IF VAL(n$)=0 AND LEN(n$)>1 PROCdisptext(n$)  :REM Otherwise the decimal point does not show until a digit is added.
        WHEN ".":IF INSTR(n$,".")=0 :n$+=a$
          PROCdisptext(n$) :REM Inhibits invalid decimals
          IF VAL(n$)=0 AND LEN(n$)>0 PROCdisptext("0"+n$)
        WHEN "C":acc=0: op%=0: n$=""  :PROCdisp(acc)
          IF C% mem=0 : GCOL 15 :PROCm(2,12,4,Oy%,"MR")
          C%=TRUE :REM double clear clears memory.
        WHEN "E" : n$+=a$ :E%=TRUE  :PROCdisptext(n$)
        WHEN "MR": @%=&01130F  :REM adjust print format.
          n$=STR$(mem) :PROCdisp(mem)
          @%=&90A
        WHEN "M+": PROCcomp(acc,VAL(n$),op%)
          mem+=acc :op%=5
          GCOL 9 :PROCm(2,12,4,Oy%,"MR")
        WHEN "<<":n$=LEFT$(n$) :PROCdisptext(n$)
        WHEN "(": REM save current accumulator and penfing operation
          oldacc=acc:oldop%=op%
          acc=0 :n$="":op%=0
        WHEN ")": REM finish calculation operate on old accumulator
          PROCcomp(acc,VAL(n$),op%)
          PROCcomp(oldacc,acc,oldop%)
          acc=oldacc: op%=5:n$=""
        WHEN "(-)": REM Negate input or accumulator as appropriate.
          IF E% THEN
            REM allow negative exponent.
            n$+="-"
            PROCdisptext(n$)
          ELSE
            IF op%=0 THEN
              IF LEFT$(n$,1) <> "-" n$="-"+n$ ELSE n$=MID$(n$,2)
              PROCdisp(VAL(n$))
            ELSE
              acc=-acc:PROCdisp(acc)
            ENDIF
          ENDIF
        WHEN "+":PROCcomp(acc,VAL(n$),op%):op%=1:n$=""
        WHEN "-": IF E% THEN n$+="-" :PROCdisptext(n$) ELSE PROCcomp(acc,VAL(n$),op%):op%=2:n$=""
        WHEN "X":PROCcomp(acc,VAL(n$),op%):op%=3:n$=""
        WHEN "/":PROCcomp(acc,VAL(n$),op%):op%=4:n$=""
        WHEN "=":PROCcomp(acc,VAL(n$),op%):op%=5: PROCdisp(acc):n$=""
      ENDCASE
      ENDPROC

      DEF PROCcomp(RETURN a,v,p%)
      CASE p% OF
        WHEN 0:a=v
        WHEN 1:a+=v
        WHEN 2:a-=v
        WHEN 3:a*=v
        WHEN 4:IF v >0 THEN a/=v
      ENDCASE
      PROCdisp(a)
      ENDPROC

      DEF PROCdisptext(n$):LOCAL I%, n:I%=1
      DEF PROCdisp(n):LOCAL I%, n$
      REM Could be set right aligned and change @% to show more figures.
      GCOL 4 : RECTANGLE FILL 40,400,400,60 :REM LED background
      GCOL 7 : RECTANGLE 42,404,394,54      :REM LED border
      MOVE 60,440
      PRINT "                        "  :REM erase old result
      MOVE 60,440
      @%=&130F  :REM adjust print format.
      IF I% PRINTTAB(13) n$ ELSE PRINT n
      @%=&90A
      ENDPROC

      REM DEF PROChighlight(a$)
      REM REM Not fully implemented... demo only
      REM GCOL 15
      REM CASE a$ OF
      REM WHEN "0": PROCrh(0,0)             :REM 0
      REM WHEN "1": PROCrh(0,1)
      REM REM etc..
      REM
      REM OTHERWISE :REM Redraw highlights button colour.
      REM GCOL 8
      REM  PROCrh(0,0)
      REM  PROCrh(0,1)
      REM REM etc..
      REM ENDCASE
      REM ENDPROC

      DEF PROCrf(x%,y%) :REM Wrapper to tidy the code.
      RECTANGLE FILL X0%+x%*Sx%,Y0%+y%*Sy%,Size%,Size%
      ENDPROC

      DEF PROCrh(x%,y%)
      RECTANGLE  X0%+x%*Sx%+Os%,Y0%+y%*Sy%+Os%,Size%-2*Os%,Size%-2*Os%
      ENDPROC

      DEF PROCm(x%,h%,y%,v%,a$) :REM Wrapper for legends
      MOVE X0%+x%*Sx%+h%,Y0%+y%*Sy%+v% :PRINT a$
      ENDPROC

      DEF FNrow(a%,b%) :REM Start row, finish row. Allows buttons to be bigger than one Size unit such as the Equals button.
      IF X% > (X0%+a%*Sx%) AND X% <(X0%+Size%+b%*Sx%) := TRUE ELSE :=FALSE

      DEF FNcol(a%) :REM Column width range
      IF Y% > (Y0%+a%*Sy%) AND Y% < (Y0%+Size%+a%*Sy%) :=TRUE ELSE :=FALSE
If the update looks a little crowded it would be easy to extend the window and put the Clear on the 5th line of the button grid. I have added the code to PROCscan, you would just have to adjust the button drawing and legend writing up a pitch as well.
There are a couple of little differences from a real calculator that are mainly cosmetic, but you can make it go wrong if you really try. The errors usually just nullify the calculation rather than give an erroneous result that looks as if it might me right. But if there are any serious gotcha's please write in and tell me, or better still fix it and let us know how.

Z