aUCBLogo Demos and Tests / simstring3


be simstring3 [singleshot false][FrameNr 0]
   
norefresh
   
singlebuffer
   
setUpdateGraph false
   
maxm=40
   
dopt=20
   
fac=;1.5 ;0.2
   
dopt5=5*dopt
   
ffein=100
   
maxf=ffein*dopt5
   
phE=0.2
   
tE=2
   
anfE=0.4
   
expo=1
   
gravV=-0.005*fac
   
mov=0.005*fac
   
airFriction=0.0002*fac
   
size=3
   
sizel=list size size
   
sizelm=sizel* -1
   
f=(FloatArray maxf+1 0)
   
j=Int maxf*0.3
   
;for [i 0 j]
   ;[;   f.i=fac*(exp -((i/(dopt*ffein))^expo))*cos 180*i/(2*dopt*ffein)
   ;   f.i=fac*((10*exp -(i/(2*dopt*ffein)))
   ;          *((sqr (i/(2*dopt*ffein)-1)/3)-0.1))
   ;]
   
f=rSeqFA -fac maxf+1
   
for [i j maxf+1]
   
[   f.i=f.j
   
]
   
white=RGB 1 1 1
   
hideTurtle
;   cs 
   
pu home
   
setpc "white
   
pd setx 400 setx -400
   
setXY rSeqFA -400 400 maxf+f*100
   
pu setXY -400+800*dopt*ffein/maxf  300
   
pd setXY -400+800*dopt*ffein/maxf -300
;throw "toplevel
   
disposalY=0
   
onePoint=true
   
gravity=false
   
air=true
   
wavMaking=false
   
wav=[]

   
m={0 0 0}
   
x=Array 3
   
o=Array 3
   
v=Array 3
   
a=Array 3
   
xj=Array 3
   
hx=Array 3
   
for [1 3]
   
[   x.i=FloatArray maxm
      
o.i=FloatArray maxm
      
v.i=FloatArray maxm
      
a.i=FloatArray maxm
   
]
   
x.(1).1= -400   x.(2).1=0      x.(3).1=0
   
v.(1).1=0      v.(2).1=0      v.(3).1=0
   
for [maxm]
   
[   x.(1).i=x.(1).1+(i-1)*dopt
      
x.(2).i=0
      
x.(3).i=0
      
v.(1).i=0
      
v.(2).i=0
      
v.(3).i=0
   
]

   
(reRandom 0)
   
(print [(RETURN)splines (+)heat (-)cool (G)ravity (A)ir 
      
(W)avMaking (other key)=clean Mouse: L=pull R=del])
   
pal=loadpalette "teile.pal
   
setScreenColor pal.1
   
WindowMode

   
running=true
   
while [running]
   
[   for [1 10]
      
[   moveThem
         
updateGraph
         
if singleshot [stop]
         
if wavMaking
         
[   wav=fput 0+x.2 wav
            
wavlength=wavlength+1
         
]
         
if MouseButtons==[MousePulling]
         
if Key?
         
[   ch=upperCase readChar
            
case ch
            
[   [[char wxk_escaperunning=false]
               
[[char wxk_returnonePoint=not onePoint]
               
["- cooling]
               
["+ heating]
               
["G gravity=not gravity (print [Gravitygravity)]
               
["A air=not air (print [Airair)]
               
["W ifelse wavMaking
                  
[   StaticTextDestroy wavInfo
                     
saveWav
                  
][   wavlength=0
                     
wavInfo=StaticText [] 0
                     
StaticTextSetColor wavInfo 0
                  
]
                  
wavMaking=not wavMaking
               
]
               
["i m.3=m.3+10 print m.3];in
               
["o m.3=m.3-10 print m.3];out
               
[else clean]
            
]
         
]
         
GC
      
]
      
if wavMaking
      
[   StaticTextSetLabel wavInfo wavLength
      
]
   
]
   
   
be moveThem
      
for [1 3]
      
[   a.i=rSeqFA 0 0 maxm
         
xj.i=rotate x.1
      
]
      
dx=x-xj
      
d=sqrt (sqr dx.1)+(sqr dx.2)+(sqr dx.3)
      
d=f.saturateAbove maxf IntArray trunc d*ffein
      
for [1 3][hx.i=dx.i*d]
               
      
a=a+hx
      
for [1 3][a.i=a.i-rotate hx.-1]
      
if air
      
[   vair=(sqrt (sqr v.1)+(sqr v.2)+(sqr v.3))*airFriction
         
for [1 3][a.i=a.i-v.i*vair]
      
]
      
v=v+a
      
if gravity
      
[   v.2=v.2+gravV
      
]
      
v.(1).1=0   v.1.maxm=0
      
v.(2).1=0   v.2.maxm=0
      
v.(3).1=0   v.3.maxm=0
      
x=x+v
      
d.1=0   d.maxm=0
      
for [maxm]
      
[   if onePoint
         
[   setFC 0  
            
pu setXY o.(1).i o.(2).i 
            
pd fillRect sizelm sizel
         
]
         
c=Int 15+1500*abs d.i
         
if 255 [c=255]
         
setFC pal.c
         
pu setXY x.(1).i x.(2).i 
         
pd fillRect sizelm sizel
      
]
      
o=x
   
end
   
   
be cooling
      
v=v/tE
   
end
   
   
be heating
      
v=v*tE
   
end
   
   
be MousePulling
      
local [i d]
      
m.1=MouseX
      
m.2=MouseY
      
i=findNearest m
   
      
if onePoint
      
[   setFC 0  
         
pu setXY x.(1).i x.(2).i 
         
pd fillRect sizelm sizel
      
]   
      
for [1 3][v.k.i=v.k.i/tE+(m.k-x.k.i)*mov]
      
ConsoleSetFocus
   
end
   
   
be findNearest f
      
local [i j dmin d]
      
dmin=intmax
      
for [maxm]
      
[   d=trunc sqrt 
             
(sqr f.1-x.(1).i)
            
+(sqr f.2-x.(2).i)
            
+(sqr f.3-x.(3).i)
         
if dmin
         
[   dmin=d
            
j=i
         
]
      
]
      
output j
   
end
   
   
be saveWav
      
local [size]
      
rate=44100
      
size=count wav
   
      
openWriteBin "tmp.wav
      
setWriter "tmp.wav
      
type [RIFF]
      
typebin 4+8+8+16+size*2
      
type [WAVE]
      
type [fmt]
      
typebin 16
      
typebin int16 1 
      
typebin int16 1
      
typebin rate
      
typebin rate*2
      
typebin int16 2
      
typebin int16 16
      
type [data]
      
typebin size*2
      
      
wav=reverse wav
      
ifelse (max wav) > (min wav)
      
[   volume=Int16Max/(max wav)*0.5
      
][   volume=Int16Max/(min wav)*0.5
      
]
      
foreach wav 
      
[   typebin int16 ?*volume
      
]
      
setWriter []
      
close "tmp.wav
   
end
end