mandelbrot.tal (4925B)
1 ( mandelbrot.tal ) 2 ( ) 3 ( by alderwick and d_m ) 4 5 %WIDTH { #02a0 } 6 %HEIGHT { #0200 } 7 %XMIN { #de69 } ( -8601 ) 8 %XMAX { #0b33 } ( 2867 ) 9 %YMIN { #ecc7 } ( -4915 ) 10 %YMAX { #1333 } ( 4915 ) 11 12 |00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1 13 |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 14 15 |0100 ( -> ) 16 17 ( theme ) 18 #0f0f .System/r DEO2 19 #0ff0 .System/g DEO2 20 #00ff .System/b DEO2 21 22 ( size ) 23 WIDTH .Screen/width DEO2 24 HEIGHT .Screen/height DEO2 25 26 ( run ) 27 draw-mandel 28 BRK 29 30 ( draw the mandelbrot set using 4.12 fixed point numbers ) 31 @draw-mandel ( -> ) 32 XMAX XMIN SUB2 WIDTH DIV2 ,&dx STR2 ( ; &dx<-{xmax-min}/width ) 33 YMAX YMIN SUB2 HEIGHT DIV2 ,&dy STR2 ( ; &dy<-{ymax-ymin}/height ) 34 [ LIT2 01 -Screen/auto ] DEO ( ; auto<-1 ) 35 LIT2r 8000 ( [8000] ) 36 YMAX YMIN ( ymax* ymin* [8000] ) 37 &yloop ( ymax* y* [8000] ) 38 XMAX XMIN ( ymax* y* xmax* xmin* [8000] ) 39 &xloop ( ymax* y* xmax* x* [8000] ) 40 ROT2k evaluate ( ymax* y* xmax* x* xmax* count^ [8000] ) 41 .Screen/pixel DEO POP2 ( ymax* y* xmax* x* [8000] ) 42 [ LIT2 &dx $2 ] ADD2 ( ymax* y* xmax* x+dx* [8000] ) 43 OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* [8000] ) 44 OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* 8000+x+dx* [8000] ) 45 GTH2 ?&xloop ( ymax* y* xmax* x+dx* [8000] ) 46 POP2 POP2 ( ymax* y* [8000] ) 47 #0000 .Screen/x DEO2 ( ymax* y* [8000] ; sc/x<-0 ) 48 .Screen/y DEI2k ( ymax* y* d^ sy* [8000] ) 49 INC2 ROT DEO2 ( ymax* y* [8000] ; sc/y<-sy+1 ) 50 [ LIT2 &dy $2 ] ADD2 ( ymax* y+dy* [8000] ) 51 OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* [8000] ) 52 OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* 8000+y+dy* [8000] ) 53 GTH2 ?&yloop ( ymax* y+dy* [8000] ) 54 POP2 POP2 POP2r JMP2r ( ) 55 56 @evaluate ( x* y* -> count^ ) 57 #0000 DUP2 ,&x1 STR2 ( x* y* ; x1<-0 ) 58 DUP2 ,&y1 STR2 ( x* y* ; y1<-0 ) 59 DUP2 ,&x2 STR2 ( x* y* ; x2<-0 ) 60 ,&y2 STR2 ( x* y* ; y2<-0 ) 61 LIT2r 2000 ( x* y* [20 00] ) 62 &loop ( x* y* [20 n^] ) 63 [ LIT2 &x1 $2 ] ( x* y* x1* [20 n^] ) 64 [ LIT2 &y1 $2 ] ( x* y* x1* y1* [20 n^] ) 65 smul2 DUP2 ADD2 ( x* y* 2x1y1* [20 n^] ) 66 OVR2 ADD2 ,&y1 STR2 ( x* y* [20 n^] ; y1<-2x1y1+y* ) 67 SWP2 [ LIT2 &x2 $2 ] ( y* x* x2* [20 n^] ) 68 [ LIT2 &y2 $2 ] SUB2 ( y* x* x2-y2* [20 n^] ) 69 OVR2 ADD2 ,&x1 STR2 SWP2 ( x* y* [20 n^] ; x1<-x2-y2+x* ) 70 ,&x1 LDR2 square ( x* y* x1^2* [20 n^] ) 71 DUP2 ,&x2 STR2 ( x* y* x1^2* [20 n^] ; x2<-x1^2* ) 72 ,&y1 LDR2 square ( x* y* x1^2* y1^2* [20 n^] ) 73 DUP2 ,&y2 STR2 ( x* y* x1^2* y1^2* [20 n^] ; y2<-y1^2* ) 74 ADD2 #4000 GTH2 ?&end ( x* y* [20 n^] ) 75 INCr GTHkr STHr ?&loop ( x* y* [20 n+1*] ) 76 &end ( x* y* [20 count^] ) 77 POP2 POP2 NIPr STHr JMP2r ( count^ ) 78 79 ( multiply two signed 4.12 fixed point numbers ) 80 @smul2 ( a* b* -> ab* ) 81 LIT2r 0001 DUP2 #8000 LTH2 ?&bpos negate SWPr ( a* |b|* [sign*] ) 82 &bpos SWP2 DUP2 #8000 LTH2 ?&apos negate SWPr ( |b|* |a|* [sign*] ) 83 &apos smul2-pos STHr ?&abpos negate ( ab* [scrap^] ) 84 &abpos POPr JMP2r ( ab* ) 85 86 ( multiply two non-negative fixed point numbers ) 87 ( ) 88 ( a * b = {a0/16 + a1/4096} * {b0/16 + b1/4096} ) 89 ( = a0b0/256 + a1b0/65536 + a0b1/65536 + a1b1/16777216 ) 90 ( = x + y + z + 0 ; the last term is too small to represent, i.e. zero ) 91 ( ) 92 ( x = a0b0 << 4 ) 93 ( y = a1b0 >> 4 ) 94 ( z = a0b1 >> 4 ) 95 @smul2-pos ( a* b* -> ab* ) 96 aerate ROT2 aerate ( b0* b1* a0* a1* ) 97 STH2 ROT2k ( b0* b1* a0* b1* a0* b0* [a1*] ) 98 STH2 MUL2r ( b0* b1* a0* b1* a0* [a1b0*] ) 99 MUL2 STH2 ADD2r ( b0* b1* a0* [a1b0+a0b1*] ) 100 NIP2 MUL2 #07ff min #40 SFT2 ( a0b0* [y+z*] ) 101 STH2r #04 SFT2 ADD2 ( x* [y+z*] ) 102 #7fff !min ( ab* ) 103 104 ( equivalent to DUP2 smul2 but faster ) 105 @square ( a* -> aa* ) 106 DUP2 #8000 LTH2 ?&pos negate &pos 107 108 ( >> ) 109 110 ( equivalent to DUP2 smul2-pos but faster ) 111 @square-pos ( a* -> aa* ) 112 aerate ( 00 ahi^ 00 alo^ ) 113 OVR2 MUL2 #03 SFT2 SWP2 ( yz* ahi* ) 114 DUP2 MUL2 #07ff min #40 SFT2 ( x* yz* ) 115 ADD2 #7fff !min ( aa* ) 116 117 ( convert each byte of a a short into a short ) 118 @aerate ( x* -> 00 xhi^ 00 xlo^ ) SWP #0000 ROT SWP2 SWP JMP2r 119 120 ( negate a fixed point number. doesn't work for #8000 ) 121 @negate ( x* -> -x* ) DUP2k EOR2 SWP2 SUB2 JMP2r 122 123 ( return the minimum of two non-negative numbers. ) 124 @min ( x* y* ) GTH2k [ JMP SWP2 ] NIP2 JMP2r