Fish tiles

[tsh73]

My student did that today during exam session.
In C# with filled polygons.
Much faster then I did here ;)
(really good student)
(I would say that this proves polygons are extremely useful)
(I almost made my own "filled polygon" graphic primitive, based on this thread
justbasiccom.proboards.com/thread/469/filled-polygons?page=1
But end up using filled rotated rectangle by B+
)
And C# has no double lines problem - points are floats.


'fish!
'by tsh73 Jun 2021
'likely from  book
'"Penrose Tiles to Trapdoor Ciphers"
'by Martin Gardner

'problems: some double lines due to roundoff
nomainwin

sq2=sqr(2)
s=24

desiredWidth = 5*2*s*sq2+s/sq2
desiredHeight = s*sq2+5*1.5*s*sq2+s*sq2

gosub [ajustWindow]
'now, center window
   UpperLeftX = (DisplayWidth - WindowWidth)/2
   UpperLeftY = (DisplayHeight - WindowHeight)/2

   'now, open your window with desired size
open "Fish!" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
#gr "down; home; posxy cx cy"

y=s*sq2
right=0
while y <2*cy
   for x=0 to 2*cx-2*s*sq2 step 2*s*sq2
       call fish x, y, s, 0
   next

   xx=x+s/sq2
   y=y+1.5*s*sq2
   for x=xx to 0 step -2*s*sq2
       call fish x, y, s, 1
   next

   y=y+1.5*s*sq2
wend


wait

[quit]
close #gr
end

sub fish x, y, s, right     'right is 1 or 0
   if right = 0 then    'fill the fish
       #gr "color lightgray"    'filled rectangle
       #gr "backcolor white"    'eye
       sq2=sqr(2)
       call drawfilledrectangle -45, x, y, 2*s, 2*s
       call drawfilledrectangle 45, x+2*s*sq2, y, s, s
       call drawfilledrectangle -135, x+2*s*sq2, y, s, s
       #gr "color black"        'border
   else
       #gr "backcolor lightgray"    'eye
   end if
   #gr "place ";x;" ";y
   #gr "north;turn ";45+right*180
   #gr "go ";2*s
   #gr "turn 90;go ";s
   #gr "turn -90;go ";s
   #gr "turn 90;go ";s
   #gr "turn 90;go ";s
   #gr "turn -90;go ";s
   #gr "turn 90;go ";s
   #gr "turn 90;go ";s
   #gr "turn -90;go ";s
   #gr "turn 90;go ";2*s
   #gr "place ";x+s*(1-2*right);" ";y-s/2
   #gr "circlefilled ";s/4
end sub

'-----by B+
sub drawfilledrectangle a, x, y, w, h 'tsh fixed
   #gr "size 2;north;turn 180;turn ";a
   for i = 1 to h  'draw *part of* bigger and bigger rectangles
       #gr "place ";x;" ";y;";go ";i;";turn -90;go ";w;";turn 90"
   next
   #gr "size 1"
end sub

'-------------------------------------------------
[ajustWindow]
   UpperLeftX = 20
   UpperLeftY = 20
   WindowWidth = 200   '100 seems to be too much - works different
   WindowHeight = 100
   open "Ajusting..." for graphics_nsb_nf as #gr
'   graphics
'   graphics_nsb
'   graphics_nsb_nf

   #gr, "home ; down ; posxy x y"
   'x, y give us width, height
   width = 2*x : height = 2*y
   close #gr

   slackX = 200-width
   slackY = 100-height

   WindowWidth = desiredWidth + slackX
   WindowHeight = desiredHeight + slackY

return



[B+]

Oh man this wasn't easy!

'Fish tiles.txt for JB v 2.0 by B+ 2021-01-19
'
global  H$, XMAX, YMAX, SU
H$ = "gr"
XMAX = 600  '< actual drawing space needed
YMAX = 600  '< actual drawing space needed
SU = 20

nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = 300
UpperLeftY = 40

open "Fish Tile" for graphics_nsb_nf as #gr
#gr "trapclose quit"
#gr "down"

silver$ = "190 190 190"
blue$ = "190 190 255"
pink$ = "255 190 190"
gray$ = "120 120 120"

[incj]
for i = -0 to XMAX step 4 * SU  ' over kill!
call drawFishUp i + j, i, "yellow"
call drawFishUp i + 2 * SU + j, i + 2 * SU, "blue"
call drawFishDown i + 3 * SU + j, i, "red"
call drawFishDown i + SU + j, i - 2 * SU, "darkgreen"
next
j = j + 6 * SU
if j < XMAX then goto [incj]

