[openfirmware] r1677 - cpu/x86/pc/olpc
svn at openfirmware.info
svn at openfirmware.info
Tue Jan 19 02:15:59 CET 2010
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 ;
More information about the openfirmware
mailing list