Charlie Veniot 18th November 2022 at 6:39pm
' BASIC ANYWHERE MACHINE program by Charlie Veniot
' 🟠 Declarations
DIM SHARED AS INTEGER yAdj, lblWidth
yAdj = 3
lblWidth = 7
' "Calculator Display" content variables
DIM SHARED line$(1 TO 5) : DIM SHARED blank_line$
blank_line$ = SPC( (lblWidth+2) * 4 - 2 )
TYPE btnType
lbl AS STRING
y AS INTEGER
x AS INTEGER
END TYPE
DIM SHARED AS btnType btn(1 to 20)
DECLARE FUNCTION PadBtnLabel$(l$)
DECLARE SUB SetupButton(i%, l$, y%, x%)
DECLARE SUB ShowButton(i%, c%)
DECLARE SUB DisplayLine(l%)
' 🟠 Main program
SCREEN _NEWIMAGE((4*(lblWidth+2)*8),336,12)
LINE (0,0) - ((4*(lblWidth+2)*8)-1,80), 3, BF
GOSUB ClearDisplay
GOSUB SetupButtons
last_mousex = -99
last_mousey = -99
DO
IF _mousex <> last_mousex OR _mousey <> last_mousey THEN
GOSUB ShowButtons
GOSUB SetButtonFocus
last_mousex = _mousex : last_mousey = _mousey
END IF
GOSUB HandleButtonClick
_DISPLAY
LOOP
END
' 🟠 Functions, Subroutines, and Gosubroutines
' 🟠 Functions
FUNCTION PadBtnLabel$(l$)
llen = CINT( (lblWidth - len(l$)) / 2 )
PadBtnLabel$= SPC(llen) + l$ + SPC(llen)
END FUNCTION
' 🟠 Subroutines
SUB SetupButton(i%, l$, y%, x%)
btn(i%).lbl = l$
btn(i%).x = x%
btn(i%).y = y%
END SUB
SUB ShowButton(i%, c%)
COLOR c%
LOCATE (btn(i%).y) * 3 + yAdj + 0, ( btn(i%).x ) * (lblWidth + 2) - (lblWidth+1) : PRINT CHR$(201);STRING$(lblWidth,CHR$(205));CHR$(187);
LOCATE (btn(i%).y) * 3 + yAdj + 1, ( btn(i%).x ) * (lblWidth + 2) - (lblWidth+1) : PRINT CHR$(186);PadBtnLabel$(btn(i%).lbl);CHR$(186);
LOCATE (btn(i%).y) * 3 + yAdj + 2, ( btn(i%).x ) * (lblWidth + 2) - (lblWidth+1) : PRINT CHR$(200);STRING$(lblWidth,CHR$(205));CHR$(188);
END SUB
SUB DisplayLine(l%)
COLOR 15,1 : LOCATE l%, 2 : PRINT right$((blank_line$ + line$(l%)), (lblWidth+2) * 4 - 2)
END SUB
' 🟠 Gosubroutines
SetupButtons:
id = 0
FOR ys = 1 TO 5
FOR xs = 1 TO 4
id = id + 1
READ l$
CALL SetupButton(id, l$, ys, xs)
NEXT xs
NEXT ys
DATA " ", "A_C", "del", "/"
DATA "7", "8", "9", "*"
DATA "4", "5", "6", "-"
DATA "1", "2", "3", "+"
DATA "+/-", "0", ".", "="
RETURN
ShowButtons:
COLOR 15, 0
FOR i = 1 TO 20
CALL ShowButton(i,15)
NEXT i
RETURN
SetButtonFocus:
found_it = FALSE
FOR i = 1 TO 20
IF NOT found_it THEN
btn_t = ( (btn(i).y + yAdj + 1 + (2*( btn(i).y -1)) ) *16 - 1 )
btn_b = btn_t + 3*16
btn_r = ( lblWidth + 2) * btn(i).x * 8 - 1
btn_l = btn_r - ((lblWidth+2) * 8)
IF _MOUSEY >= btn_t AND _MOUSEY <= btn_b AND _MOUSEX >= btn_l AND _MOUSEX <= btn_r THEN CALL ShowButton(i,14): found_it = TRUE
END IF
NEXT i
LINE (0,80) - ((4*(lblWidth+2)*8),81), 3, BF
LINE (0,125) - ((4*(lblWidth+2)*8),128), 3, BF
LINE (0,173) - ((4*(lblWidth+2)*8),176), 3, BF
LINE (0,221) - ((4*(lblWidth+2)*8),224), 3, BF
LINE (0,269) - ((4*(lblWidth+2)*8),272), 3, BF
LINE (0,317) - ((4*(lblWidth+2)*8),335), 3, BF
LINE (0,0) - (0,335), 3, BF
LINE (70,80) - (71,335), 3, BF
LINE (142,80) - (143,335), 3, BF
LINE (214,80) - (215,335), 3, BF
LINE ((4*(lblWidth+2)*8)-1,0) - ((4*(lblWidth+2)*8)-1,335), 3, BF
LINE (0,317) - ((4*(lblWidth+2)*8),335), 3, BF
RETURN
HandleButtonClick:
IF _MOUSEBUTTON(1) THEN
SOUND 40,0.125
found_it = FALSE
FOR i = 1 TO 20
IF NOT found_it THEN
btn_t = ( (btn(i).y + yAdj + 1 + (2*( btn(i).y -1)) ) *16 - 1 )
btn_b = btn_t + 3*16
btn_r = ( lblWidth + 2) * btn(i).x * 8 - 1
btn_l = btn_r - ((lblWidth+2) * 8)
IF _MOUSEY >= btn_t AND _MOUSEY <= btn_b AND _MOUSEX >= btn_l AND _MOUSEX <= btn_r THEN
COLOR 0,15
SELECT CASE btn(i).lbl
CASE "A_C"
GOSUB ClearDisplay
CASE "del"
GOSUB DeleteLastKey
CASE "0" TO "9", "."
this_line = 0
IF line$(2) = "" THEN
this_line = 1
ELSEIF line$(4) = "" THEN
this_line = 3
END IF
IF this_line > 0 THEN
IF ( btn(i).lbl <> "." ) OR ( INSTR(line$(this_line), ".") = 0 ) THEN
line$(this_line) = line$(this_line) + btn(i).lbl : CALL DisplayLine(this_line)
END IF
END IF
CASE "/", "*", "-", "+"
IF line$(5) <> "" THEN
line$(1) = line$(5) : line$(2) = btn(i).lbl : line$(3) = "" : line$(4) = "" : line$(5) = ""
CALL DisplayLine(5) : CALL DisplayLine(4) : CALL DisplayLine(3) : CALL DisplayLine(2) : CALL DisplayLine(1)
ELSEIF line$(3) <> "" THEN
GOSUB DoCalc
line$(1) = line$(5) : line$(2) = btn(i).lbl : line$(3) = "" : line$(4) = "" : line$(5) = ""
CALL DisplayLine(5) : CALL DisplayLine(4) : CALL DisplayLine(3) : CALL DisplayLine(2) : CALL DisplayLine(1)
ELSEIF line$(1) <> "" AND line$(2) = "" THEN
line$(2) = btn(i).lbl : Call DisplayLine(2)
END IF
CASE "="
IF line$(3) <> "" AND line$(5) = "" THEN line$(4) = STRING$((lblWidth+2) * 4 - 2, "=") : CALL DisplayLine(4) : GOSUB DoCalc
CASE ELSE
LOCATE 5,2 : PRINT blank_line$ : LOCATE 5,2 : PRINT btn(i).lbl
END SELECT
found_it = TRUE
END IF
END IF
NEXT i
WHILE _MOUSEBUTTON(1) = 1 : WEND
SOUND 50,0.125
END IF
RETURN
ClearDisplay:
line$(1) = "" : line$(2) = "" : line$(3) = "" : line$(4) = "" : line$(5) = ""
COLOR 15,1 : FOR i = 1 TO 5 : LOCATE i, 2 : PRINT blank_line$ : NEXT i
COLOR 15,0
RETURN
DeleteLastKey:
this_line = 0
FOR i = 5 TO 1 STEP -1
IF this_line = 0 THEN
IF line$(i) <> "" THEN this_line = i
END IF
NEXT i
IF this_line <> 0 THEN
IF this_line >= 4 THEN
line$(5) = "" : CALL DisplayLine(5)
line$(4) = "" : CALL DisplayLine(4)
ELSE
line$(this_line) = left$( line$(this_line), len(line$(this_line)) - 1 )
CALL DisplayLine(this_line)
END IF
END IF
RETURN
DoCalc:
num1# = val(line$(1))
num2# = val(line$(3))
op$ = line$(2)
SELECT CASE op$
CASE "/"
value# = num1# / num2#
CASE "*"
value# = num1# * num2#
CASE "-"
value# = num1# - num2#
CASE "+"
value# = num1# + num2#
END SELECT
line$(5) = STR$( value# )
DisplayLine(5)
RETURN