'Option TraceCache On 32

Const NumPoints = 500
Const Radius = 190
Const Dist = 500
Const X0 = MM.HRES\2
Const Y0 = MM.VRES\2

Dim x(NumPoints), y(NumPoints), z(NumPoints)
Dim angleX, angleY

For i=1 To NumPoints
phi=2*Pi*Rnd
theta=ACos(2*Rnd-1)
x(i)=Radius*Sin(theta)*Cos(phi)
y(i)=Radius*Sin(theta)*Sin(phi)
z(i)=Radius*Cos(theta)
Next

Colour RGB(Cyan)

Do
Inc angleX,.02
Inc angleY,.03
CLS : Print Timer: Timer =0

For i=1 To NumPoints
 ny=y(i)*Cos(angleX)-z(i)*Sin(angleX)
 nz=y(i)*Sin(angleX)+z(i)*Cos(angleX)
 nx=x(i)*Sin(angleY)+nz*Cos(angleY)

 finalZ=-x(i)*Sin(angleY)+nz*Cos(angleY)
 proj=dist/(dist-finalZ)
 Pixel X0+nx*proj,Y0+ny*proj
Next
Loop While Inkey$=""

Option TraceCache On 32
CLS
Dim N=600, R=200
Dim X(N), Y(N), Z(N)

For i=1 To N
TH=Pi*Rnd
PH=2*Pi*Rnd
X(i)=R*Sin(TH)*Cos(PH)
Y(i)=R*Sin(TH)*Sin(PH)
Z(i)=R*Cos(TH)
Next

AY=0.05: CY=Cos(AY): SY=Sin(AY)
AX=0.03: CX=Cos(AX): SX=Sin(AX)
OX=MM.HRES\2: OY=MM.VRES\2

Do
Timer =0
For i=1 To N
 If Z(i)>0 Then Pixel OX+X(i),OY+Y(i),0
 XT=X(i)*CY-Z(i)*SY:ZT=X(i)*SY+Z(i)*CY
 X(i)=XT:Z(i)=ZT
 YT=Y(i)*CX-Z(i)*SX:ZT=Y(i)*SX+Z(i)*CX
 Y(i)=YT: Z(i)=ZT
 If Z(i)>0 Then Pixel OX+X(i),OY+Y(i)
Next
Print @(0,0)Timer;
Loop While Inkey$=""

Const N=1023
Const SclX=N/MM.HRES
Const SclY=N/MM.VRES
Dim integer X,Y

Colour RGB(Green):CLS

For X=0 To N
 For Y=0 To N
   If X And Y Then Y=Y+(X And Y)\2
   Pixel (X+Y\2)/SclX,MM.VRES-Y/SclY
 Next
Next

Type Bubble
 x As INTEGER
 y As INTEGER
 r As INTEGER
 c As INTEGER
 s As INTEGER
End Type

Dim b(30) As Bubble

Dim c(15)=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
Colour Map c(),c()

For i=1 To 30
 b(i).x=Int(Rnd*MM.HRES)
 b(i).y=MM.VRES+Int(Rnd*200)
 b(i).r=10+Int(Rnd*20)
 b(i).c=c(1+Int(Rnd*14))
 b(i).s=1+Int(Rnd*4)
Next

Do
 For i=1 To 30
   Circle b(i).x, b(i).y, b(i).r,,,0,0
   b(i).y=b(i).y-b(i).s
   b(i).x=b(i).x+Int(Rnd*3)-1

   If b(i).y+b(i).r<0 Then
     b(i).x=Int(Rnd*MM.HRES)
     b(i).y=MM.VRES+b(i).r
     b(i).r=10+Int(Rnd*20)
     b(i).c=c(1+Int(Rnd*14))
     b(i).s=1+Int(Rnd*4)
   EndIf
   Circle b(i).x, b(i).y, b(i).r,,,b(i).c
   Circle b(i).x-Int(b(i).r/3), b(i).y-Int(b(i).r/3), Int(b(i).r/5)
 Next
Loop While Inkey$=""

MODE 3
Dim c(15)=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
Colour Map c(),c()

Type Bubble
 x As INTEGER
 y As INTEGER
 dx As INTEGER
 dy As INTEGER
 r As INTEGER
 c As INTEGER
 act As INTEGER
 pop As INTEGER
End Type

Const maxBubbles = 20
Dim b(maxBubbles) As Bubble

For i=1 To maxBubbles
InitBubble(i)
Next

