mandelbrot.tal (6297B)
1 ( mandelbrot.tal ) 2 ( ) 3 ( by alderwick and d_m ) 4 ( ) 5 ( uses 4.12 fixed point arithmetic. ) 6 7 ( SCALE LOGICAL SCREENSIZE ) 8 ( #0001 21x16 42x32 ) 9 ( #0002 42x32 84x64 ) 10 ( #0004 84x64 168x128 ) 11 ( #0008 168x128 336x256 ) 12 ( #0010 336x256 672x512 ) 13 ( #0020 672x512 1344x1024 ) 14 15 %SCALE { #0009 } ( 32 ) 16 %WIDTH { #0015 } ( 21 ) 17 %HEIGHT { #0010 } ( 16 ) 18 %XMIN { #de69 } ( -8601 => -8601/4096 => -2.100 ) 19 %XMAX { #0b33 } ( 2867 => 2867/4096 => 0.700 ) 20 %YMIN { #ecc7 } ( -4915 => -4915/4096 => -1.200 ) 21 %YMAX { #1333 } ( 4915 => 4915/4096 => 1.200 ) 22 23 |00 @System &vector $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1 24 |20 @Screen &vector $2 &width $2 &height $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 25 26 |0100 ( -> ) 27 28 ( set colors ) 29 #00ff .System/r DEO2 30 #0ff0 .System/g DEO2 31 #0f0f .System/b DEO2 32 33 ( set window size ) 34 width #10 SFT2 .Screen/width DEO2 35 height #10 SFT2 .Screen/height DEO2 36 37 ( run ) 38 draw-mandel BRK 39 40 ( logical width ) 41 @width ( -> w* ) 42 WIDTH SCALE MUL2 JMP2r 43 44 ( logical height ) 45 @height ( -> h* ) 46 HEIGHT SCALE MUL2 JMP2r 47 48 ( draw the mandelbrot set using 4.12 fixed point numbers ) 49 @draw-mandel ( -> ) 50 XMAX XMIN SUB2 width DIV2 ,&dx STR2 ( ; &dx<-{xmax-min}/width ) 51 YMAX YMIN SUB2 height DIV2 ,&dy STR2 ( ; &dy<-{ymax-ymin}/height ) 52 [ LIT2 01 -Screen/auto ] DEO ( ; auto<-1 ) 53 LIT2r 8000 ( [8000] ) 54 YMAX YMIN ( ymax* ymin* [8000] ) 55 &yloop ( ymax* y* [8000] ) 56 XMAX XMIN ( ymax* y* xmax* xmin* [8000] ) 57 &xloop ( ymax* y* xmax* x* [8000] ) 58 ROT2k evaluate ( ymax* y* xmax* x* xmax* count^ [8000] ) 59 draw-px POP2 ( ymax* y* xmax* x* [8000] ) 60 [ LIT2 &dx $2 ] ADD2 ( ymax* y* xmax* x+dx* [8000] ) 61 OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* [8000] ) 62 OVR2 STH2kr ADD2 ( ymax* y* xmax* x+dx* 8000+xmax* 8000+x+dx* [8000] ) 63 GTH2 ?&xloop ( ymax* y* xmax* x+dx* [8000] ) 64 POP2 POP2 ( ymax* y* [8000] ) 65 #0000 .Screen/x DEO2 ( ymax* y* [8000] ; sc/x<-0 ) 66 .Screen/y ;inc2 adjust ( ymax* y* [8000] ; sc/y<-sy+1 ) 67 [ LIT2 &dy $2 ] ADD2 ( ymax* y+dy* [8000] ) 68 OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* [8000] ) 69 OVR2 STH2kr ADD2 ( ymax* y+dy* 8000+ymax* 8000+y+dy* [8000] ) 70 GTH2 ?&yloop ( ymax* y+dy* [8000] ) 71 POP2 POP2 POP2r JMP2r ( ) 72 73 ( dithering pattern for 2x2 pixels: ) 74 ( ) 75 ( |o o| -> |x o| -> |x o| -> |x x| -> |x x| ) 76 ( |o o| -> |o o| -> |o x| -> |o x| -> |x x| ) 77 ( ) 78 ( |[p+3]/4 [px+1]/4| ) 79 ( |[p+0]/4 [px+2]/4| ) 80 @draw-px ( px^ -> ) 81 INCk INCk INC ( p+0 p+1 p+3 ) 82 draw-quad draw-quad ( p+0 ; draw NW, NE ) 83 .Screen/y ;inc1 adjust ( ; y<-y+1 ) 84 .Screen/x ;sub2 adjust ( ; x<-x-2 ) 85 INCk INC SWP ( p+2 p+0 ) 86 draw-quad draw-quad ( ; draw SW, SE ) 87 .Screen/y ;sub1 !adjust ( ; y<-y-1 ) 88 89 ( draw one quadrant of a 2x2 area ) 90 @draw-quad ( p^ -> ) 91 #02 SFT .Screen/pixel DEO JMP2r ( ; pixel<-p/4 ) 92 93 ( evaluate the mandelbrot function at one point ) 94 @evaluate ( x* y* -> count^ ) 95 #0000 DUP2 ,&x1 STR2 ( x* y* ; x1<-0 ) 96 DUP2 ,&y1 STR2 ( x* y* ; y1<-0 ) 97 DUP2 ,&x2 STR2 ( x* y* ; x2<-0 ) 98 ,&y2 STR2 ( x* y* ; y2<-0 ) 99 LIT2r 2000 ( x* y* [20 00] ) 100 &loop ( x* y* [20 n^] ) 101 [ LIT2 &x1 $2 ] ( x* y* x1* [20 n^] ) 102 [ LIT2 &y1 $2 ] ( x* y* x1* y1* [20 n^] ) 103 smul2 DUP2 ADD2 ( x* y* 2x1y1* [20 n^] ) 104 OVR2 ADD2 ,&y1 STR2 ( x* y* [20 n^] ; y1<-2x1y1+y* ) 105 SWP2 [ LIT2 &x2 $2 ] ( y* x* x2* [20 n^] ) 106 [ LIT2 &y2 $2 ] SUB2 ( y* x* x2-y2* [20 n^] ) 107 OVR2 ADD2 ,&x1 STR2 SWP2 ( x* y* [20 n^] ; x1<-x2-y2+x* ) 108 ,&x1 LDR2 square ( x* y* x1^2* [20 n^] ) 109 DUP2 ,&x2 STR2 ( x* y* x1^2* [20 n^] ; x2<-x1^2* ) 110 ,&y1 LDR2 square ( x* y* x1^2* y1^2* [20 n^] ) 111 DUP2 ,&y2 STR2 ( x* y* x1^2* y1^2* [20 n^] ; y2<-y1^2* ) 112 ADD2 #4000 GTH2 ?&end ( x* y* [20 n^] ) 113 INCr GTHkr STHr ?&loop ( x* y* [20 n+1*] ) 114 &end ( x* y* [20 count^] ) 115 POP2 POP2 NIPr STHr JMP2r ( count^ ) 116 117 ( is x a non-negative signed value? ) 118 @non-negative ( x* -> x* x>=0^ ) 119 DUP2 #8000 LTH2 JMP2r 120 121 ( multiply two signed 4.12 fixed point numbers ) 122 @smul2 ( a* b* -> ab* ) 123 LIT2r 0001 non-negative ?{ negate SWPr } ( a* |b|* [sign*] ) 124 SWP2 non-negative ?{ negate SWPr } ( |b|* |a|* [sign*] ) 125 smul2-pos STHr ?{ negate } POPr JMP2r ( ab* ) 126 127 ( multiply two non-negative fixed point numbers ) 128 ( ) 129 ( a * b = {a0/16 + a1/4096} * {b0/16 + b1/4096} ) 130 ( = a0b0/256 + a1b0/65536 + a0b1/65536 + a1b1/16777216 ) 131 ( = x + y + z + 0 ; the last term is too small to represent, i.e. zero ) 132 ( ) 133 ( x = a0b0 << 4 ) 134 ( y = a1b0 >> 4 ) 135 ( z = a0b1 >> 4 ) 136 @smul2-pos ( a* b* -> ab* ) 137 aerate ROT2 aerate ( b0* b1* a0* a1* ) 138 STH2 ROT2k STH2 MUL2r ( b0* b1* a0* b1* a0* [a1b0*] ) 139 MUL2 STH2 ADD2r ( b0* b1* a0* [a1b0+a0b1*] ) 140 NIP2 MUL2 #07ff min #40 SFT2 ( a0b0* [y+z*] ) 141 STH2r #04 SFT2 ADD2 ( x* [y+z*] ) 142 #7fff !min ( ab* ) 143 144 ( equivalent to DUP2 smul2 but faster ) 145 @square ( a* -> aa* ) 146 non-negative ?{ negate } ( |a|* ) 147 aerate ( 00 ahi^ 00 alo^ ) 148 OVR2 MUL2 #03 SFT2 SWP2 ( yz* ahi* ) 149 DUP2 MUL2 #07ff min #40 SFT2 ( x* yz* ) 150 ADD2 #7fff !min ( aa* ) 151 152 ( update a device d^ given a function f: x* -> f[x]* ) 153 @adjust ( d^ f* -> ) 154 STH2 DEI2k STH2r JSR2 ROT DEO2 JMP2r 155 156 ( return the minimum of two non-negative numbers. ) 157 @min ( x* y* ) 158 GTH2k [ JMP SWP2 ] NIP2 JMP2r 159 160 ( convert each byte of a a short into a short ) 161 @aerate ( x* -> 00 xhi^ 00 xlo^ ) 162 SWP #0000 ROT SWP2 SWP JMP2r 163 164 ( negate a fixed point number. doesn't work for #8000 ) 165 @negate ( x* -> -x* ) 166 DUP2k EOR2 SWP2 SUB2 JMP2r 167 168 ( useful arithmetic operations ) 169 @inc2 ( n* -> n+2* ) INC2 170 @inc1 ( n* -> n+1* ) INC2 JMP2r 171 @sub1 ( n* -> n-1* ) #0001 SUB2 JMP2r 172 @sub2 ( n* -> n-2* ) #0002 SUB2 JMP2r