Page 1 of 2

### Calculator (group effort)

Posted: Fri 03 Aug 2018, 02:35
MOST CURRENT PROGRAM MOVED TO TOP OF THREAD:

Code: Select all

``````      REM PRINT EVAL("1.1+2")
REM lets make n\$ = first number and n1\$ = second number and r\$= result
REM The solution to repeating an unwanted number is a bit of a challenge.
r=0
PROCgraphics(250,250)
n\$="":n1\$="":r\$="":REM Create calculator
PROCsbox(1,1,499,499,"white")
PROCsbox(40,420,480,480,"140,140,140"):REM LED display on calculator
ret\$= FNabutton(40,50,50,"100,100,100","fill") :REM 0
GCOL 15:MOVE 60,80:PRINT "0"
ret\$= FNabutton(120,50,50,"100,100,100","fill"):REM .
GCOL 15:MOVE 140,80:PRINT "."
REM ret\$= FNabutton(200,50,50,"100,100,100","fill"):REM +/-
ret\$= FNabutton(300,70,100,"150,150,150","fill"):REM +
GCOL 15:MOVE 345,125: PRINT"+"
ret\$= FNabutton(430,50,50,"150,150,150","fill"): REM =
GCOL 15:MOVE 450,80:PRINT"="
ret\$= FNabutton(430,120,50,"150,150,150","fill"):REM -
GCOL 15:MOVE 450,150:PRINT "-"
ret\$= FNabutton(40,120,50,"100,100,100","fill"):REM 1
GCOL 15:MOVE 60,150:PRINT "1"
ret\$= FNabutton(40,190,50,"100,100,100","fill"):REM 4
GCOL 15:MOVE 60,220:PRINT "4"
ret\$= FNabutton(40,260,50,"100,100,100","fill"):REM 7
GCOL 15:MOVE 60,290:PRINT "7"
ret\$= FNabutton(40,330,50,"200,100,100","fill"):REM ON/C
GCOL 15:MOVE 50,360:PRINT"CE"
ret\$= FNabutton(120,120,50,"100,100,100","fill"):REM 2
GCOL 15:MOVE 140,150: PRINT"2"
ret\$= FNabutton(120,190,50,"100,100,100","fill"):REM 5
GCOL 15:MOVE 140,220:PRINT"5"
ret\$= FNabutton(120,260,50,"100,100,100","fill"):REM 8
GCOL 15:MOVE 140,290:PRINT"8"
ret\$= FNabutton(200,120,50,"100,100,100","fill"):REM 3
GCOL 15:MOVE 220,150:PRINT"3"
ret\$= FNabutton(200,190,50,"100,100,100","fill"):REM 6
GCOL 15:MOVE 220,220:PRINT"6"
ret\$= FNabutton(200,260,50,"100,100,100","fill"):REM 9
GCOL 15:MOVE 220,290:PRINT"9"
ret\$= FNabutton(350,190,50,"150,150,150","fill"):REM X
GCOL 15:MOVE 370,220
PRINT "x"
ret\$= FNabutton(430,190,50,"150,150,150","fill"):REM /
GCOL 15:MOVE 450,220 :PRINT"/"
REM Begin button activity checks
* REFRESH OFF
REPEAT
REM ret\$= FNabutton(200,50,50,"100,100,100","fill"):REM +/-
op\$=""
IF VAL(n\$)>0 AND VAL(n1\$)=0 THEN
IF FNabutton(300,70,100,"150,150,150","+")="+" THEN n1\$=n\$+"+":op\$="+":REM +
IF FNabutton(430,120,50,"150,150,150","-")="-" THEN n1\$=n\$+"-":op\$="-":REM -
IF FNabutton(350,190,50,"150,150,150","X")="X" THEN n1\$=n\$+"*":op\$="*":REM X
IF FNabutton(430,190,50,"150,150,150","/")="/" THEN n1\$=n\$+"/":op\$="/":REM /
IF VAL(n1\$)>0 THEN n\$=""
ENDIF
chk\$=RIGHT\$(n1\$,1)
IF chk\$="+" OR chk\$="-" OR chk\$="*" OR chk\$="/" THEN chk\$="0" ELSE chk\$="1"
IF VAL(n\$)=0 AND VAL(n1\$)>0 AND chk\$="1" THEN
IF FNabutton(300,70,100,"150,150,150","+")="+" THEN n1\$=n1\$+"+":REM +
IF FNabutton(430,120,50,"150,150,150","-")="-" THEN n1\$=n1\$+"-":REM -
IF FNabutton(350,190,50,"150,150,150","X")="X" THEN n1\$=n1\$+"*":REM X
IF FNabutton(430,190,50,"150,150,150","/")="/" THEN n1\$=n1\$+"/":REM /
ENDIF
er\$=""
IF VAL(n\$)>0 AND VAL(n1\$)>0 THEN
IF FNabutton(300,70,100,"150,150,150","+")="+" THEN er\$=n1\$+n\$:op\$="+":REM +
IF FNabutton(430,120,50,"150,150,150","-")="-" THEN er\$=n1\$+n\$:op\$="-":REM -
IF FNabutton(350,190,50,"150,150,150","X")="X" THEN er\$=n1\$+n\$:op\$="*":REM X
IF FNabutton(430,190,50,"150,150,150","/")="/" THEN er\$=n1\$+n\$:op\$="/":REM /
IF FNabutton(430,50,50,"150,150,150","=")= "=" THEN er\$=n1\$+n\$:op\$="=": REM =
IF op\$="+" OR op\$="-"OR op\$="*" OR op\$="/" THEN
r=EVAL(er\$)
IF r>0 THEN n1\$=STR\$(r):n\$=""
IF r>0 THEN n1\$=n1\$+op\$:n\$=""
r=0
ENDIF
IF op\$="=" THEN
r=EVAL(er\$)
IF r>0 THEN n1\$=STR\$(r):n\$=""
n\$=""
r=0
ENDIF
ENDIF
IF FNabutton(40,330,50,"200,100,100","ON")="ON" THEN op\$="ON":n\$="":n1\$="":r\$="":REM ON/C
GCOL 15:MOVE 50,440:PRINT n\$
MOVE 50,470:PRINT n1\$
* REFRESH
WAIT 5
REM 140,140,140 is the background color of the LED display on the calculator
PROCcolor("f","140,140,140"):MOVE 50,440:PRINT n\$
MOVE 50,470:PRINT n1\$
UNTIL FALSE
END
PRIVATE dv\$,dx%,dy%,db%,mdv\$,nmx%,nmy%,nmb%
IF FNabutton(120,50,50,"100,100,100",".")="." THEN dv\$=".":REM .
IF FNabutton(40,50,50,"100,100,100","0")="0" THEN dv\$="0" :REM 0
IF FNabutton(40,120,50,"100,100,100","1")="1" THEN dv\$="1":REM 1
IF FNabutton(40,190,50,"100,100,100","4")="4" THEN dv\$="4":REM 4
IF FNabutton(40,260,50,"100,100,100","7")="7" THEN dv\$="7":REM 7
IF FNabutton(120,120,50,"100,100,100","2")="2" THEN dv\$="2":REM 2
IF FNabutton(120,190,50,"100,100,100","5")="5" THEN dv\$="5":REM 5
IF FNabutton(120,260,50,"100,100,100","8")="8" THEN dv\$="8":REM 8
IF FNabutton(200,120,50,"100,100,100","3")="3" THEN dv\$="3":REM 3
IF FNabutton(200,190,50,"100,100,100","6")="6" THEN dv\$="6":REM 6
IF FNabutton(200,260,50,"100,100,100","9")="9" THEN dv\$="9":REM 9
REM I guess the mouse coordinates MUST be global for this to work
n\$=n\$+dv\$
dv\$=""
ENDPROC
REM I put resetrgb back into the library because VDU 20 clears the screen.
DEFPROCresetrgb
LOCAL N
FOR N = 0 TO 15
VDU 19,N,N,0,0,0
NEXT N
VDU 20
ENDPROC
REM FNabutton added October 22 2017
DEFFNabutton(x,y,size%,c\$,com\$)
LOCAL _mx,_my,_mb,ret\$
MOUSE _mx,_my,_mb
PROCcolor("f","5")
PROCrect(x,y,x+size%,y+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):PROCrect(x,y,x+size%,y+size%)
IF _mb=4 THEN ret\$=com\$:MOUSE TO x-5,y
ENDIF
=ret\$
DEFPROCarrowu(x,y)
LOCAL _xx,_yy
VDU 20:GCOL 0
LINE _xx,_yy,_xx-20,_yy-20
LINE _xx,_yy,_xx+20,_yy-20
GCOL 15
LINE x,y,x-20,y-20
LINE x,y,x+20,y-20
_xx=x:_yy=y
ENDPROC
DEFPROCarrowd(x,y)
PRIVATE _hh,_vv
VDU 20:GCOL 0
LINE _hh,_vv,_hh-20,_vv+20
LINE _hh,_vv,_hh+20,_vv+20
GCOL 15
LINE x,y,x-20,y+20
LINE x,y,x+20,y+20
_hh=x:_vv=y
ENDPROC
REM the following code is RETROLIB.. created by Michael J Gallup with contributions from Zaphod (code structure improvement
REM and Richard Russell (word interpreter / tools)
REM the world is free to use it ( including myself ) to help become more productive.
REM *******************************************************************************
DEFPROCslate(x%,y%,size%,r%,g%,b%)
LOCAL cun%,r\$,g\$,b\$,cd%
FOR cun%=120 TO 0 STEP-11
PROCcrgb(r%-cun%,g%-cun%,b%-cun%)
PROCrect(x%+cd%,y%+cd%,x%+size%-cd%,y%+size%-cd%)
cd%+=1
NEXT cun%
r\$=FNnumstr(r%):g\$=FNnumstr(g%):b\$=FNnumstr(b%)
PROCpaint(x%+cd%+1,y%+cd%+1,r\$+","+g\$+","+b\$)
ENDPROC
REM example FNroll(150) gives a random number between 1 and 150  ************* just another tool
DEFFNroll(r)
LOCAL r_t%
r_t%=RND(r)
=r_t%
DEFPROCturtle(coun%,angle,pen\$,RETURN x%,RETURN y%)
PRIVATE sx%,sy%
IF pen\$="move" THEN sx%=x%:sy%=y%
IF pen\$="up" OR pen\$="down" THEN
IF pen\$="down" THEN LINE x%,y%,sx%,sy%
ENDIF
x%=sx%:y%=sy%
ENDPROC
DEFPROCgr(cmd\$)
PRIVATE pen\$,x%,y%,angle
LOCAL x\$,y\$,h\$,v\$,c\$,word\$,size\$,size2\$,lx%,ly%,r\$,g\$,b\$,di%,di\$,amt\$,name\$,h%,v%,resp\$,speed\$,speed,amt%,c_h\$,l_ocation\$,fx,c_v\$
LOCAL r%,g%,b%
REPEAT
word\$ = FNword(cmd\$)
CASE word\$ OF
WHEN "color" : c\$=FNword(cmd\$) : PROCcolor("f",c\$)
WHEN "r" : angle=angle - VAL(FNword(cmd\$))
WHEN "l" : angle=angle + VAL(FNword(cmd\$))
WHEN "f" : PROCturtle(VAL(FNword(cmd\$)),angle,pen\$,x%,y%)
WHEN "rect" : x\$=FNword(cmd\$):y\$=FNword(cmd\$):h\$=FNword(cmd\$):v\$=FNword(cmd\$) :PROCrect(VAL(x\$),VAL(y\$),VAL(h\$),VAL(v\$))
WHEN"graphics" :  PROCgraphics(1000,600)
WHEN"size" : size\$=FNword(cmd\$):PROCdotsize(VAL(size\$))
WHEN"donut" :x\$=FNword(cmd\$):x%=VAL(x\$):y\$=FNword(cmd\$):y%=VAL(y\$):PROC_donut(x%,y%,VAL(r\$),VAL(g\$),VAL(b\$))
WHEN"move" :
x\$=FNword(cmd\$):y\$=FNword(cmd\$)
lx%= VAL(x\$)
ly%= VAL(y\$)
x%=lx%:y%=ly%
PROCturtle(0,angle,"move",x%,y%)
PROCgo("move",0)
WHEN"ellipse" :
x\$=FNword(cmd\$):y\$=FNword(cmd\$):size\$=FNword(cmd\$):size2\$=FNword(cmd\$):di\$=FNword(cmd\$)
PROCellipse(VAL(x\$),VAL(y\$),VAL(size\$),VAL(size2\$),VAL(r\$),VAL(g\$),VAL(b\$),VAL(di\$))
WHEN"print" : PROCpr(lx%,ly%,FNbuild(cmd\$),"15")
WHEN"rgb" :
r\$=FNword(cmd\$):g\$=FNword(cmd\$):b\$=FNword(cmd\$)
r%=VAL(r\$):g%=VAL(g\$):b%=VAL(b\$)
PROCcrgb(r%,g%,b%)
WHEN"block" :
x\$=FNword(cmd\$):y\$=FNword(cmd\$):size\$=FNword(cmd\$):di\$=FNword(cmd\$)
PROC_block(VAL(x\$),VAL(y\$),VAL(size\$),r%,g%,b%,VAL(di\$))
REM button x y di
WHEN"button" :
x\$=FNword(cmd\$):y\$=FNword(cmd\$):di\$=FNword(cmd\$)
x%=VAL(x\$):y%=VAL(y\$):di%=VAL(di\$)
PROC_button(x%,y%,15,25,r%,g%,b%,di%)
WHEN"sbox" :
x\$=FNword(cmd\$):y\$=FNword(cmd\$):h\$=FNword(cmd\$):v\$=FNword(cmd\$):
c\$=FNword(cmd\$)
PROCsbox(VAL(x\$),VAL(y\$),VAL(h\$),VAL(v\$),c\$)
WHEN"sphere" :
x\$=FNword(cmd\$):y\$=FNword(cmd\$):size\$=FNword(cmd\$):di\$=FNword(cmd\$)
PROC_sphere(VAL(x\$),VAL(y\$),VAL(size\$),r%,g%,b%,VAL(di\$))
WHEN"savebmp" :
name\$=FNword(cmd\$)+".bmp":x\$=FNword(cmd\$):x%=VAL(x\$):y\$=FNword(cmd\$):y%=VAL(y\$):h\$=FNword(cmd\$):h%=VAL(h\$):v\$=FNword(cmd\$):v%=VAL(v\$)
OSCLI "SCREENSAVE """+name\$+""" "+STR\$(x%)+","+STR\$(y%)+","+STR\$(h%)+","+STR\$(v%)
name\$=FNword(cmd\$)+".bmp":x\$=FNword(cmd\$):x%=VAL(x\$):y\$=FNword(cmd\$):y%=VAL(y\$):h\$=FNword(cmd\$):h%=VAL(h\$):v\$=FNword(cmd\$):v%=VAL(v\$)
OSCLI "DISPLAY """+name\$+""" "+STR\$(x%)+","+STR\$(y%)+","+STR\$(h%)+","+STR\$(v%)
WHEN"ring" : c_h\$=FNword(cmd\$):c_v\$=FNword(cmd\$):x\$=FNword(cmd\$):y\$=FNword(cmd\$):size\$=FNword(cmd\$):size2\$=FNword(cmd\$):di\$=FNword(cmd\$)
PROC_ellipsering(VAL(c_h\$),VAL(c_v\$),VAL(x\$),VAL(y\$),VAL(size\$),VAL(size2\$),r%,g%,b%,VAL(di\$))
WHEN"eyes" :
x\$=FNword(cmd\$):y\$=FNword(cmd\$):l_ocation\$=FNword(cmd\$):speed\$=FNword(cmd\$):speed=VAL(speed\$)
FOR fx=1 TO 40:PROClefteye(VAL(x\$),VAL(y\$),l_ocation\$,speed):PROCrighteye(VAL(x\$)-100,VAL(y\$),l_ocation\$,speed):NEXT fx
WHEN "c","n","s","e","w","ne","nw","se","sw","fill" :
resp\$=word\$
amt\$=FNword(cmd\$)
amt%=VAL(amt\$)
PROCgo(resp\$,amt%)
WHEN "up","down" : pen\$=word\$:PROCgo(word\$,0)
REM LMFAO !!!   set is crazy
WHEN "set" : x\$=FNword(cmd\$):y\$=FNword(cmd\$):PROCset(VAL(x\$),VAL(y\$),STR\$(VAL(FNnumstr(r%)))+","+STR\$(VAL(FNnumstr(g%)))+","+STR\$(VAL(FNnumstr(b%)))+"")
WHEN"cls" : CLG
ENDCASE
UNTIL word\$ = ""
ENDPROC

DEF FNbuild(a\$) :REM Used by PROCgr
LOCAL b\$,build\$
REPEAT
b\$= FNword(a\$)
IF b\$<>":" THEN build\$+=" "+b\$
UNTIL b\$="" OR INSTR(":.?",RIGHT\$(b\$))>0
=build\$
REM thanks Richard
DEF FNword(RETURN A\$)
PRIVATE Alphabet\$
LOCAL space\$
Alphabet\$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"+"0123456789:,./"
space\$ = FNtoken(A\$, " ")
= FNtoken(A\$,Alphabet\$)

DEF FNtoken(RETURN A\$, list\$)
LOCAL T\$
WHILE INSTR(list\$, LEFT\$(A\$,1))
T\$ += LEFT\$(A\$,1)
A\$ = MID\$(A\$,2)
ENDWHILE
= T\$
DEFPROCcrgb(r%,g%,b%)
COLOUR 0,r%,g%,b% : GCOL 0
ENDPROC
REM RETROLIB 2
REM THIS IS "RETROLIB" library version for NOVEMBER 28 2016 @ 6:08am
DEF PROCblast(x%,y%,chance%)
LOCAL dv%,dh%,xc%
PROCdotsize(1)
REPEAT
dv%=RND(chance%)
dh%=RND(chance%)
PROCdotsize(2)
PROCdotrgb(x%+dh%,y%+dv%,255,RND(255),100)
dv%=RND(chance%)
dh%=RND(chance%)
PROCdotrgb(x%-dh%,y%+dv%,255,RND(255),100)
dv%=RND(chance%)
dh%=RND(chance%)
PROCdotrgb(x%+dh%,y%-dv%,255,RND(255),100)
dv%=RND(chance%)
dh%=RND(chance%)
PROCdotrgb(x%-dh%,y%-dv%,255,RND(255),100)
WAIT 1
xc%+=1
UNTIL xc%>20
ENDPROC
DEF PROC_button(h,v,b_egin,s_ize,x,c,a,d_i)
REM restore default color palettes
PROCresetrgb:GCOL 0
LOCAL r,g,b,p,ny
r=x
g=c
b=a
p=s_ize-b_egin
p=p/2
p=b_egin+p
FOR ny=p TO s_ize
COLOUR 0,x,c,a :GCOL 0
LINE h-ny,v-ny,h+ny,v-ny
LINE h+ny,v-ny,h+ny,v+ny
LINE h+ny,v+ny,h-ny,v+ny
LINE h-ny,v+ny,h-ny,v-ny
x=x-d_i
c=c-d_i
a=a-d_i
IF x<2 THEN x=2
IF c<2 THEN c=2
IF a<2 THEN a=2
NEXT ny
p=s_ize-b_egin
p=p/2
p=b_egin+p
FOR ny=b_egin TO p
COLOUR 1,x,c,a :GCOL 1
LINE h-ny,v-ny,h+ny,v-ny
LINE h+ny,v-ny,h+ny,v+ny
LINE h+ny,v+ny,h-ny,v+ny
LINE h-ny,v+ny,h-ny,v-ny
x=x+d_i
c=c+d_i
a=a+d_i
NEXT ny
PROCpaint(h,v,FNnumstr(r)+" "+FNnumstr(g)+" "+FNnumstr(b))
ENDPROC
DEF PROC_block(h,v,s,x,c,a,d_i)
LOCAL p,y
p=s/2
FOR y=1 TO s
COLOUR 0,x,c,a:GCOL 0
LINE h-y,v-y,h+y,v-y
LINE h+y,v-y,h+y,v+y
LINE h+y,v+y,h-y,v+y
LINE h-y,v+y,h-y,v-y
x=x-d_i
c=c-d_i
IF x<2 THEN x=2
IF c<2 THEN c=2
IF a<2 THEN a=2
p=p-1
NEXT y
ENDPROC
DEF PROC_donut(h,v,r,g,b)
PROC_ellipsering(3,3,h,v,30,40,r,g,b,10)
PROC_sphere(h,v,10,r,g,b,7)
ENDPROC
DEF PROC_ellipsering(ch,cv,h,v,s,t,x,c,a,d_i)
LOCAL oc,och,ocv,r,dc,ny
IF s > t THEN s = t
oc=t/2
och=ch+oc
ocv=cv+oc
r=0
dc=s/2
FOR ny=1 TO dc
COLOUR 1,x,c,a GCOL 1
ELLIPSE h,v,och-r,ocv-r
ELLIPSE h,v,och+r,ocv+r
r=r+1
x=x-d_i
c=c-d_i
a=a-d_i
IF x<2 THEN x=2
IF c<2 THEN c=2
IF a<2 THEN a=2
NEXT ny
ENDPROC
REM ellipse h,v,sizex,sizey,R,G,B,dimmer
DEF PROCellipse(h,v,sizex,sizey,x,c,a,di):REM' dimmer cannot be more than 24
LOCAL limit,y,hi,wi
MOVE h,v
IF sizex>sizey THEN limit=sizex
IF sizey>sizex THEN limit=sizey
FOR y=0 TO limit
PROCcrgb(x,c,a)
hi=hi+1:IF sizex>sizey THEN hi=hi+1
wi=wi+1:IF sizey>sizex THEN wi=wi+1
IF hi>sizex THEN hi=sizex
IF wi>sizey THEN wi=sizey
ELLIPSE h,v,hi,wi
x=x-di
c=c-di
a=a-di
IF x<2 THEN x=2
IF c<2 THEN c=2
IF a<2 THEN a=2
NEXT y
ENDPROC
DEFPROC_sphere(h,v,s,r%,g%,b%,d_i%)
LOCAL x%,skip%
PROCdotsize(3)
skip%=FALSE
FOR x%=0 TO s
r%=r%-d_i%
g%=g%-d_i%
b%=b%-d_i%
IF r% <2 THEN r%=2
IF g% <2 THEN g%=2
IF b%<2 THEN b%=2
IF r%<50 AND g%<50 AND b%<50 THEN skip%=TRUE
IF skip%=FALSE THEN
COLOUR 1,r%,g%,b%:GCOL 1
CIRCLE h,v,x%
ENDIF
NEXT x%
PROCdotsize(1)
ENDPROC
DEFPROCdotsize(n)
VDU 23,23,n|
ENDPROC
REM "mygraphics" - "INTERFACE" - "OBJECTS" - (Combined libraries) * to make it easier to manage
REM save as "RETROLIB"
REM To make this easier to modify, keep the remarks
REM "OBJECTS"  library

DEFPROCrighteye(x,y,location\$,speed): PRIVATE dx,dy,counx,couny,eyeh,eyev,seyeh,seyev
DEFPROClefteye(x,y,location\$,speed) : PRIVATE dx,dy,counx,couny,eyeh,eyev,seyeh,seyev
IF counx<x-12 THEN counx=x-12:REM this ensures the pupil stays within eye
IF counx>x+12 THEN counx=x+12
IF couny<y-12 THEN couny=y-12
IF couny>y+12 THEN couny=y+12
CASE location\$ OF
WHEN "center":dx=x:dy=y:eyeh=15:eyev=15
WHEN "right":dx=x+80:dy=y:eyeh=10:eyev=15
WHEN "down":dx=x:dy=y-80:eyev=10:eyeh=15
WHEN "up":dx=x:dy=y+80:eyev=10:eyeh=15
WHEN "left":dx=x-80:dy=y:eyeh=10:eyev=15
ENDCASE
IF counx<dx THEN counx=counx+1
IF counx>dx THEN counx=counx-1
IF couny<dy THEN couny=couny+1
IF couny>dy THEN couny=couny-1
IF seyeh<eyeh THEN seyeh+=.4
IF seyeh>eyeh THEN seyeh-=.4
IF seyev<eyev THEN seyev+=.4
IF seyev>eyev THEN seyev-=.4
REM dx, dy is meant to hold the destination of the pupil
REM counx,couny is meant to hold the current pupil location
REM eyeh,eyev is meant to hold the shape of the pupil as it moves
REM speed is the rate that the pupil moves. I am not sure how fast it should move but it will be in decimal value
GCOL 15
CIRCLE FILL x,y,20
GCOL 4
ELLIPSE FILL counx,couny,seyeh,seyev
PROCcolor("f","000,000,000")
ELLIPSE FILL counx,couny,seyeh/2,seyev/2
WAIT speed
ENDPROC
REM COLORMIX object mixer
DEFFNcolormix(x,y)
PRIVATE rgb\$,r%,g%,b%,switch%
LOCAL h%,v%,click%
MOUSE h%,v%,click%
IF click%=4 THEN
IF h%>x AND h%<x+50 AND v%>y AND v%<y+255 THEN r%=v%-y
IF h%>x+49 AND h%<x+90 AND v%>y AND v%<y+255 THEN g%=v%-y
IF h%>x+99 AND h%<x+140 AND v%>y AND v%<y+255 THEN b%=v%-y
ENDIF
IF switch%=0 OR click%=4 THEN
PROCsbox(x-5,y-5,x+150,y+265,"255,255,255")
PROCsbox(x,y+r%,x+40,y+r%+10,"200,000,000")
PROCsbox(x+50,y+g%,x+90,y+g%+10,"000,200,000")
PROCsbox(x+100,y+b%,x+140,y+b%+10,"000,000,200")
switch%=1
rgb\$=FNnumstr(r%)+","+FNnumstr(g%)+","+FNnumstr(b%)
PROCsbox(x-5,y+265,x+150,y+295,rgb\$)
ENDIF
=rgb\$
REM  GRAPHICS(x,y) - simple?
DEF PROCgraphics(x,y)
VDU 23,22,x;y;8,15,16,1
OFF
VDU 5
ENDPROC
DEFFNkey
LOCAL r\$
r\$=INKEY\$(4)
=r\$
REM SBOX **********************
DEF PROCsbox(x%,y%,w%,h%,c\$)
LOCAL ry%,sx%,sy%
sx%=x%:sy%=y%
IF x%>w% THEN x%=w%:w%=sx%
IF y%>h% THEN y%=h%:h%=sy%
ry%=y%
PROCcolor("f",c\$)
REPEAT
LINE x%,y%,w%,y%
y%=y%+1
UNTIL y%=h%
y%=ry%
IF c\$<>"0" THEN PROCcolor("f","000,000,000") ELSE PROCcolor("f","white")
LINE x%+2,y%+2,w%-2,y%+2
LINE w%-2,y%+2,w%-2,h%-4
LINE w%-2,h%-4,x%+2,h%-4
LINE x%+2,h%-4,x%+2,y%+2
VDU 20
ENDPROC
REM RECT **********************
DEFPROCrect(x%,y%,w%,h%)
LOCAL sx%,sy%
sx%=x%:sy%=y%
IF x%>w% THEN x%=w%:w%=sx%
IF y%>h% THEN y%=h%:h%=sy%
LINE x%,y%,w%,y%
LINE w%,y%,w%,h%
LINE w%,h%,x%,h%
LINE x%,h%,x%,y%
ENDPROC
REM pixel *******************
DEFPROCpixel(x%,y%,c\$)
PROCcolor("f",c\$)
MOVE x%,y%:DRAW x%,y%
ENDPROC
REM SET  c\$ can be colors like blue or 1 or a R,G,B color
DEF PROCset(x%,y%,c\$)
LOCAL h%
PROCcolor("f",c\$)
FOR h%=0 TO 20
LINE x%+h%,y%,x%+h%,y%+20
NEXT
MOVE 0,0
ENDPROC
DEF PROCcolor(fb\$,rgb\$)
PRIVATE assemble\$,br%,bg%,bb%
IF rgb\$="0" OR rgb\$="black" THEN rgb\$="000,000,000"
IF rgb\$="1" OR rgb\$="red" THEN rgb\$="200,000,000"
IF rgb\$="2" OR rgb\$="green" THEN rgb\$="000,200,000"
IF rgb\$="3" OR rgb\$="yellow" THEN rgb\$="200,200,000"
IF rgb\$="4" OR rgb\$="blue" THEN rgb\$="000,000,200"
IF rgb\$="5" OR rgb\$="magenta" THEN rgb\$="200,000,200"
IF rgb\$="6" OR rgb\$="cyan" THEN rgb\$="000,200,200"
IF rgb\$="7" OR rgb\$="white" THEN rgb\$="200,200,200"
IF rgb\$="8" OR rgb\$="grey" THEN rgb\$="056,056,056"
IF rgb\$="9" OR rgb\$="light red" THEN rgb\$="248,056,056"
IF rgb\$="10" OR rgb\$="light green" THEN rgb\$="056,248,056"
IF rgb\$="11" OR rgb\$="light yellow" THEN rgb\$="248,248,056"
IF rgb\$="12" OR rgb\$="light blue" THEN rgb\$="056,056,248"
IF rgb\$="13" OR rgb\$="light magenta" THEN rgb\$="248,056,248"
IF rgb\$="14" OR rgb\$="light cyan" THEN rgb\$="056,248,248"
IF rgb\$="15" OR rgb\$="light white" THEN rgb\$="248,248,248"
assemble\$=rgb\$
br%=VAL(MID\$(assemble\$,1,3)):bg%=VAL(MID\$(assemble\$,5,3)):bb%=VAL(MID\$(assemble\$,9,3))
IF fb\$="f" OR fb\$="F" THEN COLOUR 0,br%,bg%,bb% : GCOL 0
IF fb\$="b" OR fb\$="B" THEN COLOUR 1,br%,bg%,bb% : GCOL 128+1
ENDPROC
REM h and v must always be a higher value as they are the top right corner of the image.( I make make this smart like sbox)
DEFPROCgo(cm\$,coun%)
REM Simplified. Line draws the right color and right length now. Much faster. Zaphod
PRIVATE x%,y%,pen%,c\$
REM x% ,y% are already in @vdu.p.x%, @vdu.p.y% so are not needed to be kept separately as PRIVATE variables
REM @vdu.g.x has all the color details. BB4W Help "System Variables"
LOCAL xinc%,yinc%,dist%
CASE cm\$ OF
WHEN "up" : pen%=1
WHEN "down" : pen%=0
WHEN "fill" : PROCpaint(x%,y%,STR\$(coun%))
WHEN "c" : c\$=STR\$(coun%):PROCcolor("f",c\$)
ENDCASE
dist%=INT(coun%/SQR(2)+0.5) REM round to the nearest pixel for 45° angles
CASE cm\$ OF
WHEN "n" : yinc%=coun%  : xinc%=0
WHEN "s" : yinc%=-coun% : xinc%=0
WHEN "e" : yinc%=0  : xinc%=coun%
WHEN "w" : yinc%=0  : xinc%=-coun%
WHEN "ne" :yinc%=dist%  : xinc%=dist%
WHEN "nw" :yinc%=dist%  : xinc%=-dist%
WHEN "sw" :yinc%=-dist%  : xinc%=-dist%
WHEN "se" :yinc%=-dist%  : xinc%=dist%
ENDCASE
IF pen% =0 IF (ABS(yinc%)+ABS(xinc%))<>0 THEN LINE x%,y%,x%+xinc%,y%+yinc%
x%+=xinc%:y%+=yinc%
ENDPROC
DEFFNnumstr(num)
LOCAL cov\$,l%,r\$
cov\$=STR\$(num)
l%=LEN(cov\$)
IF l%=1 THEN r\$="00"+cov\$
IF l%=2 THEN r\$="0"+cov\$
IF l%=3 THEN r\$=cov\$
=r\$
DEFPROCpaint(x%,y%,co\$)
PROCcolor("b",FNrgb(x%,y%)):PROCcolor("f",co\$)
FILL x%,y%
ENDPROC
REM dotrgb ********************************
DEFPROCdotrgb(x%,y%,r%,g%,b%)
COLOUR 0,r%,g%,b% : GCOL 0
MOVE x%,y%:DRAW x%,y%
ENDPROC
REM *****SPECIAL RGB tools (color extraction) has use with PROCdotrgb
DEF PROCrgbret(x%,y%,RETURN r%,RETURN g%,RETURN b%)
LOCAL rgb%
rgb%=TINT(x%,y%)
r%=rgb% AND &FF
g%=rgb%>>8 AND &FF
b%=rgb%>>16 AND &FF
ENDPROC
REM experimental
DEFFNrgb(x%,y%)
LOCAL rgb%, r&, g&, b&
rgb%=TINT(x%,y%)
r&=rgb%    :REM Use byte variable as mask.
g&=rgb% >>8
b&=rgb% >>16
=FNnumstr(r&)+","+FNnumstr(g&)+","+FNnumstr(b&)
REM  "INTERFACE" -library - for graphics text input and other tools
REM X,Y,message,r,g,b
DEF PROCpr(x,y,msg\$,c\$)
PRIVATE trackx,tracky,trackmsg\$,trackc\$
LOCAL initialx%,fi%,reduction%,tx,ty
IF trackx=x AND tracky=y AND trackmsg\$<>msg\$ THEN PROCprsub(trackx,tracky,trackmsg\$,"000,000,000")
IF trackx<>x OR tracky<>y OR trackmsg\$<>msg\$ OR trackc\$<>c\$ THEN
initialx%=LEN(msg\$)
PROCcolor("f",c\$)
GCOL 0
LET tx= x+initialx%+25
LET ty= y:reduction%=0
reduction%=initialx%/2
reduction%=reduction%*6
IF initialx%<20 THEN reduction%=reduction%/2
initialx%=initialx%*22-reduction%
FOR fi%=12 TO 48
LINE x-3,y+20-fi%,x+initialx%+8,y+20-fi%
NEXT
COLOUR 0,0,0,0
GCOL 0
MOVE tx,ty
PRINT msg\$
MOVE 0,0
ENDIF
trackx=x:tracky=y:trackmsg\$=msg\$:trackc\$=c\$
ENDPROC
REM used by PROCpr to enhance clean up from text overlays
DEFPROCprsub(x,y,msg\$,c\$)
LOCAL initialx%,fi%,reduction%,tx,ty
initialx%=LEN(msg\$)
PROCcolor("f",c\$)
GCOL 0
LET tx= x+initialx%+25
LET ty= y:reduction%=0
reduction%=initialx%/2
reduction%=reduction%*6
IF initialx%<20 THEN reduction%=reduction%/2
initialx%=initialx%*22-reduction%
FOR fi%=12 TO 48
LINE x-3,y+20-fi%,x+initialx%+8,y+20-fi%
NEXT
COLOUR 0,0,0,0
GCOL 0
MOVE tx,ty
PRINT msg\$
MOVE 0,0
ENDPROC
REM H,V,TEXTLIMIT (simpler?)
DEF FN_input(bx,b_y,textlimit)
LOCAL f_ill,message\$,mes\$,cey\$,s_l%,i_tialx%
i_tialx%=0:s_l%=0:cey\$="":message\$="":mes\$=""
i_tialx%=textlimit*16.2
FOR f_ill=1 TO 58
PROCcolor("f","15"):LINE bx+3,b_y+20-f_ill,bx+i_tialx%,b_y+20-f_ill
NEXT f_ill
PROCcolor("f","0"):LINE bx+3,b_y+20,bx+i_tialx%,b_y+20:LINE bx+3,b_y+20-f_ill,bx+i_tialx%,b_y+20-f_ill:
REPEAT
REPEAT
cey\$ =INKEY\$(1)
PROCcolor("F","0")
MOVE bx,b_y:PRINT message\$;"_" :* REFRESH
s_l%=LEN(message\$)
UNTIL cey\$ <>""
s_l%=LEN(message\$)
IF INKEY(-48) s_l%=LEN(message\$)-1:cey\$=""
REPEAT UNTIL INKEY(0)=-1
IF s_l%<LEN(message\$) THEN
PROCcolor("F","15")
MOVE bx,b_y
PRINT message\$;"_"
ENDIF
mes\$=MID\$(message\$,0,s_l%)
message\$=mes\$
PROCcolor("F","15"):MOVE bx,b_y:PRINT message\$;"_"
IF LEN(cey\$) = 1 THEN
IF LEN(message\$)<textlimit THEN PROCcolor("F","15"):MOVE bx,b_y:PRINT message\$;"_": message\$=message\$+cey\$:* REFRESH OFF
ENDIF
UNTIL INKEY(-74)
* REFRESH ON
=message\$
DEFFNbuttonz(x,y,msg\$)
PRIVATE st\$
IF msg\$<> "clearitall" THEN
initialx%=LEN(msg\$)
LET tx= x+initialx%+25
LET ty= y:reduction%=0
reduction%=initialx%/2
reduction%=reduction%*6
IF initialx%<20 THEN reduction%=reduction%/2
initialx%=initialx%*22-reduction%
MOUSE mx%,my%,mb%
c\$="255,255,255"
IF mb%=4 THEN st\$=msg\$
ELSE c\$="200,200,200"
ENDIF
IF FNrgb(x,y)="000,000,000" THEN c\$="200,200,200"
PROCcolor("f",c\$)
IF FNrgb(x,y)<>c\$ THEN
FOR fi%=12 TO 48
LINE x-3,y+20-fi%,x+initialx%+8,y+20-fi%
NEXT
PROCcolor("f","000,000,000")
MOVE tx,ty
PRINT msg\$
ENDIF
ENDIF
IF msg\$="clearitall" THEN st\$=""
MOVE 0,0 REM hide that thing
=st\$
DEFFNstcorecol(wdnum\$)
VDU 20
LOCAL tcol%
CASE wdnum\$ OF
WHEN "0","black" :tcol%=0
WHEN "1","red" :tcol%=1
WHEN "2","green" :tcol%=2
WHEN "3","yellow" :tcol%=3
WHEN "4","blue" :tcol%=4
WHEN "5","magneta" :tcol%=5
WHEN "6","cyan":tcol%=6
WHEN "7","white":tcol%=7
WHEN "8","grey":tcol%=8
WHEN "9","light red":tcol%=9
WHEN "10","light green":tcol%=10
WHEN "11","light yellow":tcol%=11
WHEN "12","light blue":tcol%=12
WHEN "13","light magneta":tcol%=13
WHEN "14","light cyan":tcol%=14
WHEN "15","light white" :tcol%=15
ENDCASE
=tcol%
DEF PROCfcolor(co\$)
LOCAL rcol%
rcol%=FNstcorecol(co\$)
GCOL rcol%
ENDPROC
DEF PROCbcolor(co\$)
LOCAL rcol%
rcol%=FNstcorecol(co\$)
GCOL 128 +rcol%
ENDPROC
``````

### Re: Calculator (group effort)

Posted: Mon 13 Aug 2018, 08:17
Hi Michael,

Why not just add the symbols to the expression, which you could store as a string, and then use EVAL to do the calculation when "=" is pressed?

Why is "+" so big? Consider making it the same size as the other operators, and/or making "=" bigger?

The space above the operator is for the addition of other operations (SQR, Sin/Cos/Tan etc?)

"Autorepeat" if you hold the mouse down is perhaps too sensitive? I'd "debounce" the mouse: once you've sensed button down, I'd wait until it is no longer pressed, then clear the buffer.

Best wishes,

D

### Re: Calculator (group effort)

Posted: Wed 22 Aug 2018, 16:32
Hello,

This calculator is certainly nice looking. I like the 3D effect on the calculator screen.

Though I'm used to using a calculator program (gnome-calculator on linux) that can take expressions (I mean like 1+2*3/4^5) and also that can let you define variables.
A calculator that lets you type expressions wouldn't be too hard to make with BASIC, you'd probably use EVAL to evaluate the expressions and catch errors with ON ERROR. But I think defining variables would be more difficult, I'm not sure how that might be done.

### Re: Calculator (group effort)

Posted: Fri 07 Sep 2018, 04:29
This flawed code is removed to prevent confusion with most recent sample.. MOST RECENT SAMPLE CODE IS AT START OF CALCULATOR TOPIC

### Re: Calculator (group effort)

Posted: Fri 07 Sep 2018, 13:16
Hi Mike.

I found a few problems fairly quickly.
1) I get multiple digit entries. Really you should only get one digit per click and suppress the auto repeat. I typically get 2 to 3 numbers per click which makes it unusable.
2) It crashes on line 71 the EVAL frequently. Seems like if you have a number with an exponent on the top line and then the new entry crashes when you hit the multiply key and perhaps other operators.
3) If you get multiple decimal points (the repeat function of item1) it seems to hang.

You have a spurious /code] in the code box. It does not affect the program just the cross reference utility.
I hope your slight modifications can take account of these issues.

regards

Z

### Re: Calculator (group effort)

Posted: Mon 10 Sep 2018, 00:57
I found a simple solution to the problem.

I just use MOUSE TO x,y after the chosen button is clicked... It will be offset the button slightly so a second button press will have no effect!

HA HA !! I WIN ?

I do know that this will affect future button captures, as I think I will work this into ABUTTON so it is less tedious in the future.

I do know that efficiency will need to be a focus. But for now this is an advancement !

As before, here is a more functional calculator which will be improved. (feel free to express your concerns) ( THE CODE HAS BEEN MOVED TO TOP OF SUBJECT THREAD AND REPLACED SAMPLE)

### Re: Calculator (group effort)

Posted: Mon 10 Sep 2018, 01:34
Michael,

OK, I added that MOUSE TO x,y and it works so long as you have a steady hand and don't wander a pixel back onto the button, x-5,y-5 would solve that. So I guess that counts as a win. I think there must be better ways rather than having the mouse jump off the button.

I tried playing around with this program code to try to solve the issue but got into problems with your library functions.
For example these all plot exactly the same rectangle.

Code: Select all

``````      PROCrect(100,100, 50, 50)
PROCrect(100, 50, 50, 100)
PROCrect(50,  50, 100, 100)
PROCrect(50, 100, 100, 50)
``````
It plots the same as RECTANGLE 50,50,50,50

PROCsbox has similar features. It seems misleading the have the parameters listed as (x%,y%,w%,h%) when clearly they aren't the obvious interpretations of what they might stand for as I quickly found out.
Perhaps you could add a couple of REM's as to how YOU use these procedures.

Z

### Re: Calculator (group effort)

Posted: Mon 10 Sep 2018, 01:49
PROCrect(x,y,w,h) works like this:

DEFPROCrect(x%,y%,w%,h%)
LOCAL sx%,sy%
sx%=x%:sy%=y%
IF x%>w% THEN x%=w%:w%=sx%
IF y%>h% THEN y%=h%:h%=sy%

x% always wants to be less than w% so if w% is greater then they swap values
y% always wants to be less than h% so if y% is greater than h% then they swap values
I guess I could have saved using extra variables and used: SWAP v1,v2

SBOX uses this method to ensure that a proper bordered box is made no matter what angle the coordinates are assigned for start and end locations.

I admit, its been a while since I looked at the technical aspects of the commands.

I did make a reference for RETROLIB 10 and that is inside the old BBC4W forum

RECTANGLE 50,50,50,50 is different in the way it draws the image, even though the image is the same:

The first 2 coordinates are the start location and 50,50 is the amount of pixels from that location 50 right to 50 up

But rect doesnt work like that, as at the time, rect was an attempt to solve a few customization issues. ( it does at times create a distinct shape)

### Re: Calculator (group effort)

Posted: Mon 10 Sep 2018, 13:47
I understand the code but not the reasoning behind it.
If you rewrote this as:

Code: Select all

``````
DEF PROCrect(x0,y0, x1,y1)
RECTANGLE x0,y0,x1-x0,y1-y0
ENDPROC

``````
it would give the exactly the same result as x0,y0 is the origin, and x1,y1 is the opposite corner. RECTANGLE can have negative width and height so it maps to the same rectangles as before. I guess it was just the naming of the parameters that confused me.
Why not just use the RECTANGLE built in function directly? I see lots of places where you could use RECTANGLE and RECTANGLE FILL to advantage and save lots of lines of code.

On the issue of the repeat keys I think a better solution would be to set a flag once you detect a mouse down and generate the first number, and reset it when the mouse button is released. The flag being set would inhibit further number entry. Saves all that mouse jumping off the button although that is a novel feature not found on many calculators. Or you could just go into an idle loop until the button is released.
If you replace your MOUSE TO with

Code: Select all

``````
REPEAT: WAIT 5: MOUSE _mx,_my,_mb  UNTIL_mb=0

``````
It solves that repeat key problem and gives you the number when the button is released which is like other online and PC calculators.

I notice that the calculator doesn't seem to like calculations that would give a negative result which is a bit of a bummer.
On that crash I mentioned earlier it seems to be adding a number (n\$) to the exponent in n1\$ so that it then tries to evaluate a number that is too large.

Can I give you a wish list?
a) Not have to press the clear before every new calculation. The Equals should signal a new calculation if the next entry isn't an operator.
b) a Back button for all those mistakes on entry.
c) a change sign button so you could say start with a negative number etc,
d) Parentheses so you can avoid having to use a pencil and paper to save intermediate results.

If you don't find these comments helpful just let me know and I will leave you to it.

Z

### Re: Calculator (group effort)

Posted: Mon 10 Sep 2018, 14:10
If you don't find these comments helpful just let me know and I will leave you to it.
Every suggestion helps. A negative number may be important if I have a deficit in my calculation. I need to see how that would work.

I appreciate your helpful efforts. I will see how your solution for rect compares to the possible outcomes. I think rect was created for the purpose you pointed out. Perhaps it was not needed.

I tried to set up the calculator to work like my hand held.
The last number after = should be available for further calculation.
The first number (or last result) is always the current solution carried into the new operator chosen and number to equate
The solution must become the current first number

So.. my general use calculator would work like this:
(number equation number) and regardless of equation, it always would calculate the first and last numbers then carry the result into the next calculation..

Perhaps on a more advanced calculator they may have parenthesis, but I dont recall seeing one. (I may have seen a fancy calculator years ago with a huge keyboard, and it may have had all those goodies)

I think I will allow a person to move back through calculations in case of error and do edit of numbers like on an accountants page. Of course this would be another page on the side of the calculator that is interactive.. ( would actually like this for doing my own time sheet prep work)

'MAKE IT SO...'