From df07eda12e467d2859abe3bd9fc742ed0b73e537 Mon Sep 17 00:00:00 2001 From: d6 Date: Fri, 5 May 2023 10:29:10 -0400 Subject: [PATCH] better graphing --- graph.tal | 201 +++++++++++++++++++++++++++++++++++++++++++++++++++ interval.tal | 2 +- 2 files changed, 202 insertions(+), 1 deletion(-) create mode 100644 graph.tal diff --git a/graph.tal b/graph.tal new file mode 100644 index 0000000..b9fef6d --- /dev/null +++ b/graph.tal @@ -0,0 +1,201 @@ +( graph.tal ) +( ) +( graphing calculator ) + +( EXPRESSIONS ) +( ) +( expressions use one byte for an id, and ) +( zero or more bytes for data. ) +( ) +( ID NAME DATA DESCRIPTION ) +( 00 var variable x ) +( 01 lit const* literal value ) +( 02 neg e1* -e1 ) +( 03 pow e* k^ e^k ) +( 04 add e1* e2* e1 + e2 ) +( 05 sub e1* e2* e1 - e2 ) +( 06 mul e1* e2* e1 * e2 ) +( 07 div e1* e2* e1 / e2 ) +( ) +( const* is a fixed point value ) +( e*, e1*, and e2* are addresses of expressions. ) +( k^ is an unsigned integer ) + +|00 @System &vect $2 &wst $1 &rst $1 &eaddr $2 &ecode $1 &pad $1 &r $2 &g $2 &b $2 &debug $1 &halt $1 +|20 @Screen &vect $2 &w $2 &h $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 + +|0000 + @epsilon $2 ( graph value per pixel ) + + @xmin $2 ( min x graph coord ) + @xmax $2 ( max x graph coord ) + @ymin $2 ( min y graph coord ) + @ymax $2 ( max y graph coord ) + + @step $2 ( current step size for drawing ) + + @expr $2 + + @x0 $2 ( lower bound of x ) + @x1 $2 ( upper bound of x ) + @y0 $2 ( lower bound of y ) + @y1 $2 ( upper bound of y ) + +|0100 + ( colors ) + #0f0f .System/r DEO2 + #0ff0 .System/g DEO2 + #00ff .System/b DEO2 + + ( default settings ) + #0004 .epsilon STZ2 ( 0.004 ) + #fc00 .xmin STZ2 ( -4.0 ) + #0400 .xmax STZ2 ( +4.0 ) + #fc00 .ymin STZ2 ( -4.0 ) + #03fc .ymax STZ2 ( +4.0 - epsilon ) + + ( h = w = 0x200 = 512 ) + .xmax LDZ2 .xmin LDZ2 SUB2 .epsilon LDZ2 DIV2 .Screen/w DEO2 + .ymax LDZ2 .ymin LDZ2 SUB2 .epsilon LDZ2 DIV2 .Screen/h DEO2 + + ;x^3-2x+1 .expr STZ2 + + draw-border + + .xmin LDZ2 .ymin LDZ2 #0800 draw + + BRK + +@hline ( x1* x2* y* ) + #01 .Screen/auto DEO .Screen/y DEO2 OVR2 .Screen/x DEO2 + SUB2 &xloop #02 .Screen/pixel DEO INC2 ORAk ?&xloop POP2 JMP2r + +@vline ( y1* y2* x* ) + #02 .Screen/auto DEO .Screen/x DEO2 OVR2 .Screen/y DEO2 + SUB2 &yloop #02 .Screen/pixel DEO INC2 ORAk ?&yloop POP2 JMP2r + +@draw-border + #0000 #0200 #0100 vline + #0000 #0200 #0100 hline + + #00f0 #0110 #0040 vline + #00f0 #0110 #0080 vline + #00f0 #0110 #00c0 vline + #00f0 #0110 #0140 vline + #00f0 #0110 #0180 vline + #00f0 #0110 #01c0 vline + + #00f0 #0110 #0040 hline + #00f0 #0110 #0080 hline + #00f0 #0110 #00c0 hline + #00f0 #0110 #0140 hline + #00f0 #0110 #0180 hline + #00f0 #0110 #01c0 hline + JMP2r + +( recursive drawing procedure ) +( ) +( this draws the area [x,y] to [x+s,y+s]. ) +( first it checks whether that area contains a point. ) +( next it checks if s=1: ) +( - if so we draw that point ) +( - if not, we split into a 2x2 grid and recurse ) +@draw ( x* y* s* -> ) + STH2k .step STZ2 ( x* y* [s*] ; step<-s ) + OVR2 OVR2 evaluate ?&hit ( x* y* [s*] ) + POP2 POP2 POP2r JMP2r ( ; miss ) + &hit ( x* y* [s*] ) + STH2kr #0001 EQU2 ?&term ( x* y* [s*] ) + LITr 01 SFT2r ( x* y* [h=s/2*] ) + OVR2 OVR2 ( x* y* x* y* h* [h*] ) + STH2kr draw ( x* y* [h*] ; south west ) + OVR2 OVR2 STH2kr ADD2 ( x* y* x* y+h* [h*] ) + STH2kr draw ( x* y* [h*] ; north west ) + OVR2 STH2kr ADD2 OVR2 ( x* y* x+h* y* [h*] ) + STH2kr draw ( x+h* y* [h*] ; south east ) + STH2kr ADD2 SWP2 STH2kr ADD2 SWP2 ( x+h* y+h* [h*] ) + STH2r draw ( ; upper-right ) + JMP2r ( ) + &term ( x* y* [s*] ) + POP2r ( x* y* ) + .ymax LDZ2 SWP2 SUB2 ( x* ymax-y* ) + .epsilon LDZ2 DIV2 ( x* sy=(ymax-y)/e* ) + .Screen/y DEO2 ( x* ; screen/y<-sy ) + .xmin LDZ2 SUB2 ( x-xmin* ) + .epsilon LDZ2 DIV2 ( x* sx=(x-xmin)/e* ) + .Screen/x DEO2 ( ; screen/x<-sx ) + #41 .Screen/pixel DEO ( ; screen/pixel<-40 ) + JMP2r ( ) + +( determine if the given x and y intervals intersect ) +( if they do, at least one point of the graph is in this region ) +( if not, the entire region is empty. ) +@evaluate ( x* y* -> bool^ ) + + ( store epsilon and x/y intervals ) + LITr -step LDZ2r ( x* y* [e*] ) + DUP2 .y0 STZ2 ( x* y* [e*] ; y0<-y ) + STH2kr x16-add .y1 STZ2 ( x* [e*] ; y1<-y+e ) + DUP2 .x0 STZ2 ( x* [e*] ; x0<-x ) + STH2r x16-add .x1 STZ2 ( ; x1<-x+e ) + + ( evaluate our equation ) + .expr LDZ2 eval ( x-iv** ) + .y0 LDZ2 .y1 LDZ2 ( x-iv** y-iv** ) + !iv-intersects ( result^ ) + +( requires .x0 and .x1 to already be set ) +@eval ( expr* -> interval** ) + LDAk #00 NEQ ?&o1 ( var ) POP2 .x0 LDZ2 .x1 LDZ2 JMP2r + &o1 LDAk #01 NEQ ?&o2 ( lit ) INC2 LDA2 DUP2 JMP2r + &o2 LDAk #02 NEQ ?&o3 ( neg ) INC2 LDA2 eval !iv-negate + &o3 LDAk #03 NEQ ?&o4 ( pow ) INC2 STH2k LDA2 eval STH2r INC2 INC2 LDA !iv-pow + &o4 LDAk #04 NEQ ?&o5 ( add ) ;iv-add !binop + &o5 LDAk #05 NEQ ?&o6 ( sub ) ;iv-sub !binop + &o6 LDAk #06 NEQ ?&o7 ( mul ) ;iv-mul !binop + &o7 #0000 DIV ( TODO: div ) + +@binop ( addr* op* -> interval** ) + STH2 INC2 STH2k ( addr+1* [op* addr+1*] ) + LDA2 eval ( lhs** [op* addr+1*] ) + STH2r INC2 INC2 LDA2 eval ( lhs** rhs** [op*] ) + STH2r JMP2 ( result** ) + +@clear ( -> ) + #0000 ;expr STA2 + ;arena ;next STA2 + JMP2r + +@alloc ( id^ size* -> addr* ) + ;next LDA2k STH2k ( id^ size* next* addr* [addr*] ) + ROT2 ADD2 SWP2 STA2 ( id^ [addr*] ; next<-addr+size ) + STH2kr STA ( [addr*] ; addr<-id ) + STH2r JMP2r ( addr* ) + +@alloc-const ( const* -> e* ) + #01 #0003 alloc ( const* addr* ) + STH2k INC2 STA2 ( [addr*] ; addr+1<-const ) + STH2r JMP2r ( addr* ) + +@alloc-lit ( const* -> e* ) + #01 #0003 alloc ( const* addr* ) + STH2k INC2 STA2 ( [addr*] ; addr+1<-const ) + STH2r JMP2r ( addr* ) + +@alloc-neg ( e0* -> e* ) + #02 #0003 alloc ( e0 addr* ) + STH2k INC2 STA2 ( [addr*] ; addr+1<-e0* ) + STH2r JMP2r ( addr* ) + +@x^3-2x+1 04 =x^3-2x =one +@x^3-2x 05 =x^3 =2x +@one 01 0100 +@x^3 03 =x 03 +@2x 06 =x =two +@two 01 0200 + +~interval.tal + +@x 00 +@next :arena +@arena $1000 diff --git a/interval.tal b/interval.tal index 4e8cb4f..25e5470 100644 --- a/interval.tal +++ b/interval.tal @@ -54,7 +54,7 @@ DUP2 #8000 LTH2 ?&positive ( negative ) x16-negate SWP2 !x16-negate &positive JMP2r - &cross POP x16-negate #0000 SWP2 JMP2r + &cross SWP2 x16-negate x16-max #0000 SWP2 JMP2r @iv-scalar-add ( x** y* -> x+y** ) STH2k x16-add SWP2