Mandelbrot Fractal
Acorn computers don't have floating point chips so I wrote my own routines for this program. I wrote a divide routine as well but that is not used here. Subtraction was the trickiest one!
|
REM Mandlebrot to 256 colour sprite (c) R Geleit February 1995
ONERRORPROCerror
MODE13
OFF
VDU24,0;0;1023;1023;
VDU28,32,31,39,0
GCOL4,7
X=-2
Y=-1.25
S=2.5
PROCassemble
REPEAT
T%=TIME
CALLdrawmb
T%=TIME-T%
PROCnewxys
UNTIL0
END
DEFPROCassemble
DIM codespace 2000
REM GLOBAL
Fma=0
Fea=1
Fm1=2
Fe1=3
Fm2=4
Fe2=5
REM MAIN LOOP
x=11
y=12
c=8
to=9
REM FLOATING POINT
mman1=Fe1
mman2=Fe2
lman1=6
lman2=7
shift=7
mask=9
maskh=10
FORT%=0TO2 STEP2
P%=codespace
[OPTT%
ALIGN
.drawmb STMFD R13!,{R0-R12,R14}
MVN x,#0
LDR Fm1,cxm
LDR Fe1,cxe
STR Fm1,Xm
STR Fe1,Xe
.oloop LDR Fm1,cym
LDR Fe1,cye
STR Fm1,Ym
STR Fe1,Ye
LDR Fm1,Xm
LDR Fe1,Xe
LDR Fm2,pixm
LDR Fe2,pixe
BL add
STR Fma,Xm
STR Fea,Xe
MOV y,#255
ADD x,x,#1
.iloop LDR Fm1,Ym
LDR Fe1,Ye
LDR Fm2,pixm
LDR Fe2,pixe
BL add
STR Fma,Ym
STR Fea,Ye
BL docalc
LDR to,stscn
MOV Fma,#320
MLA to,Fma,y,to
STRB c,[to,x]
SUBS y,y,#1
BGE iloop
SWI "OS_ReadEscapeState"
BCS quit
CMP x,#255
BLT oloop
.quit LDMFD R13!,{R0-R12,PC}^
.docalc STMFD R13!,{R14}
ADR r14,Xm
LDMIA r14!,{Fm1,Fe1,Fm2,Fe2}
STMIA r14,{Fm1,Fe1,Fm2,Fe2}
MOV c,#0
.cloop LDR Fm1,xm
LDR Fe1,xe
BL sqr
STR Fma,xxm
STR Fea,xxe
LDR Fm1,ym
LDR Fe1,ye
BL sqr
STR Fma,yym
STR Fea,yye
ADR r14,xm
LDMIA r14,{Fm1,Fe1,Fm2,Fe2}
BL mult \ get xy
MOV Fm1,Fma
ADD Fe1,Fea,#1 \ *2
LDR Fm2,Ym
LDR Fe2,Ye
BL add \ y'=y+2xy
STR Fma,ym
STR Fea,ye
ADR r14,xxm
LDMIA r14,{Fm1,Fe1,Fm2,Fe2}
EOR Fm2,Fm2,#1<<31
BL add \ get x*x-y*y
MOV Fm1,Fma
MOV Fe1,Fea
LDR Fm2,Xm
LDR Fe2,Xe
BL add \ x'=x+x*x-y*y
STR Fma,xm
STR Fea,xe
ADD c,c,#1
ADR r14,xxm
LDMIA r14,{Fm1,Fe1,Fm2,Fe2}
BL add
CMP Fea,#2
BGE fin \ x*x+y*y>4 ?
CMP c,#1024 \ max iterations
BLT cloop
.fin LDMFD R13!,{PC}
.sqr LDR maskh,maskhl \ square
MOV Fea,Fe1,LSL#1
ORR Fm1,Fm1,#1<<31
AND lman1,Fm1,maskh
MOV Fm1,Fm1,LSR#16
MULS Fma,lman1,Fm1
MOV Fma,Fma,RRX
MOV Fma,Fma,LSR#14
MLAS Fma,Fm1,Fm1,Fma
MOVPL Fma,Fma,ASL#1
ADDMI Fea,Fea,#1
EOR Fma,Fma,#1<<31
MOV pc,r14
.ex1 EQUD 0
.man1 EQUD 0
.ex2 EQUD 0
.man2 EQUD 0
.aex EQUD 0
.aman EQUD 0
.maskhl EQUD &0000FFFF
.stscn EQUD !&10C0
.Xm EQUD 0
.Xe EQUD 1<<31
.Ym EQUD 0
.Ye EQUD 1<<31
.xm EQUD 0
.xe EQUD 1<<31
.ym EQUD 0
.ye EQUD 1<<31
.xxm EQUD 0
.xxe EQUD 1<<31
.yym EQUD 0
.yye EQUD 1<<31
.count EQUD 0
.cxm EQUD FNtoman(X)
.cxe EQUD FNtoexp(X)
.cym EQUD FNtoman(Y)
.cye EQUD FNtoexp(Y)
.pixm EQUD FNtoman(S/256)
.pixe EQUD FNtoexp(S/256)
.mult MOV mask,#1<<31
LDR maskh,maskhl
CMP Fe1,mask
BEQ zerout
CMP Fe2,mask
BEQ zerout
ADD Fea,Fe1,Fe2
AND Fe1,mask,Fm1
ORR Fm1,mask,Fm1
BIC Fe2,mask,Fm2
ORR Fm2,mask,Fm2
EOR mask,Fe1,Fe2
AND lman1,Fm1,maskh
AND lman2,Fm2,maskh
MOV Fm1,Fm1,LSR#16
MOV Fm2,Fm2,LSR#16
MUL mman1,lman1,Fm2
MUL mman2,lman2,Fm1
ADDS Fma,mman1,mman2
MOV Fma,Fma,RRX
MOV Fma,Fma,LSR#16-1
MLAS Fma,Fm1,Fm2,Fma
MOVPL Fma,Fma,ASL#1
ADDMI Fea,Fea,#1
EOR Fma,mask,Fma
MOV pc,r14
.add STMFD R13!,{R14}
MOV mask,#1<<31
\ CMP Fe1,mask
\ BEQ ok1
\ CMP Fe2,mask
\ BEQ ok2
CMP Fe1,Fe2
BLLT swap
MOV Fea,Fe1
SUB shift,Fe1,Fe2
\ CMP shift,#32
\ MOVGE Fma,Fm1
\ BGE out
AND Fe1,Fm1,mask
AND Fe2,Fm2,mask
ORR Fm1,Fm1,mask
ORR Fm2,Fm2,mask
MOV Fm2,Fm2,LSR shift
EORS Fma,Fe1,Fe2
BPL same
.difrnt CMP Fm1,Fm2
BLLT swap
CMP shift,#0
BEQ revsb
SUBS Fma,Fm2,Fm1
EORMI Fma,Fe1,Fma
LDMMIFD R13!,{PC}
MOVPL Fe2,Fe1
BPL totopb+4
.revsb SUBS Fma,Fm1,Fm2
SUBMI Fea,Fea,#1
.totopb MOVMIS Fma,Fma,ASL#1
SUBPL Fea,Fea,#1
FNleft(3)
BMI enuf
FNleft(14)
BMI enuf
FNleft(14)
.enuf EOR Fma,Fe2,Fma
LDMFD R13!,{PC}
.same ADDS Fma,Fm1,Fm2
ADDCS Fea,Fea,#1
ORRCS Fma,mask,Fma,LSR#1
BIC Fma,Fma,mask
ORR Fma,Fma,Fe1
LDMFD R13!,{PC}
.zerout MOV Fea,mask
MOV Fma,#0
.out LDMFD R13!,{PC}
.swap STMFD R13!,{Fea,R14}
MOV Fea,Fe1
MOV Fe1,Fe2
MOV Fe2,Fea
MOV Fma,Fm1
MOV Fm1,Fm2
MOV Fm2,Fma
LDMFD R13!,{Fea,PC}
.ok1 MOV Fea,Fe2
MOV Fma,Fm2
LDMFD R13!,{PC}
.ok2 MOV Fea,Fe1
MOV Fma,Fm1
LDMFD R13!,{PC}
]
NEXT
ENDPROC
DEFFNleft(howmany)
LOCALA%
FORA%=1TOhowmany
[OPTT%
MOVPLS Fma,Fma,ASL#1
SUBPL Fea,Fea,#1
]
NEXTA%
=""
DEFFNtoreal(mant,expn)
mant=!mant
expn=!expn
IF expn=1<<31 THEN=0
=-1^(mant>>>31)*2^expn*(1+ABS((mant AND&7FFFFFFF)/1<<31))
DEFFNtoexp(float)
IF float=0 THEN=1<<31
float=ABSfloat
LOCALA%
A%=0
WHILE float>=2
float=float/2
A%=A%+1
ENDWHILE
WHILE float<1
float=float*2
A%=A%-1
ENDWHILE
=A%
DEFFNtoman(float)
IF float=0 THEN=0
LOCALA%,S%
S%=(SGNfloat-1)/-2
float=ABSfloat
WHILE float>=2
float=float/2
ENDWHILE
WHILE float<1
float=float*2
ENDWHILE
A%=2^31*(float-1)
A%=A%+(S%<<31)
=A%
DEFPROCnewxys
LOCAL A$,X%,Y%,S%,Z%,R%,D%
CLS
PRINT"TIME:"'STR$(T%/100);"s "''"SAVE?"
A$=GET$
IF A$="y" OR A$="Y" THEN *screensave $.frac
PRINT'"Mouse:"''" €‹Š"'" SMA"
S%=100
REPEAT
RECTANGLEX%,Y%,S%
WAIT
RECTANGLEX%,Y%,S%
MOUSEX%,Y%,Z%
X%=X%-(S%>>1)
Y%=Y%-(S%>>1)
S%=S%+2*(Z%AND2)-4*(Z%AND1)
IFS%<9 S%=9
IFS%>1024 S%=1024
UNTIL Z%AND4
X=X+X%/1024*S
Y=Y+Y%/1024*S
S=S*S%/1024
P%=cxm
[OPT2
EQUD FNtoman(X)
EQUD FNtoexp(X)
EQUD FNtoman(Y)
EQUD FNtoexp(Y)
EQUD FNtoman(S/256)
EQUD FNtoexp(S/256)
]
ENDPROC
DEFPROCerror
REPORT
PRINT'"at line:";ERL/10
END