simlab <@CSNET-RELAY.ARPA,@ucsc.csnet (Simlab Class):simlab@ucsc (02/02/85)
As promised, here is my VFORTH 3-D graphics viewing system.
It offers all the classic 3-D viewing transformations, plus a turtle
graphics system to aid in making pretty pictures. It takes about 1/2
hour to bring up a new terminal on this system once you understand what's
needed--but that may take a bit longer!
Cheers,
Andy Valencia
...!{ucbvax,fortune}!hpda!vandys
: The rest of this file will extract:
: matutil.fth object.fth plot.fth transform.fth turtle.fth load_3a load_dm load_hp doc/demo_session doc/doc_adding_terms doc/doc_implement doc/doc_words figs/box figs/turt_box figs/turt_oct figs/turt_tube figs/turt_tube2 terms/3a.fth terms/dm.fth terms/fa
ke_line.fth terms/hp.fth terms/line.fth
echo extracting - matutil.fth
sed 's/^X//' > matutil.fth << '/*EOF'
X." Loading matutil.fth" cr
X( utility words for dealing with 4x4 matrices )
X
X ( Check top two stack items for range [0..3] )
X: rngchk
X dup 0 < swap 3 > or
X swap dup 0 < swap 3 > or or
X if
X ." Range error" cr abort
X endif
X;
X
X: @elem ( v r c --- n ) ( fetches floating point value n from element )
X ( [r,c] of floating point array v )
X 2dup rngchk
X 4 * swap 16 * + + @ ;
X
X: !elem ( n v r c --- ) ( stores floating point value n in )
X ( element [r,c] of array v )
X 2dup rngchk
X 4 * swap 16 * + + ! ;
X
X
X ( Clear a matrix to 0's )
X: clrmat
X 64 0 fill
X;
X
X ( set up 4x4 matrix to be the identity matrix )
X: ident ( v --- )
X
X dup clrmat ( clear matrix to all zeros )
X 4 0 do
X 1.0 over i i !elem
X loop
X drop
X;
X
X ( Print out a matrix )
X: .mat
X 4 0 do
X 4 0 do
X dup j i @elem f. 9 emit
X loop cr
X loop
X drop
X;
X
X ( Allocate a matrix )
X: matvar
X variable
X 62 allot
X;
X
X ( matcpy--copy one matrix into another )
X: matcpy ( src dst -- )
X swap
X 16 0 do
X dup @ swap 4 + swap rot dup 4 + -rot !
X loop
X;
X
Xvariable mat1 ( Temporary storage for matrix addresses )
Xvariable mat2
Xmatvar tmpmat ( And a temporary matrix )
Xvariable tmpw ( Temp storage for a word quantity )
X
X: mat* ( S T --- ) ( 4x4 matrix multply: T = T * S )
X mat2 ! ( store addr of matices )
X mat1 !
X
X 4 0 do ( Which row of mat1 we're on )
X 4 0 do ( Which column of mat2 )
X 0.0 4 0 do ( For that r & c, loop through & sum )
X mat1 @ k i @elem
X mat2 @ i j @elem
X f* f+
X loop
X tmpmat j i !elem ( Save the result )
X loop
X loop
X
X tmpmat mat2 @ matcpy ( copy result to destination )
X;
/*EOF
echo extracting - object.fth
sed 's/^X//' > object.fth << '/*EOF'
X." Loading object.fth" cr
X( Implementation of graphical objects )
X
X ( To keep a linked list of all objects )
Xvariable lstobj 0 lstobj !
X
X ( Intrinsic to create an object )
X: newobj
X variable
X -4 allot
X
X ( Add this object to our list )
X here lstobj dup @ , !
X
X ( Initially, each object is displayed )
X true ,
X
X ( And initially, the object has no members )
X 0 ,
X;
X
X ( Internal routine to add words to dictionary space )
X: (addside) ( xf yf zf -- )
X
X ( They come in the wrong order, so reverse it & store )
X >r >r
X
X ( This is gross. To maintain our innocence as to which way )
X ( floats are on the stack, we have to use the ! operator )
X here ! 4 allot
X r> here ! 4 allot
X r> here ! 4 allot
X;
X
X ( Add a side to our most current object )
X: addside ( x1f y1f z1f x2f y2f z2f -- )
X
X ( Increment the side counter )
X lstobj @ dup if
X 8 + dup @ 1 + swap !
X else
X ." No current object" cr abort
X endif
X
X ( We just call our routine once for each point )
X (addside) (addside)
X;
X
X ( Hide & show an object )
X: hide ( a -- )
X 4 + false swap !
X;
X: show ( a -- )
X 4 + true swap !
X;
X
X ( Draw an object )
X: dr-obj ( a -- )
X
X ( Don't draw object if marked "no display" )
X dup 4 + @ if
X
X ( Don't drop into the do loop if there are no sides )
X dup 8 + @ if
X ( Repeat for each side... )
X dup 12 + swap 8 + @ 0 do
X
X ( Stash current address on return stack )
X dup >r
X
X ( Get the two points, increment pointer )
X 3d@ r> 12 +
X
X ( Repeat process for next point, draw line )
X dup >r 3d@ 3dline r> 12 +
X loop
X endif
X endif
X drop
X;
X
X ( Draw all objects )
X: draw
X
X ( Get start of list )
X lstobj @
X
X ( While not at end of list, do an object )
X begin
X dup
X while
X dup @ swap dr-obj
X repeat
X drop
X;
X
X ( These are the words which execute transformations upon objects )
X
X ( This is the matrix which takes on successive transformations )
Xmatvar curxfm
X
X ( xfm--sets up everything, get ready to describe a sequence )
X ( of transformations )
X: xfm
X curxfm ident
X;
X
X ( x,y,z rot--do rotations about the various axis )
X: xrot ( d -- )
X curxfm (xrot) ;
X: yrot ( d -- )
X curxfm (yrot) ;
X: zrot ( d -- )
X curxfm (zrot) ;
X
X3dpt tmppt
X ( Reverse the order of the top three 2-word elements )
X: revarg ( xf yf zf -- zf yf xf )
X tmppt 3d! tmppt z@ tmppt y@ tmppt x@ ;
X
X ( trans--do a translation )
X: trans ( xf yf zf -- )
X
X ( The internal routine wants them the other way around )
X revarg
X
X curxfm (trans) ;
X
X ( scale--do a scaling operation )
X: scale ( xf yf zf -- )
X revarg curxfm (scale) ;
X
X ( doxfm--implement all the transformations on the named object )
X: doxfm ( a -- )
X
X ( For each point... )
X dup 12 + swap 8 + @ 2 * 0 do
X
X ( Fetch the current point, advance to next )
X dup 12 + swap
X
X ( Hold the current point's address in tmpw )
X tmpw !
X
X ( For each column of the transformation matrix... )
X 3 0 do
X
X ( Do a matrix multiplication )
X tmpw @ x@ curxfm 0 i @elem f*
X tmpw @ y@ curxfm 1 i @elem f*
X tmpw @ z@ curxfm 2 i @elem f*
X curxfm 3 i @elem
X f+ f+ f+
X loop
X ( Now store the new point, which has been build on the stack, )
X ( back into the current point )
X tmpw @ 3d!
X
X loop drop
X;
X
X ( .obj--print the sides making up an object )
X: .obj ( a -- )
X
X ( For each pair of points... )
X dup 12 + swap 8 + @ 0 do
X
X ( Fetch the current point, advance to next )
X dup 12 + swap
X ." (" dup x@ f. 32 emit dup y@ f. 32 emit z@ f. ." ) to ("
X dup 12 + swap
X dup x@ f. 32 emit dup y@ f. 32 emit z@ f. ." )" cr
X
X loop drop
X;
X
X ( Routines for centering & uncentering an object around the origin )
X
X ( Holds the current sum of X,Y,Z values, and # of sides )
X3dpt centmp
Xvariable cencnt
X
X ( Clear the summing temporary variable "centmp" )
X: cenclr
X 0.0 dup dup centmp 3d! ;
X
X ( Add a transformation which will move the object's center to the )
X ( origin, or move it back from the origin )
X: center ( a -- )
X
X cenclr
X dup 4 + @ if
X ( Repeat for each side... )
X dup 12 + swap 8 + @ dup negate i->f cencnt ! 0 do
X
X ( Add current point's X,Y,Z to centmp )
X dup x@ centmp x@ f+ centmp x!
X dup y@ centmp y@ f+ centmp y!
X dup z@ centmp z@ f+ centmp z!
X
X ( Advance to next point )
X 12 +
X loop
X drop
X
X ( Divide by # of points, negate all coordinates )
X centmp x@ cencnt @ f/
X centmp y@ cencnt @ f/
X centmp z@ cencnt @ f/
X trans
X
X endif
X;
X: uncenter
X
X ( Just change the sign of our previous work )
X cencnt @ fnegate cencnt !
X
X ( Divide by # of points )
X centmp x@ cencnt @ f/
X centmp y@ cencnt @ f/
X centmp z@ cencnt @ f/
X trans
X;
/*EOF
echo extracting - plot.fth
sed 's/^X//' > plot.fth << '/*EOF'
X." Loading plot.fth" cr
X( Routines to do plotting of a 3-D line into our 2-D viewing plane )
X
X ( Our center of projection for perspective projection viewing )
X ( Since these are variables, they may be dynamically altered )
X ( interactively. )
Xvariable xc 0.5 xc !
Xvariable yc 0.5 yc !
Xvariable zc -1.0 zc !
X
X ( Intrinsics for handling 3D points )
X
X ( Create a storage cell for a point )
X: 3dpt
X variable
X 8 allot
X;
X
X ( Fetch/store elements of a point )
X: x! ( xf a -- )
X ! ;
X: x@ ( a -- xf )
X @ ;
X: y! ( yf a -- )
X 4 + ! ;
X: y@ ( a -- yf )
X 4 + @ ;
X: z! ( zf a -- )
X 8 + ! ;
X: z@ ( a -- zf )
X 8 + @ ;
X
X ( Point store & fetch primitives )
X: 3d! ( xf yf zf a -- )
X dup >r z!
X r> dup >r y!
X r> x!
X;
X: 3d@ ( a -- xf yf zf )
X dup >r x@
X r> dup >r y@
X r> z@
X;
X
X ( Print a 3D point )
X: 3d.
X ." (" dup x@ f. 32 emit dup y@ f. 32 emit z@ f. ." )"
X;
X
X ( Hold the two points we're clipping against )
X ( and an indicator as to whether any of it is displayable )
X3dpt cp1
X3dpt cp2
Xvariable canshow
X
X ( The clipping words, one for each side of the window )
X: cright
X cp1 x@ 0.0 f< cp2 x@ 0.0 f< and if false canshow !
X else
X cp1 x@ 0.0 f< if
X cp1 y@ cp1 x@ cp2 y@ f* cp1 x@ cp1 y@ f* f-
X cp2 x@ cp1 x@ f- f/ f-
X cp1 y! 0.0 cp1 x!
X else
X cp2 x@ 0.0 f< if
X cp1 y@ cp1 x@ cp2 y@ f* cp1 x@ cp1 y@ f* f-
X cp2 x@ cp1 x@ f- f/ f-
X cp2 y! 0.0 cp2 x!
X endif
X endif
X endif
X;
X: cleft
X cp1 x@ 1.0 f> cp2 x@ 1.0 f> and if false canshow !
X else
X cp1 x@ 1.0 f> if
X 1.0 cp1 x@ f- cp2 x@ cp1 x@ f- f/
X cp2 y@ cp1 y@ f- f* cp1 y@ f+
X cp1 y! 1.0 cp1 x!
X else
X cp2 x@ 1.0 f> if
X 1.0 cp1 x@ f- cp2 x@ cp1 x@ f- f/
X cp2 y@ cp1 y@ f- f* cp1 y@ f+
X cp2 y! 1.0 cp2 x!
X endif
X endif
X endif
X;
X: cbot
X cp1 y@ 0.0 f< cp2 y@ 0.0 f< and if false canshow !
X else
X cp1 y@ 0.0 f< if
X cp1 x@ cp1 y@ cp2 x@ f* cp1 y@ cp1 x@ f* f-
X cp2 y@ cp1 y@ f- f/ f-
X cp1 x! 0.0 cp1 y!
X else
X cp2 y@ 0.0 f< if
X cp1 x@ cp1 y@ cp2 x@ f* cp1 y@ cp1 x@ f* f-
X cp2 y@ cp1 y@ f- f/ f-
X cp2 x! 0.0 cp2 y!
X endif
X endif
X endif
X;
X: ctop
X cp1 y@ 1.0 f> cp2 y@ 1.0 f> and if false canshow !
X else
X cp1 y@ 1.0 f> if
X 1.0 cp1 y@ f- cp2 y@ cp1 y@ f- f/
X cp2 x@ cp1 x@ f- f* cp1 x@ f+
X cp1 x! 1.0 cp1 y!
X else
X cp2 y@ 1.0 f> if
X 1.0 cp1 y@ f- cp2 y@ cp1 y@ f- f/
X cp2 x@ cp1 x@ f- f* cp1 x@ f+
X cp2 x! 1.0 cp2 y!
X endif
X endif
X endif
X;
X
X ( 2D clipping onto window of <0..1,0..1> )
X: 2dline ( x1f y1f x2f y2f -- )
X
X ( Set up our local work variables )
X 0.0 cp2 3d! 0.0 cp1 3d! true canshow !
X
X ( Now successively clip left,right,bottom,top )
X cright
X canshow @ if cleft endif
X canshow @ if cbot endif
X canshow @ if ctop endif
X
X ( Finally, get back the clipped endpoints )
X canshow @ if cp1 3d@ drop cp2 3d@ drop line endif
X;
X
X ( Temporary storage for 3D points )
X3dpt t1
X3dpt t2
Xvariable tmp1
Xvariable tmp2
X
X ( intersect--Project t1f onto the plane z=0 against t2f )
X: intersect ( t1f t2f -- )
X
X ( Stash their addresses away )
X tmp2 ! tmp1 !
X
X ( Do the perspective projection for x )
X tmp1 @ z@ tmp2 @ x@ f* tmp1 @ x@ tmp2 @ z@ f* f-
X tmp1 @ z@ tmp2 @ z@ f- f/
X
X ( Do the perspective projection for y )
X tmp1 @ z@ tmp2 @ y@ f* tmp1 @ y@ tmp2 @ z@ f* f-
X tmp1 @ z@ tmp2 @ z@ f- f/
X
X ( Replace the old values of t1f with these new ones )
X 0.0 tmp1 @ z!
X tmp1 @ y!
X tmp1 @ x!
X;
X
X ( 3line--plot a 3-D line )
X: 3dline ( x1f y1f z1f x2f y2f z2f -- )
X
X ( Save the two points )
X t2 3d! t1 3d!
X
X ( Trivial rejection test: if both points are behind our )
X ( view plane, don't plot them. )
X t1 z@ 0.0 f< t2 z@ 0.0 f< and 0 = if
X
X ( We DO have something to plot. If we have a point behind )
X ( the viewing plane, then interpolate it to its intersection )
X ( with the viewing plane. )
X t1 z@ 0.0 f< if t1 t2 intersect
X else
X t2 z@ 0.0 f< if t2 t1 intersect endif
X endif
X
X ( Now do a simple perspective projection, hand the result to )
X ( our 2D plot routine. Note that clipping is done in the 2D )
X ( plot routine, not here. )
X xc @ t1 z@ f* t1 x@ zc @ f* f- t1 z@ zc @ f- f/
X yc @ t1 z@ f* t1 y@ zc @ f* f- t1 z@ zc @ f- f/
X xc @ t2 z@ f* t2 x@ zc @ f* f- t2 z@ zc @ f- f/
X yc @ t2 z@ f* t2 y@ zc @ f* f- t2 z@ zc @ f- f/
X 2dline
X
X endif
X;
/*EOF
echo extracting - transform.fth
sed 's/^X//' > transform.fth << '/*EOF'
X." Loading transform.fth" cr
X ( Set up matrix V to do scaling on X, Y, and Z )
X: (scale) ( z y x v --- )
X
X ( Save its address )
X tmpw !
X
X ( Work our way through the elements on the stack, into 0,0, 1,1, ... )
X 3 0 do
X tmpw @ i i @elem
X f*
X tmpw @ i i !elem
X loop
X;
X
X ( set up matrix v to do translation )
X: (trans) ( z y x v --- )
X
X ( Save address of V into tmpw )
X tmpw !
X
X ( For each element on stack, add it on to current translation )
X 3 0 do
X tmpw @ 3 i @elem
X f+
X tmpw @ 3 i !elem
X loop
X;
X
X ( Hold SIN & COS of current angle )
Xvariable sintmp
Xvariable costmp
X
X ( Generate sin & cos for top item on stack, put into sintmp, costmp )
X: gentrig ( a -- )
X
X ( Set sintmp, costmp to hold the sin & cosin values of D )
X dup
X fsin sintmp !
X fcos costmp !
X;
X
X ( Make V do a rotation of D radians around x, turning y into z )
X: (xrot) ( d v --- )
X
X ( Get our trig values )
X swap gentrig
X
X ( Save matrix address in tmpw )
X tmpw !
X
X ( Loop through the rows )
X 4 0 do
X
X ( Calculate an intermediate value, keep it on the stack )
X tmpw @ i 1 @elem costmp @ f*
X tmpw @ i 2 @elem sintmp @ f* f-
X
X ( Now change tmatrix[i,2] )
X tmpw @ i 1 @elem sintmp @ f*
X tmpw @ i 2 @elem costmp @ f* f+
X tmpw @ i 2 !elem
X
X ( Put temporary into tmatrix[i,1] )
X tmpw @ i 1 !elem
X
X loop
X;
X
X ( Make V do a rotation of D radians around y, turning z into x )
X: (yrot) ( d v --- )
X
X ( Get our trig values )
X swap gentrig
X
X ( Save matrix address in tmpw )
X tmpw !
X
X ( Loop through the rows )
X 4 0 do
X
X ( Calculate an intermediate value, keep it on the stack )
X tmpw @ i 0 @elem costmp @ f*
X tmpw @ i 2 @elem sintmp @ f* f+
X
X ( Now change tmatrix[i,2] )
X tmpw @ i 2 @elem costmp @ f*
X tmpw @ i 0 @elem sintmp @ f* f-
X tmpw @ i 2 !elem
X
X ( Put temporary into tmatrix[i,0] )
X tmpw @ i 0 !elem
X
X loop
X;
X
X ( Make V do a rotation of D radians around z, turning x into y )
X: (zrot) ( d v --- )
X
X ( Get our trig values )
X swap gentrig
X
X ( Save matrix address in tmpw )
X tmpw !
X
X ( Loop through the rows )
X 4 0 do
X
X ( Calculate an intermediate value, keep it on the stack )
X tmpw @ i 0 @elem costmp @ f*
X tmpw @ i 1 @elem sintmp @ f* f-
X
X ( Now change tmatrix[i,2] )
X tmpw @ i 0 @elem sintmp @ f*
X tmpw @ i 1 @elem costmp @ f* f+
X tmpw @ i 1 !elem
X
X ( Put temporary into tmatrix[i,0] )
X tmpw @ i 0 !elem
X
X loop
X;
/*EOF
echo extracting - turtle.fth
sed 's/^X//' > turtle.fth << '/*EOF'
X." Loading turtle.fth" cr
X( Words to implement turtle-style graphics )
X
X( The following forth code embodies the algorithms presented )
X( in "Turtle Geometry" by Abelson and diSessa. )
X
X ( The three vectors which represent our turtle's heading )
X3dpt hdir ( Heading )
X3dpt udir ( 'up' direction )
X3dpt ldir ( 'left' direction )
X
X ( The turtle's cartesian position )
X3dpt tpos
X
X ( Initialize to the standard turtle starting parameters )
X1.0 0.0 0.0 hdir 3d!
X0.0 1.0 0.0 ldir 3d!
X0.0 0.0 1.0 udir 3d!
X0.5 0.5 0.5 tpos 3d!
X
X ( Temporary storage vector )
X3dpt ttmp
X
X ( Word to rotate one vector around another )
X ( Rotates vector 'va' around vector 'pva' 'angle' degrees. )
X ( Returns the new vector as 'nva' on the stack )
X: dorot ( va pva angle -- nva )
X
X ( Get sin, cos of angle--put in sintmp, costmp )
X i->f gentrig
X
X ( Fill in stuff on pva, use 'cp1' for temp storage )
X dup x@ sintmp @ f* cp1 x!
X dup y@ sintmp @ f* cp1 y!
X z@ sintmp @ f* cp1 z!
X
X ( Now add in stuff for va )
X dup x@ costmp @ f* cp1 x@ f+ cp1 x!
X dup y@ costmp @ f* cp1 y@ f+ cp1 y!
X z@ costmp @ f* cp1 z@ f+ cp1 z!
X
X ( Finally, return the address of cp1 as our result )
X cp1
X;
X
X ( Pen position, true=down, false=up )
Xvariable penpos
Xtrue penpos !
X
X ( Command to move forward )
X: forward ( d -- )
X
X ( Scale distance down by 100 )
X i->f 100.0 f/
X
X ( Now multiply distance by hdir, add to tpos )
X dup hdir x@ f* tpos x@ f+ ttmp x!
X dup hdir y@ f* tpos y@ f+ ttmp y!
X hdir z@ f* tpos z@ f+ ttmp z!
X
X ( Only draw the side if the pen's down )
X penpos @ if
X ( Add a side to current object from old position to new )
X ttmp 3d@ tpos 3d@ addside
X endif
X
X ( update turtle position )
X ttmp 3d@ tpos 3d!
X;
X
X ( 3dneg--return the address of a negated 3d vector. We use cp2, )
X ( so the returned value should be used or copied immediately )
X: 3dneg ( v -- v2 )
X dup x@ fnegate cp2 x!
X dup y@ fnegate cp2 y!
X z@ fnegate cp2 z!
X cp2
X;
X
X ( yaw--this is TURN in 2D, but we go to navigational terms in 3D )
X: yaw ( a -- )
X
X ( Calculate our new H )
X dup hdir ldir rot dorot 3d@ ttmp 3d!
X
X ( Calculate & update L )
X ldir hdir 3dneg rot dorot 3d@ ldir 3d!
X
X ( Now update H )
X ttmp 3d@ hdir 3d!
X;
X
X ( Pitch--tip our nose up or down )
X: pitch ( a -- )
X
X ( Calculate H )
X dup hdir udir rot dorot 3d@ ttmp 3d!
X
X ( Calculate & update U )
X udir hdir 3dneg rot dorot 3d@ udir 3d!
X
X ( Update H )
X ttmp 3d@ hdir 3d!
X;
X
X ( Roll--tip us sideways )
X: roll ( a -- )
X
X ( Calculate L )
X dup ldir udir rot dorot 3d@ ttmp 3d!
X
X ( Calculate & update U )
X udir ldir 3dneg rot dorot 3d@ udir 3d!
X
X ( Update L )
X ttmp 3d@ ldir 3d!
X;
X
X ( Pen position changing )
X: penup false penpos ! ;
X: pendown true penpos ! ;
/*EOF
echo extracting - load_3a
sed 's/^X//' > load_3a << '/*EOF'
Xinput terms/3a.fth
Xinput matutil.fth
Xinput transform.fth
Xinput plot.fth
Xinput object.fth
Xinput turtle.fth
/*EOF
echo extracting - load_dm
sed 's/^X//' > load_dm << '/*EOF'
Xinput terms/dm.fth
Xinput matutil.fth
Xinput transform.fth
Xinput plot.fth
Xinput object.fth
Xinput turtle.fth
/*EOF
echo extracting - load_hp
sed 's/^X//' > load_hp << '/*EOF'
Xinput terms/hp.fth
Xinput matutil.fth
Xinput transform.fth
Xinput plot.fth
Xinput object.fth
Xinput turtle.fth
/*EOF
echo making subdirectory - doc
mkdir doc
echo extracting - doc/demo_session
sed 's/^X//' > doc/demo_session << '/*EOF'
X( load this to get a pretty view of an octagonal object )
Xinput figs/turt_oct
Xnewobj foobar
Xoct
Xxfm
X foobar center
X 70.0 xrot
X -60.0 yrot
X uncenter
Xfoobar doxfm
Xinit erase draw
/*EOF
echo extracting - doc/doc_adding_terms
sed 's/^X//' > doc/doc_adding_terms << '/*EOF'
X How to tell vforth about your terminal
X
X The process for adding your terminal to vforth is fairly
Xstraightforward. In the vforth directory there will be files with
Xnames like "load_<TERM>"; within each file, the first line will look
Xlike "input terms/<TERM>.fth". The following lines load in the graphics
Xsystem. Since the graphics system is the same regardless of the terminal,
Xyou don't need to worry about changing it. The idea is that you will
Xset up a load file, and then create a vforth file which describes
Xyour terminal.
X
X The following discussion
X
XStep one: create a load file
X Get in the vforth directory, and do:
X% cp load_hp load_myterm
X% ed load_myterm
X1
Xs/hp/myterm/
Xw
Xq
X
XStep two: write words to drive your terminal
X This is the part that requires some forth knowledge. Use one
Xof the sample description files in "terms/". The words which you have
Xto write are: "init", "erase", and "plot". The documentation file
X"glossary" tells you what each word has to do.
X
X One fine point is that a terminal which has only pixel-
Xplotting ability will have to rely on a line-drawing routine. This
Xroutine is already supplied, in the form "terms/line.fth". If you
Xdon't have line-drawing primitives, you write "plot", and include
X"line.fth". If you DO have line-drawing primitives, you just write
Xthe word "line", and don't bother with "plot".
X
X The points which are passed to both "line" and "plot" are in
X"device normal" format. This simply means that the X and Y axes are
X1 unit long, with the origin begin in the lower left corner.
X
X Once you've written your routines, load them, and then load
Xthe graphics system on top of them. They need not do any clipping, as
Xthe graphics system does this for you; the coordinates sent will always
Xbe between 0.0 and 1.0.
X
X As always, I am available for opinions and/or help.
X
X Good luck!
X Andy Valencia
X ...!{ucbvax,fortune}!hpda!vandys
X
/*EOF
echo extracting - doc/doc_implement
sed 's/^X//' > doc/doc_implement << '/*EOF'
X
XImplementation details of the FORTH graphics system.
X
X This document describes the forth graphics system turned in
Xas the final project of CIS160 (Computer Graphics) at UC Santa Cruz
Xby Andy Valencia. At time of writing, the forth language system
Xused was JHU Forth; since then, a much faster 32-bit forth system
Xhas been written.
X
X1. Initial system
X The forth system used to implement this graphics package was
Xthe John Hopkins University forth system. This software is in the
Xpublic domain.
X
X2. System modifications
X
X Three major shortcomings made it necessary to modify the forth system
Xas received. First, the system insisted that all identifiers be
XUPPER CASE. In a UNIX environment, this was unacceptable. The
Xstring recognition routines of JHU forth were modified so that
Xall letters of the string were mapped to upper case prior to searching
Xfor a string. Thus, backward compatibility was maintained
Xwith existing software, while not forcing us to use upper case.
X
X The second major problem was the lack of floating point. The
Xlanguage system was modified so that floating point math was
Xsupported. This entailed adding the floating point routines, and
Xthen modifying the input recognizer to recognize (and handle
Xspecially) floating point numbers. The biggest problem with
Xthis phase was that forth used 16-bit integers, whereas the
Xfloating point numbers were 32-bit quantities. As the major
Xdata structures became apparent, sets of words were developed
Xso that these 32-bit quantities could be handled naturally.
X
X Finally, the system possessed no trigonometric functions;
Xwe added sin and cosin. Our implementation of these functions was quite
Xefficient; we made a table of the sin values from 0 to 90, then
Xwrote routines which looked up the angle needed (doing quadrant
Xmapping, sign changing, etc.) rather than executing a numeric
Xalgorithm. The initial routines returned an integer quantity
Xwhich was the sin value scaled by 10000; we later wrote
Xfloating versions of sin and cosin (named "fsin" and "fcos")
Xwhich scaled these integers back into real numbers between
X-1 and 1.
X
X3. Graphics interface
X
X Although graphics presentation is most rewarding when done
Xon a specialized device, we realized that we would probably have
Xto do most of the development on character-display devices. Thus,
Xthe graphics display device is presented to the higher level
Xsoftware as a call to "line". Line takes device normal coordinates,
Xand draws the line on the screen. On, say, a Tek 4016, the call
Xto line merely scales the values given and displays them using
Xthe line drawing primitives resident in the device. However,
Xto support character devices, a second technique was developed.
X"line" was written using the DDA algorithm. This could
Xthen call the routine "plot", which would a character on the screen.
XAs an efficiency enhancement, "plot" will not emit any escape
Xsequences to the terminal if there is already a character plotted
Xat the desired position.
X
X4. Matrix manipulation words
X
X A set of words were made which allowed matrices to be used in
Xa relatively natural way. Words were made for allocating matrices,
Xand for accessing both their individual elements and the matrix in
Xits entirety.
X
X Surprisingly, the only bona fide matrix math operation which
Xwas needed was matrix multiplication; most routines access the
Xelements of a matrix directly for efficiency.
X
X5. Objects
X
X After carefully considering other approachs to objects, we decided
Xto take a more classic approach. An object is defined as an arbitrary number
Xof sides. An object is either displayed or not displayed. The
Xonly things you can do to an object are: add sides, display it,
Xhide it, or execute transformations upon it.
X
X6. Transformation words
X
X The transformation capability of the forth graphics system
Xwas developed in two layers. First a set of primitive, generalized
Xroutines were written which generated the desired transformations.
XThen a second set of parallel words were written which integrated
Xall the different transformations into a single mechanism.
X
X The high level mechanism keeps the successsive transformations
Xinternally, then executes them upon selected objects. Thus, the
Xforth commands to translate A and B by -0.5 in the X, Y, and Z,
Xthen rotate about the X axis by 45 degrees would be:
X xfm -0.5 -0.5 -0.5 trans 45 xrot a doxfm b doxfm
X
XNote that forth is a free-format language; the commands did not
Xhave to be put on a single line. Also note that the invocation
Xof the listed transformations is on an object-by-object basis.
X
X7. 3D viewing system
X
X We soon realized that the CORE display file concept was
Xat odds with the interactive nature of the forth
Xsystem we were implementing our graphics routines on. The approach
Xwe took was to enhance the interactive nature of the graphics
Xtools; this is most obvious in our viewing system.
X
X Our viewing system is invoked by the "draw" word. Each object
Xwhich is not hidden will be displayed on the screen. An object
Xis drawn on a line-by-line basis. The clipping is done in two
Xpasses: first the line is clipped against the viewing plane. If the
Xline intersects the viewing plane, then the point which is behind
Xthe viewing plane is projected to its intersection with the viewing
Xplane. If a line is completely behind the plane, it is not displayed.
XAfter this clipping, the two endpoints are mapped onto the plane
Xusing perspective projection. Finally, these points are handed
Xoff to a 2-dimensional routine for display.
X
X The 2-dimensional routine then clips against the right, left,
Xtop, and bottom borders. Two equivalent ways of looking at the
Xviewing process can be taken: the viewer can move around the object,
Xor the object can be moved. In deviating from the book's (and
XCORE's) decision to move the viewer, we took the philosophy that
Xwhat is most natural to a human should be used. In a system this
Xsize, we will be looking at rather small objects. It is natural
Xfor a human to reach out and manipulate an object, rather than
Xpassively move around it (consider the plethora of "Don't touch"
Xsigns we encounter in museums and expensive stores). Thus, one's
Xviewing plane is fixed at the plane Y=0, with border limits
Xof 0..1 for each side.
X
X We found this solution to be quite acceptable, with the exception
Xof the case where one wanted to rotate an object to see it from
Xdifferent angles--it was quite inconvenient to figure out what kind
Xof translation was needed to move it to the origin. We solved this
Xby adding the transformations "center" and "uncenter". The former
Xtranslates the object so that its center (defined as the arithmetic
Xmean of its X, Y, and Z componenets) was at the origin. The latter
Xmerely undoes this affect. Thus, a common transformation to view
Xan object named "box" from a tilted angle might be:
X
X xfm box center 22 xrot 22 yrot uncenter box doxfm
XWhich would rotate the box by 22 degrees around its center on both
Xthe X and Y axes.
X
X8. A nicer way to make pictures
X
X As an application to exercise this graphics system, we implemented
Xa 3D turtle graphics system. In such a system, you have an entity named
Xthe turtle which possesses a 3D location and heading. Using the
Xnavigational terms "yaw", "pitch", and "roll", one may make the turtle
Xface in any direction. Then it may be moved forward with (strangely
Xenough) the "forward" command. These may all be embedded within
Xa FORTH program, gaining a surprising amount of power. The sequence:
X
X: octa
X 8 0 do
X 10 forward
X 45 yaw
X loop
X;
X
Xwill generate an octagon.
X
XThe Turtle "pen" may be either up or down. When it is up, "forward" words
Xwill not add sides to the object. When it is down, "forward" will add
Xsides. Initially, it is down.
X
XThus, with the previous program available, the sequence
X newobj showoff
X octa 90 roll octa
Xwill generate a pair of octagons, sharing a common side, which
Xare at right angles to each other.
X
/*EOF
echo extracting - doc/doc_words
sed 's/^X//' > doc/doc_words << '/*EOF'
X
X The following is the list of routines, all written in forth,
Xwhich implement the 3D viewing system.
X
Xinit ( Clear our graphic buffer )
X This word is called once to initialize the graphics display device.
X
Xerase
X This will erase the graphics display device.
X
Xplot ( fx fy -- )
X Draws a point at the specified position. This word is only defined
Xif the device being driven does not have intrinsic line-drawing
Xcapability. It is used by the "line" word, which is an implementation
Xof DDA.
X
Xline ( fx1 fy1 fx2 fy2 -- )
X Implements DDA. Note that the line is NOT clipped; see 2dline
Xfor this functionality. Generally, this word is a simple mapping onto
Xthe escape sequences needed to display on a particular device.
X
Xrngchk ( r c -- )
X An internal routine which does range checking on the indices of
Xa matrix element.
X
X@elem ( v r c --- n )
X Fetches the floating point element "fn" from the matrix whose
Xaddress is "v", at row "r", column "c".
X
X!elem ( n v r c --- ) ( stores floating point value n in )
X The complementary routine to "@elem@ which stores the value in
Xthe matrix.
X
Xclrmat
X Initializes all members of a matrix to 0.
X
Xident ( v --- )
X Sets the matrix to the identity matrix.
X
X.mat ( v -- )
X Prints the contents of a matrix on the screen.
X
Xmatvar
X Allocates space for a named matrix.
X
Xmatcpy ( src dst -- )
X Copies the contents of matrix "src" to "dst".
X
Xmat* ( S T --- ) ( 4x4 matrix multply: T = T * S )
X Matrix multiplication: T = T * S.
X
Xfcos ( a -- fv )
X Returns the floating cosin value of angle 'a', where 'a' is in degrees.
X
Xfsin ( a -- fv )
X As "fcos", but does sin.
X
Xnewobj
X Allocates space for a new named object, and adds this object to
Xthe object list. After creation with this routine, sides may be added
Xto the object with the "addside" word.
X
X(addside) ( xf yf zf -- )
X Internal routine which stores a point into memory.
X
Xaddside ( x1f y1f z1f x2f y2f z2f -- )
X Causes the 3-dimensional line segment to become a part of the
Xcurrent object.
X
Xhide ( a -- )
X Causes the object whose address is "a" to not be displayed during
Xdisplay updates. Initially, an object is drawn.
X
Xshow ( a -- )
X Changes the attribute of the object back to "show"; undoes
Xthe effect of a "hide".
X
Xdr-obj ( a -- )
X An internal routine which draws the named object on the screen.
X
Xdraw
X Draws all objects whose attribute is "show".
X
Xxfm
X Starts off a series of transformations. The most common use
Xis: xfm <transformation>,... <object> doxfm
Xwhich will cause the named object to be put through the
Xspecified transformations.
X
Xxrot ( d -- )
Xyrot ( d -- )
Xzrot ( d -- )
X Rotation of "d" degrees around the X, Y, and Z axis. Used
Xafter "xfm" is invoked.
X
Xrevarg ( xf yf zf -- zf yf xf )
X A generally useful word which reverses the order of the top
Xthree floating point numbers.
X
Xtrans ( xf yf zf -- )
X A translation with offsets of xf, yf, and zf is done. Used after
X"xfm" is invoked.
X
Xscale ( xf yf zf -- )
X Scales the X, Y, and Z coordinates by xf, yf, and zf. Used with
X"xfm".
X
Xdoxfm ( a -- )
X Implements all pending transformations on the named object. Note
Xthat the pending transformations may be done to several objects by
Xusing "<object> doxfm" a number of times.
X
X.obj ( a -- )
X Prints the points which make up an object. Generally useful
Xonly for debugging.
X
Xcenclr
X An internal initialization routine for the "center" word.
X
Xcenter ( a -- )
X Take the named object, figure out its mathematical center, and then
Xenter the negation of this as a translation (see "trans"). This is used
Xto bring an object to the origin without doing any hand calculations.
X
Xuncenter
X Undoes the translation done by "center".
X
X3dpt
X Allocates space for the named 3-dimensional point.
X
Xx! ( xf a -- )
Xx@ ( a -- xf )
Xy! ( yf a -- )
Xy@ ( a -- yf )
Xz! ( zf a -- )
Xz@ ( a -- zf )
X Fetch & store primitives which access the X, Y, and Z fields
Xof a 3D point.
X
X3d! ( xf yf zf a -- )
X3d@ ( a -- xf yf zf )
X Fetch & store of the 3 elements of a 3D point, en masse.
X
X3d.
X Print a 3D point's values.
X
Xcright
Xcleft
Xcbot
Xctop
X Internal routines which clip the four sides of a 2D window.
X
X2dline ( x1f y1f x2f y2f -- )
X Draw a 2D line (by calling "line") after clipping.
X
Xintersect ( t1f t2f -- )
X Internal routine to 3dline which is used for viewing-plane
Xintersection calculations.
X
X3dline ( x1f y1f z1f x2f y2f z2f -- )
X Plot a line expressed in 3D. This routine does front and back-plane
Xclipping, then calls 2dline.
X
Xgentrig ( a -- )
X Internal routine which stores the sin and cosin values of angle "a"
Xinto sintmp and costmp.
X
X(scale) ( z y x v --- )
X(trans) ( z y x v --- )
X(xrot) ( d v --- )
X(yrot) ( d v --- )
X(zrot) ( d v --- )
X Internal routines which do the actual matrix operations associated
Xwith scaling, translating, and rotations.
X
Xdorot ( va pva angle -- nva )
X Internal routine used with the turtle graphics subsystem. Does
Xrotations of a vector around a perpendicular vector by "angle" degrees.
X
X3dneg ( v -- v2 )
X Internal turtle graphics routine which negates a 3D vector.
X
Xforward ( d -- )
X Turtle graphics. Moves the turtle "d" units forward in its
Xcurrent direction.
X
Xyaw ( a -- )
X Turns the turtle right or left on its current plane by 'a' degrees.
X
Xpitch ( a -- )
X Tips the turtle's nose up or down by "a" degrees.
X
Xroll ( a -- )
X Rolls the turtle right or left by "a" degrees.
X
Xpenup
X All successive "forward" commands will not draw sides.
X
Xpendown
X All successive "forward" commands will draw sides. Default condition.
X
/*EOF
echo making subdirectory - figs
mkdir figs
echo extracting - figs/box
sed 's/^X//' > figs/box << '/*EOF'
Xnewobj box
X0.25 0.25 0.1 0.25 0.75 0.1 addside
X0.25 0.75 0.1 0.75 0.75 0.1 addside
X0.75 0.75 0.1 0.75 0.25 0.1 addside
X0.75 0.25 0.1 0.25 0.25 0.1 addside
X
X0.25 0.25 0.9 0.25 0.75 0.9 addside
X0.25 0.75 0.9 0.75 0.75 0.9 addside
X0.75 0.75 0.9 0.75 0.25 0.9 addside
X0.75 0.25 0.9 0.25 0.25 0.9 addside
X
X0.25 0.25 0.1 0.25 0.25 0.9 addside
X0.25 0.75 0.1 0.25 0.75 0.9 addside
X0.75 0.25 0.1 0.75 0.25 0.9 addside
X0.75 0.75 0.1 0.75 0.75 0.9 addside
/*EOF
echo extracting - figs/turt_box
sed 's/^X//' > figs/turt_box << '/*EOF'
X: box1
X -90 pitch 8 forward
X 90 pitch 8 forward
X 90 pitch penup 8 forward pendown
X 90 pitch 8 forward 180 pitch
X;
X: box2
X 4 0 do
X box1
X penup 8 forward pendown
X 90 yaw
X loop
X;
/*EOF
echo extracting - figs/turt_oct
sed 's/^X//' > figs/turt_oct << '/*EOF'
X: oct2
X 8 0 do
X 10 forward
X -45 pitch
X 10 forward
X loop
X;
X: oct
X 6 0 do
X oct2
X 30 yaw
X loop
X;
/*EOF
echo extracting - figs/turt_tube
sed 's/^X//' > figs/turt_tube << '/*EOF'
X: tub1
X -90 yaw
X 40 forward
X 90 yaw
X 10 forward
X 90 yaw penup
X 40 forward pendown
X 90 yaw 10 forward
X 180 yaw
X;
X: tube
X 8 0 do
X tub1
X penup 10 forward pendown
X -45 pitch
X loop
X;
/*EOF
echo extracting - figs/turt_tube2
sed 's/^X//' > figs/turt_tube2 << '/*EOF'
X: tub2
X 90 yaw
X 8 0 do
X 10 forward -45 pitch
X loop
X -90 yaw
X;
X: tube
X 10 0 do
X tub2
X penup 5 forward pendown
X loop
X;
X
/*EOF
echo making subdirectory - terms
mkdir terms
echo extracting - terms/3a.fth
sed 's/^X//' > terms/3a.fth << '/*EOF'
X( plot routines for an ADM3A ) decimal
X
Xvariable scrnmem 1916 allot
X
X42 constant plotchar ( We will plot with a star )
X
X: init ( Clear our graphic buffer )
X 1920 0 do
X 0 i scrnmem + c!
X loop
X;
X
X: erase
X init 26 emit
X;
X
X: plot ( xf yf -- )
X 23.0 f* f->i 23 swap - ( Turn 0..1 to 23..0 )
X swap 79.0 f* f->i swap ( Turn 0..1 into 0..79 )
X 2dup 80 * + scrnmem + dup c@ plotchar = if
X drop
X 2drop ( already plotted here )
X else
X plotchar swap c! ( mark our plot )
X ." =" ( 3a Cursor address command )
X 32 + emit 32 + emit ( emit the char )
X plotchar emit ( plot our character )
X endif
X;
X
Xinput terms/line.fth
/*EOF
echo extracting - terms/dm.fth
sed 's/^X//' > terms/dm.fth << '/*EOF'
X( plot routines for an DM1520 ) decimal
X
Xvariable scrnmem 1916 allot
X
X42 constant plotchar ( We will plot with a star )
X
X: init ( Clear our graphic buffer )
X 1920 0 do
X 0 i scrnmem + c!
X loop
X;
X
X: erase
X init 12 emit
X;
X
X: plot ( xf yf -- )
X 23.0 f* f->i 23 swap - ( Turn 0..1 to 23..0 )
X swap 79.0 f* f->i swap ( Turn 0..1 into 0..79 )
X 2dup 80 * + scrnmem + dup c@ plotchar = if
X drop
X 2drop ( already plotted here )
X else
X plotchar swap c! ( mark our plot )
X ." " ( 3a Cursor address command )
X swap 32 + emit 32 + emit ( emit the char )
X plotchar emit ( plot our character )
X endif
X;
X
Xinput terms/line.fth
/*EOF
echo extracting - terms/fake_line.fth
sed 's/^X//' > terms/fake_line.fth << '/*EOF'
X: line ." (" 2swap f. ." ," f. ." ) to (" 2swap f. ." ," f. ." )" cr ;
/*EOF
echo extracting - terms/hp.fth
sed 's/^X//' > terms/hp.fth << '/*EOF'
X( plot routines for an HP terminal ) decimal
X
Xvariable scrnmem 1916 allot
X
X42 constant plotchar ( We will plot with a star )
X
X: init ( Clear our graphic buffer )
X scrnmem 1920 0 fill
X;
X
X: erase
X init ." hJ"
X;
X
X ( Plot the normal coordinate point <x,y> )
X: plot ( xf yf -- )
X 23.0 f* f->i 23 swap - >r ( turn 0..1 to 23..0 )
X 79.0 f* f->i ( turn 0..1 to 0..79 )
X r> 2dup 80 * + scrnmem + dup c@ plotchar = if
X drop ( already plotted here )
X 2drop
X else
X decimal
X plotchar swap c! ( mark our plot )
X ." &a" ( HP Cursor address command )
X . ." r" . ." C"
X plotchar emit ( plot our character )
X endif
X;
X
Xinput terms/line.fth
/*EOF
echo extracting - terms/line.fth
sed 's/^X//' > terms/line.fth << '/*EOF'
X( words to provide line-drawing capability )
X
X( NOTE: these routines are generally used only with low-resolution )
X( terminals without intrinsic line-drawing ability. )
X
Xvariable p1x ( Storage for our two points )
Xvariable p1y
Xvariable p2x
Xvariable p2y
X
Xvariable dx ( Holds delta-x,y )
Xvariable dy
X
X: line ( x2f y2f x1f y1f -- )
X
X ( Save end points )
X p1y ! p1x !
X p2y ! p2x !
X
X ( Calculate DX, DY )
X p2x @ p1x @ f- dx !
X p2y @ p1y @ f- dy !
X
X ( Calculate # steps needed )
X dx @ fabs dy @ fabs fmax 132.0 f* 1.0 f+
X
X ( Scale DX, DY for this number of steps )
X dx @ over f/ dx !
X dy @ over f/ dy !
X
X ( For the required # of steps, do... )
X f->i 0 do
X
X ( Get the current point, store it back incremented by DX,DY )
X p1x @ dup dx @ f+ p1x !
X p1y @ dup dy @ f+ p1y !
X
X ( Plot the point )
X plot
X
X loop
X
X;
/*EOF