[openfirmware] [commit] r1904 - cpu/x86/pc/olpc/via
repository service
svn at openfirmware.info
Tue Aug 3 21:43:51 CEST 2010
Author: wmb
Date: Tue Aug 3 21:43:50 2010
New Revision: 1904
URL: http://tracker.coreboot.org/trac/openfirmware/changeset/1904
Log:
Checked-in auxiliary code to draw waveforms on "Tektronix vector displays" (as emulated by TeraTERM and xterm).
Added:
cpu/x86/pc/olpc/via/tekwaveform.fth
Added: cpu/x86/pc/olpc/via/tekwaveform.fth
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ cpu/x86/pc/olpc/via/tekwaveform.fth Tue Aug 3 21:43:50 2010 (r1904)
@@ -0,0 +1,137 @@
+\ TeraTERM must be in AutoSwitch mode - Setup>Terminal - for to-tek and to-vt
+\ to work. Otherwise you have to invoke the Tek emulator manually (Control>Open TEK)
+\ and switch back and forth with the mouse
+: to-tek ( -- ) h# 1f emit ;
+: to-vt ( -- ) h# 1b emit [char] 2 emit ;
+
+: tek-page ( -- ) h# 1b emit h# c emit ; \ Clear screen
+
+: tek-alpha ( -- ) h# 1f emit ;
+: tek-plot ( -- ) h# 1d emit ;
+
+: component ( n tag -- ) swap h# 1f and or emit ;
+
+d# 1024 constant screen-width
+d# 780 constant screen-height
+
+: tek-move ( x y -- )
+ \ Clip the xy components so they can be represented in the
+ \ 10 bit width of the encoding protocol.
+ d# 1023 min ( x y' )
+ dup 5 rshift h# 20 component ( x y ) \ hi-y
+ h# 60 component ( x ) \ lo-y
+ d# 1023 min ( x' )
+ dup 5 rshift h# 20 component ( x ) \ hi-x
+ h# 40 component ( ) \ lo-x
+;
+\ Here's how line drawing works. Starting in alphanumeric mode:
+\ Execute tek-plot to get into line drawing mode. The pen is
+\ now up, so the first line is invisible, i.e. it's a move.
+\ The pen automatically goes down after the first move, and
+\ subsequent moves draw lines. tek-alpha gets you out of
+\ drawing mode.
+
+: tek-box ( -- )
+ to-tek
+ tek-plot
+ 10 10 tek-move \ initial non-drawn move
+ 40 10 tek-move
+ 40 60 tek-move
+ 10 60 tek-move
+ 10 10 tek-move
+ tek-alpha
+ to-vt
+;
+
+\ PostScript-style line drawing commands
+
+variable cur-x variable cur-y
+: moveto ( x y -- ) cur-y ! cur-x ! ;
+: tek-at ( x y -- )
+ moveto tek-plot cur-x @ cur-y @ tek-move tek-alpha
+;
+: lineto ( x y -- )
+\ to-tek
+ tek-plot
+ cur-x @ cur-y @ tek-move ( x y )
+ 2dup moveto tek-move ( )
+ tek-alpha
+\ to-vt
+;
+: rline ( dx dy -- ) swap cur-x @ + swap cur-y @ + lineto ;
+
+: box2 ( -- )
+ tek-page
+ 10 10 moveto
+ 40 10 lineto
+ 40 60 lineto
+ 10 60 lineto
+ 10 10 lineto
+ to-vt
+;
+
+alias clear-plot tek-page
+0 constant white
+1 constant black
+2 constant red
+3 constant green
+4 constant blue
+5 constant cyan
+6 constant magenta
+7 constant yellow
+: set-fg ( n -- ) h# 1b emit ." ML" h# 30 + emit ;
+
+0 [if]
+\ Incremental plotting mode; not very useful. Exit with tek-alpha
+: tek-turtle ( -- ) h# 1e emit ;
+: unpen ( -- ) bl emit ;
+: pen ( -- ) [char] P emit ;
+: east ( -- ) [char] A emit ;
+: west ( -- ) [char] B emit ;
+: north ( -- ) [char] D emit ;
+: south ( -- ) [char] H emit ;
+: nw ( -- ) [char] F emit ;
+: ne ( -- ) [char] E emit ;
+: sw ( -- ) [char] J emit ;
+: se ( -- ) [char] I emit ;
+[then]
+
+\ End of tek.fth
+
+
+7 constant wave-scale
+: wave-height 1 d# 15 wave-scale - << 2+ ;
+
+: wave0 ( -- ) screen-height wave-height - ;
+
+: plot0 ( -- x y ) 0 d# 10 ;
+
+variable ylim variable ymin
+1 value stretch
+: clip-y ( value -- value' ) ymin @ - 0 max ylim @ min ;
+: plot ( xt xmin xmax xscale ymin ymax -- )
+ over - ylim ! ymin ! to stretch ( xt xmin xmax )
+ over 3 pick execute clip-y ( xt xmin xmax y-at-xmin )
+ plot0 2 pick - moveto ( xt xmin xmax y-at-xmin )
+ -rot swap 1+ ?do ( xt last )
+ i 2 pick execute clip-y ( xt last value )
+ tuck - ( xt value delta )
+ stretch swap rline ( xt value )
+ loop ( xt last )
+ 2drop ( )
+;
+
+: clear-waveform ( -- ) clear-plot ;
+: waveform-start ( -- ) 0 wave0 moveto ;
+: draw-wave ( adr )
+ 0 swap ( last adr )
+ screen-width 0 do ( last adr )
+ tuck <w@ ( adr last this-unscaled )
+ wave-scale >>a ( adr last this )
+ tuck swap - ( adr this distance )
+ 1 swap rline ( adr this )
+ swap wa1+ ( this adr )
+ loop ( last adr )
+ 2drop
+;
+: waveform ( adr -- ) clear-waveform waveform-start draw-wave to-vt ;
More information about the openfirmware
mailing list