PROCgraphics(1000,600) PROC_chrgb("Hello World") PROC_rdrgb(0) END 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 DEF PROC_rdrgb(l%) LOCAL xr%,yr% LOCAL rr%,gr%,br%,pass%,s$,cou% yr%=l%:xr%=0 FOR cou%=0 TO 11 PROCrgbret(xr%,yr%,rr%,gr%,br%) s$=s$+CHR$(rr%) s$=s$+CHR$(gr%) s$=s$+CHR$(br%) xr%=xr%+2 NEXT PROCcolor("f","000,000,000") PROCpr(10,100," "+s$+" ","100,255,255") ENDPROC DEF PROC_chrgb(t$) LOCAL pos%,x%,y%,i,R$,G$,B$,r%,g%,b%,dr,dg,db,wd1$,wd2$,wd3$ x%=1 y%=1 pos%=1 IF LEN(t$)<>0 THEN REPEAT R$=MID$(t$,pos%,1):REM r%=ASC(R$) pos%+=1 REM IF pos%>LEN(t$) THEN g%=32 ELSE G$=MID$(t$,pos%,1):REM g%=ASC(G$) pos%+=1 REM IF pos%>LEN(t$) THEN b%=32 ELSE B$=MID$(t$,pos%,1):REM b%=ASC(B$) pos%+=1 PROCdotrgb(x%,y%,ASC(R$),ASC(G$),ASC(B$)) x%=x%+2 IF x%>100 THEN x%=0:y%+=1 UNTIL pos%>LEN(t$) ENDIF ENDPROC DEFPROCdotsize(n) VDU 23,23,n| ENDPROC 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 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 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
text$="It is a truth universally acknowledged, that a single man in possession of a good fortune, must be in want of a wife. " text$+="However little known the feelings or views of such a man may be on his first entering a neighbourhood, " text$+="this truth is so well fixed in the minds of the surrounding families, that he is considered the rightful property " text$+="of some one or other of their daughters." MODE 20 PRINT LEN(text$) leftover$=FNEncode(100,100,20,20,text$) IF leftover$<>"" THEN PRINT"It didn't all fit! You'll need another call!" PRINT PRINT FNDecode(100,100,20,20) END : DEFFNEncode(x%,y%,w%,h%,t$) LOCAL a%,tx%,ty%,r%,g%,b% GCOL 0 FOR a%=1 TO LEN(t$) STEP 3 r%=ASC(MID$(t$,a%,1)) g%=ASC(MID$(t$,a%+1,1)) IF g%<0 THEN g%=0 b%=ASC(MID$(t$,a%+2,1)) IF b%<0 THEN b%=0 COLOUR 0,r%,g%,b% tx%=a% MOD w% ty%=a% DIV w% IF ty%=h% THEN COLOUR 0,0,0,0:=MID$(t$,a%) LINE (x%+tx%)*2,(y%+ty%)*2,(x%+tx%)*2,(y%+ty%)*2 NEXT a% COLOUR 0,0,0,0 ="" : DEFFNDecode(x%,y%,w%,h%) LOCAL a%,tx%,ty%,c%,t$ t$="" FOR a%=0 TO w%*h%-1 tx%=a% MOD w% ty%=a% DIV w% c%=TINT((x%+tx%)*2,(y%+ty%)*2) t$+=CHR$(c% AND 255)+CHR$((c%>>8) AND 255) +CHR$((c%>>16) AND 255) NEXT a% =t$