Do
 For i=1 To maxBubbles
   Circle b(i).x, b(i).y, b(i).r,,,0,0
   If b(i).act=1 Then
     b(i).x=b(i).x+b(i).dx
     b(i).y=b(i).y+b(i).dy
     If b(i).x-b(i).r<0 Or b(i).x+b(i).r>MM.HRES Then
       b(i).dx=-b(i).dx
     EndIf
     If b(i).y-b(i).r<0 Or b(i).y+b(i).r>MM.VRES Then
       b(i).dy=-b(i).dy
     EndIf
     For j=i+1 To maxBubbles
       If b(j).act=1 Then
         dist!=Sqr((b(i).x-b(j).x)^2+(b(i).y-b(j).y)^2)
         minDist!=b(i).r+b(j).r
         If dist!<minDist! Then
           t=b(i).dx: b(i).dx=b(j).dx: b(j).dx=t
           t=b(i).dy: b(i).dy=b(j).dy: b(j).dy=t
           If Int(Rnd*10)=0 Then
             b(i).act=2
             b(i).pop=5
           EndIf
         EndIf
       EndIf
     Next j

     If Int(Rnd*1000)=0 Then
       b(i).act=2
       b(i).pop=5
     EndIf
     Circle b(i).x, b(i).y, b(i).r,2,,b(i).c
     t=310-b(i).x\16
     Arc b(i).x, b(i).y, b(i).r-8,,t,50+t,b(i).c

   ElseIf b(i).act=2 Then
     For p=1 To 8
       angle!=p*0.785
       px=b(i).x+(b(i).r+(5-b(i).pop)*3)*Cos(angle!)
       py=b(i).y+(b(i).r+(5-b(i).pop)*3)*Sin(angle!)
       Pixel px,py,b(i).c
     Next p
     b(i).pop=b(i).pop-1
     If b(i).pop <=0 Then
       t=b(i).r*10: Play Tone t,t,20
       Circle b(i).x, b(i).y, b(i).r+15,,,0,0
       InitBubble(i)
     EndIf
   EndIf
 Next i
Loop While Inkey$=""

Sub InitBubble(i As INTEGER)
 b(i).r=Int(Rnd*40)+15
 b(i).x=Int(Rnd*(MM.HRES-2*b(i).r))+b(i).r
 b(i).y=Int(Rnd*(MM.VRES-2*b(i).r))+b(i).r
 b(i).dx=(Rnd*4)-2: If b(i).dx=0 Then b(i).dx=1
 b(i).dy=(Rnd*4)-2: If b(i).dy=0 Then b(i).dy=1
 b(i).c=c(Int(Rnd*14)+1)
 b(i).act=1
 b(i).pop=0
End Sub

'SOAP BUBBLES original Javavi 2026

 if instr("2350",mm.device$) then
   MODE 3
   Dim c(15)=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
   Colour Map c(),c()
 else
   mode 2
   dim c(15):For f%=1 To 15:Read c(f%):Next f%
 end if
 
 framebuffer create
 framebuffer write F

Type Bubble
 x As INTEGER
 y As INTEGER
 dx As INTEGER
 dy As INTEGER
 r As INTEGER
 c As INTEGER
 act As INTEGER
 pop As INTEGER
End Type
 
 Const maxBubbles = 5'20
 Dim b(maxBubbles) As Bubble
 
 For i=1 To maxBubbles
   InitBubble(i)
 Next
 
 Do
   For i=1 To maxBubbles
     Circle b(i).x, b(i).y, b(i).r,,,0,0
     If b(i).act=1 Then
       b(i).x=b(i).x+b(i).dx
       b(i).y=b(i).y+b(i).dy
       If b(i).x-b(i).r<0 Or b(i).x+b(i).r>MM.HRES Then
         b(i).dx=-b(i).dx
       EndIf
       If b(i).y-b(i).r<0 Or b(i).y+b(i).r>MM.VRES Then
         b(i).dy=-b(i).dy
       EndIf
       For j=i+1 To maxBubbles
         If b(j).act=1 Then
           dist!=Sqr((b(i).x-b(j).x)^2+(b(i).y-b(j).y)^2)
           minDist!=b(i).r+b(j).r
           If dist!<minDist! Then
             t=b(i).dx: b(i).dx=b(j).dx: b(j).dx=t
             t=b(i).dy: b(i).dy=b(j).dy: b(j).dy=t
             If Int(Rnd*10)=0 Then
               b(i).act=2
               b(i).pop=5
             EndIf
           EndIf
         EndIf
       Next j
       
       If Int(Rnd*1000)=0 Then
         b(i).act=2
         b(i).pop=5
       EndIf
       Circle b(i).x, b(i).y, b(i).r,2,,b(i).c
       t=310-b(i).x\16
       Arc b(i).x, b(i).y, b(i).r-8,,t,50+t,b(i).c
       
     ElseIf b(i).act=2 Then
       For p=1 To 8
         angle!=p*0.785
         px=b(i).x+(b(i).r+(5-b(i).pop)*3)*Cos(angle!)
         py=b(i).y+(b(i).r+(5-b(i).pop)*3)*Sin(angle!)
         Pixel px,py,b(i).c
       Next p
       b(i).pop=b(i).pop-1
       If b(i).pop <=0 Then
         t=b(i).r*10: Play Tone t,t,20
         Circle b(i).x, b(i).y, b(i).r+15,,,0,0
         InitBubble(i)
       EndIf
     EndIf
   Next i
   framebuffer copy F,N
 Loop While Inkey$=""
 
