Gravity
This one was published in Acorn User (don't ask me which issue). It simulates 24 stars through their mutual gravity. In my original program the stars ended up flying off in all directions. Acorn User didn't like this, so they made me alter it so that the stars all collapsed inwards together (I added a maximum velocity).
|
REM Mutually attractive particles through gravity
REM (c) R Geleit Apr 1993
ON ERROR IF NOTINKEY-1 PROCerror ELSE RUN
MODE0
OFF
stars=24
G=(1<<30)
Maxvel=(1<<25)
PROCassemble
PROCinit_tables
VDU5
CALL run
END
DEF PROCassemble
quant=(stars AND-8)
quan2=FNexp2(stars)+2
blocks=(stars DIV8)-1
tables=(quant<<1)
DIM code 1000
DIM data ((quant<<2)*7),table ((1<<quan2)*(quant<<1))
x1=0
y1=1
m1=2
x2=3
y2=4
m2=5
d2=6
ctr1=7
ctr2=8
fx=x2
fy=y2
ptr=14
x=9
a=10
c=11
sum=12
answ=ptr
divd=x
visr=a
mask=c
sign=sum
ax=x
ay=sum
accm=8
tsad=9
blox=10
dnad=11
sptr=12
tctr=14
FOR T%=0TO2 STEP2
P%=code
[OPTT%
.mtas EQUD data
.axts EQUD data+(quant<<2)
.ayts EQUD data+(quant<<2)*2
.vxts EQUD data+(quant<<2)*3
.vyts EQUD data+(quant<<2)*4
.xtas EQUD data+(quant<<2)*5
.ytas EQUD data+(quant<<2)*6
.fxas EQUD table
.fyas EQUD table+(1<<quan2)*quant
.run STMFD R13!,{R14}
.tlp BL makeft
BL sumft
BL deltav
BL plot
SWI "OS_ReadEscapeState"
BCC tlp
LDMFD R13!,{PC}^
.makeft STMFD R13!,{R14}
MOV ctr1,#quant-1
.lp1 LDR x1,xtas
LDR y1,ytas
LDR m1,mtas
LDR x1,[x1,ctr1,LSL#2]
LDR y1,[y1,ctr1,LSL#2]
LDR m1,[m1,ctr1,LSL#2]
SUB ctr2,ctr1,#1
.lp2 LDR x2,xtas
LDR y2,ytas
LDR m2,mtas
LDR x2,[x2,ctr2,LSL#2]
LDR y2,[y2,ctr2,LSL#2]
LDR m2,[m2,ctr2,LSL#2]
SUB x2,x1,x2
SUB y2,y1,y2
MOV x,x2,asr#17
MOV a,y2,asr#17
MUL d2,x,x
MLA d2,a,a,d2
MOV d2,d2,asr#16
.div MOV divd,#G
MOVS visr,d2
MOVEQ answ,#0
BEQ byzer
EOR sign,divd,visr
CMP divd,#0
RSBLT divd,divd,#0
CMP visr,#0
RSBLT visr,visr,#0
MOV answ,#0
MOV mask,#1
.dlp1 MOV visr,visr,LSL#1
MOV mask,mask,LSL#1
CMP visr,divd
BLS dlp1
MOV visr,visr,LSR#1
MOV mask,mask,LSR#1
.dlp2 CMP visr,divd
ORRLs answ,answ,mask
SUBLs divd,divd,visr
MOV visr,visr,LSR#1
MOVS mask,mask,LSR#1
BNE dlp2
CMP sign,#0
RSBLT answ,answ,#0
.byzer MOV x2,x2,asr#16
MOV y2,y2,asr#16
MOV answ,answ,asr#16
MUL fx,answ,x2
MUL fy,answ,y2
LDR a,fxas
LDR c,fyas
MOV fx,fx,asr#16
MOV fy,fy,asr#16
MOV ptr,ctr2,LSL#quan2
ADD ptr,ptr,ctr1,LSL#2
MUL ax,fx,m1
MUL ay,fy,m1
STR ax,[a,ptr]
STR ay,[c,ptr]
MOV ptr,ctr1,LSL#quan2
ADD ptr,ptr,ctr2,LSL#2
RSB fx,fx,#0
RSB fy,fy,#0
MUL ax,fx,m2
MUL ay,fy,m2
STR ax,[a,ptr]
STR ay,[c,ptr]
SUBS ctr2,ctr2,#1
BPL lp2
SUBS ctr1,ctr1,#1
BNE lp1
LDMFD R13!,{PC}^
.sumft STMFD R13!,{R14}
ldr tsad,fxas
ldr dnad,axts
mov tctr,#0
.smlp2 mov accm,#0
mov blox,#blocks
add sptr,tsad,tctr,LSL#quan2
.smlp1 LDMIA (sptr)!,{R0-R7}
add accm,accm,R0,ASR#2
add accm,accm,R1,ASR#2
add accm,accm,R2,ASR#2
add accm,accm,R3,ASR#2
add accm,accm,R4,ASR#2
add accm,accm,R5,ASR#2
add accm,accm,R6,ASR#2
add accm,accm,R7,ASR#2
subs blox,blox,#1
bpl smlp1
STMIA (dnad)!,{accm}
add tctr,tctr,#1
cmp tctr,#tables
blt smlp2
LDMFD R13!,{PC}^
.deltav STMFD R13!,{R14}
LDR R8,axts
LDR R9,vxts
MOV R10,#((blocks+1)<<2)-1
.dvlp1 LDMIA R8!,{R0-R3}
LDMIA R9,{R4-R7}
ADD R0,R0,R4
ADD R1,R1,R5
ADD R2,R2,R6
ADD R3,R3,R7
STMIA R9!,{R0-R3}
SUBS R10,R10,#1
BPL dvlp1
.deltax LDR R8,vxts
LDR R9,xtas
MOV R10,#((blocks+1)<<2)-1
.dxlp1 LDMIA R8,{R4-R7}
LDMIA R9,{R0-R3}
ADD R0,R0,R4
ADD R1,R1,R5
ADD R2,R2,R6
ADD R3,R3,R7
cmn r4,#Maxvel
mvnle r4,#0
cmn r5,#Maxvel
mvnle r5,#0
cmn r6,#Maxvel
mvnle r6,#0
cmn r7,#Maxvel
mvnle r7,#0
cmp r4,#Maxvel
movge r4,#0
cmp r5,#Maxvel
movge r5,#0
cmp r6,#Maxvel
movge r6,#0
cmp r7,#Maxvel
movge r7,#0
stmIA R9!,{R0-R3}
STMIA R8!,{R4-R7}
SUBS R10,R10,#1
BPL dxlp1
LDMFD R13!,{PC}^
.plot STMFD R13!,{R14}
MOV R0,#19
SWI "OS_Byte"
LDR R12,scnst
MOV R0,#0
MOV R1,#0
MOV R2,#0
MOV R3,#0
MOV R4,#0
MOV R5,#0
MOV R6,#0
MOV R7,#0
MOV R8,#0
MOV R9,#0
MOV R10,#0
MOV R11,#0
MOV R14,#127
.clslp STMIA R12!,{R0-R11}
STMIA R12!,{R0-R11}
STMIA R12!,{R0-R11}
STMIA R12!,{R0-R3}
SUBS R14,R14,#1
BPL clslp
MOV R0,#4
MOV R5,#quant
LDR R3,xtas
LDR R4,ytas
.pllp LDMIA R3!,{R1}
LDMIA R4!,{R2}
MOV R1,R1,LSR#22
MOV R2,R2,LSR#22
SWI "OS_Plot"
SWI &18F
SUBS R5,R5,#1
BNE pllp
LDMFD R13!,{PC}^
.scnst EQUD !&10C0
]
NEXT
ENDPROC
DEF PROCinit_tables
FOR T%=(quant<<2)*5 TO (quant<<2)*7-1 STEP4
data!T%=RND
NEXT
FOR T%=(quant<<2)*3 TO (quant<<2)*5-1 STEP4
data!T%=RND(1<<22)-RND(1<<22)
NEXT
FOR T%=0 TO (quant<<2)*3-1 STEP4
data!T%=RND(1<<14)+(1<<13)
NEXT
FOR T%=0 TO ((1<<quan2)*(quant<<1))-1 STEP4
table!T%=0
NEXT
ENDPROC
DEF FNexp2(A%)
LOCAL C%
C%=0
REPEAT C%+=1
UNTIL (1<<C%)>=A%
=C%
DEF PROCerror
VDU4
PRINT REPORT$;" at line ";STR$(ERL/10)
REM OSCLI("SAVE RAM:$.PLOPPY "+STR$~table+"+"+STR$~((1<<quan2)*(quant<<1)))
END