Optical illusions

sometimes99er · October 31, 2017

Two rectangular prongs at the top transform into three cylindrical prongs.

100 call clear::call char(48,"01020408102040808040201008040201808080808080808080C0A09088848281")
110 call char(52,"814224181020408003020408F",54,"E01008040402020201020408081010101008080403")
120 for l=5 to 19::read c,s$::display at(l,c):s$; ::next l::for l=0 to 9^9::next l
130 data 17,01,16,0  1,15,0 03 1,14,0 0 21 1,13,0 0 010 02,12,0 0 0 0 0 2,11,0 0 0 0 0 0,10
140 data 0 0 0 0 0 0,9,0 0 0 0 0 0,8,760 0 0 0 0,8,85 0 0 0 0,10,760 0 0,10,85 0 0,12,760,12,85
run

Edited November 22, 2021 by sometimes99er

digdugnate · October 31, 2017

Two rectangular prongs at the top transform into three cylindrical prongs.

100 call clear::call char(48,"01020408102040808040201008040201808080808080808080C0A09088848281")
110 call char(52,"814224181020408003020408F",54,"E01008040402020201020408081010101008080403")
120 for l=5 to 19::read c,s$::display at(l,c):s$; ::next l::for l=0 to 9^9::next l
130 data 17,01,16,0  1,15,0 03 1,14,0 0 21 1,13,0 0 010 02,12,0 0 0 0 0 2,11,0 0 0 0 0 0,10
140 data 0 0 0 0 0 0,9,0 0 0 0 0 0,8,760 0 0 0 0,8,85 0 0 0 0,10,760 0 0,10,85 0 0,12,760,12,85
run

A classic, and very cool I loaded up in js99er to see what it'd look like.

i need to print some of these out to type in on my TI!

+TheBF · November 1, 2017

Two rectangular prongs at the top transform into three cylindrical prongs.

100 call clear::call char(48,"01020408102040808040201008040201808080808080808080C0A09088848281")
110 call char(52,"814224181020408003020408F",54,"E01008040402020201020408081010101008080403")
120 for l=5 to 19::read c,s$::display at(l,c):s$; ::next l::for l=0 to 9^9::next l
130 data 17,01,16,0  1,15,0 03 1,14,0 0 21 1,13,0 0 010 02,12,0 0 0 0 0 2,11,0 0 0 0 0 0,10
140 data 0 0 0 0 0 0,9,0 0 0 0 0 0,8,760 0 0 0 0,8,85 0 0 0 0,10,760 0 0,10,85 0 0,12,760,12,85
run

That is really cool. Now I have to figure out how you did it!

+TheBF · November 1, 2017

Here is how I rendered it in Camel99 Forth

\ classic pipe & bar illusion by sometimes99er on Atariage
GRAPHICS
HEX
CREATE SHAPES
       0102 , 0408 , 1020 , 4080 ,
       8040 , 2010 , 0804 , 0201 ,
       8080 , 8080 , 8080 , 8080 ,
       80C0 , A090 , 8884 , 8281 ,
       8142 , 2418 , 1020 , 4080 ,
       0302 , 0408 , F000 , 0000 ,
       E010 , 0804 , 0402 , 0202 ,
       0102 , 0408 , 0810 , 1010 ,
       1008 , 0804 , 0300 , 0000 ,

