Author |
Topic: Challenge: guess what this program is doing (Read 390 times) |
|
michael
Senior Member
member is offline
Posts: 335
|
 |
Challenge: guess what this program is doing
« Thread started on: Nov 30th, 2016, 05:59am » |
|
Challenge:
Outputs hello world... but can you guess what the function of this program is?
I had to experiment to see if this was practical. (it is)
Code:
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
|
| « Last Edit: Nov 30th, 2016, 06:00am by michael » |
 Logged
|
I like making program generators and like reinventing the wheel
|
|
|
DDRM
Administrator
member is offline
Gender: 
Posts: 321
|
|
Re: Challenge: guess what this program is doing
« Reply #1 on: Nov 30th, 2016, 1:22pm » |
|
PROC_chrgb(t$) encodes the text of t$, 3 characters at a time, as a series of coloured dots near the origin of the graphics coordinates.
PROC_rdrgb(l%) reads some back from a specified place, partly guided by the parameter l%, the characters associated with 12 dots, and then prints them using PROCpr.
Interestingly, you write the dots starting at (1,1) and read them starting at (0,0). Fortunately for you, that works, given the nature of BB4W graphics coordinates!
I know you hinted (can't remember if it was here or on the other forum) that you were looking at this kind of "memory storage" - but I'm not quite sure why you think it's a useful thing to do? Why not just store the data in conventional memory, where it's easy to read and write?
I guess you could adapt it to act as a form of steganography...
D
|
|
Logged
|
|
|
|
michael
Senior Member
member is offline
Posts: 335
|
|
Re: Challenge: guess what this program is doing
« Reply #2 on: Nov 30th, 2016, 2:03pm » |
|
* I plan to make it work like the old micro film devices long ago. *
You would take your mouse and hold the left button down in the area where the content is. It would update accordingly.
But it is more than even that. With no array usage and no traditional file storage. This can be used for encryption, and hidden messages, or perhaps even for an elaborate footprint.
Say you made something and wanted to put your name on it, but didnt want anyone to see that you did it.
Also this can be used for a type of IDE. You would have endless commands you could give with the remaining colors in one palette.
|
|
Logged
|
I like making program generators and like reinventing the wheel
|
|
|
DDRM
Administrator
member is offline
Gender:
Posts: 321
|
|
Re: Challenge: guess what this program is doing
« Reply #3 on: Dec 1st, 2016, 07:52am » |
|
The "microfilm" idea is interesting. Consider storing the data in squarish blocks, perhaps surrounded by black borders to allow your reader to identify the bit being pointed to?
With regard to encryption, that's what I meant be steganography. However, your approach (to date) will result in a "nonsense" image - which might tip the unwanted observer to guess it is coded. In steganography you typically only encode the hidden data in the bottom 1 or 2 bits of the colour information, so the image may be virtually unchanged to visual inspection. Obviously you need a lot more points to store your data, but a 1024 x 1024 image has over a million points, so that won't be a problem for anything up to the size of a small book...
D
|
|
Logged
|
|
|
|
DDRM
Administrator
member is offline
Gender:
Posts: 321
|
|
Re: Challenge: guess what this program is doing
« Reply #4 on: Dec 1st, 2016, 12:03pm » |
|
Here's a variant, which writes the text into a block of dots. I was thinking you could have a standard-sized block (maybe 16 x 16 pixels, rather than 20 x 20, since that will fit standard screen modes better) - then it would be relatively easy to work out which block the mouse was hovering over, so you could get the associated text. That's probably more satisfactory than having to put black borders round them.
Note that the code takes coordinates in *pixels* not graphics units.
Best wishes,
D
Code: 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$
|
|
Logged
|
|
|
|
michael
Senior Member
member is offline
Posts: 335
|
|
Re: Challenge: guess what this program is doing
« Reply #5 on: Dec 1st, 2016, 1:51pm » |
|
I would create a long strip and load bmp images and replace the existing pages with new depending on your position in the document.
But in order to have control of keyword colors, I would need to use the graphics screen.
This tactic could also be used for game design. Mario anyone?
|
|
Logged
|
I like making program generators and like reinventing the wheel
|
|
|
|
