BBC BASIC for Windows
« Challenge: guess what this program is doing »

Welcome Guest. Please Login or Register.
Apr 5th, 2018, 10:18pm



ATTENTION MEMBERS: Conforums will be closing it doors and discontinuing its service on April 15, 2018.
Ad-Free has been deactivated. Outstanding Ad-Free credits will be reimbursed to respective payment methods.

If you require a dump of the post on your message board, please come to the support board and request it.


Thank you Conforums members.

BBC BASIC for Windows Resources
Online BBC BASIC for Windows documentation
BBC BASIC for Windows Beginners' Tutorial
BBC BASIC Home Page
BBC BASIC on Rosetta Code
BBC BASIC discussion group
BBC BASIC for Windows Programmers' Reference

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Challenge: guess what this program is doing  (Read 390 times)
michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
wink 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 » User IP Logged

I like making program generators and like reinventing the wheel
DDRM
Administrator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 321
wink 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
User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
wink 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.
User IP Logged

I like making program generators and like reinventing the wheel
DDRM
Administrator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 321
wink 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
User IP Logged

DDRM
Administrator
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 321
wink 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$
 
User IP Logged

michael
Senior Member
ImageImageImageImage


member is offline

Avatar




PM


Posts: 335
wink 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?
User IP Logged

I like making program generators and like reinventing the wheel
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

| |

This forum powered for FREE by Conforums ©
Terms of Service | Privacy Policy | Conforums Support | Parental Controls