mirror of https://git.sr.ht/~rabbits/uxn
125 lines
4.8 KiB
Tal
125 lines
4.8 KiB
Tal
( mandelbrot.tal )
|
|
( )
|
|
( by alderwick and d_m )
|
|
|
|
%WIDTH { #02a0 }
|
|
%HEIGHT { #0200 }
|
|
%XMIN { #de69 } ( -8601 )
|
|
%XMAX { #0b33 } ( 2867 )
|
|
%YMIN { #ecc7 } ( -4915 )
|
|
%YMAX { #1333 } ( 4915 )
|
|
|
|
|00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1
|
|
|20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1
|
|
|
|
|0100 ( -> )
|
|
|
|
( theme )
|
|
#0f0f .System/r DEO2
|
|
#0ff0 .System/g DEO2
|
|
#00ff .System/b DEO2
|
|
|
|
( size )
|
|
WIDTH .Screen/width DEO2
|
|
HEIGHT .Screen/height DEO2
|
|
|
|
( run )
|
|
draw-mandel
|
|
BRK
|
|
|
|
( draw the mandelbrot set using 4.12 fixed point numbers )
|
|
@draw-mandel ( -> )
|
|
XMAX XMIN SUB2 WIDTH DIV2 ,&dx STR2 ( ; &dx<-{xmax-min}/width )
|
|
YMAX YMIN SUB2 HEIGHT DIV2 ,&dy STR2 ( ; &dy<-{ymax-ymin}/height )
|
|
[ LIT2 01 -Screen/auto ] DEO ( ; auto<-1 )
|
|
LIT2r 8000 ( [8000] )
|
|
YMAX YMIN ( ymax* ymin* [8000] )
|
|
&yloop ( ymax* y* [8000] )
|
|
XMAX XMIN ( ymax* y* xmax* xmin* [8000] )
|
|
&xloop ( ymax* y* xmax* x* [8000] )
|
|
ROT2k evaluate ( ymax* y* xmax* x* xmax* count^ [8000] )
|
|
.Screen/pixel DEO POP2 ( ymax* y* xmax* x* [8000] )
|
|
[ LIT2 &dx $2 ] ADD2 ( ymax* y* xmax* x+dx* [8000] )
|
|
OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* [8000] )
|
|
OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* 8000+x+dx* [8000] )
|
|
GTH2 ?&xloop ( ymax* y* xmax* x+dx* [8000] )
|
|
POP2 POP2 ( ymax* y* [8000] )
|
|
#0000 .Screen/x DEO2 ( ymax* y* [8000] ; sc/x<-0 )
|
|
.Screen/y DEI2k ( ymax* y* d^ sy* [8000] )
|
|
INC2 ROT DEO2 ( ymax* y* [8000] ; sc/y<-sy+1 )
|
|
[ LIT2 &dy $2 ] ADD2 ( ymax* y+dy* [8000] )
|
|
OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* [8000] )
|
|
OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* 8000+y+dy* [8000] )
|
|
GTH2 ?&yloop ( ymax* y+dy* [8000] )
|
|
POP2 POP2 POP2r JMP2r ( )
|
|
|
|
@evaluate ( x* y* -> count^ )
|
|
#0000 DUP2 ,&x1 STR2 ( x* y* ; x1<-0 )
|
|
DUP2 ,&y1 STR2 ( x* y* ; y1<-0 )
|
|
DUP2 ,&x2 STR2 ( x* y* ; x2<-0 )
|
|
,&y2 STR2 ( x* y* ; y2<-0 )
|
|
LIT2r 2000 ( x* y* [20 00] )
|
|
&loop ( x* y* [20 n^] )
|
|
[ LIT2 &x1 $2 ] ( x* y* x1* [20 n^] )
|
|
[ LIT2 &y1 $2 ] ( x* y* x1* y1* [20 n^] )
|
|
smul2 DUP2 ADD2 ( x* y* 2x1y1* [20 n^] )
|
|
OVR2 ADD2 ,&y1 STR2 ( x* y* [20 n^] ; y1<-2x1y1+y* )
|
|
SWP2 [ LIT2 &x2 $2 ] ( y* x* x2* [20 n^] )
|
|
[ LIT2 &y2 $2 ] SUB2 ( y* x* x2-y2* [20 n^] )
|
|
OVR2 ADD2 ,&x1 STR2 SWP2 ( x* y* [20 n^] ; x1<-x2-y2+x* )
|
|
,&x1 LDR2 square ( x* y* x1^2* [20 n^] )
|
|
DUP2 ,&x2 STR2 ( x* y* x1^2* [20 n^] ; x2<-x1^2* )
|
|
,&y1 LDR2 square ( x* y* x1^2* y1^2* [20 n^] )
|
|
DUP2 ,&y2 STR2 ( x* y* x1^2* y1^2* [20 n^] ; y2<-y1^2* )
|
|
ADD2 #4000 GTH2 ?&end ( x* y* [20 n^] )
|
|
INCr GTHkr STHr ?&loop ( x* y* [20 n+1*] )
|
|
&end ( x* y* [20 count^] )
|
|
POP2 POP2 NIPr STHr JMP2r ( count^ )
|
|
|
|
( multiply two signed 4.12 fixed point numbers )
|
|
@smul2 ( a* b* -> ab* )
|
|
LIT2r 0001 DUP2 #8000 LTH2 ?&bpos negate SWPr ( a* |b|* [sign*] )
|
|
&bpos SWP2 DUP2 #8000 LTH2 ?&apos negate SWPr ( |b|* |a|* [sign*] )
|
|
&apos smul2-pos STHr ?&abpos negate ( ab* [scrap^] )
|
|
&abpos POPr JMP2r ( ab* )
|
|
|
|
( multiply two non-negative fixed point numbers )
|
|
( )
|
|
( a * b = {a0/16 + a1/4096} * {b0/16 + b1/4096} )
|
|
( = a0b0/256 + a1b0/65536 + a0b1/65536 + a1b1/16777216 )
|
|
( = x + y + z + 0 ; the last term is too small to represent, i.e. zero )
|
|
( )
|
|
( x = a0b0 << 4 )
|
|
( y = a1b0 >> 4 )
|
|
( z = a0b1 >> 4 )
|
|
@smul2-pos ( a* b* -> ab* )
|
|
aerate ROT2 aerate ( b0* b1* a0* a1* )
|
|
STH2 ROT2k ( b0* b1* a0* b1* a0* b0* [a1*] )
|
|
STH2 MUL2r ( b0* b1* a0* b1* a0* [a1b0*] )
|
|
MUL2 STH2 ADD2r ( b0* b1* a0* [a1b0+a0b1*] )
|
|
NIP2 MUL2 #07ff min #40 SFT2 ( a0b0* [y+z*] )
|
|
STH2r #04 SFT2 ADD2 ( x* [y+z*] )
|
|
#7fff !min ( ab* )
|
|
|
|
( equivalent to DUP2 smul2 but faster )
|
|
@square ( a* -> aa* )
|
|
DUP2 #8000 LTH2 ?&pos negate &pos
|
|
|
|
( >> )
|
|
|
|
( equivalent to DUP2 smul2-pos but faster )
|
|
@square-pos ( a* -> aa* )
|
|
aerate ( 00 ahi^ 00 alo^ )
|
|
OVR2 MUL2 #03 SFT2 SWP2 ( yz* ahi* )
|
|
DUP2 MUL2 #07ff min #40 SFT2 ( x* yz* )
|
|
ADD2 #7fff !min ( aa* )
|
|
|
|
( convert each byte of a a short into a short )
|
|
@aerate ( x* -> 00 xhi^ 00 xlo^ ) SWP #0000 ROT SWP2 SWP JMP2r
|
|
|
|
( negate a fixed point number. doesn't work for #8000 )
|
|
@negate ( x* -> -x* ) DUP2k EOR2 SWP2 SUB2 JMP2r
|
|
|
|
( return the minimum of two non-negative numbers. )
|
|
@min ( x* y* ) GTH2k [ JMP SWP2 ] NIP2 JMP2r
|