j = 0
[decj]
j = j + (-6 * SU)
for i = 0 to XMAX step 4 * SU   ' over kill!
call drawFishUp i + j, i, silver$
call drawFishUp i + 2 * SU + j, i + 2 * SU, pink$
call drawFishDown i + 3 * SU + j, i, blue$
call drawFishDown i + SU + j, i - 2 * SU, gray$
next
if j > -1 * XMAX then goto [decj]

'fill holes
for x = 5 * SU to XMAX step 6 * SU
   #gr "color ";"blue"
   #gr "backcolor ";"blue"
   #gr "place ";x;" ";0
   #gr "boxfilled ";x + SU;" ";SU
next
wait


sub drawFishUp x, y, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   #gr "place ";x;" ";y
   #gr "boxfilled ";x + 2 * SU;" ";y + 2 * SU
   #gr "place ";x + 2 * SU;" ";y + SU
   #gr "boxfilled ";x + 3 * SU;" ";y + 2 * SU
   #gr "place ";x + SU;" ";y + 2 * SU
   #gr "boxfilled ";x + 2 * SU;" ";y + 3 * SU
   #gr "color black"
   #gr "backcolor black"
   #gr "place ";x + 2/3 * SU;" ";y + 2/3 * SU;"; circlefilled ";1/4 * SU
   #gr "color yellow"
   #gr "place ";x + 2/3 * SU;" ";y + 2/3 * SU;"; circlefilled ";1/6 * SU
end sub

sub drawFishDown x, y, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   #gr "place ";x + SU;" ";y + SU
   #gr "boxfilled ";x + 3 * SU;" ";y + 3 * SU
   #gr "place ";x;" ";y + SU
   #gr "boxfilled ";x + SU;" ";y + 2 * SU
   #gr "place ";x + SU;" ";y
   #gr "boxfilled ";x + 2 * SU;" ";y + SU
   #gr "color black"
   #gr "backcolor black"
   #gr "place ";x + (2 + 1/3) * SU;" ";y + (2 + 1/3) * SU;"; circlefilled ";1/4 * SU
   #gr "color yellow"
   #gr "place ";x + (2 + 1/3) * SU;" ";y + (2 + 1/3) * SU;"; circlefilled ";1/6 * SU
end sub

sub quit Hdl$
   close #Hdl$
   end
end SUb





[B+]

Sometimes the fish swim up stream (looking from a distance), sometimes they swim down (backwards), sometimes they just blink

'Fish tiles.txt for JB v 2.0 by B+ 2021-01-19
'
global  H$, XMAX, YMAX, SU
H$ = "gr"
XMAX = 600  '< actual drawing space needed
YMAX = 600  '< actual drawing space needed
SU = 20

nomainwin
WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = 300
UpperLeftY = 40

open "Fish Tile" for graphics_nsb_nf as #gr
#gr "trapclose quit"
#gr "down"

silver$ = "190 190 190"
blue$ = "190 190 255"
pink$ = "255 64 64"
gray$ = "120 120 120"
green$ = "0 128 255"
[incj]
for i = -0 to XMAX step 4 * SU  ' over kill!
call drawFishUp i + j, i, "blue"
call drawFishUp i + 2 * SU + j, i + 2 * SU, green$
call drawFishDown i + 3 * SU + j, i, "red"
call drawFishDown i + SU + j, i - 2 * SU, pink$
next
j = j + 6 * SU
if j < XMAX then goto [incj]

j = 0
[decj]
j = j + (-6 * SU)
for i = 0 to XMAX step 4 * SU   ' over kill!
call drawFishUp i + j, i, "blue"
call drawFishUp i + 2 * SU + j, i + 2 * SU, green$
call drawFishDown i + 3 * SU + j, i, "red"
call drawFishDown i + SU + j, i - 2 * SU, pink$
next
if j > -1 * XMAX then goto [decj]

'fill holes
for x = 5 * SU to XMAX step 6 * SU
   #gr "color ";"white"
   #gr "backcolor ";"white"
   #gr "place ";x;" ";0
   #gr "boxfilled ";x + SU;" ";SU
next

#gr "getbmp b1 ";2 * SU;" ";2 * SU;" ";XMAX;" ";YMAX
#gr "getbmp b2 0 0 ";XMAX;" ";YMAX
#gr "color black"
#gr "backcolor black"
while 1
scan
toggle = (toggle + 1) mod 2
if toggle then #gr "background b1" else #gr "background b2"
#gr "drawsprites"
for i = 0 to 2 * SU
   #gr "place ";i;" ";i
   #gr "box ";XMAX -  i;" ";YMAX -  i
next
call pause 200
wend

wait

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

