PicoMiteVGA DEMO


Author Message
twofingers

Guru

Joined: 02/06/2014
Location: Germany
Posts: 1767
Posted: 10:46pm 08 Jun 2026      

Hi Vadim,
Thanks for your previous post (The dot murmuration simulation on the screen)! It inspired me to play around with it and expand on it a bit. I hope that’s okay with you!
I found it interesting how quickly the different species come together.

'Option Profiling On
Option TraceCache On 32' 64 to demonstrate the TraceCache "if"-bug!
'Option Cache Debug On
MODE 3'3 or 2
Const NB=40,NG=4'1-15
Dim float X(NB),Y(NB),U(NB),V(NB),LK(NB)
Dim float cx,cy,ax,ay,lx,ly,dx,dy,ds,ss,sp,px,py,pu,pv,b,MS(NG),MP(NG)
Dim integer i,j,k,l,ifbug=0'1=demonstrate the TraceCache "if"-bug
Dim integer C(15)=(0,6,8,14,12,15,3,7,1,9,10,11,5,13,4,2)
Colour Map C(),C()
'dim string G$=Chr$(142)

For i=1 To NG:MS(i)=9+(i Mod 4)*3:MP(i)=Sqr(MS(i)):Next i
For i=1 To NB:X(i)=Int(Rnd*MM.HRES):Y(i)=Int(Rnd*MM.VRES):U(i)=(Rnd*4)-2:V(i)=(Rnd*4)-2:LK(i)=(i Mod NG)+1:Next i
Do : Print @(0,0) MM.Info(heap),Int(Timer),l"   ";:Timer =0
 Inc l
 For i=1 To NB
   px=X(i):py=Y(i):pu=U(i):pv=V(i):b=LK(i)
   Circle X(i),Y(i),7,1,,0
   Pixel X(i),Y(i),0
   'Text px,py,G$,"CM",1,1,0
   cx=0:cy=0:ax=0:ay=0:lx=0:ly=0:k=0
   For j=1 To NB
     If i<>j Then
       dx=X(j)-px:dy=Y(j)-py:ds=dx*dx+dy*dy
       If ds<10000 Then
         If b=LK(j) Then
           Inc cx,X(j):Inc cy,Y(j):Inc lx,U(j):Inc ly,V(j):Inc k
           If ds<400 Then Inc ax,-dx:Inc ay,-dy
         Else
           If ds<1600 Then Inc ax,-dx*1.5:Inc ay,-dy*1.5
         EndIf
       EndIf
     EndIf
   Next
   If k>0 Then cx=(cx/k)-px:cy=(cy/k)-py:Inc pu,cx*.005:Inc pv,cy*.005:lx=lx/k:ly=ly/k:Inc pu,lx*.05:Inc pv,ly*.05
   Inc pu,ax*.1:Inc pv,ay*.1:ss=pu*pu+pv*pv
   If ss>MS(b) Then sp=Sqr(ss):pu=(pu/sp)*MP(b):pv=(pv/sp)*MP(b)
   Inc px,pu:Inc py,pv
   If ifbug Then
     If px<10 Then Inc pu,.5 Else If px>MM.HRES-10 Then Inc pu,-.5
     If py<10 Then Inc pv,.5 Else If py>MM.VRES-10 Then Inc pv,-.5
   Else
     Select Case px:Case <10:Inc pu,.5:Case >MM.HRES-10:Inc pu,-.5:End Select
     Select Case py:Case <10:Inc pv,.5:Case >MM.VRES-10:Inc pv,-.5:End Select
   EndIf
   X(i)=px:Y(i)=py:U(i)=pu:V(i)=pv':Text px,py,G$,"CM",1,1,cl
   Pixel X(i),Y(i),C(b)
   Circle X(i),Y(i),7,1,,C(b)
 Next
Loop While Inkey$=""
'Save image "swarm"
End


Additionally, I think I’ve found a small but annoying bug in the TRACECACHE option. The attached code demonstrates this with an If/Then statement. If I replace it with Select/Case, the "NumBoids" elements no longer disappear (after a few hundred loop iterations). I haven't investigated the exact causes any further; this is just meant as a tip for other users.
Otherwise, the TRACECACHE option is very useful and amazing!
Regards
Michael