Sub InitBubble(i As INTEGER)
 b(i).r=Int(Rnd*40)+15
 b(i).x=Int(Rnd*(MM.HRES-2*b(i).r))+b(i).r
 b(i).y=Int(Rnd*(MM.VRES-2*b(i).r))+b(i).r
 b(i).dx=(Rnd*4)-2: If b(i).dx=0 Then b(i).dx=1
 b(i).dy=(Rnd*4)-2: If b(i).dy=0 Then b(i).dy=1
 b(i).c=c(Int(Rnd*14)+1)
 b(i).act=1
 b(i).pop=0
End Sub
 
 '--Colorscheme accordung to matherp
 Data RGB(BLUE),RGB(GREEN),RGB(CYAN),RGB(RED)
 Data RGB(MAGENTA),RGB(YELLOW),RGB(WHITE),RGB(MYRTLE)
 Data RGB(COBALT) ,RGB(MIDGREEN),RGB(CERULEAN),RGB(RUST)
 Data RGB(FUCHSIA),RGB(BROWN),RGB(LILAC)

MODE 2
Const NumBoids=30
Dim X(NumBoids), Y(NumBoids)
Dim VX(NumBoids), VY(NumBoids)

For i=1 To NumBoids
 X(i)=Int(Rnd*MM.HRES)
 Y(i)=Int(Rnd*MM.VRES)
 VX(i)=(Rnd*4)-2
 VY(i)=(Rnd*4)-2
Next

Do
 For i=1 To NumBoids
   Pixel X(i),Y(i),0 'Clear
   centerX=0: centerY=0
   avoidX=0: avoidY=0
   alignX=0: alignY=0
   count=0
   For j=1 To NumBoids
     If i<>j Then
       distX=X(j)-X(i)
       distY=Y(j)-Y(i)
       dist=Sqr(distX*distX+distY*distY)
       If dist<100 And dist>0 Then
         centerX=centerX+X(j)
         centerY=centerY+Y(j)
         alignX=alignX+VX(j)
         alignY=alignY+VY(j)
         count=count+1
         If dist<20 Then
           avoidX=avoidX-distX
           avoidY=avoidY-distY
         EndIf
       EndIf
     EndIf
   Next j
   If count>0 Then
     centerX=(centerX/count)-X(i)
     centerY=(centerY/count)-Y(i)
     VX(i)=VX(i)+centerX*.005
     VY(i)=VY(i)+centerY*.005
     alignX=alignX/count
     alignY=alignY/count
     VX(i)=VX(i)+alignX*.05
     VY(i)=VY(i)+alignY*.05
   EndIf
   VX(i)=VX(i)+avoidX*.1
   VY(i)=VY(i)+avoidY*.1
   speed=Sqr(VX(i)*VX(i)+VY(i)*VY(i))
   If speed>4 Then
     VX(i)=(VX(i)/speed)*4
     VY(i)=(VY(i)/speed)*4
   EndIf
   X(i)=X(i)+VX(i)
   Y(i)=Y(i)+VY(i)
   If X(i)<10 Then VX(i)=VX(i)+.5
   If X(i)> MM.HRES-10 Then VX(i)=VX(i)-.5
   If Y(i)<10 Then VY(i)=VY(i)+.5
   If Y(i)>MM.VRES-10 Then VY(i)=VY(i)-.5
   Pixel X(i),Y(i)
 Next i
Loop While Inkey$=""

MODE 3
K=360
Dim SinT(K), CosT(K)
For i=0 To K
 T=i*2*Pi/K: SinT(i)=Sin(T): CosT(i)=Cos(T)
Next
Do
U=120: V=-60: D=2: N=7: A=70
Color Rnd*&HFFFFFF
If Rnd>.5 Then CLS
For J=1 To 40
For T=0 To K*2
Z=A*CosT(((T*N)\D)Mod K)
X=U+Z*CosT(T Mod K)
Y=V+Z*SinT(T Mod K)
E=X*X
R=Sqr(E+Y*Y)
F=Y+K
G=Sqr(E+F*F)
L=Y+60
I=X-120
H=Sqr(I*I+L*L)
If (G>220 And R>K) Then Continue For
If (R>380 And Abs(X)<160 And Abs(X) Mod 32>4 And R Mod 48>4) Then Continue For
If (J>1 And H<90) Then Continue For
If (-300<Y And Y<-160 And -X*2-Y>180) Then Continue For
Pixel 320+X\2,186-Y\2: Pixel 320-X\2,186-Y\2
Next T
U=Rnd*K: V=Rnd*940-520
D=Rnd*3+1: N=Rnd*5+2: A=Rnd*80+50
Color RGB(White)
Next J
Loop While Inkey$=""

'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