Author: wmb Date: 2010-01-19 02:15:59 +0100 (Tue, 19 Jan 2010) New Revision: 1677
Modified: cpu/x86/pc/olpc/waveform.fth Log: olpc/waveform.fth - added Bezier curve drawing and double-size drawing.
Modified: cpu/x86/pc/olpc/waveform.fth =================================================================== --- cpu/x86/pc/olpc/waveform.fth 2010-01-16 20:02:47 UTC (rev 1676) +++ cpu/x86/pc/olpc/waveform.fth 2010-01-19 01:15:59 UTC (rev 1677) @@ -13,10 +13,39 @@ 5 value fg h# f value bg
-: pointat ( x y -- ) +: halve ( n -- n/2 ) dup 1 and swap u2/ + ; + +defer pointat ( x y -- ) +defer subpixel-pointat ( xf yf -- ) + +0 0 2value dot-offset + +: draw-dot ( x y -- ) + dot-offset d+ bytes/line * swap wa+ frame-buffer-adr + fg swap w! ; +: subpixel-draw-dot ( xf yf -- ) + swap halve swap halve + bytes/line * swap wa+ frame-buffer-adr + fg swap w! +; +' draw-dot to pointat +' subpixel-draw-dot to subpixel-pointat
+: subpixel-double-dot ( x y -- ) + over 1+ over draw-dot + over 1+ over 1+ draw-dot + over over 1+ draw-dot + draw-dot +; +: double-dot ( x y -- ) + swap 2* swap 2* ( x' y' ) + subpixel-double-dot +; +: double-size ( -- ) + ['] double-dot to pointat + ['] subpixel-double-dot to subpixel-pointat +; + variable curx variable cury : moveto ( x y -- ) cury ! curx ! ; : rmove ( dx dy -- ) cury +! curx +! ; @@ -79,6 +108,13 @@
: lineto ( x y -- ) swap curx @ - swap cury @ - rline ;
+: boxat ( x y w h -- ) + 2swap moveto ( w h ) + 0 over rline ( w h ) \ Up + over 0 rline ( w h ) \ Right + 0 swap negate rline ( w ) \ Down + negate 0 rline ( ) \ Left +;
1 [if] \ Test for line drawing @@ -104,7 +140,57 @@ 3 +loop ; [then] +3 value subpixel-shift +: >point ( x y -- ) swap subpixel-shift lshift swap subpixel-shift lshift wljoin ;
+: place-point ( p -- ) + lwsplit + swap subpixel-shift 1- rshift swap subpixel-shift 1- rshift ( x y ) + subpixel-pointat ( ) +; + +: mid ( p0 p1 -- mid ) + + lwsplit halve swap halve swap wljoin +; +: close-coord? ( n0 n1 -- flag ) - abs 1 subpixel-shift lshift <= ; +: close-point? ( p0 p1 -- flag ) + lwsplit rot lwsplit ( x1 y1 x0 y0 ) + rot close-coord? -rot close-coord? and +; + +\ Bezier curve rendering by the midpoint method - see, for example, +\ http://web.cs.wpi.edu/~matt/courses/cs563/talks/surface/bez_surf.html +: bezier-steps ( p0 p1 p2 p3 -- ) + dup 4 pick close-point? if 4drop exit then + 2over mid >r ( p0 p1 p2 p3 r: p01 ) + -rot tuck ( p0 p3 p2 p1 p2 r: p01 ) + mid >r ( p0 p3 p2 r: p01 p12 ) + over mid ( p0 p3 p23 r: p01 p12 ) + dup r@ mid ( p0 p3 p23 p123 r: p01 p12 ) + r> r@ mid ( p0 p3 p23 p123 p012 r: p01 ) + 2dup mid ( p0 p3 p23 p123 p012 p0123 r: p01 ) + dup place-point ( p0 p3 p23 p123 p012 p0123 r: p01 ) + + \ For convenience of stack manipulation, we calculate the right half "backwards" + \ This gives equivalent results due to the symmetry of the calculation + tuck 2>r ( p0 p3 p23 p123 p0123 r: p01 p012 p0123 ) + recurse ( p0 r: p01 p012 p0123 ) + + 2r> r> -rot ( p0 p01 p012 p0123 ) + recurse ( ) +; +: bezier ( p0 p1 p2 p3 -- ) + dup place-point 4 pick place-point bezier-steps +; + +: curveto ( x1 y1 x2 y2 x3 y3 -- ) + 2>r ( x1 y1 x2 y2 x3 y3 r: x3 y3 ) + 2r@ >point >r >point >r >point >r ( r: x3 y3 p3 p2 p1 ) + curx @ cury @ >point r> r> r> ( p0 p1 p2 p3 r: x3 y3 ) + bezier ( r: x3 y3 ) + 2r> cury ! curx ! +; + : plot0 ( -- x y ) 0 screen-height 10 - ; : clear-plot ( width height -- ) 2>r @@ -165,7 +251,7 @@
dend
-: $call-screen ( ? name$ -- ? ) stdout @ $call-method ; +\ : $call-screen ( ? name$ -- ? ) stdout @ $call-method ; : wave ( adr -- ) " waveform" $call-screen ; : clear-plot ( width height -- ) " clear-plot" $call-screen ; : lineplot ( xt xmin xmax xscale ymin ymax -- ) " plot" $call-screen ;