Post by Admin on Oct 8, 2020 3:15:46 GMT
Paste the code in BBC Basic For Windows and try it out.. I think it should work on BBCSDL depending on the platform you are on)
REM VOLATILE VASES MODIFIED FOR BBCSDL on NOVEMBER 22, 2019
REM this is the code only version (no external images required)
cy%=0:di%=0:xf%=0:yf%=0:xff%=0:yff%=0:mx%=0:my%=0:mb%=0:pass%=0:chk1$="":chk2$="":chk3$="":cyff%=0:cxff%=0
scx%=0:scy%=0:score%=0:checkx%=0:checky%=0:jmou%=0
Pitch% = 0
Speed% = 0
Voice$ = ""
m$="":v%=0
an%=0
d%=0:d%=1:ti%=0:rt%=0:ub%=0:u%=0
reply$="":tic%=0 :reply%=0
PROCgraphics(1000,600)
*REFRESH OFF
CLS
PROCgameboard(0,0)
PROCnewmix
luk$="":st$=""
PROCgr("move 100 1150 rgb 200 200 200 print Volatile Vases CREATED BY Michael Gallup- ")
PROCgr("move 100 1100 print SCORE ")
REPEAT
IF pass%=0 THEN
PROCcolor("f","255,100,100")
LINE xf%+5,yf%,xf%+150,yf%
LINE xf%+5,yf%,xf%+5,yf%+150
LINE xf%+5,yf%+150,xf%+150,yf%+150
LINE xf%+153,yf%+150,xf%+153,yf%
ENDIF
IF pass%=0 THEN
PROCcolor("f","100,255,100")
LINE xff%+5,yff%,xff%+150,yff%
LINE xff%+5,yff%,xff%+5,yff%+150
LINE xff%+5,yff%+150,xff%+150,yff%+150
LINE xff%+153,yff%+150,xff%+153,yff%
ENDIF
*REFRESH
PROCcolor("f","000,000,000"):
LINE xf%+5,yf%,xf%+150,yf%
LINE xf%+5,yf%,xf%+5,yf%+150
LINE xf%+5,yf%+150,xf%+150,yf%+150
LINE xff%+5,yff%,xff%+150,yff%
LINE xff%+5,yff%,xff%+5,yff%+150
LINE xff%+5,yff%+150,xff%+150,yff%+150
LINE xf%+153,yf%+150,xf%+153,yf%
LINE xff%+153,yff%+150,xff%+153,yff%
REPEAT
MOUSE mx%,my%,mb%
IF mx%=checkx% AND my%=checky% AND mb%<1 THEN WAIT 10 ELSE jmo%=1
luk$=FNgkey
IF luk$<>"" THEN jmo%=1
UNTIL jmo%=1
jmo%=0
checkx%=mx%:checky%=my%
IF mb%=4 THEN
MOUSE mx%,my%,mb%
IF mx%>0 AND mx%<1200 AND my%>0 AND my%<1100 THEN
IF mx%>xf% +150 AND my%>yf% THEN yf%+=150:xf%+=150
IF mx%>xf% +150 AND my%<yf% THEN xf%+=150
IF mx%>xf% AND mx%<xf%+150 THEN
IF my%< yf%+150 THEN yf%-=150
IF my%> yf%+150 THEN yf%+=150
ENDIF
IF mx%<xf% AND my%< yf%+150 AND my%>yf%-150 THEN xf%-=150
ENDIF
ENDIF
IF mb%=1 THEN
MOUSE mx%,my%,mb%
IF mx%>0 AND mx%<1200 AND my%>0 AND my%<1100 THEN
IF mx%>xff% +150 AND my%>yff% THEN yff%+=150:xff%+=150
IF mx%>xff% +150 AND my%<yff% THEN xff%+=150
IF mx%>xff% AND mx%<xff%+150 THEN
IF my%< yff%+150 THEN yff%-=150
IF my%> yff%+150 THEN yff%+=150
IF yff%>900 THEN yff%=900
ENDIF
IF mx%<xff% AND my%< yff%+150 AND my%>yff%-150 THEN xff%-=150
ENDIF
ENDIF
IF luk$="ENTER" OR luk$="E" THEN st$=" MOVE TO "
IF st$=" MOVE TO " THEN
chk1$="":chk2$="":chk3$="":chk4$="":pass%=0:cyff%=yff%+75:cxff%=xff%+75:rspr$="":uspr$="":lspr$="":dspr$=""
chk1$=FNrgb(cxff%+150,cyff%):chk2$=FNrgb(cxff%,cyff%+150):chk3$=FNrgb(cxff%-150,cyff%):chk4$=FNrgb(cxff%,cyff%-150):
IF xff%>xf%-200 AND yff%>yf%-200 AND xff%<xf%+230 AND yff%<yf%+230 THEN
mini%=0:REM if this is higher than 1 then move check1 is ok
IF chk1$=corri$ THEN rspr$="right":mini%+=1
IF chk2$=corri$ THEN uspr$="up":mini%+=1
IF chk3$=corri$ THEN lspr$="left":mini%+=1
IF chk4$=corri$ THEN dspr$="down":mini%+=1
IF FNrgb(cxff%,cyff%)="7" THEN mini%=2
IF mini%>1 THEN RECTANGLE SWAP xf%,yf%,150,150 TO xff%,yff%:SOUND 0,-15,100,1:WAIT 20
ENDIF:mini%=0
st$=""
ENDIF
WAIT 1
IF luk$="SPACE" OR luk$="Q" THEN xf%=xff%:yf%=yff%
IF luk$="G" THEN st$="GATHER "
IF st$="GATHER " AND FNrgb(xf%+75,yf%+75) <> "7" THEN
sweep%=0:dow%=0:upp%=0:rit%=0:lef%=0:scx%=xf%+75:scy%=yf%+75
corri$=FNrgb(xf%+75,yf%+75)
IF yff%>yf% THEN SWAP yff%,yf%
REPEAT
scy%-=150
IF FNrgb(scx%,scy%)= corri$ THEN dow%+=1
UNTIL FNrgb(scx%,scy%)<> corri$
IF dow%>1 THEN
scy%-=75-150:scx%-=75
FOR sweep%=0 TO dow%
score%=score%+10
PROCbcolor("0"):PROCcolor("f","150,150,180")
RECTANGLE FILL scx%+15,scy%+15,125,125
scy%+=150
NEXT sweep%
ENDIF
dow%=0:scx=xf%+75:scy%=yf%+75
IF xff%>xf% THEN SWAP xff%,xf%
REPEAT
scx%-=150
IF FNrgb(scx%,scy%)= corri$ THEN dow%+=1
UNTIL FNrgb(scx%,scy%)<> corri$
IF dow%>1 THEN
scy%-=75:scx%-=75-150
FOR sweep%=0 TO dow%
score%=score%+10
PROCbcolor("0"):PROCcolor("f","150,150,180")
RECTANGLE FILL scx%+15,scy%+15,125,125
scx%+=150
NEXT sweep%
dow%=0
ENDIF
ENDIF
IF luk$="UP" OR luk$="W" THEN yff%+=150:WAIT 12
IF yf%>900 THEN yf%=900
IF luk$="RIGHT" OR luk$="D" THEN xff%+=150:WAIT 12
IF xf%>1050 THEN xf%=1050:IF xff%>1050 THEN xff%=1050
IF luk$="LEFT" OR luk$="A" THEN xff%-=150:WAIT 12
IF xf%<0 THEN xf%=0: IF xff%<0 THEN xff%=0
IF luk$="DOWN" OR luk$="S" THEN yff%-=150:WAIT 12
IF yf%<0 THEN yf%=0:IF yff%<0 THEN yff%=0
corri$=FNrgb(xf%+75,yf%+75)
luk$=""
st$=FNbuttonz(0,0,"clearitall")
st$=FNbuttonz(1520,1000," MOVE TO ")
st$=FNbuttonz(1530,1100,"GATHER ")
st$=FNbuttonz(1300,700,"NEXT BOARD ")
st$=FNbuttonz(1520,910," UP ")
st$=FNbuttonz(1520,780," DOWN ")
st$=FNbuttonz(1310,850," LEFT ")
st$=FNbuttonz(1730,850," RIGHT ")
st$=FNbuttonz(1510,850,"GRAB VASE")
IF st$=" LEFT " THEN xff%-=150:WAIT 2
IF st$=" RIGHT " THEN xff%+=150:WAIT 2
IF st$=" UP " THEN yff%+=150 :WAIT 2
IF st$=" DOWN " THEN yff%-=150 :WAIT 2
IF yff%<0 THEN yff%=0
IF yff%>900 THEN yff%=900
IF xff%<0 THEN xff%=0
IF xff%>1050 THEN xff%=1050 REM ****************************************
IF st$="GRAB VASE" THEN xf%=xff%:yf%=yff%
IF st$="NEXT BOARD " THEN
PROCcolor("b","000,000,000")
PROCgameboard(0,0)
PROCnewmix
luk$="":st$=""
PROCcolor("f","200,200,200")
PROCtype(100,1150," Volatile Pots CREATED BY Michael J Gallup ","200,200,200")
ENDIF
PROCdropvases
REM Add a random vase to top if a empty spot is found
topcy%=0
FOR topcy%=80 TO 1130 STEP 150
IF FNrgb(topcy%,980)="7" THEN
PROCshufflecol(pr%,pg%,pb%)
PROCoval(topcy%,980,50,pr%,pg%,pb%)
ENDIF
NEXT topcy%
PROCpr(100,1100,"SCORE "+STR$(score%)+"","230,230,200")
UNTIL FALSE
REM PROC_exitsprites
REM PROC_comexit
END
DEF PROCdropvases
LOCAL cycy%,pr%,pg%,pb%,rres%
FOR cycy% = 80 TO 830 STEP 150
IF FNrgb(80,cycy%)="7" THEN RECTANGLE SWAP 0,cycy%+70,150,150 TO 0,cycy%-80:*REFRESH
IF FNrgb(230,cycy%)="7" THEN RECTANGLE SWAP 150,cycy%+70,150,150 TO 150,cycy%-80:*REFRESH:WAIT 350
IF FNrgb(380,cycy%)="7" THEN RECTANGLE SWAP 300,cycy%+70,150,150 TO 300,cycy%-80:*REFRESH:WAIT 350
IF FNrgb(530,cycy%)="7" THEN RECTANGLE SWAP 450,cycy%+70,150,150 TO 450,cycy%-80:*REFRESH:WAIT 350
IF FNrgb(680,cycy%)="7" THEN RECTANGLE SWAP 600,cycy%+70,150,150 TO 600,cycy%-80:*REFRESH:WAIT 350
IF FNrgb(830,cycy%)="7" THEN RECTANGLE SWAP 750,cycy%+70,150,150 TO 750,cycy%-80:*REFRESH:WAIT 350
IF FNrgb(980,cycy%)="7" THEN RECTANGLE SWAP 900,cycy%+70,150,150 TO 900,cycy%-80:*REFRESH:WAIT 350
IF FNrgb(1130,cycy%)="7" THEN RECTANGLE SWAP 1050,cycy%+70,150,150 TO 1050,cycy%-80:*REFRESH:WAIT 350
NEXT cycy%
ENDPROC
DEF PROCgameboard(lx%,ly%)
LOCAL rt%,v%,ub%,u%
REPEAT
REPEAT
PROCslate(lx%+rt%,ly%+ub%,150,200,200,200)
rt%+=150
v%=FNcounter(8)
UNTIL v%>0
ub%+=150:u%+=1
rt%=0
UNTIL u%=7
PROCsbox(1220,650,1990,0,"white")
PROCtype(1230,620,"1 Use the buttons to move the GREEN box ","white")
PROCtype(1230,590,"2 GRAB VASE- select a vase","white")
PROCtype(1230,560,"3 The RED box will move to the vase","white")
PROCtype(1230,500,"4 GREEN box-destination","white")
PROCtype(1230,470,"5 MOVE TO button - will swap if allowed","white")
PROCtype(1230,430,"6 To gather, move GREEN box to vase line","white")
PROCtype(1230,400,"7 PRESS GRAB VASE","white")
PROCtype(1230,360,"8 Press GATHER button ","white")
PROCtype(1230,320," W or UP arrow = UP","white")
PROCtype(1230,290," S or DOWN arrow = DOWN","white")
PROCtype(1230,260," A or LEFT arrow = LEFT","white")
PROCtype(1230,230," D or RIGHT arrow =RIGHT","white")
PROCtype(1230,200," SPACE BAR=or Q = GRAB VASE","white")
PROCtype(1230,170," ENTER or E = SWAP ","white")
PROCtype(1230,140," G = GATHER (Type / Click twice)","white")
PROCtype(1230,100," Gather requires 1 box on each end ","white")
PROCtype(1230,40," Vases fall as you navigate the board","white")
ENDPROC
DEF PROCnewmix
LOCAL cycy%,pr%,pg%,pb%,rres%
FOR cycy% = 80 TO 980 STEP 150
PROCshufflecol(pr%,pg%,pb%)
PROCoval(80,cycy%,50,pr%,pg%,pb%)
PROCshufflecol(pr%,pg%,pb%)
PROCoval(230,cycy%,50,pr%,pg%,pb%)
PROCshufflecol(pr%,pg%,pb%)
PROCoval(380,cycy%,50,pr%,pg%,pb%)
PROCshufflecol(pr%,pg%,pb%)
PROCoval(530,cycy%,50,pr%,pg%,pb%)
PROCshufflecol(pr%,pg%,pb%)
PROCoval(680,cycy%,50,pr%,pg%,pb%)
PROCshufflecol(pr%,pg%,pb%)
PROCoval(830,cycy%,50,pr%,pg%,pb%)
PROCshufflecol(pr%,pg%,pb%)
PROCoval(980,cycy%,50,pr%,pg%,pb%)
PROCshufflecol(pr%,pg%,pb%)
PROCoval(1130,cycy%,50,pr%,pg%,pb%)
NEXT cycy%
ENDPROC
DEFPROCshufflecol(RETURN pr%,RETURN pg%,RETURN pb%)
LOCAL rres%
rres%=FNroll(7)
CASE rres% OF
WHEN 0:pr%=150:pg%=150:pb%=250
WHEN 1:pr%=50:pg%=190:pb%=190
WHEN 2:pr%=250:pg%=155:pb%=150
WHEN 3:pr%=150:pg%=250:pb%=150
WHEN 4:pr%=50:pg%=50:pb%=100
WHEN 5:pr%=200:pg%=150:pb%=150
WHEN 6:pr%=150:pg%=255:pb%=255
WHEN 7:pr%=250:pg%=250:pb%=150
ENDCASE
ENDPROC
RETROLIB 11
REM LATEST TEXTURE FILLER JAN 1 2017 (needs more development
REM light%= distance before central light:x,y,h,v--work area:style$-"edge" or "light" or "curve":r%,g%,b% start palette
REM eg : PROCcolor("f","225,255,255"):ELLIPSE FILL 100,70,100,200:PROCtexture(0,0,300,300,"light",20,225,255,255,1.4,1)
DEFPROCtexture(x%,y%,h%,v%,style$,light%,r%,g%,b%,di,stagger%)
LOCAL dx%,dy%,c$,counx%,couny%,pr%,pg%,pb%,rr,gg,bb
pr%=r%:pg%=g%:pb%=b%
counx%=0:couny%=0:rr=r%:gg=g%:bb=b%
dx%= h%-x%
dy%= v%-y%
IF dy%>dx% OR dx%=dy% THEN
REPEAT
c$=FNrgb(x%+counx%,y%+couny%)
IF c$<>"000,000,000" THEN PROCdotrgb(x%+counx%,y%+couny%+dy%+1,r%,g%,b%):IF r%>1 AND g%>1 AND b%>1 THEN rr=rr-di:gg=gg-di:bb=bb-di
counx%+=2:IF counx%>=x%+dx% THEN counx%=0:couny%=couny%+2:r%=pr%:g%=pg%:b%=pb%:rr=r%:gg=g%:bb=b%:pr%=pr%-stagger%:pg%=pg%-stagger%:pb%=pb%-stagger%
REM IF r%>1 AND g%>1 AND b%>1 THEN r%=r%-di%:g%=g%-di%:b%=b%-di%
r%=rr:g%=gg:b%=bb
UNTIL couny%>dy%
ENDIF
ENDPROC
REM my custom counter
DEFFNcounter(n%)
PRIVATE cond%
LOCAL retcond%
cond%=cond%+1
IF cond%=(n%) THEN retcond%=cond%:cond%=0
=retcond%
REM game keys check (experimental)
DEFFNgkey
LOCAL rk$
IF INKEY(-66) THEN rk$="A"
IF INKEY(-82) THEN rk$="S"
IF INKEY(-51) THEN rk$="D"
IF INKEY(-34) THEN rk$="W"
IF INKEY(-74) THEN rk$="ENTER"
IF INKEY(-99) THEN rk$="SPACE"
IF INKEY(-26) THEN rk$="LEFT"
IF INKEY(-122) THEN rk$="RIGHT"
IF INKEY(-58) THEN rk$="UP"
IF INKEY(-42) THEN rk$="DOWN"
IF INKEY(-84) THEN rk$="G"
IF INKEY(-17) THEN rk$="Q"
IF INKEY(-35) THEN rk$="E"
=rk$
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$)
PROCbcolor("0"):PROCcolor("f","150,150,180")
RECTANGLE FILL x%+15,y%+15,125,125
ENDPROC
DEFPROCoval(x%,y%,size%,r%,g%,b%)
LOCAL cun%,r$,g$,b$,cd%,nd%
PROCshade(x%,y%,size%-5)
FOR cun%=130 TO 0 STEP-12
PROCcrgb(r%-cun%,g%-cun%,b%-cun%)
PROCgr("size 3")
CIRCLE x%,y%+cd%,size%-cd%
cd%+=2
NEXT cun%
PROCcrgb(r%-100,g%-100,b%-100)
PROCgr("size 1")
CIRCLE x%,y%+cd%-2,size%-cd%+5
r$=FNnumstr(r%):g$=FNnumstr(g%):b$=FNnumstr(b%)
PROCpaint(x%,y%+cd%,r$+","+g$+","+b$)
nd%=cd%
FOR cun%=50 TO 130 STEP 5
PROCcrgb(r%-cun%,g%-cun%,b%-cun%)
PROCgr("size 3")
CIRCLE x%,y%+cd%-2,size%-nd%
nd%+=2
NEXT cun%
ENDPROC
REM for putting a shadow at base of image ***
DEFPROCshade(xxx%,yyy%,spread%)
LOCAL xr%,xg%,xb%,xcun%,xcd%
xcd%=5
PROCrgbret(xxx%,yyy%,xr%,xg%,xb%)
PROCgr("size 2")
FOR xcun%=70 TO 0 STEP-1
PROCcrgb(xr%-xcun%,xg%-xcun%,xb%-xcun%)
PROCgr("size 3")
CIRCLE xxx%,yyy%-15,spread%-xcd%
xcd%+=1
NEXT xcun%
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 example FNroll(150) gives a random number between 1 and 150 ************* just another tool
DEFFNroll(r)
rt%=RND(r)
=rt%
DEF PROCspeak(phrase$,pitch%,speed%,voice$)
tts% = FN_createobject("Sapi.SpVoice")
IF tts% THEN
LOCAL qual$
qual$ = "<PITCH ABSMIDDLE="""""+STR$pitch%+"""""/><RATE ABSSPEED="""""+STR$speed%+"""""/>"
IF voice$<>"" qual$ += "<VOICE REQUIRED=""""NAME="+voice$+"""""/>"
PROC_callmethod(tts%, "Speak("""+qual$+phrase$+""")")
PROC_releaseobject(tts%)
REM ENDPROC
ENDIF
ENDPROC
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%
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%,r%,g%,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$),r%,g%,b%,VAL(di$))
WHEN"print" : PROCpr(lx%,ly%,FNbuild(cmd$),"15")
WHEN"say" : PROCspeak(FNbuild(cmd$),Pitch%,Speed%,Voice$)
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" : ch$=FNword(cmd$):cv$=FNword(cmd$):x$=FNword(cmd$):y$=FNword(cmd$):size$=FNword(cmd$):size2$=FNword(cmd$):di$=FNword(cmd$)
PROC_ellipsering(VAL(ch$),VAL(cv$),VAL(x$),VAL(y$),VAL(size$),VAL(size2$),r%,g%,b%,VAL(di$))
WHEN"eyes" :
x$=FNword(cmd$):y$=FNword(cmd$):location$=FNword(cmd$):speed$=FNword(cmd$):speed=VAL(speed$)
FOR x=1 TO 40:PROClefteye(VAL(x$),VAL(y$),location$,speed):PROCrighteye(VAL(x$)-100,VAL(y$),location$,speed):NEXT x
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$
REM made to force text regardless of what is there
DEF PROCtype(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
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,BEGIN,SIZE,X,C,A,DI)
PROCcolor("f","000,000,000")
LOCAL R,G,B,P
R=X
G=C
B=A
P=SIZE-BEGIN
P=P/2
P=BEGIN+P
FOR Y=P TO SIZE
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-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
P=SIZE-BEGIN
P=P/2
P=BEGIN+P
FOR Y=BEGIN TO P
COLOUR 1,X,C,A :GCOL 1
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+DI
C=C+DI
A=A+DI
NEXT Y
PROCpaint(H,V,FNnumstr(R)+" "+FNnumstr(G)+" "+FNnumstr(B))
PROCresetrgb
ENDPROC
DEF PROC_block(H,V,SIZE,X,C,A,DI)
LOCAL P,Y
P=SIZE/2
FOR Y=1 TO SIZE
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-DI
C=C-DI
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,RR,GG,BB)
PROC_ellipsering(3,3,H,V,30,40,RR,GG,BB,10)
PROC_sphere(H,V,10,RR,GG,BB,7)
ENDPROC
DEF PROC_ellipsering(CENTERH,CENTERV,H,V,SIZE,THICKNESS,X,C,A,DI)
IF SIZE > THICKNESS THEN SIZE = THICKNESS
OC=THICKNESS/2
OUTCENTERH=CENTERH+OC
OUTCENTERV=CENTERV+OC
R=0
DEPTHCOUNT=SIZE/2
FOR Y=1 TO DEPTHCOUNT
COLOUR 1,X,C,A GCOL 1
ELLIPSE H,V,OUTCENTERH-R,OUTCENTERV-R
ELLIPSE H,V,OUTCENTERH+R,OUTCENTERV+R
R=R+1
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
PROCresetrgb
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,SIZE,R,G,B,DI)
LOCAL r%,g%,b%,di%,x%,size%,skip%
skip%=FALSE
r%=R
g%=G
b%=B
size%=SIZE
di%=DI
FOR x%=0 TO size%
r%=r%-di%
g%=g%-di%
b%=b%-di%
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%
PROCresetrgb
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)
DEF PROCgraphics(x,y)
VDU 23,22,x;y;8,15,16,1
OFF
VDU 5
REM these variables are temporary
N%=0
N%=20
DIM X(20),Y(20),H(20),V(20)
ENDPROC
DEFFNkey
response$=INKEY$(0)
=response$
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
PROCresetrgb
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
REM restore default color palettes
DEFPROCresetrgb
COLOUR 0,0,0,0 :COLOUR 1,200,0,0 :COLOUR 2,000,200,000
COLOUR 3,200,200,000:COLOUR 4,000,000,200:COLOUR 5,200,000,200
COLOUR 6,000,200,200:COLOUR 7,200,200,200:COLOUR 8,056,056,056
COLOUR 9,248,056,056:COLOUR 10,056,248,056:COLOUR 11,248,248,056
COLOUR 12,056,056,248:COLOUR 13,248,056,248:COLOUR 14,056,248,248
COLOUR 15,248,248,248
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)
DEFPROCmask(x%,y%,h%,v%)
LOCAL dx%,dy%,c%,counx%,couny%
counx%=0:couny%=0
dx%= h%-x%
dy%= v%-y%
IF dx%>dy% THEN
REPEAT
c%=TINT(x%+counx%,y%+couny%)
IF c%=0 THEN PROCpixel(x%+counx%,y%+couny%+dy%+1,"light white") ELSE PROCpixel(x%+counx%,y%+couny%+dy%+1,"0")
couny%+=1:IF couny%=y%+dy% THEN couny%=0:counx%=counx%+1
UNTIL counx%=dx%
ENDIF
IF dy%>dx% THEN
REPEAT
c%=TINT(x%+counx%,y%+couny%)
IF c%=0 THEN PROCpixel(x%+counx%,y%+couny%+dy%+1,"255,255,255") ELSE PROCpixel(x%+counx%,y%+couny%+dy%+1,"0")
counx%+=1:IF counx%=x%+dx% THEN counx%=0:couny%=couny%+1
UNTIL couny%=dy%
ENDIF
ENDPROC
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%
cov$=STR$(num)
l%=LEN(cov$)
IF l%=1 THEN ret$="00"+cov$
IF l%=2 THEN ret$="0"+cov$
IF l%=3 THEN ret$=cov$
=ret$
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%=POINT(x%,y%)
=STR$(rgb%)
REM getpic sorta functions like GET from the 80s but in this case it just assigns capture area information
REM each getpic only needs to be called once, but you can reassign
REM num refers to the variable arrays that will carry each image's capture point (it ranges from 0- 20)
REM I guess h,v are the height and width of the image.
DEFPROCgetpic(num%,xx,yy,hh,vv)
N%=num%
X(N%)=xx
Y(N%)=yy
H(N%)=hh
V(N%)=vv
ENDPROC
REM Hmmm
REM now that the image coordinates are stored, we can move it and redefine the borders
DEFPROCpastepic(num%,nx,ny)
LOCAL tx%,ty%,th%,tv%
N%=num%
tx%=X(N%)
ty%=Y(N%)
th%=H(N%)
tv%=V(N%)
RECTANGLE tx%,ty%,th%,tv% TO nx,ny
X(N%)=nx
Y(N%)=ny
ENDPROC
REM seems to work the same?
DEFPROCmovepic(num,nx,ny)
LOCAL tx%,ty%
tx%=X(N%)
ty%=Y(N%)
RECTANGLE SWAP tx%,ty%,H(num),V(num) TO nx,ny
X(N%)=nx
Y(N%)=ny
ENDPROC
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
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$="100,180,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$)
PROCresetrgb
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