aUCBLogo Demos and Tests / drawasteroids
be drawasteroids [singleshot false][FrameNr 0]
clearscreen
perspective
setPC RGB .5 .5 .5
drawAsteroid 100
stop
if (not singleshot) or2 FrameNr==0
[ setUpdateGraph false
perspective
; allfullscreen
; fullscreen
PU hT
setPC RGB .5 .5 .5
setSC 0
GraphicStart
r=200
drawAsteroid r
a=GraphicEnd
size=400
n=4
poss=[]
dpos=[]
ori=[]
dw=[]
w=array n
repeat n
[ i=repCount
do_while
[ setxyz size*(rnd-0.5) size*(rnd-0.5) size*(rnd-0.5)
again=false
for [j 1 i-1 1]
[ if (DistanceXYZ poss.j) < r [again=true]
]
][again]
push "poss PosXYZ
push "dpos (List rnd-0.5 rnd-0.5 rnd-0.5)*4
right random 360
up random 360
push "ori Orientation
push "dw rnd
w.repCount=0
]
poss=Array poss
dpos=Array dpos
ori=Array ori
dw=Array dw
]
while [true]
[ clean
poss=poss+dpos
w=Modulo w+dw 360
repeat n
[ i=repCount
if (maxNorm poss.i) > size
[ if (abs poss.i.1) > size
[ setItem 1 dpos.i -dpos.i.1
]
if (abs poss.i.2) > size
[ setItem 2 dpos.i -dpos.i.2
]
if (abs poss.i.3) > size
[ setItem 3 dpos.i -dpos.i.3
]
poss.i=poss.i+dpos.i
]
setPosXYZ poss.i
setOrientation ori.i
rightRoll w.i
drawGraphic a
]
updateGraph
if singleshot [break]
if key? [notFullScreen ss stop]
]
end
be drawAsteroid r
be get i j
i=Int trunc Modulo i s*2
j=Int trunc Modulo j s
if i == s*2 [i=0]
if j == s [j=0]
output (dist.i).j
end
be put i j d
i=Int trunc Modulo i s*2
j=Int trunc Modulo j s
if i == s*2 [i=0]
if j == s [j=0]
dist.i.j=d
end
be getw theta phi
output get s*2*theta/180 s*phi/360
end
be putw theta phi d
put s*2*theta/180 s*phi/360 d
end
be displayIt
refresh
clearScreen
d=getw 0 0
stp=4
Surface
[ for [phi 0 360 stp]
[ for [theta stp 180 stp]
[ d=getw theta phi
; setPC hsb i*j 1 1
PD fd d PU
back d
down stp
]
up 180
SurfaceColumn
rightRoll stp
]
]
updateGraph
rotatescene2
noRefresh
end
be filterIt
repeat s*2
[ i=repCount-1
repeat s
[ j=repCount-1
dist.i.j=((get i j)+(get i+1 j)+(get i j+1))/3
]
]
end
be saveIt
filename="drawasteroids.dat
openWriteBin filename
setWriter filename
typeBin Int s
typeBin Int k
repeat s*2
[ i=repcount-1
typeBin dist.i
]
setWriter []
close filename
end
be loadIt
filename="drawasteroids.dat
openReadBin filename
setReader filename
s=readIntBin
k=readIntBin
dist=(array s*2 0)
repeat s*2
[ i=repcount-1
dist.i=(readFloatArrayBin s 0)
]
setReader []
close filename
end
; local [s dist d i j k j0 k0]
s=90
dist=(array s*2 0)
repeat s*2
[ d=(FloatArray s 0)
repeat s
[ j=repCount-1
d.j=r
]
dist.(repCount-1)=d
]
p0=PosXYZ
PenUp
noRefresh
ch=0
for [k 1 1000]
[ ;r2=(sqr sqr rnd)*r*2+r/2
r2=2*r/sqrt k
clearScreen
Home
theta=random 180
phi=random 360
rightroll phi
right theta
forward (getw theta phi)+r2*0.86
;pd circle r2 pu
right 90
p1=[]
p3=PosXYZ
o3=Orientation
nx=int s*5.13*r2/r
for [j 0 nx]
[ setPosXYZ p3
setOrientation o3
down 180/nx*j
for [i 0 nx]
[ forward r2
phi=ArcTan xCor zCor
theta=ArcTan yCor sqrt (sqr xCor)+(sqr zCor)
d=getw theta phi
if (distanceXYZ p0) < d
[ p2=PosXYZ
; if p1 != []
; [ setPosXYZ p1
; PenDown
; setPosXYZ p2
; PenUp
; ]
p1=p2
putw theta phi distanceXYZ p0
]
back r2
right 180/nx
]
if Key?
[ ch=readChar
if ch=="f [displayIt filterIt displayIt]
if ch=="s [print [Please wait...]]
if ch=="l [loadIt displayIt break]
if ch==" [displayIt]
if ch==Char 27 [stop]
]
]
if ch=="s [saveIt print [saved.] ch=0 displayIt]
]
refresh
comment [
for [i 1 5]
[ j0=1+random s
k0=1+random s*2
repeat s*2
[ d=array s
repeat s
[ j=repCount
w=180*j/s
d.j=r*(0.6+rnd*0.3*(Sin w)+0.3*sqr Cos w)
]
dist.repCount=d
]
]
repeat s*2
[ i=1+Modulo repCount-1 s*2
dist.i.1=(get 1 1)
dist.i.s=(get 1 s)
dist.i.2=((get 1 1)*2+(get 1 i))/3
dist.i.(s-1)=((get 1 s)*2+(get 1 i))/3
]
repeat s*2
[ i=1+Modulo repCount-1 s*2
repeat s
[ j=repCount
dist.i.j=((get i j)+(get i+1 j)+(get i j+1))/3
]
]
fd r
SurfaceStart
back r
repeat s*2+1
[ i=1+Modulo repCount-1 s*2
repeat s+1
[ j=1+Modulo repCount-1 s
d=(dist.i).j
; setPC hsb i*j 1 1
PD fd d PU
back d
rt 180/s
]
left 180+180/s
SurfaceColumn
rightRoll 180/s
]
SurfaceEnd
be get i j
if i==0 [i=s*2]
if j==0 [j=s]
i=1+Modulo i-1 s*2
j=1+Modulo j-1 s
output (dist.i).j
end
be put i j d
if i==0 [i=s*2]
if j==0 [j=s]
i=1+Modulo i-1 s*2
j=1+Modulo j-1 s
dist.i.j=d
end
]
end