twofingers
 Guru
 Joined: 02/06/2014 Location: GermanyPosts: 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 |