\ write character definitions to VDP RAM all at once
: CHARACTERS ( 'pattern ascii# char-cnt   -- ) 8* SWAP ]PDT SWAP VWRITE ;

DECIMAL
SHAPES  CHAR 0   9 CHARACTERS

: RUN  PAGE
       CR ."                01"
       CR ."               0  1"
       CR ."              0 03 1"
       CR ."             0 0 21 1"
       CR ."            0 0 010 02"
       CR ."           0 0 0 0 0 2"
       CR ."          0 0 0 0 0 0"
       CR ."         0 0 0 0 0 0"
       CR ."        0 0 0 0 0 0"
       CR ."       760 0 0 0 0 "
       CR ."       85 0 0 0 0"
       CR ."         760 0 0"
       CR ."         85 0 0"
       CR ."           760"
       CR ."           85"
       BEGIN KEY? UNTIL ;

+Lee Stewart · November 1, 2017

...and here it is in fbForth 2.0 with slightly modified logistics:

\ fbForth 2.0 port of Camel99 Forth version
\ of classic pipe & bar illusion by sometimes99er on Atariage
BASE @  \ current radix to stack
HEX
: SHAPES  ( --- addr cell-cnt )
      DATA[
         0102 0408 1020 4080
         8040 2010 0804 0201
         8080 8080 8080 8080
         80C0 A090 8884 8281
         8142 2418 1020 4080
         0302 0408 F000 0000
         E010 0804 0402 0202
         0102 0408 0810 1010
         1008 0804 0300 0000
      ]DATA  ;
BASE !   \ restore radix

: RUN  ( --- )
      VDPMDE @       \ save current graphics mode to stack
      GRAPHICS
      SHAPES ASCII 0 DCHAR    \ redefine characters '0'..'8'
      PAGE
      CR ."                01"
      CR ."               0  1"
      CR ."              0 03 1"
      CR ."             0 0 21 1"
      CR ."            0 0 010 02"
      CR ."           0 0 0 0 0 2"
      CR ."          0 0 0 0 0 0"
      CR ."         0 0 0 0 0 0"
      CR ."        0 0 0 0 0 0"
      CR ."       760 0 0 0 0 "
      CR ."       85 0 0 0 0"
      CR ."         760 0 0"
      CR ."         85 0 0"
      CR ."           760"
      CR ."           85"
      BEGIN ?KEY UNTIL
      VMODE  ;       \ restore graphics mode

...lee

+TheBF · November 1, 2017

Hey Lee,

When you post Forth code, what language do you select to make the colors look like that?

+Lee Stewart · November 1, 2017

On 11/1/2017 at 5:07 PM, TheBF said:

Hey Lee,

When you post Forth code, what language do you select to make the colors look like that?

That is done by the code (<>) button in the editor.

I often indent a block of text in the “Courier New” font and bold/color it how I like. That procedure is more trouble and has greater line-spacing than the code button. I put long stretches of code formatted that way into spoilers.

...lee

[EDIT: OOPS! I misread your question! I don't choose any language.]

[EDIT(2): The default language is HTML, so, any coloring in my code is likely due to my forgetting to choose “No Syntax Highlighting” and leaving it at “HTML”.]

Edited September 19, 2022 by Lee Stewart
CLARIFICATION

PeteE · December 11, 2017

Curvature Blindness - all the curves are exactly the same shape. Source

100 call clear::call screen(3)::call color(1,1,1,2,1,1,3,1,1,4,1,1,5,1,1,6,1,1,7,1,1,8,1,1)::call magnify(3)
110 c$="00000000C038070000000000031CE000000738C000000000"::d$="000738C00000000000E01C030000000000000000C0380700"
120 call char(32,"00000000000000000103070F1F3F7FFFFFFFFFFFFFFFFFFF",48,c$,56,c$,64,c$,72,d$,80,d$,88,d$)
130 call char(40,"0000000000000000FFFEFCF8F0E0C080")::e$=rpt$(" ",max(0,11))&"!"&rpt$("""",22)&")"&rpt$("(",14)
140 a$=rpt$("2IJ1",7)&rpt$("HI01",7)::b$=rpt$(":QR9",7)&rpt$("PQ89",7)::c$=rpt$("BYZA",7)&rpt$("XY@A",7)
150 for i=0 to 7::read x,y,z::j=1+28*(i and 1)::d$=seg$(a$,j,x)&seg$(b$,x+j,y)&seg$(c$,x+y+j,z)
160 display at(i*3+1,1):d$;::display at(i*3+2,1):d$;::display at(i*3+3,1):seg$(e$,i*3+1,28);::next i
170 for i=0 to 7::read c$::call char(i*4+96,c$)::next i
180 for i=0 to 4::call sprite(#i+1,96+(i and 3)*4,3,i*24+1,113-i*24)
190 call sprite(#i+6,112+(i and 3)*4,3,i*24+73,225-i*24)::next i
200 call color(1,3,16,2,3,2,3,4,16,4,4,3,5,4,2,6,13,16,7,13,3,8,13,2)::call screen(16)::for i=0 to 9^9::next i
210 data 14,14,0, 11,17,0, 8,20,0, 5,21,2, 2,21,5, 0,20,8, 0,17,11, 0,14,14
220 data "00000000000000000100070F1F3F7FFF0103030C1F3F7FFFFF1FE3FCFFFFFFFF"
230 data "00000000000000000103030C1F3F7FFF0103070F1F0778FFFFFFFFFF3FC7F8FF"
240 data "00000000000000000103070F1F0778FF0103070F1C231FFFFFFFFFFFFCE31FFF"
250 data "00000000000000000103070F1C231FFF0100070F1F3F7FFFFFF8C73FFFFFFFFF"
260 data "FFFFFFFF3FC7F8FFFFFEFCF830C0C080FFFEFCF8F0E000800000000000000000"
270 data "FFFFFFFFFCE31FFFFFFEFCF8F0E00080FFF8C438F0E0C0800000000000000000"
280 data "FFF8C73FFFFFFFFFFFF8C438F0E0C080FF1EE0F8F0E0C0800000000000000000"
290 data "FF1FE3FCFFFFFFFFFF1EE0F8F0E0C080FFFEFCF830C0C0800000000000000000"
run

Edited November 21, 2021 by PeteE

+Retrospect · December 11, 2017

Two rectangular prongs at the top transform into three cylindrical prongs.

100 call clear::call char(48,"01020408102040808040201008040201808080808080808080C0A09088848281")
110 call char(52,"814224181020408003020408F",54,"E01008040402020201020408081010101008080403")
120 for l=5 to 19::read c,s$::display at(l,c):s$; ::next l::for l=0 to 9^9::next l
130 data 17,01,16,0  1,15,0 03 1,14,0 0 21 1,13,0 0 010 02,12,0 0 0 0 0 2,11,0 0 0 0 0 0,10
140 data 0 0 0 0 0 0,9,0 0 0 0 0 0,8,760 0 0 0 0,8,85 0 0 0 0,10,760 0 0,10,85 0 0,12,760,12,85
run

MY EYES!!!!

sometimes99er · December 20, 2017

The boxes seem to tilt.

100 call clear::call screen(6)::call char(33,"30C0030C30C0030C0C03C0300C03C03")
110 call box(4,9,29,11,33)::call box(10,13,23,18,34)::for i=0 to 9^9::next i
120 sub box(x1,y1,x2,y2,c)::for y=y1 to y2::call hchar(y,x1,c,x2-x1+1)::next y::subend
run

Edited November 22, 2021 by sometimes99er

+TheBF · March 3, 2018

The boxes seem to tilt.

100 call clear::call screen(6)::call char(33,"30C0030C30C0030C0C03C0300C03C03")
110 call box(4,9,29,11,33)::call box(10,13,23,18,34)::for i=0 to 9^9::next i
120 sub box(x1,y1,x2,y2,c)::for y=y1 to y2::call hchar(y,x1,c,x2-x1+1)::next y::subend
run

This is an amazing illusion. I can't believe my eyes lie to me like that.

I did this one in Forth because it was easier for me but I am sure you could crank this off in BASIC pretty easily.

It's called the Ternus Illusion. I found it on Wikipedia.

HEX
CREATE SPOTDATA
       071F , 3F7F , 7FFF , FFFF , \ upper left
       E0F8 , FCFE , FEFF , FFFF , \ upper right
       FFFF , FF7F , 7F3F , 1F07 , \ lower left
       FFFF , FFFE , FEFC , F8E0 , \ lower right

DECIMAL
: AS_SPOT ( char -- ) SPOTDATA  SWAP ]PDT  32 VWRITE ;

: DRAW_SPOT ( 1stchar col row -- )
              AT-XY                   \ Position cursor
              DUP EMIT  1+ DUP EMIT   \ draw top 2 chars
              1 VROW +!  -2 VCOL +!   \ goto next row, back 2 cols.
              1+ DUP EMIT 1+ EMIT ;   \ draw bottom 2 chars

: FRAME1    16 1 1 COLOR   17 18 2 1 COLORS  ;
: FRAME2    16 18 1 1 COLORS  ;      \ blank frame
: FRAME3    16 17 2 1 COLORS   18 1 1 COLOR  ;

: TERNUS
     GRAPHICS  
     PAGE
     16 SCREEN
     8 0 AT-XY ." Ternus Illusion"

     128 AS_SPOT   16 2 1 COLOR
     136 AS_SPOT   17 2 1 COLOR
     144 AS_SPOT   18 1 1 COLOR

     128  5 10 DRAW_SPOT
     136 15 10 DRAW_SPOT
     144 25 10 DRAW_SPOT

    BEGIN
        BEEP
        0  23 BL 32 HCHAR
        1 23 AT-XY ." Element Motion (press key)"
        BEGIN
           FRAME1 500 MS
           FRAME2  15 MS
           FRAME3 500 MS
           FRAME2  15 MS
           KEY?
        UNTIL
        
        BEEP
        0  23 BL 32 HCHAR
        10 23 AT-XY ." GROUP Motion"
        BEGIN
           FRAME1 500 MS
           FRAME2 250 MS
           FRAME3 500 MS
           FRAME2 250 MS
           KEY?
        UNTIL
        ?BREAK
     AGAIN ;

TERNUS.mp4

+Lee Stewart · March 3, 2018

This is an amazing illusion. I can't believe my eyes lie to me like that.

I did this one in Forth because it was easier for me but I am sure you could crank this off in BASIC pretty easily.

It's called the Ternus Illusion. I found it on Wikipedia.

<snip>

This code does not work correctly in Camel99 Forth v1.98 (latest?). I traced it to the definition of COLORS , which should have the address difference incremented by 1 to give VFILL the proper copy count.

( *NEW*  change contiguous character sets at once)
: COLORS  ( set1 set2 fg bg  -- )
          1 ?MODE
          >COLR >R
          SWAP ]CTAB SWAP ]CTAB OVER - 
          R> VFILL ;

should be

( *NEW*  change contiguous character sets at once)
: COLORS  ( set1 set2 fg bg  -- )
          1 ?MODE
          >COLR >R
          SWAP ]CTAB SWAP ]CTAB OVER - 
          1+      \ increment color-table-address difference to get proper count for VFILL
          R> VFILL ;

...lee

+TheBF · March 3, 2018

This code does not work correctly in Camel99 Forth v1.98 (latest?). I traced it to the definition of COLORS , which should have the address difference incremented by 1 to give VFILL the proper copy count.
( *NEW*  change contiguous character sets at once)
: COLORS  ( set1 set2 fg bg  -- )
          1 ?MODE
          >COLR >R
          SWAP ]CTAB SWAP ]CTAB OVER - 
          R> VFILL ;
should be
( *NEW*  change contiguous character sets at once)
: COLORS  ( set1 set2 fg bg  -- )
          1 ?MODE
          >COLR >R
          SWAP ]CTAB SWAP ]CTAB OVER - 
          1+      \ increment color-table-address difference to get proper count for VFILL
          R> VFILL ;
...lee

You caught me Lee. In doing all this playing around I am finding bugs and or ways the words work that I like or dis-like.

I changed the COLORS word to increment the second colour set so you can state a range (from...too) of colour sets.

I am working on V1.99 as we speak so I will put it up there by end of day. So your change is correct.

Amazing. You must be the only user. :-)

B

+TheBF · March 4, 2018

I put Version 1.99 up for you Lee.

Can't promise that it is bug-for-bug compatible, but I found a lot of little things that saved space.

Now I realize that the CAMEL Forth header takes 1 extra byte versus Fig-Forth so that is eating 300+ bytes alone.

More work on the cross-compiler will get me V2.0 with smaller headers and hopefully multiple binary file output for >8K programs.

See CAMEL Forth thread for a log of changes.

+Lee Stewart · March 4, 2018

...

Amazing. You must be the only user. :-)

B

Actually, I did not realize anything was wrong until I played your MP4 video. When I downloaded and ran the code, I had a “meh” moment because nothing looked different. That is when I played the video for comparison, showing the third spot, which was missing from the running code.

...lee

PeteE · November 20, 2021

It's been a while since I've done one of these

100 call clear::call screen(15)::call color(5,2,15,6,16,15,7,2,4,8,16,4)
110 a$="07030101010101010101010101010307E0C0808080808080808080808080C0E0"
120 b$="FF80000000000000FF0100000000000000000000000080C00000000000000103"
130 call char(64,a$,72,a$,80,b$,88,b$)::for i=0 to 20 step 4
140 display at(i+1,1):seg$(rpt$("HXYB@XYJ",4),1,28);
150 display at(i+2,1):seg$(rpt$("IRSCARSK",4),1,28);
160 display at(i+3,1):seg$(rpt$("@PQJHPQB",4),1,28);
170 display at(i+4,1):seg$(rpt$("AZ[KIZ[C",4),1,28);
180 next i::for i=0 to 9^9::next i
run

Edited November 26, 2021 by PeteE
changed to use display at

PeteE · November 21, 2021

Peripheral Drift

This one requires bitmap mode, so you'll need to use TI-BASIC with MiniMem cartridge, or RXB (or any with PEEKV and POKEV really)

100 rem set reg 0 bitmap mode >02
101 call peekv(-32766,a)

110 rem set reg 3 color  table >9f  hybrid
111 call peekv(-31841,a)
120 rem set reg 4 pattern table >00  hybrid
121 call peekv(-31744,a)
130 rem background color tan
131 call peekv(-30966,a)

150 rem load character patterns and colors
151 for i=112 to 135
152 read a$
153 call char(i,a$)
154 next i

160 rem copy data from pattern table >6C0..>738 to color table >2680..>26f8
161 for i=1728 to 1848 step 8
162 call peekv(i,a,b,c,d,e,f,g,h)
163 call pokev(i+8128,a,b,c,d,e,f,g,h)
164 next i

170 rem copy 2nd half of duplicate patterns 
171 restore 210
172 for i=120 to 127
173 read a$
174 call char(i,a$)
175 next i

180 rem screen image table is >0000
181 restore 240
182 read a,b,c,d,e,f,g,h
183 k=32
184 for i=0 to 23*32 step 96
185 call pokev(i,a,a+1,k,b,b+1,k,c,c+1,k,d,d+1,k,e,e+1,k,f,f+1,k,g,g+1,k,h,h+1,k,a,a+1,k,b,b+1,k,c,c+1)
186 call pokev(i+32,a+4,a+5,k,b+4,b+5,k,c+4,c+5,k,d+4,d+5,k,e+4,e+5,k,f+4,f+5,k,g+4,g+5,k,h+4,h+5,k,a+4,a+5,k)
187 call pokev(i+59,b+4,b+5,k,c+4,c+5,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k,k)
188 j=h
189 h=g
190 g=f
191 f=e
192 e=d
193 d=c
194 c=b
195 b=a
196 a=j
197 next i

200 goto 200

210 rem char patterns
211 data "FFFFC0C0C0C0C0C0","FEFC030303030303","7F3FC0C0C0C0C0C0","FFFF030303030303"
212 data "C0C0C0C0C0C08000","030303030303FFFF","C0C0C0C0C0C0FFFF","0303030303030100"

220 rem char colors
221 data "F0F0F4F4F4F4F4F4","F1F1141414141414","F1F1141414141414","F0F0F4F4F4F4F4F4"
222 data "F4F4F4F4F4F4F111","1414141414141010","1414141414141010","F4F4F4F4F4F4F1F1"
223 data "1010141414141414","1F1FF4F4F4F4F4F4","1F1FF4F4F4F4F4F4","1010141414141414"
224 data "1414141414141FFF","F4F4F4F4F4F4F0F0","F4F4F4F4F4F4F0F0","1414141414141F1F"

240 rem screen image patterns
241 data 208,210,210,216,216,218,218,208

After breaking out the program, the bitmap mode will garble the screen, so blindly paste this to restore graphics mode

call peekv(-32768,a)

Edited November 21, 2021 by PeteE

HOME AUTOMATION · November 21, 2021

Wow!

The whole room feels very unstable...

My eyelids are getting very heavy...

Uhoh, I must leave you now...???

P.S. Unreal!!!

PeteE · November 21, 2021

Primrose's Field

100 call clear::call screen(15)::call color(5,14,13,6,16,4,7,14,4,8,16,13)
110 a$="0000000103030D1F00000080C0C0B0F81F0D030301000000F8B0C0C080000000"
120 b$="0000000000000000"::call char(64,b$,65,a$,72,b$,73,a$,81,a$,89,a$)
130 a$=rpt$("IZARIZARQBYJQBYJ",3)::b$=rpt$("[LSD[LSDCTK\CTK\",3)
140 display at(1,1):rpt$("HH@@",7)::for i=0 to 20 step 4
150 display at(i+2,1):"H";seg$(a$,21-i,26);"@";"@";seg$(b$,21-i,26);"H"
160 if i<20 then display at(i+4,1):"@";seg$(a$,19-i,26);"H";"H";seg$(b$,19-i,26);"@"
170 next i::display at(24,1):rpt$("@@HH",7);::for i=0 to 9^9::next i
run

Edited November 26, 2021 by PeteE
changed to use display at

1980gamer · November 22, 2021

On 10/26/2017 at 2:55 PM, RickyDean said:

Yes, but I can see them in a line too..

3 or 4 horizontally. 3 easy, 4th pops in and out. Not vertical.. strange.

+OLD CS1 · November 22, 2021

6 hours ago, PeteE said:

Primrose's Field

I have been walked down such a path, before.

sometimes99er · November 23, 2021

On 11/21/2021 at 10:14 PM, PeteE said:

Primrose's Field


100 call clear::call screen(15)::call color(5,14,13,6,16,4,7,14,4,8,16,13)
110 a$="0000000103030D1F00000080C0C0B0F81F0D030301000000F8B0C0C080000000"
120 b$="0000000000000000"::call char(64,b$,65,a$,72,b$,73,a$,80,b$,81,a$,88,b$,89,a$)
130 a$=rpt$("IZARIZARQBYJQBYJ",3)::b$=rpt$("[LSD[LSDCTK\CTK\",3)
140 print rpt$("HH@@",7)::for i=0 to 5
150 print "H";seg$(a$,21-i*4,26);"@";"@";seg$(b$,21-i*4,26);"H"
160 if i<5 then print "@";seg$(a$,19-i*4,26);"H";"H";seg$(b$,19-i*4,26);"@"
170 next i::print rpt$("@@HH",7);::for i=0 to 9^9::next i
run

Crazy and well done.

And PRINT may take up less space than a DISPLAY AT solution. The latter may execute slightly faster (not having to scroll).

Edited November 23, 2021 by sometimes99er

PeteE · November 23, 2021

11 hours ago, sometimes99er said:

Crazy and well done.

And PRINT may take up less space than a DISPLAY AT solution. The latter may execute slightly faster (not having to scroll).

Thanks. I had backlog of Magellan files I wanted to implement in XB. I will modify them to use "DISPLAY AT".

P.S. I'm happy to see you've edited your previous posts that were damaged by "8)" and ":d" getting removed. I've also attempted to fix mine.

+TheBF · September 15, 2022

I saw this today on Twitter and it shocked the hell out of me so I had to make one.

It would be simple in XB.

The zip file has a program that loads with editor assembler on Classic99. (might not work on real iron)

Edit: Replaced zip file with code that runs on real hardware.

GREENBALL.ZIP

+TheBF · September 16, 2022

I replaced the zip file of the GREENBALL illusion with a version that I ran on real hardware.

I was busy making bugs again and screwed up my E/A5 save utility.

Sign In

Optical illusions

Recommended Posts

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Join the conversation

Recently Browsing 0 members