sub drawFishUp x, y, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   #gr "place ";x;" ";y
   #gr "boxfilled ";x + 2 * SU;" ";y + 2 * SU
   #gr "place ";x + 2 * SU;" ";y + SU
   #gr "boxfilled ";x + 3 * SU;" ";y + 2 * SU
   #gr "place ";x + SU;" ";y + 2 * SU
   #gr "boxfilled ";x + 2 * SU;" ";y + 3 * SU
   #gr "color black"
   #gr "backcolor black"
   #gr "place ";x + 2/3 * SU;" ";y + 2/3 * SU;"; circlefilled ";1/4 * SU
   #gr "color yellow"
   #gr "place ";x + 2/3 * SU;" ";y + 2/3 * SU;"; circlefilled ";1/6 * SU
end sub

sub drawFishDown x, y, c$
   #gr "color ";c$
   #gr "backcolor ";c$
   #gr "place ";x + SU;" ";y + SU
   #gr "boxfilled ";x + 3 * SU;" ";y + 3 * SU
   #gr "place ";x;" ";y + SU
   #gr "boxfilled ";x + SU;" ";y + 2 * SU
   #gr "place ";x + SU;" ";y
   #gr "boxfilled ";x + 2 * SU;" ";y + SU
   #gr "color black"
   #gr "backcolor black"
   #gr "place ";x + (2 + 1/3) * SU;" ";y + (2 + 1/3) * SU;"; circlefilled ";1/4 * SU
   #gr "color yellow"
   #gr "place ";x + (2 + 1/3) * SU;" ";y + (2 + 1/3) * SU;"; circlefilled ";1/6 * SU
end sub

sub quit Hdl$
   close #Hdl$
   end
end SUb






[tsh73]

Just to say
It reminded me of that weird episode in I think TombRider 1.
You walk around ancient ruins - and you notice bas-relief of cats walking along whole hall.
Ok
But after you do some puzzle these stone cats starts to actually RUN !
;)

But I say to make fish swim one needs minimum 3 frames, not two.

Anyway
I spent some time trying to make simple program along same fish
- having only one loop (actually 2, cols and rows) and drawing only one fish in a middle of a loop.
So here what I got.

(just for kicks I made it redraw on resize. But it works really slow on my machine).

'fish pattern
'recreated in C+winBGIm, translated back to JB
nomainwin
global s, color$
s=20
for i = 0 to 3
   c$(i)=word$("cyan white lightgray darkgray",i+1)
next
col0=2

open "Fishies!" for graphics_nsb as #gr
#gr "trapclose [quit]"

[again]    'in case of resize, it redraws
#gr "down; cls; fill black; flush; home; posxy cx cy"

row=0
for y=-2 to 2*cy/s+2 step 2
   col0=2-col0
   if row mod 3 = 0 then col0=0
   i=0
   for x=(2*row) mod 6 -6 to 2*cx/s+1 step 3
       color$=c$((col0+i) mod 4)
       call fish x,y,i mod 2
       i=i+1
   next
   row=row+1
next

#gr "flush"

timer 100, [refresh]
wait

[refresh]
   #gr "home; posxy cx1 cy1"
   'print cx, cy, cx1, cy1
   if cx<>cx1 or cy<>cy1 then
   cx1=cx:cy1=cy
   timer 0
   goto [again]
   end if
wait

[quit]
   timer 0
   close #gr
end

sub cell x,y
   #gr "backcolor ";color$
   #gr "color ";color$
   #gr "place ";x*s;" ";y*s
   #gr "boxfilled ";(x+1)*s;" ";(y+1)*s
end sub

sub eye x,y
   #gr "color black"
   #gr "place ";x*s+s/2;" ";y*s+s/2
   #gr "circle ";s/4
end sub

sub fish x, y, isDown
   REM /*
   REM *  ##   #
   REM *  ### ###
   REM *   #   ##
   REM */
   if not(isDown) then call cell x, y
   call cell x+1, y
       if not(isDown) then call eye x+1, y

   call cell x, y+1
   call cell x + 1, y+1
   call cell x + 2, y+1
       if isDown then call eye x+2, y+1
       'call pause 300

   call cell x + 1, y+2
   if isDown then call cell x + 2, y + 2
end sub

sub pause mil
   t0=time$("ms")
   while time$("ms")-t0<mil
       scan
   wend
[quit]
end sub


[marshawn]


'Fish!
'iz fakulteta za razhujarnistvo in informatiko
'univerza v ljubljana
'tanslated to JB
H$ = "gr"

global pi, a1, a2, a, b, w1, w2, h
pi = 4*atn(1)

a1 = 14
a2 = 4

w = 30*7
w1 = w*5/7
w2 = w - w1
h = w*2/7

a = (-1)*h/a2/sin(pi*w/w1)
a = exp(log(a)/w)
b = a1*pi/w1/w2

