RosettaCodeData/Task/Yin-and-yang/BASIC/yin-and-yang-16.basic
2019-09-12 10:33:56 -07:00

49 lines
1.2 KiB
Text

open window 640, 480
color 0,0,0
clear window
taijitu(640/2, 480/2, 480/4)
taijitu(100,100,50)
sub taijitu(x,y,r)
fill circle x,y,r
color 255,255,255
fill circle x,y,r-4
color 0,0,0
line x, y-r to x, y+r
infill(x-2, y-2)
fill circle x,y-r/2,r/2
color 255,255,255
fill circle x,y+r/2-2,r/2-1
fill circle x,y-r/2-2,r/8-1
color 0,0,0
fill circle x,y+r/2-2,r/8-1
end sub
sub infill(x,y)
local oy,lx,rx,nx,i,m,t,l$,r$,a$,test$
test$=getbit$(x,y,x,y) // get a sample of fill area
oy=y-1 : lx=x : rx=x : m=1 // m=1 makes go downwards
for t=1 to 2
repeat
repeat
l$=getbit$(lx,y,lx,y)
lx=lx-1 : if lx<0 break // test how far left to go
until (l$<>test$)
repeat
r$=getbit$(rx,y,rx,y)
rx=rx+1 : if rx>peek("winwidth") break // test how far right to go
until (r$<>test$)
lx=lx+2 : rx=rx-2 : line lx,y to rx,y // draw line across fill area
nx=0
for i=lx to rx
a$=getbit$(i,y+m,i,y+m) // get sample for next line
if a$=test$ let nx=i : break // test if new cycle reqd
next i
lx=nx : rx=nx
y=y+m : if (y<0 or y>peek("winheight")) break // test how far up or down to go
until (nx=0)
lx=x : rx=x : y=oy : m=-1 // m=-1 makes go upwards
next t
end sub