ON ERROR END PROCgraphics(400,300) DIM cmd$(50) current$="":ln%=0:pln%=0 butx%=0:buty%=0:buth%=0:butv%=0:sx%=0:sy%=0:sh%=0:sv%=0:cx%=0:cy%=0 PROCcolor("b","000,000,000"):CLG PROCcolor("f","yellow") PROCpr(10,425,"Color Mixer with Hexidecimal for rr gg bb ","white") REPEAT s3$=FNcolormix(100,100) MOUSE mx%,my%,butt% IF mx%>0 AND mx%<501 AND my%>0 AND my%<501 AND butt%=4 THEN butx%=mx%/10:buty%=my%/10 IF mx%>0 AND mx%<501 AND my%>0 AND my%<501 AND butt%=1 THEN buth%=mx%/10:butv%=my%/10 IF butx%<1 THEN butx%=1 IF buty%<1 THEN buty%=1 IF buth%<1 THEN buth%=1 IF butv%<1 THEN butv%=1 WAIT 10 UNTIL FALSE END 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 PROCpr(10,80,"rr "+STR$~(r%)+" gg "+STR$~(g%)+" bb "+STR$~(b%)+"","white") =rgb$ REM GRAPHICS(x,y) DEF PROCgraphics(x,y) VDU 23,22,x;y;8,15,16,1 OFF VDU 5 ENDPROC 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 ******************* 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 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%) b%=INT(rgb%/(256*256)) g%=INT((rgb%-b% *256*256)/256) r%=INT(rgb%-b%*256*256-g%*256) ENDPROC REM experimental DEFFNrgb(x%,y%) LOCAL r$,g$,b$,join$,r,g,b rgb%=TINT(x%,y%) b=INT(rgb%/(256*256)) g=INT((rgb%-b *256*256)/256) r=INT(rgb%-b*256*256-g*256) r$=FNnumstr(r):g$=FNnumstr(g):b$=FNnumstr(b) join$=r$+","+g$+","+b$ =join$ 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 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