Dark Bit Factory & Gravity

PROGRAMMING => Other languages => Yabasic => Topic started by: bikemadness on January 30, 2009

Title: Re: Doilys (upgraded)
Post by: bikemadness on January 30, 2009
I've managed to make the patterns turn.
Press R1 to action the sample that comes up.
Press L1 to random patterns and colour.
All instructions on screen.

Code: [Select]
open window 640,512
ang=pi/180
x=400
y=260
sel1=1
sel2=1
dim title$(7)
for b=1 to 7
read title$(b)
next b
dim instruction$(19)
for b=1 to 19
read instruction$(b)
next b
doilys=5
dim points(doilys),dir(doilys),gap(doilys)
dim ra(doilys),r(doilys),g(doilys),b(doilys)
dim turn(doilys),m(doilys)
for c=1 to doilys   
points(c)=32 
dir(c)=360/points(c)
gap(c)=6
ra(c)=(c+7.4)^2.16
r(c)=200 
g(c)=200 
b(c)=200
m(c)=1:m(2)=-1:m(3)=1:m(4)=-1:m(5)=1
next c
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
setrgb 1,200,200,0
fill rectangle 0,0 to 160,640
setrgb 1,0,0,0
line 15,198 to 135,198
triangle 41,315 to 55,315 to 48,302
line 105,305 to 115,315
line 115,305 to 105,315
rectangle 127,334 to 141,348
circle 30,392,7
setrgb 1,0,0,0
for b=1 to 7
text 10,b*20+30,title$(b)
next b
setrgb 1,80,80,80
for b=1 to 19
text 0,b*17+176,instruction$(b)
next b
d=peek("port1")
go=go+1
if go>10 go=10
if and(d,16)>0 and go=10 then
sel1=sel1-1
go=0
endif
if and(d,64)>0 and go=10 then
sel1=sel1+1
go=0
endif
if sel1<1 sel1=1
if sel1>7 sel1=7
setrgb 1,0,80,0
text 80,sel1*20+30,"<"
rectangle 78,sel1*20+20 to 93,sel1*20+35
if and(d,128)>0 and go=10 then
sel2=sel2-1
go=0
endif
if and(d,32)>0 and go=10 then
sel2=sel2+1
go=0
endif
if sel2<1 sel2=1
if sel2>doilys sel2=doilys
if and(d,32768)>0 and go=10 then
doilys=doilys-1
go=0
endif
if and(d,8192)>0 and go=10 then
doilys=doilys+1
go=0
endif
if doilys<1 doilys=1
if doilys>5 doilys=5
setrgb 1,0,0,0
text 75,20,"doilys:"+str$(doilys)
text 10,20,"RGBmix"
for c=1 to doilys
setrgb 1,0,0,0   
if sel2=c then
text 75,35,"doily#"+str$(c)
text 100,50,str$(points(c))
text 100,70,str$(gap(c))
text 100,90,str$(ra(c))
text 100,110,str$(r(c))
text 100,130,str$(g(c))
text 100,150,str$(b(c))
setrgb 1,r(c),g(c),b(c)
fill rectangle 10,25 to 70,35
setrgb 1,0,0,0
rectangle 10,25 to 70,35
endif
if and(d,4096)>0 and sel2=c and sel1=1 and go=10 then
points(sel2)=points(sel2)+1
go=0
endif
if and(d,16384)>0 and sel2=c and sel1=1 and go=10 then
points(sel2)=points(sel2)-1
go=0
endif
if points(sel2)<gap(sel2)*2+1 points(sel2)=gap(sel2)*2+1
if points(sel2)>40 points(sel2)=40
if and(d,4096)>0 and sel2=c and sel1=2 and go=10 then
gap(sel2)=gap(sel2)+1
go=0
endif
if and(d,16384)>0 and sel2=c and sel1=2 and go=10 then
gap(sel2)=gap(sel2)-1
go=0
endif
if gap(sel2)<1 gap(sel2)=1
if gap(sel2)>points(sel2)/2+1 gap(sel2)=points(sel2)/2+1
if and(d,4096)>0 and sel2=c and sel1=3 ra(sel2)=ra(sel2)+1
if and(d,16384)>0 and sel2=c and sel1=3 ra(sel2)=ra(sel2)-1
if ra(sel2)<40 ra(sel2)=40
if ra(sel2)>250 ra(sel2)=250
if and(d,4096)>0 and sel2=c and sel1=4 r(sel2)=r(sel2)+1
if and(d,16384)>0 and sel2=c and sel1=4 r(sel2)=r(sel2)-1
if r(sel2)<0 r(sel2)=0
if r(sel2)>256 r(sel2)=256
if and(d,4096)>0 and sel2=c and sel1=5 g(sel2)=g(sel2)+1
if and(d,16384)>0 and sel2=c and sel1=5 g(sel2)=g(sel2)-1
if g(sel2)<0 g(sel2)=0
if g(sel2)>256 g(sel2)=256
if and(d,4096)>0 and sel2=c and sel1=6 b(sel2)=b(sel2)+1
if and(d,16384)>0 and sel2=c and sel1=6 b(sel2)=b(sel2)-1
if b(sel2)<0 b(sel2)=0
if b(sel2)>256 b(sel2)=256
if and(d,4096)>0 and sel2=c and sel1=7 m(sel2)=1
if and(d,16384)>0 and sel2=c and sel1=7 m(sel2)=-1
if m(sel2)=1 then
setrgb 1,0,0,0
text 110,165,">"
setrgb 1,50,50,50
circle 115,169,8
endif
if m(sel2)=-1 then
setrgb 1,0,0,0
text 109,166,"<"
setrgb 1,50,50,50
circle 115,169,8
endif
if and(d,1024)>0 then
points(c)=int(ran(38))+3
gap(c)=int(ran(points(c)/2))+1
ra(c)=int(ran(200))+50
r(c)=int(ran(256))
g(c)=int(ran(256))
b(c)=int(ran(256))
m(c)=int(ran(2)):if m(c)=0 m(c)=-1
endif
if and(d,256)>0 ra(c)=ra(c)+1
if and(d,512)>0 ra(c)=ra(c)-1
dir(c)=360/points(c)
if and(d,2048)>0 turn(c)=turn(c)+m(c)
if turn(c)>360 turn(c)=1
if turn(c)<1 turn(c)=360
setrgb 1,r(c),g(c),b(c)
for a=1 to points(c)
line cos((dir(c)*a+turn(c))*ang)*ra(c)+x,sin((dir(c)*a+turn(c))*ang)*ra(c)+y to cos((dir(c)*(a+gap(c))+turn(c))*ang)*ra(c)+x,sin((dir(c)*(a+gap(c))+turn(c))*ang)*ra(c)+y
next a
next c
until (1=0)
data "points","  gaps","radius"," col-R"," col-G"," col-B","turn<>"
data " instructions","Use L/R to see","plot-points of"
data "each doily.","Use U/D to high","-light a doily"
data "plot-point. ","Use   and   to","alter the plot-"
data "points. Use","to decrease the","number of doilys"
data "or   to add them","back.","L1 to random"
data "R1 turns doilys","L2/R2 changes","sizes of all","doilys shown"

I noticed the member count. Last time I noticed 400.

Title: Re: Re: Doilys (upgraded)
Post by: Shockwave on January 31, 2009
Nice in a kaleidoscopic kind of way :)
Title: Re: Re: Doilys (upgraded)
Post by: Yaloopy on February 02, 2009
Looks cool, could make a good demo :)