file_id.diz
REM >Trackman
REM By Jan Vlietinck
save=TRUE
RE=FALSE
PROCinit(13)
REPEAT
A$=CHR$((ASC GET$) AND NOT 32)
IF help THEN PROChelp:help=FALSE
CASE A$ OF
WHEN "M":PROCmandle:MAN=TRUE
WHEN "J":PROCjulia:MAN=FALSE
WHEN "S":PROCsave
WHEN "R":IF MAN THEN PROCinit_mandle(-2,-2,4) ELSE PROCinit_julia
WHEN "C":PROCcycle_up
WHEN "D":PROCcycle_down
WHEN "V":VIDEO=NOT VIDEO
WHEN "N":PROCmode_change
WHEN "Q":IF INKEY(-1) PROCmake
WHEN "H":PROChelp
ENDCASE
UNTIL 0
END
DEF PROChelp
VDU 5
MOVE 0,Ey-16
PRINT "The following keys can be used"'
PRINT "'M' : to generate a mandelbrot fractal"
PRINT "'J' : to generate a julia fractal"
PRINT "'R' : to redraw the initial fractal"
PRINT "'D' : to cycle the colors up"
PRINT "'C' : to cycle the colors down"
PRINT "'V' : to turn on/off the video DMA"
PRINT "'S' : to save the screen"
PRINT "'N' : to change to another video mode"
PRINT "'H' : to show this help"''
PRINT "The mouse buttons are"'
PRINT "Left : zoom out"
PRINT "Right : zoom in"
PRINT "Middle : start generating"''
PRINT "Supported modes are: 9,13,20,21,27,28,31"
VDU4:OFF
help=TRUE
ENDPROC
DEF PROCsave
VDU 5
MOVE 0,Ey-16:INPUT "Enter the name of the screen ? "S$
MOVE 0,Ey-16:PRINT "Enter the name of the screen ? "S$
VDU4:OFF
OSCLI "SCREENSAVE "+S$
ENDPROC
DEF PROCmake
PROCinit_mandle(-1.5,-1.25,2.5)
PROCASS
CALL set
CALL read
CASE MODE OF
WHEN 13
MODE 1:OFF
CALL set
CALL write
*SCREENSAVE MANDEL
WHEN 21
MODE 19:OFF
CALL set
CALL write
*SCREENSAVE HMANDEL
ENDCASE
END
ENDPROC
DEF PROCmode_change
RE=TRUE
VDU 26
REPEAT
INPUT "New mode ";Mode
PROCinit(Mode)
UNTIL Mode<>-1
IF MAN THEN
PROCmandle_redraw
ELSE
PROCjulia_redraw
ENDIF
ENDPROC
DEF PROCmandle_redraw
!OXD=OX*2^29
!OYD=OY*2^29
!FD=SC/Col*2^29
!DD=ITER
IF ((!FD) >> 16) <> 0 THEN !method=iterationL ELSE !method=iterationH
IF first_mandle THEN PROCinit_mandle(-2,-2,4) ELSE PROC_draw(mandle)
new_mandle=TRUE
ENDPROC
DEF PROCjulia_redraw
!JXD=JX*2^29
!JYD=JY*2^29
!JFD=JS/Col*2^29
!JDD=JITER
!AD=AT
!BD=BT
IF (!JFD >> 20 ) <> 0 THEN !method=juliaL ELSE !method=juliaH
IF first_julia THEN PROCinit_julia ELSE PROC_draw(mandle)
RE=TRUE
ENDPROC
DEF PROCjulia
IF choose_julia THEN
IF new_mandle AND save THEN
*SCREENSAVE FRACTAL
ENDIF
REPEAT
MOUSE X%,Y%,Z%
LINE X%-64,Y%,X%+64,Y%
LINE X%,Y%-64,X%,Y%+64
WAIT
LINE X%-64,Y%,X%+64,Y%
LINE X%,Y%-64,X%,Y%+64
UNTIL Z%=2
AT=(OX+X%/Ex*SC)*2^29
BT=(OY+(Ey-Y%)/Ex*SC)*2^29
!AD=AT
!BD=BT
PROCinit_julia
choose_julia=FALSE
ELSE
first_julia=FALSE
*FX 5
W%=Ex/4
REPEAT
MOUSE X%,Y%,Z%
IF Z%=4 THEN W%+=4
IF Z%=1 THEN W%-=4
RECTANGLE X%,Y%,W%,W%*Ratio
WAIT
RECTANGLE X%,Y%,W%,W%*Ratio
UNTIL Z%=2
VDU 26
INPUT "Iterations ",JITER
IF JITER=0 THEN JITER=100
JX=JX+X%/Ex*JS
JY=JY+(Ey-(Y%+W%*Ratio))/Ex*JS
JS=JS*W%/Ex
!JXD=JX*2^29
!JYD=JY*2^29
!JFD=JS/Col*2^29
!JDD=JITER
IF (!JFD >> 20 ) <> 0 THEN !method=juliaL ELSE !method=juliaH
PROC_draw(mandle)
ENDIF
ENDPROC
DEF PROCmandle
choose_julia=TRUE
IF RE=TRUE THEN
PROCmandle_redraw
new_mandle=TRUE
RE=FALSE
ENDPROC
ENDIF
IF MAN=FALSE THEN
IF save THEN
*SCREENLOAD FRACTAL
ELSE
PROCmandle_redraw
ENDIF
new_mandle=FALSE
ENDPROC
ENDIF
first_mandle=FALSE
new_mandle=TRUE
*FX 5
W%=Ex/4
REPEAT
MOUSE X%,Y%,Z%
IF Z%=4 THEN W%+=4
IF Z%=1 THEN W%-=4
RECTANGLE X%,Y%,W%,W%*Ratio
WAIT:WAIT
RECTANGLE X%,Y%,W%,W%*Ratio
UNTIL Z%=2
VDU 26
INPUT "Iterations ",ITER
IF ITER=0 THEN ITER=100
OX=OX+X%/Ex*SC
OY=OY+(Ey-(Y%+W%*Ratio))/Ex*SC
SC=SC*W%/Ex
!OXD=OX*2^29
!OYD=OY*2^29
!FD=SC/Col*2^29
!DD=ITER
IF ((!FD) >> 16) <> 0 THEN !method=iterationL ELSE !method=iterationH
PROC_draw(mandle)
ENDPROC
DEF PROCcycle_up
IF Nr_Cols=16 THEN
FOR N%=1 TO CS%:T%=15-CS%+N%:COLOUR N%,C1%(T%),C2%(T%),C3%(T%):NEXT
IF CS%<>15 THEN
FOR N%=CS%+1 TO 15:T%=N%-CS%:COLOUR N%,C1%(T%),C2%(T%),C3%(T%):NEXT
ENDIF
CS%=CS% MOD 15 +1
ELSE
!CTD=UPCTABLE
CALL cycle
ENDIF
ENDPROC
DEF PROCcycle_down
IF Nr_Cols=16 THEN
FOR N%=1 TO CS%:T%=15-CS%+N%:COLOUR N%,C1%(T%),C2%(T%),C3%(T%):NEXT
IF CS%<>15 THEN
FOR N%=CS%+1 TO 15:T%=N%-CS%:COLOUR N%,C1%(T%),C2%(T%),C3%(T%):NEXT
ENDIF
IF CS%=1 THEN CS%=15 ELSE CS%-=1
ELSE
!CTD=DOWNCTABLE
CALL cycle
ENDIF
ENDPROC
DEF PROCinit(M)
Mode=M
CASE Mode OF
WHEN 9:Col=320:Row=256:Ex=4*Col:Ey=4*Row:Nr_Cols=16
WHEN 20:Col=640:Row=512:Ex=2*Col:Ey=2*Row:Nr_Cols=16
WHEN 27:Col=640:Row=480:Ex=2*Col:Ey=2*Row:Nr_Cols=16
WHEN 31:Col=800:Row=600:Ex=2*Col:Ey=2*Row:Nr_Cols=16
WHEN 13:Col=320:Row=256:Shf=6:Ex=4*Col:Ey=4*Row:Nr_Cols=256
WHEN 21:Col=640:Row=512:Shf=7:Ex=2*Col:Ey=2*Row:Nr_Cols=256
WHEN 28:Col=640:Row=480:Shf=7:Ex=2*Col:Ey=2*Row:Nr_Cols=256
OTHERWISE PRINT"Sorry, mode not supported":Mode=-1:ENDPROC
ENDCASE
Ratio=Ey/Ex
IF NOT RE THEN
DIM CTABLE 256
DIM C1%(15),C2%(15),C3%(15)
DIM Q1% 2000
DIM Q2% 2000
DIM Qjul% 1400:Qjul%=16*(Qjul%DIV16)+16
DIM Qmand% 1400:Qmand%=16*(Qmand%DIV16)+16
PROCcoltable(CTABLE)
PROCinvtable
PROCASS0
ENDIF
MODE Mode
IF Nr_Cols=16 THEN
FOR N%=1 TO 15
F1%=24*N%:F2%=F1%+120:F3%=F1%+240
C1%(N%)=128*(SINRADF1%+1)
C2%(N%)=128*(SINRADF2%+1)
C3%(N%)=128*(SINRADF3%+1)
COLOUR N%,C1%(N%),C2%(N%),C3%(N%)
NEXT
ENDIF
CS%=15
OFF:GCOL 3,63
*POINTER
MOUSE ON
PROCmand
PROCjul
IF Nr_Cols=256 THEN
PROCASS1
ELSE
PROCASS2
ENDIF
IF NOT RE THEN
first_julia=TRUE
MAN=TRUE
VIDEO=TRUE
PROCinit_mandle(-2,-2,4)
PROChelp
ENDIF
RE=FALSE
ENDPROC
DEF PROCinit_mandle(X,Y,S)
new_mandle=TRUE
SC=S:OX=X:OY=Y*Ratio+SC/Col
ITER=100
!OXD=OX*2^29
!OYD=OY*2^29
!FD=SC/Col*2^29
!DD=ITER
!method=iterationL
PROC_draw(mandle_half)
first_mandle=TRUE
choose_julia=TRUE
ENDPROC
DEF PROCinit_julia
JX=-1.5:JY=-1.5*Ratio:JS=3
JITER=100
!JXD=JX*2^29
!JYD=JY*2^29
!JFD=JS/Col*2^29
!JDD=JITER
!method=juliaL
PROC_draw(julia_half)
first_julia=TRUE
ENDPROC
DEF PROC_draw(fractal)
REMON ERROR IF ERR=17 AND INKEY(-1) THEN END ELSE ENDPROC
CLG
TIME=0
IF NOT VIDEO CALL Video_off
CALL set
IF USR fractal THEN CALL filler
IF NOT VIDEO CALL Video_on
VDU 5:MOVE Ex*(1-84/Col),Ey*(1-4/Row)
GCOL 63:PRINT TIME/100:VDU 4
OFF:GCOL 3,63
*FX 5
ENDPROC
DEF PROCASS
DIM Q% 2000
DIM BUFF Row*Col/4
T=0:K=1:H=2:A=3:B=4:X=5:Y=6:W=7:D=8:SCR=9:S=10:CO=11:C=12:BUF=7
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
FNSCREEN
.BUFFER EQUD BUFF
.read
LDR SCR,screen
LDR BUF,BUFFER
MOV CO,#Row*Col
MOV S,#255
MOV H,#2
.rloop
MOV K,#0
LDR T,[SCR],#4
TST T,S,LSL #8*3
MOVNE K,H,LSL #2*3
TST T,S,LSL #8*2
ORRNE K,K,H,LSL #2*2
TST T,S,LSL #8
ORRNE K,K,H,LSL #2
TST T,S
ORRNE K,K,H
STRB K,[BUF],#1
SUBS CO,CO,#4
BNE rloop
MOV PC,R14
.write
LDR SCR,screen
LDR BUF,BUFFER
MOV CO,#Row*Col
.wloop
LDR T,[BUF],#4
STR T,[SCR],#4
SUBS CO,CO,#16
BNE wloop
MOV PC,R14
]
NEXT
ENDPROC
DEF PROCASS0
LOCAL Q%,P%
DIM Q% 200
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.Video_on
MVN R0,#0
MOV R1,#1<<10
SWI "OS_UpdateMEMC"
MOV PC,R14
.Video_off
MOV R0,#0
MOV R1,#1<<10
SWI "OS_UpdateMEMC"
MOV PC,R14
]
NEXT
ENDPROC
DEF PROCASS1
Q%=Q1%
T=0:K=1:H=2:A=3:B=4:X=5:Y=6:W=7:D=8:SCR=9:S=10:CO=11:C=12:SP=13
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
FNSCREEN
.CTD EQUD 0
.cycle
LDR SCR,screen
ADD K,SCR,#Row*Col
MOV H,#255
LDR W,CTD
MOV D,#1<<10
.cycleloop
LDR T,[SCR]
AND A,H,T
CMP A,D
LDRNEB B,[W,A]
MOV C,B
AND D,H,T,LSR #8
CMP A,D
LDRNEB B,[W,D]
ADD C,C,B,LSL #8
AND A,H,T,LSR #16
CMP A,D
LDRNEB B,[W,A]
ADD C,C,B,LSL #16
AND D,H,T,LSR #24
CMP A,D
LDRNEB B,[W,D]
ADD C,C,B,LSL #24
STR C,[SCR],#4
CMP SCR,K
BLO cycleloop
MOV PC,R14
.filler
LDR SCR,screen
ADD K,SCR,#Row*Col
.vulloop
LDR CO,[SCR]
ANDS X,CO,#&000000FF
MOVNE T,X
CMP T,#255
MOVEQ T,#0
MOV C,T
ANDS X,CO,#&0000FF00
MOVNE T,X,LSR #8
CMP T,#255
ORRNE C,C,T,LSL #8
ANDS X,CO,#&00FF0000
MOVNE T,X,LSR #16
CMP T,#255
ORRNE C,C,T,LSL #16
ANDS X,CO,#&FF000000
MOVNE T,X,LSR #24
CMP T,#255
ORRNE C,C,T,LSL #24
STR C,[SCR],#4
CMP SCR,K
BLO vulloop
MOV PC,R14
]
NEXT
Q%=P%
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.stack EQUD 0
.method EQUD iterationL
.mandle
FN_TRACK1(Nr_Cols,Row,Col,Shf)
FN_TRACK2(Nr_Cols,Row,Col,Shf)
]
NEXT
Q%=P%
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.mandle_half
FN_TRACK1(Nr_Cols,Row/2+12,Col,Shf)
ADD S,B,B,LSL #2
SUB S,A,S,LSL #Shf
ADD S,S,#Row*Col
SUB S,S,#2*Col
STRB T,[S,SCR]
FN_TRACK2(Nr_Cols,Row,Col,Shf)
]
NEXT
Q%=P%
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.julia_half
FN_TRACK1(Nr_Cols,Row/2,Col,Shf)
RSB S,S,#Row*Col
SUB S,S,#1
SUB S,S,#0
STRB T,[S,SCR]
FN_TRACK2(Nr_Cols,Row,Col,Shf)
]
NEXT
ENDPROC
DEF PROCASS2
Q%=Q2%
T=0:K=1:H=2:A=3:B=4:X=5:Y=6:W=7:D=8:SCR=9:S=10:CO=11:C=12:SP=13:G=14
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
FNSCREEN
.filler
LDR SCR,screen
MOV S,#Row
MOV T,#Col
MUL T,S,T
ADD K,SCR,T,LSR #1
.vulloop
LDR CO,[SCR]
ANDS X,CO,#&0000000F
MOVNE T,X
CMP T,#15
MOVEQ T,#0
MOV C,T
ANDS X,CO,#&000000F0
MOVNE T,X,LSR #4
CMP T,#15
ORRNE C,C,T,LSL #4
ANDS X,CO,#&00000F00
MOVNE T,X,LSR #8
CMP T,#15
ORRNE C,C,T,LSL #8
ANDS X,CO,#&0000F000
MOVNE T,X,LSR #12
CMP T,#15
ORRNE C,C,T,LSL #12
ANDS X,CO,#&000F0000
MOVNE T,X,LSR #16
CMP T,#15
ORRNE C,C,T,LSL #16
ANDS X,CO,#&00F00000
MOVNE T,X,LSR #20
CMP T,#15
ORRNE C,C,T,LSL #20
ANDS X,CO,#&0F000000
MOVNE T,X,LSR #24
CMP T,#15
ORRNE C,C,T,LSL #24
ANDS X,CO,#&F0000000
MOVNE T,X,LSR #28
CMP T,#15
ORRNE C,C,T,LSL #28
STR C,[SCR],#4
CMP SCR,K
BLO vulloop
MOV PC,R14
]
NEXT
Q%=P%
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.stack EQUD 0
.method EQUD iterationL
.mandle
FN_TRACK1(Nr_Cols,Row,Col,Shf)
FN_TRACK2(Nr_Cols,Row,Col,Shf)
]
NEXT
Q%=P%
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.mandle_half
FN_TRACK1(Nr_Cols,Row,Col,Shf)
RSB B,B,#Row
SUB B,B,#2
MOV S,#Col
MUL S,B,S
ADD S,S,A
ADD B,B,#2
RSB B,B,#Row
STRB G,[SCR,S,LSR #1]
FN_TRACK2(Nr_Cols,Row,Col,Shf)
]
NEXT
Q%=P%
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.julia_half
FN_TRACK1(Nr_Cols,Row/2,Col,Shf)
RSB B,B,#Row
MOV S,#Col
MUL S,B,S
SUB S,S,A
SUB S,S,#1
MOV G,G,LSL #4
ADD G,G,G,LSR #8
STRB G,[SCR,S,LSR #1]
RSB B,B,#Row
FN_TRACK2(Nr_Cols,Row,Col,Shf)
]
NEXT
ENDPROC
DEF FNSCREEN
[OPT PASS
.screen1 EQUD 148:EQUD -1
.screen EQUD 0
.set
ADR R0,screen1
ADR R1,screen
SWI "OS_ReadVduVariables"
MOV PC,R14
]:=""
DEF FN_TRACK1(Nr_Cols,Row,Col,Shf)
[OPT PASS
STMFD (SP)!,{14}
LDR SCR,screen
MOV A,#0
MOV B,#0
MOV R14,PC
LDR PC,method
STRB T,[SCR]
MOV S,#0
STR SP,stack
STMFD (SP)!,{S}
.while_1
LDR T,stack
CMP SP,T
MVNEQ R0,#0
BEQ endwhile_1
.track
LDMFD (SP)!,{S}
MOV D,S,LSR #28
BIC S,S,D,LSL #28
MOV C,S,LSR #20
BIC S,S,C,LSL #20
MOV Y,S,LSR #10
BIC X,S,Y,LSL #10
]
IF Nr_Cols=256 THEN
[OPT PASS
ADD S,Y,Y,LSL #2
ADD S,X,S,LSL #Shf
LDRB K,[SCR,S]
]
ELSE
[OPT PASS
MOV T,#Col
MUL S,Y,T
ADD S,X,S
LDRB K,[SCR,S,LSR #1]
TST S,#1
BICEQ K,K,#&F0
MOVNE K,K,LSR #4
]
ENDIF
[OPT PASS
MOV H,S
MOV W,#0
.while_2
ADD D,D,#5
CMP K,#Nr_Cols-1
BICEQ D,D,#1
MOV CO,#8
.loop
SUBS CO,CO,#1
BEQ endtrack
ADD A,X,#1
MOV B,Y
ADD D,D,#1
CMP K,#Nr_Cols-1
ADDEQ D,D,#1
AND D,D,#%111
CMP D,#1
ADDHS B,Y,#1
CMP D,#2
SUBHS A,A,#1
CMP D,#3
SUBHS A,A,#1
CMP D,#4
SUBHS B,B,#1
CMP D,#5
SUBHS B,B,#1
CMP D,#6
ADDHS A,A,#1
CMP D,#7
ADDHS A,A,#1
CMP A,#Col
CMPLO B,#Row
MVNHS C,#0
BHS loop
]
IF Nr_Cols=256 THEN
[OPT PASS
ADD S,B,B,LSL #2
ADD S,A,S,LSL #Shf
CMP H,S:BEQ endtrack
LDRB T,[SCR,S]
]
ELSE
[OPT PASS
MOV T,#Col
MUL S,B,T
ADD S,S,A
CMP H,S:BEQ endtrack
LDRB G,[SCR,S,LSR #1]
TST S,#1
BICEQ T,G,#&F0
MOVNE T,G,LSR #4
]
ENDIF
[OPT PASS
CMP T,K
ADDEQ W,W,#1
CMP CO,#5
CMPNE W,#8
BHI endtrack
CMP T,#0
BNE endif_3
MOV R14,PC
LDR PC,method
]
IF Nr_Cols=256 THEN
[OPT PASS
STRB T,[S,SCR]
]
ELSE
[OPT PASS
LDRB G,[SCR,S,LSR #1]
TST S,#1
ADDEQ G,G,T
ADDNE G,G,T,LSL #4
STRB G,[SCR,S,LSR #1]
]
ENDIF
=""
DEF FN_TRACK2(Nr_Cols,Row,Col,Shf)
[OPT PASS
CMP T,K
MOVEQ W,#0
BEQ endif_2
CMP T,C
BEQ endif_1
ADD S,A,B,LSL #10
ADD S,S,C,LSL #20
ADD S,S,D,LSL #28
STMFD (SP)!,{S}
MOV C,T
.endif_1
.endif_2
.endif_3
CMP T,K
BNE loop
MOV X,A
MOV Y,B
BAL while_2
.endtrack
SWI "OS_ReadEscapeState"
BCC while_1
MOV R0,#&7C
SWI "OS_Byte"
MOV R0,#0
.endwhile_1
LDR SP,stack
LDMFD (SP)!,{PC}
]:=""
DEF PROCcoltable(CTABLE)
SWP=2
C=0:M=15
FOR K=0 TO M
PROCput(C+(K AND %1100)*5.25,K AND %11)
NEXT
FOR T=1 TO 3
C=T:M=4*(4-T)-1
PROCside( 4)
PROCside(- 1)
PROCside( 16)
PROCside(- 4)
PROCside( 1)
PROCside(-16)
NEXT
ENDPROC
DEF PROCside(RGB)
FOR I=1 TO T
C+=RGB
IF SWP=1 THEN
FOR K=0 TO M
PROCput(C+(K AND %1100)*5.25,K AND %11)
NEXT
ELSE
FOR K=M TO 0 STEP -1
PROCput(C+(K AND %1100)*5.25,K AND %11)
NEXT
ENDIF
SWP=SWP EOR 3
NEXT
ENDPROC
DEF PROCput(C,T)
B1=(C>>5) AND 1
B2=(C>>4) AND 1
G1=(C>>3) AND 1
G2=(C>>2) AND 1
R1=(C>>1) AND 1
R2=(C>>0) AND 1
COL=T+4*(R2+2*(B2+2*(R1+2*(G2+2*(G1+2*B1)))))
?CTABLE=COL
CTABLE+=1
ENDPROC
DEF PROCinvtable
DIM UPCTABLE 256
DIM DOWNCTABLE 256
FOR I=1 TO 254
C=CTABLE?(I)
UPCTABLE?C=CTABLE?(I+1)
NEXT
C=CTABLE?(255)
UPCTABLE?C=CTABLE?(1)
UPCTABLE?0=0
FOR I=2 TO 255
C=CTABLE?(I)
DOWNCTABLE?C=CTABLE?(I-1)
NEXT
C=CTABLE?(1)
DOWNCTABLE?C=CTABLE?(255)
DOWNCTABLE?0=0
ENDPROC
DEF PROCmand
Q%=Qmand%
A=3:B=4:H=5:P=6:S=7:U=8:V=9:D=10:M=11:N=12:T=0
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.DD EQUD 0
.OXD EQUD 0
.OYD EQUD 0
.FD EQUD 0
.CT EQUD CTABLE
.iterationH
STMFD 13!,{1-12}
LDR U,OXD
LDR V,OYD
LDR D,FD
MLA A,D,A,U
MLA B,D,B,V
MOV U,A
MOV V,B
LDR D,DD
FNfractalH
]
NEXT PASS
Q%=P%
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.iterationL
STMFD 13!,{1-12}
LDR U,OXD
LDR V,OYD
LDR D,FD
MLA A,D,A,U
MLA B,D,B,V
MOV A,A,ASR #16
MOV B,B,ASR #16
MOV U,A
MOV V,B
LDR D,DD
FNfractalL
]
NEXT PASS
ENDPROC
DEF PROCjul
Q%=Qjul%
A=3:B=4:H=5:P=6:S=7:U=8:V=9:D=10:M=11:N=12:T=0
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.AD EQUD 0
.BD EQUD 0
.JDD EQUD 0
.JXD EQUD 0
.JYD EQUD 0
.JFD EQUD 0
.CT EQUD CTABLE
.juliaH
STMFD 13!,{1-12}
LDR U,JXD
LDR V,JYD
LDR D,JFD
MLA U,D,A,U
MLA V,D,B,V
LDR A,AD
LDR B,BD
LDR D,JDD
FNfractalH
]
NEXT PASS
Q%=P%
FOR PASS=0 TO 2 STEP 2
P%=Q%
[OPT PASS
.juliaL
STMFD 13!,{1-12}
LDR U,JXD
LDR V,JYD
LDR D,JFD
MLA A,D,A,U
MLA B,D,B,V
MOV U,A,ASR #16
MOV V,B,ASR #16
LDR A,AD
MOV A,A,ASR #16
LDR B,BD
MOV B,B,ASR #16
LDR D,JDD
FNfractalL
]
NEXT PASS
ENDPROC
DEF FNfractalL
[OPT PASS
LDR P,CT
.while_2
MOVS H,U
RSBMI H,H,#0
MUL S,H,H
MOVS H,V
RSBMI H,H,#0
MUL T,H,H
ADD H,S,T
CMP H,#4<< 26
BHS break
ADDS N,U,V
RSBMI N,N,#0
MUL M,N,N
SUB H,M,H
ADD V,B,H,ASR #13
SUB U,S,T
ADDS U,A,U,ASR #13
MOVS H,U
RSBMI H,H,#0
MUL S,H,H
MOVS H,V
RSBMI H,H,#0
MUL T,H,H
ADD H,S,T
CMP H,#4<< 26
BHS break2
ADDS N,U,V
RSBMI N,N,#0
MUL M,N,N
SUB H,M,H
ADD V,B,H,ASR #13
SUB U,S,T
ADD U,A,U,ASR #13
SUBS D,D,#2
BNE while_2
]
IF Nr_Cols=16 THEN
[OPT PASS
MOV T,#15
LDMFD 13!,{1-12}
MOV PC,R14
.break2
SUBS D,D,#1
.break
ADD D,D,#8
.while_3
CMP D,#14
SUBHI D,D,#14
BHI while_3
MOV T,D
LDMFD 13!,{1-12}
MOV PC,R14
]
ELSE
[OPT PASS
MOV T,#255
LDMFD 13!,{1-12}
MOV PC,R14
.break2
SUBS D,D,#1
.break
ADD D,D,#100
.while_3
CMP D,#254
SUBHI D,D,#254
BHI while_3
CMP D,#15
ADDHS D,D,#1
LDRB T,[P,D]
LDMFD 13!,{1-12}
MOV PC,R14
]
ENDIF
=""
DEF FNfractalH
[OPT PASS
LDR P,CT
.while_2
MOVS H,U
RSBMI H,H,#0
CMP H,#2<<29
BHS break
MOV M,H,LSR #16
BIC N,H,M,LSL #16
MUL H,M,N
MUL T,M,M
MOV M,T,LSL #3
ADD S,M,H,LSR #12
MOVS H,V
RSBMI H,H,#0
CMP H,#2<<29
BHS break
MOV M,H,LSR #16
BIC N,H,M,LSL #16
MUL H,M,N
MUL T,M,M
MOV M,T,LSL #3
ADD T,M,H,LSR #12
ADD H,S,T
CMP H,#4<<29
BHS break
ADDS N,U,V
RSBMI N,N,#0
MOV M,N,LSR #16
BIC N,N,M,LSL #16
MUL U,M,M
MOV U,U,LSL #3
MUL V,M,N
ADD M,U,V,LSR #12
SUB H,M,H
ADD V,B,H
SUB U,S,T
ADD U,U,A
SUBS D,D,#1
BNE while_2
]
IF Nr_Cols=16 THEN
[OPT PASS
MOV T,#15
LDMFD 13!,{1-12}
MOV PC,R14
.break
ADD D,D,#8
.while_3
CMP D,#14
SUBHI D,D,#14
BHI while_3
MOV T,D
LDMFD 13!,{1-12}
MOV PC,R14
]
ELSE
[OPT PASS
MOV T,#255
LDMFD 13!,{1-12}
MOV PC,R14
.break
ADD D,D,#100
.while_3
CMP D,#254
SUBHI D,D,#254
BHI while_3
CMP D,#15
ADDHS D,D,#1
LDRB T,[P,D]
LDMFD 13!,{1-12}
MOV PC,R14
]
ENDIF
=""