aUCBLogo Demos and Tests / simstring

to simstring
   init
   running=true
   while [running]
   [   moveThem
      updateGraph
      if Key?
      [   ch=readChar
         case ch
         [   [[char WXK_ESCAPE] running=false]
            [[char WXK_RETURN] onePoint=not onePoint]
            ["- cooling]
            ["+ heating]
            ["G gravity=not gravity]
            [else clean]
         ]
      ]
      case MouseButtons
      [   [1 mousePulling]
         [2 mouseSpecials]
      ]
   ]
end

to init
   maxm=40
   maxb=1
   dopt=15
   dopt5=5*dopt
   ffein=100
   maxf=ffein*dopt5
   phE=0.2
   tE=1.1
   anfE=0.4
   expo=1
   fac=1.5 ;0.2
   gravV=-0.005*fac
   mov=0.2*fac
   rx=4
   ry=3
   size=8
   disposalY=0
   mx=0
   my=0
   onePoint=true
   gravity=true
   white=RGB 1 1 1

   ox=FloatArray maxm
   oy=FloatArray maxm
   x=FloatArray maxm
   y=FloatArray maxm
   vx=FloatArray maxm
   vy=FloatArray maxm
   ax=FloatArray maxm
   ay=FloatArray maxm
   banz=FloatArray maxm
   bi=mdarray list maxm maxb
   b=mdarray list maxm maxm

   f=(FloatArray maxf+1 0)

   (reRandom 0)
   (print maxb [bindings [RETURN]=splines [+]=heat [-]=cool [G]=gravity
      [other key]=clean Mouse: L=pull R=del])
   pal=loadPalette "teile.pal
   setScreenColor pal.1
   hideTurtle
   x.1= -300
   y.1=0
   vx.1=0
   vy.1=0
   banz.1=0
   for [j 2 maxm]
   [   b.(1).j=false
   ]

   for [i 2 maxm]
   [   x.i=x.1+(i-1)*dopt
      y.i=0
      vx.i=0
      vy.i=0
      banz.i=0
      for [j 2 maxm]
      [   b.i.j=false
      ]
   ]
   for [i 0 maxf]
   [   f.i=fac*(exp -((i/(dopt*ffein))^expo))*cos 180*i/(2*dopt*ffein)
   ]
end

to moveThem
   ax=rSeqFA 0 0 maxm
   ay=rSeqFA 0 0 maxm
   for [i 1 maxm-1]
   [   for [j i+1 maxm]
      [   dx=x.i-x.j
         if (abs dx) > dopt5
         [   continueLoop
         ]
         dy=y.i-y.j
         if (abs dy) > dopt5
         [   continueLoop
         ]
         d=sqrt (sqr dx)+sqr dy
         ifelse d > dopt5
         [   if b.i.j
            [   b.i.j=false
               banz.i=banz.i-1
            ]
         ][
            if not b.i.j
            [   if (abs d-dopt) < 1
               [   EnergyLoss
               ]
               break
            ]
            d=f.int trunc d*ffein
            hx=dx*d
            hy=dy*d

            ax.i=ax.i+hx
            ay.i=ay.i+hy

            ax.j=ax.j-hx
            ay.j=ay.j-hy
         ]
      ]
   ]
   setFC white
   pu  setXY x.1 y.1  pd fillCircle size
   pu  setXY x.maxm y.maxm pd fillCircle size
;   setPixelXY x.1 y.1 white
;   setPixelXY x.maxm y.maxm white

   for [i 2 maxm-1]
   [   vx.i=vx.i+ax.i
      vy.i=vy.i+ay.i
      if gravity
      [   vy.i=vy.i+gravV
      ]
      if onePoint
      [
         setFC 0  pu setXY ox.i oy.i pd fillCircle size
;         setPixelXY ox.i oy.i 0
      ]
      x.i=x.i+vx.i
      y.i=y.i+vy.i
      ox.i=x.i
      oy.i=y.i
      setFC pal.i pu setXY ox.i oy.i pd fillCircle size
;      setPixelXY ox.i oy.i pal.i
   ]
end

to EnergyLoss
   if banz.i >= maxb
   [   stop
   ]
   if banz.i >= 1
   [   for [k 1 banz.i]
      [   if bi.i.k == j
         [   stop
         ]
      ]
   ]
   banz.i=banz.i+1
   tmp=banz.i
   bi.i.tmp=j
   b.i.j=true
   Line (list list x.i y.i list x.j y.j) pal.14
   updateGraph
   hx=(vx.i+vx.j)/2
   hy=(vy.i+vy.j)/2
   if i > 1
   [   vx.i=hx
      vy.i=hy
   ]
   vx.j=hx
   vy.j=hy
   Line (list list x.i y.i list x.j y.j) 0
end

to cooling
   for [i 1 maxm]
   [   vx.i=vx.i/tE
      vy.i=vy.i/tE
   ]
end

to heating
   for [i 1 maxm]
   [   vx.i=vx.i*tE
      vy.i=vy.i*tE
   ]
end

to MousePulling
   if (mx != MouseX) or2 (my != MouseY)
   [   mx=MouseX
      my=MouseY
      i=findNearest mx my
   ]
   vx.i=0
   vy.i=0
   d=((sqr mx-x.i)+sqr mx-y.i)^0.3
   x.i=x.i+mov*(mx-x.i)/d
   y.i=y.i+mov*(my-y.i)/d
end

to findNearest fx fy
   local [i j dmin d]
   dmin=IntMax
   for [i 1 maxm]
   [   d=trunc sqrt (sqr fx-x.i)+sqr fy-y.i
      if d < dmin
      [   dmin=d
         j=i
      ]
   ]
   output j
end