Calculator (group effort)

[mikeg]

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
        PROCnumpad
        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
      DEFPROCnumpad
      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$
      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]

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

[p_m21987]

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.

[mikeg]

This flawed code is removed to prevent confusion with most recent sample.. MOST RECENT SAMPLE CODE IS AT START OF CALCULATOR TOPIC

[Zaphod]

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

[mikeg]

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)

[Zaphod]

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

[mikeg]

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)

[Zaphod]

Thanks for the comments.
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

[mikeg]

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...'