nomainwin
sw = w*4 + w2 + 8
WindowWidth = sw
WindowHeight = h*8 + 87
UpperLeftX = 0
UpperLeftY = 0

open "Sea" for graphics_nsb_nf as #gr
#gr "trapclose quit"
#gr "down"
#gr "fill white"


for i=-1 to 4
for j=-1 to 4
   call fish w2 + i*w, 50 + h*j*2, w, i and 1
   call fish sw - w2 - i*w - 8, 50 + h*j*2 + h, (-1)*w, i and 1
next
next
wait

sub quit Hdl$
   close #Hdl$
   end
end sub

sub fish x0, y0, ww, u
   w = abs(ww)
   if ww < 0 then s = -1 else s = 1

   if u=1 then
       #gr "color lightgray"
       for x=w to w1 step -1
           #gr "line ";x0+s*(x-w);" ";y0-f(x,a2);" ";x0+s*(x-w);" ";y0-g(x-w,(-1)*w2)
       next
       for x=0 to w1
           #gr "line ";x0+s*x;" ";y0-f(x,a2);" ";x0+s*x;" ";y0+h-f(w1-x,a1)
       next
       for x=0 to w2
           #gr "line ";x0+s*(w-x);" ";y0+h-g((-1)*x,(-1)*w2);" ";x0+s*(w-x);" ";y0-f(w-x, a2)
       next
       for xx=0 to w1/3/7
           if xx>0 and xx<w1/3/7 then
               x = xx*3*7 + 3
               ox = x0 + s*x
               oy = y0 - f(x,a1)
               oy2 = y0 + h - f(w1-x,a2)
               for zz=0 to 3*7 + 3
                   z = (xx)*3*7+zz
                   #gr "line ";ox;" ";oy;" ";x0+s*z;" ";y0-f(z,a2)
                   #gr "line ";ox;" ";oy2;" ";x0+s*z;" ";y0+h-f(w1-z,a1)
               next
           end if
       next
   end if

   #gr "color black"
   #gr "place ";x0;" ";y0
   for x=0 to w
       #gr "goto ";x0+s*x;" ";y0-f(x,a2)
   next
   for x=0 to w2
       #gr "goto ";x0+s*(w-x);" ";y0+h-g((-1)*x,(-1)*w2)
   next
   for x=0 to w1
       #gr "goto ";x0+s*(w1-x);" ";y0+h-f(x,a1)
   next
   for x=w to w1 step -1
       #gr "goto ";x0+s*(x-w);" ";y0-f(x,a2)
   next
   for x=0 to w2
       #gr "goto ";x0-s*(w2-x);" ";y0-g(x,w2)
   next
   for x=0 to w1
       #gr "goto ";x0+s*x;" ";y0-f(x,a1)
   next

   for xx=0 to w1/3/7
       if xx=1 then
           x = xx*3*7 + 3
           #gr "place ";x0+s*x;" ";y0-f(x,a1)
       else
       if xx>1 and xx<w1/3/7-1 then
           x = xx*3*7
           #gr "goto ";x0+s*x;" ";y0-f(x,a2)
           x = xx*3*7 + 3
           #gr "goto ";x0+s*x;" ";y0-f(x,a1)
       end if
       end if
   next

   for xx=0 to w1/3/7
       if xx=0 then
           x = (xx+1)*3*7 + 3
           #gr "place ";x0+s*x;" ";y0+h-f(w1-x,a2)
       else
       if xx>0 and xx<w1/3/7 then
           x = xx*3*7
           #gr "goto ";x0+s*x;" ";y0+h-f(w1-x,a1)
           x = xx*3*7 + 3
           #gr "goto ";x0+s*x;" ";y0+h-f(w1-x,a2)
       end if
       end if
   next

   for xx=1 to w2/8-1
       x = w - xx*8
       x2 = w - xx*6.5 - 7
       #gr "line ";x0+s*(x-w);" ";y0-f(x,a2);" ";x0+s*(x2+2*7-w);" ";y0-f(x2, a2)
   next

   if u=1 then
       #gr "backcolor white"
   else
       #gr "backcolor lightgray"
   end if

   #gr "place ";x0+s*w1;" ";y0+3*7
   #gr "circlefilled 4";

   #gr "flush"
end sub

function f(x, aa)
   f = aa*(a^x)*sin(pi*x/w1)
end function

function g(x, v)
   g = b*x*(x - v)
end function


[plus]

Wow! MC Escher is at Just Basic Forum! very nice!

[tenochtitlanuk]

Like all the versions here.. Clever code and nice result! I like your signature tagline too...

[Rod]

Wow indeed, very nice I hope you enjoy exploring Just BASIC.