aUCBLogo Demos and Tests / drawasteroids


be drawasteroids [singleshot false][FrameNr 0]
clearscreen
perspective
setPC RGB .5 .5 .5
drawAsteroid 100
stop
   
if (not singleshotor2 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.5size*(rnd-0.5size*(rnd-0.5) 
            
again=false
            
for [i-1 1]
            
[   if (DistanceXYZ poss.j) < [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 dpos.-dpos.i.1
            
]
            
if (abs poss.i.2) > size
            
[   setItem dpos.-dpos.i.2
            
]
            
if (abs poss.i.3) > size
            
[   setItem dpos.-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 == s*[i=0]
      
if == 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 == s*[i=0]
      
if == 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 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+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 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 0)
      
repeat s
      
[   j=repCount-1
         
d.j=r
      
]
      
dist.(repCount-1)=d
   
]
   
p0=PosXYZ
   
PenUp
   
noRefresh
   
ch=0
   
for [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 [nx]
      
[   setPosXYZ p3
         
setOrientation o3
         
down 180/nx*j
         
for [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=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