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.