Calculator (group effort)

Discussions related to mathematics, numerical methods, graph plotting etc.
Post Reply
mikeg
Posts: 4
Joined: Sat 23 Jun 2018, 19:52

Calculator (group effort)

Post by mikeg » Fri 03 Aug 2018, 02:35

Hello everyone.. here is a nearly completed calculator app that should work on all platforms but I haven't tested android.

Currently, the number buttons will allow input and the decimal works and the functions are active, just that they dont perform the
task of adding or other functions..

So I invite Patrick or Richard or DDRM or RNBW or anyone to make this calculator perform the additions and other operators.

This is Open source and Free to add into a persons project. I will eventually finish it myself, but I thought I might share the nearly completed work. Let me know if your version you want to give to others for library resources...

Code: Select all

  PROCgraphics(250,250)
      n$="":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 +/-
        IF FNabutton(300,70,100,"150,150,150","+")="+" THEN op$="+":REM +
        IF FNabutton(430,50,50,"150,150,150","=")= "=" THEN op$="=": REM =
        IF FNabutton(430,120,50,"150,150,150","-")="-" THEN op$="-":REM -
        IF FNabutton(350,190,50,"150,150,150","X")="X" THEN op$="X":REM X
        IF FNabutton(430,190,50,"150,150,150","/")="/" THEN op$="/":REM /
        IF FNabutton(40,330,50,"200,100,100","ON")="ON" THEN op$="ON":n$="":REM ON/C
        PROCnumpad
        GCOL 15:MOVE 50,470:PRINT n$
        * REFRESH
        WAIT 10
        REM 140,140,140 is the background color of the LED display on the calculator
        PROCcolor("f","140,140,140"):MOVE 50,470:PRINT n$
      UNTIL FALSE
      END
      DEFPROCnumpad
      IF FNabutton(120,50,50,"100,100,100",".")="." THEN n$=n$+".":REM .
      IF FNabutton(40,50,50,"100,100,100","0")="0" THEN n$=n$+"0" :REM 0
      IF FNabutton(40,120,50,"100,100,100","1")="1" THEN n$=n$+"1" :REM 1
      IF FNabutton(40,190,50,"100,100,100","4")="4" THEN n$=n$+"4":REM 4
      IF FNabutton(40,260,50,"100,100,100","7")="7" THEN n$=n$+"7":REM 7
      IF FNabutton(120,120,50,"100,100,100","2")="2" THEN n$=n$+"2":REM 2
      IF FNabutton(120,190,50,"100,100,100","5")="5" THEN n$=n$+"5":REM 5
      IF FNabutton(120,260,50,"100,100,100","8")="8" THEN n$=n$+"8":REM 8
      IF FNabutton(200,120,50,"100,100,100","3")="3" THEN n$=n$+"3":REM 3
      IF FNabutton(200,190,50,"100,100,100","6")="6" THEN n$=n$+"6":REM 6
      IF FNabutton(200,260,50,"100,100,100","9")="9" THEN n$=n$+"9":REM 9
      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$
      ENDIF
      =ret$
      REM arrowu(x,y) added October 22,2017
      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
      REM arrowd(x,y) added October 22,2017
      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 *******************************************************************************
      REM NEW shaded edged block
      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
        sx%+=coun%*COS(RAD(angle))
        sy%+=coun%*SIN(RAD(angle))
        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"mask" : x$=FNword(cmd$):x%=VAL(x$):y$=FNword(cmd$):y%=VAL(y$):h$=FNword(cmd$):h%=VAL(h$):v$=FNword(cmd$):v%=VAL(v$)
            PROCmask(x%,y%,h%,v%)
          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%)
          WHEN"loadbmp" :
            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$)
      LOCAL initialx%,fi%,reduction%,tx,ty,mx%,my%,mb%,ad%,ady%,c$
      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%
        ad%=initialx%+8:ad%+=x:ady%=y-28
        IF mx% >x AND mx%<ad% AND my%<y+8 AND my%>ady% THEN
          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
      

DDRM
Administrator
Posts: 48
Joined: Mon 02 Apr 2018, 18:04

Re: Calculator (group effort)

Post by DDRM » 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

Post Reply