BBC BASIC for Windows
Programming >> Graphics and Games >> Challenge: guess what this program is doing
http://bb4w.conforums.com/index.cgi?board=graphics&action=display&num=1480489180
Challenge: guess what this program is doing
Post by michael 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
Re: Challenge: guess what this program is doing
Post by DDRM 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
Re: Challenge: guess what this program is doing
Post by michael 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.
Re: Challenge: guess what this program is doing
Post by DDRM 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
Re: Challenge: guess what this program is doing
Post by DDRM 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$
Re: Challenge: guess what this program is doing
Post by michael 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?