vandys@lindy.stanford.edu (Andy Valencia) (07/18/87)
I don't know if this is of interest. It's a 3D graphics system
written in Forth. Problem is, it assumes that the Forth has 32-bit integers
and 32-bit floating-point numbers. I put vforth (a VAX forth) into the
public domain to run this sucker, but that was back when a VAX was one of
the only games in town. Perhaps someone could hack up cforth to be 32-bit,
and then it could go out hand-in-hand with this? Tell me what you think.
Thanks,
Andy Valencia
vandys@lindy.stanford.edu
#!/bin/sh-----cut here-----cut here-----cut here-----cut here-----
# This is a shell archive.
# Run the following text with /bin/sh to extract.
mkdir doc
mkdir figs
mkdir terms
cat - << \Funky!Stuff! > load_grafix
" grafix.fth" fload
" matutil.fth" fload
" transform.fth" fload
" plot.fth" fload
" object.fth" fload
" turtle.fth" fload
Funky!Stuff!
cat - << \Funky!Stuff! > load_hp
input terms/hp.fth
input matutil.fth
input transform.fth
input plot.fth
input object.fth
input turtle.fth
Funky!Stuff!
cat - << \Funky!Stuff! > load_hp150
input terms/hp150.fth
input matutil.fth
input transform.fth
input plot.fth
input object.fth
input turtle.fth
Funky!Stuff!
cat - << \Funky!Stuff! > matutil.fth
( utility words for dealing with 4x4 matrices )
( Check top two stack items for range [0..3] )
: rngchk
dup 0 < swap 3 > or
swap dup 0 < swap 3 > or or
if
." Range error" cr abort
endif
;
: @elem ( v r c --- n ) ( fetches floating point value n from element )
( [r,c] of floating point array v )
2dup rngchk
4 * swap 16 * + + @ ;
: !elem ( n v r c --- ) ( stores floating point value n in )
( element [r,c] of array v )
2dup rngchk
4 * swap 16 * + + ! ;
( Clear a matrix to 0's )
: clrmat
64 0 fill
;
( set up 4x4 matrix to be the identity matrix )
: ident ( v --- )
dup clrmat ( clear matrix to all zeros )
4 0 do
1.0 1 pick i i !elem
loop
drop
;
( Print out a matrix )
: .mat
4 0 do
4 0 do
dup j i @elem f. 9 emit
loop cr
loop
drop
;
( Allocate a matrix )
: matvar
variable
62 allot
;
( matcpy--copy one matrix into another )
: matcpy ( src dst -- )
swap
16 0 do
dup @ swap 4 + swap rot dup 4 + -rot !
loop
;
variable mat1 ( Temporary storage for matrix addresses )
variable mat2
matvar tmpmat ( And a temporary matrix )
variable tmpw ( Temp storage for a word quantity )
: mat* ( S T --- ) ( 4x4 matrix multply: T = T * S )
mat2 ! ( store addr of matices )
mat1 !
4 0 do ( Which row of mat1 we're on )
4 0 do ( Which column of mat2 )
0.0 4 0 do ( For that r & c, loop through & sum )
mat1 @ k i @elem
mat2 @ i j @elem
f* f+
loop
tmpmat j i !elem ( Save the result )
loop
loop
tmpmat mat2 @ matcpy ( copy result to destination )
;
Funky!Stuff!
cat - << \Funky!Stuff! > object.fth
( Implementation of graphical objects )
( To keep a linked list of all objects )
variable lstobj 0 lstobj !
( Intrinsic to create an object )
: newobj
variable
-4 allot
( Add this object to our list )
here lstobj dup @ , !
( Initially, each object is displayed )
true ,
( And initially, the object has no members )
0 ,
;
( Internal routine to add words to dictionary space )
: (addside) ( xf yf zf -- )
( They come in the wrong order, so reverse it & store )
>r
>r
( Store the three elements of a 3D point )
here ! 4 allot
r> here ! 4 allot
r> here ! 4 allot
;
( Add a side to our most current object )
: addside ( x1f y1f z1f x2f y2f z2f -- )
( Increment the side counter )
lstobj @ dup if
8 + dup @ 1 + swap !
else
." No current object" cr abort
endif
( We just call our routine once for each point )
(addside) (addside)
;
( Hide & show an object )
: hide ( a -- )
4 + false swap !
;
: show ( a -- )
4 + true swap !
;
( Draw an object )
: dr-obj ( a -- )
dup 4 + @ if
( Don't drop into the do loop if there are no sides )
dup 8 + @ if
( Repeat for each side... )
dup 12 + swap 8 + @ 0 do
( Stash current address on return stack )
dup >r
( Get the two points, increment pointer )
3d@ r> 12 +
( Repeat process for next point, draw line )
dup >r 3d@ 3dline r> 12 +
loop
endif
endif
drop
;
( Draw all objects )
: draw
( Get start of list )
lstobj @
( While not at end of list, do an object )
begin
dup
while
dup @ swap dr-obj
repeat
drop
;
( These are the words which execute transformations upon objects )
( This is the matrix which takes on successive transformations )
matvar curxfm
( xfm--sets up everything, get ready to describe a sequence )
( of transformations )
: xfm
curxfm ident
;
( x,y,z rot--do rotations about the various axis )
: xrot ( d -- )
curxfm (xrot) ;
: yrot ( d -- )
curxfm (yrot) ;
: zrot ( d -- )
curxfm (zrot) ;
3dpt tmppt
( Reverse the order of the top three 2-word elements )
: revarg ( xf yf zf -- zf yf xf )
tmppt 3d! tmppt z@ tmppt y@ tmppt x@ ;
( trans--do a translation )
: trans ( xf yf zf -- )
( The internal routine wants them the other way around )
revarg
curxfm (trans) ;
( scale--do a scaling operation )
: scale ( xf yf zf -- )
revarg curxfm (scale) ;
( doxfm--implement all the transformations on the named object )
: doxfm ( a -- )
( For each point... )
dup 12 + swap 8 + @ 2 * 0 do
( Fetch the current point, advance to next )
dup 12 + swap
( Hold the current point's address in tmpw )
tmpw !
( For each column of the transformation matrix... )
3 0 do
( Do a matrix multiplication )
tmpw @ x@ curxfm 0 i @elem f*
tmpw @ y@ curxfm 1 i @elem f*
tmpw @ z@ curxfm 2 i @elem f*
curxfm 3 i @elem
f+ f+ f+
loop
( Now store the new point, which has been build on the stack, )
( back into the current point )
tmpw @ 3d!
loop drop
;
( .obj--print the sides making up an object )
: .obj ( a -- )
( For each pair of points... )
dup 12 + swap 8 + @ 0 do
( Fetch the current point, advance to next )
dup 12 + swap
." (" dup x@ f. 32 emit dup y@ f. 32 emit z@ f. ." ) to ("
dup 12 + swap
dup x@ f. 32 emit dup y@ f. 32 emit z@ f. ." )" cr
loop drop
;
( Routines for centering & uncentering an object around the origin )
( Holds the current sum of X,Y,Z values, and # of sides )
3dpt centmp
variable cencnt
( Clear the summing temporary variable "centmp" )
: cenclr
0.0 dup dup centmp 3d! ;
( Add a transformation which will move the object's center to the )
( origin, or move it back from the origin )
: center ( a -- )
cenclr
dup 8 + @ if
( Repeat for each side... )
dup 12 + swap 8 + @ dup negate i->f cencnt ! 0 do
( Add current point's X,Y,Z to centmp )
dup x@ centmp x@ f+ centmp x!
dup y@ centmp y@ f+ centmp y!
dup z@ centmp z@ f+ centmp z!
( Advance to next point )
12 +
loop
drop
( Divide by # of points, negate all coordinates )
centmp x@ cencnt @ f/
centmp y@ cencnt @ f/
centmp z@ cencnt @ f/
trans
endif
;
: uncenter
( Just change the sign of our previous work )
cencnt @ fnegate cencnt !
( Divide by # of points )
centmp x@ cencnt @ f/
centmp y@ cencnt @ f/
centmp z@ cencnt @ f/
trans
;
Funky!Stuff!
cat - << \Funky!Stuff! > plot.fth
( Routines to do plotting of a 3-D line into our 2-D viewing plane )
( Our center of projection for perspective projection viewing )
( Since these are variables, they may be dynamically altered )
( interactively. )
variable xc 0.5 xc !
variable yc 0.5 yc !
variable zc -1.0 zc !
( Intrinsics for handling 3D points )
( Create a storage cell for a point )
: 3dpt
variable
8 allot
;
( Fetch/store elements of a point )
: x! ( xf a -- )
! ;
: x@ ( a -- xf )
@ ;
: y! ( yf a -- )
4 + ! ;
: y@ ( a -- yf )
4 + @ ;
: z! ( zf a -- )
8 + ! ;
: z@ ( a -- zf )
8 + @ ;
( Point store & fetch primitives )
: 3d! ( xf yf zf a -- )
dup >r z!
r> dup >r y!
r> x!
;
: 3d@ ( a -- xf yf zf )
dup >r x@
r> dup >r y@
r> z@
;
( Print a 3D point )
: 3d.
." (" dup x@ f. 32 emit dup y@ f. 32 emit z@ f. ." )"
;
( Hold the two points we're clipping against )
( and an indicator as to whether any of it is displayable )
3dpt cp1
3dpt cp2
variable canshow
( The clipping words, one for each side of the window )
: cright
cp1 x@ 0.0 f< cp2 x@ 0.0 f< and if false canshow !
else
cp1 x@ 0.0 f< if
cp1 y@ cp1 x@ cp2 y@ f* cp1 x@ cp1 y@ f* f-
cp2 x@ cp1 x@ f- f/ f-
cp1 y! 0.0 cp1 x!
else
cp2 x@ 0.0 f< if
cp1 y@ cp1 x@ cp2 y@ f* cp1 x@ cp1 y@ f* f-
cp2 x@ cp1 x@ f- f/ f-
cp2 y! 0.0 cp2 x!
endif
endif
endif
;
: cleft
cp1 x@ 1.0 f> cp2 x@ 1.0 f> and if false canshow !
else
cp1 x@ 1.0 f> if
1.0 cp1 x@ f- cp2 x@ cp1 x@ f- f/
cp2 y@ cp1 y@ f- f* cp1 y@ f+
cp1 y! 1.0 cp1 x!
else
cp2 x@ 1.0 f> if
1.0 cp1 x@ f- cp2 x@ cp1 x@ f- f/
cp2 y@ cp1 y@ f- f* cp1 y@ f+
cp2 y! 1.0 cp2 x!
endif
endif
endif
;
: cbot
cp1 y@ 0.0 f< cp2 y@ 0.0 f< and if false canshow !
else
cp1 y@ 0.0 f< if
cp1 x@ cp1 y@ cp2 x@ f* cp1 y@ cp1 x@ f* f-
cp2 y@ cp1 y@ f- f/ f-
cp1 x! 0.0 cp1 y!
else
cp2 y@ 0.0 f< if
cp1 x@ cp1 y@ cp2 x@ f* cp1 y@ cp1 x@ f* f-
cp2 y@ cp1 y@ f- f/ f-
cp2 x! 0.0 cp2 y!
endif
endif
endif
;
: ctop
cp1 y@ 1.0 f> cp2 y@ 1.0 f> and if false canshow !
else
cp1 y@ 1.0 f> if
1.0 cp1 y@ f- cp2 y@ cp1 y@ f- f/
cp2 x@ cp1 x@ f- f* cp1 x@ f+
cp1 x! 1.0 cp1 y!
else
cp2 y@ 1.0 f> if
1.0 cp1 y@ f- cp2 y@ cp1 y@ f- f/
cp2 x@ cp1 x@ f- f* cp1 x@ f+
cp2 x! 1.0 cp2 y!
endif
endif
endif
;
( 2D clipping onto window of <0..1,0..1> )
: 2dline ( x1f y1f x2f y2f -- )
( Set up our local work variables )
0.0 cp2 3d! 0.0 cp1 3d! true canshow !
( Now successively clip left,right,bottom,top )
cright
canshow @ if cleft endif
canshow @ if cbot endif
canshow @ if ctop endif
( Finally, get back the clipped endpoints )
canshow @ if cp1 3d@ drop cp2 3d@ drop line endif
;
( Temporary storage for 3D points )
3dpt t1
3dpt t2
variable tmp1
variable tmp2
( intersect--Project t1f onto the plane z=0 against t2f )
: intersect ( t1f t2f -- )
( Stash their addresses away )
tmp2 ! tmp1 !
( Do the perspective projection for x )
tmp1 @ z@ tmp2 @ x@ f* tmp1 @ x@ tmp2 @ z@ f* f-
tmp1 @ z@ tmp2 @ z@ f- f/
( Do the perspective projection for y )
tmp1 @ z@ tmp2 @ y@ f* tmp1 @ y@ tmp2 @ z@ f* f-
tmp1 @ z@ tmp2 @ z@ f- f/
( Replace the old values of t1f with these new ones )
0.0 tmp1 @ z!
tmp1 @ y!
tmp1 @ x!
;
( 3line--plot a 3-D line )
: 3dline ( x1f y1f z1f x2f y2f z2f -- )
( Save the two points )
t2 3d! t1 3d!
( Trivial rejection test: if both points are behind our )
( view plane, don't plot them. )
t1 z@ 0.0 f< t2 z@ 0.0 f< and 0 = if
( We DO have something to plot. If we have a point behind )
( the viewing plane, then interpolate it to its intersection )
( with the viewing plane. )
t1 z@ 0.0 f< if t1 t2 intersect
else
t2 z@ 0.0 f< if t2 t1 intersect endif
endif
( Now do a simple perspective projection, hand the result to )
( our 2D plot routine. Note that clipping is done in the 2D )
( plot routine, not here. )
xc @ t1 z@ f* t1 x@ zc @ f* f- t1 z@ zc @ f- f/
yc @ t1 z@ f* t1 y@ zc @ f* f- t1 z@ zc @ f- f/
xc @ t2 z@ f* t2 x@ zc @ f* f- t2 z@ zc @ f- f/
yc @ t2 z@ f* t2 y@ zc @ f* f- t2 z@ zc @ f- f/
2dline
endif
;
Funky!Stuff!
cat - << \Funky!Stuff! > transform.fth
( Set up matrix V to do scaling on X, Y, and Z )
: (scale) ( z y x v --- )
( Save its address )
tmpw !
( Work our way through the elements on the stack, into 0,0, 1,1, ... )
3 0 do
tmpw @ i i @elem
f*
tmpw @ i i !elem
loop
;
( set up matrix v to do translation )
: (trans) ( z y x v --- )
( Save address of V into tmpw )
tmpw !
( For each element on stack, add it on to current translation )
3 0 do
tmpw @ 3 i @elem
f+
tmpw @ 3 i !elem
loop
;
( Hold SIN & COS of current angle )
variable sintmp
variable costmp
( Generate sin & cos for top item on stack, put into sintmp, costmp )
: gentrig ( af -- )
( Set sintmp, costmp to hold the sin & cosin values of D )
dup
fsin sintmp !
fcos costmp !
;
( Make V do a rotation of D radians around x, turning y into z )
: (xrot) ( df v --- )
( Get our trig values )
swap gentrig
( Save matrix address in tmpw )
tmpw !
( Loop through the rows )
4 0 do
( Calculate an intermediate value, keep it on the stack )
tmpw @ i 1 @elem costmp @ f*
tmpw @ i 2 @elem sintmp @ f* f-
( Now change tmatrix[i,2] )
tmpw @ i 1 @elem sintmp @ f*
tmpw @ i 2 @elem costmp @ f* f+
tmpw @ i 2 !elem
( Put temporary into tmatrix[i,1] )
tmpw @ i 1 !elem
loop
;
( Make V do a rotation of D radians around y, turning z into x )
: (yrot) ( df v --- )
( Get our trig values )
swap gentrig
( Save matrix address in tmpw )
tmpw !
( Loop through the rows )
4 0 do
( Calculate an intermediate value, keep it on the stack )
tmpw @ i 0 @elem costmp @ f*
tmpw @ i 2 @elem sintmp @ f* f+
( Now change tmatrix[i,2] )
tmpw @ i 2 @elem costmp @ f*
tmpw @ i 0 @elem sintmp @ f* f-
tmpw @ i 2 !elem
( Put temporary into tmatrix[i,0] )
tmpw @ i 0 !elem
loop
;
( Make V do a rotation of D radians around z, turning x into y )
: (zrot) ( df v --- )
( Get our trig values )
swap gentrig
( Save matrix address in tmpw )
tmpw !
( Loop through the rows )
4 0 do
( Calculate an intermediate value, keep it on the stack )
tmpw @ i 0 @elem costmp @ f*
tmpw @ i 1 @elem sintmp @ f* f-
( Now change tmatrix[i,2] )
tmpw @ i 0 @elem sintmp @ f*
tmpw @ i 1 @elem costmp @ f* f+
tmpw @ i 1 !elem
( Put temporary into tmatrix[i,0] )
tmpw @ i 0 !elem
loop
;
Funky!Stuff!
cat - << \Funky!Stuff! > turtle.fth
( Words to implement turtle-style graphics )
( The following forth code embodies the algorithms presented )
( in "Turtle Geometry" by Abelson and diSessa. )
( The three vectors which represent our turtle's heading )
3dpt hdir ( Heading )
3dpt udir ( 'up' direction )
3dpt ldir ( 'left' direction )
( The turtle's cartesian position )
3dpt tpos
( Initialize to the standard turtle starting parameters )
1.0 0.0 0.0 hdir 3d!
0.0 1.0 0.0 ldir 3d!
0.0 0.0 1.0 udir 3d!
0.5 0.5 0.5 tpos 3d!
( Temporary storage vector )
3dpt ttmp
( Word to rotate one vector around another )
( Rotates vector 'va' around vector 'pva' 'angle' degrees. )
( Returns the new vector as 'nva' on the stack )
: dorot ( va pva angle -- nva )
( Get sin, cos of angle--put in sintmp, costmp )
gentrig
( Fill in stuff on pva, use 'cp1' for temp storage )
dup x@ sintmp @ f* cp1 x!
dup y@ sintmp @ f* cp1 y!
z@ sintmp @ f* cp1 z!
( Now add in stuff for va )
dup x@ costmp @ f* cp1 x@ f+ cp1 x!
dup y@ costmp @ f* cp1 y@ f+ cp1 y!
z@ costmp @ f* cp1 z@ f+ cp1 z!
( Finally, return the address of cp1 as our result )
cp1
;
( Pen position, true=down, false=up )
variable penpos
true penpos !
( Command to move forward )
: forward ( d -- )
( Scale distance down by 100 )
i->f 100.0 f/
( Now multiply distance by hdir, add to tpos )
dup hdir x@ f* tpos x@ f+ ttmp x!
dup hdir y@ f* tpos y@ f+ ttmp y!
hdir z@ f* tpos z@ f+ ttmp z!
( Only draw the side if the pen's down )
penpos @ if
( Add a side to current object from old position to new )
ttmp 3d@ tpos 3d@ addside
endif
( update turtle position )
ttmp 3d@ tpos 3d!
;
( 3dneg--return the address of a negated 3d vector. We use cp2, )
( so the returned value should be used or copied immediately )
: 3dneg ( v -- v2 )
dup x@ fnegate cp2 x!
dup y@ fnegate cp2 y!
z@ fnegate cp2 z!
cp2
;
( yaw--this is TURN in 2D, but we go to navigational terms in 3D )
: yaw ( a -- )
i->f
( Calculate our new H )
dup hdir ldir rot dorot 3d@ ttmp 3d!
( Calculate & update L )
ldir hdir 3dneg rot dorot 3d@ ldir 3d!
( Now update H )
ttmp 3d@ hdir 3d!
;
( Pitch--tip our nose up or down )
: pitch ( a -- )
i->f
( Calculate H )
dup hdir udir rot dorot 3d@ ttmp 3d!
( Calculate & update U )
udir hdir 3dneg rot dorot 3d@ udir 3d!
( Update H )
ttmp 3d@ hdir 3d!
;
( Roll--tip us sideways )
: roll ( a -- )
i->f
( Calculate L )
dup ldir udir rot dorot 3d@ ttmp 3d!
( Calculate & update U )
udir ldir 3dneg rot dorot 3d@ udir 3d!
( Update L )
ttmp 3d@ ldir 3d!
;
( Pen position changing )
: penup false penpos ! ;
: pendown true penpos ! ;
Funky!Stuff!
cat - << \Funky!Stuff! > doc/doc_implement
Implementation details of the FORTH graphics system.
This document describes the forth graphics system turned in
as the final project of CIS160 by Andy Valencia and Ross Oliver.
1. Initial system
The forth system used to implement this graphics package was
the John Hopkins University forth system. This software is in the
public domain.
2. System modifications
Three major hurdles made it necessary to modify the forth system
as received. First, the system insisted that all identifiers be
UPPER CASE. In a UNIX environment, this was unacceptable. The
string recognition routines of JHU forth were modified so that,
prior to searching for a string, all letters of the string were
mapped to upper case. Thus, backward compatibility was maintained
with existing software, while not forcing us to use upper case.
The second major problem was the lack of floating point. The
language system was modified so that floating point math was
supported. This entailed adding the floating point routines, and
then modifying the input recognizer to recognize (and handle
specially) floating point numbers. The biggest problem with
this phase was that forth used 16-bit integers, whereas the
floating point numbers were 32-bit quantities. As the major
data structures became apparent, sets of words were developed
so that these 32-bit quantities could be handled naturally.
Finally, the system possessed no trigonometric functions;
we added sin and cosin. Our implementation of these was quite
efficient; we made a table of the sin values from 0 to 90, then
wrote routines which looked up the angle needed (doing quadrant
mapping, sign changing, etc.), rather than executing a numeric
algorithm. The initial routines returned an integer quantity
which was the sign value scaled by 10000; we later wrote
floating versions of sin and cosin (named "fsin" and "fcos")
which scaled these integers back into real numbers between
-1 and 1.
3. Graphics interface
Although graphics presentation is most rewarding when done
on a specialized device, we realized that we would probably have
to do most of the development on character-display devices. Thus,
the graphics display device is presented to the higher level
software as a call to "line". Line takes device normal coordinates,
and draws the line on the screen. On, say, a Tek 4016, the call
to line merely scales the values given and displays them. However,
to support character devices, a second technique was developed.
"line" was written using the DDA algorithm in the book. This could
then call the routine "plot", which would a character on the screen.
As an efficiency enhancement, "plot" will not emit any escape
sequences to the terminal if there is already a character plotted
there.
4. Matrix manipulation words
A set of words were made which allowed matrices to be used in
a relatively natural way. Words were made for allocating matrices,
and for accessing both their individual elements and the matrix in
its entirety.
Surprisingly, the only bona fide matrix math operation which
was needed was matrix multiplication; most routines access the
elements of a matrix directly for efficiency.
5. Objects
After carefully considering the book's approach to objects,
which he calls "segments", we decided to take a more classic
approach to the issue. An object is defined as an arbitrary number
of sides. An object is either displayed or not displayed. The
only things you can do to an object are: add sides, display it,
hide it, or execute transformations upon it.
6. Transformation words
The transformation capability of the forth graphics system
was developed in two layers. First, a set of primitive, generalized
routines were written which generated the desired transformations.
Then a second set of parallel words were written which integrated
all the different transformations into a single mechanism.
The high level mechanism keeps the successsive transformations
internally, then executes them upon selected objects. Thus, the
forth commands to translate A and B by -0.5 in the X, Y, and Z,
then rotate about the X axis by 45 degrees would be:
xfm -0.5 -0.5 -0.5 trans 45 xrot a doxfm b doxfm
Note that forth is a free-format language; the commands did not
have to be put on a single line. Also note that the invocation
of the listed transformations is on an object-by-object basis.
7. 3D viewing system
We soon realized that the display file concept described in
the book was at odds with the interactive nature of the forth
system we were implementing our graphics routines on. The approach
we took was to enhance the interactive nature of the graphics
tools; this is most obvious in our viewing system.
Our viewing system is invoked by the "draw" word. Each object
which is not hidden will be displayed on the screen. An object
is drawn on a line-by-line basis. The clipping is done in two
passes: first the line is clipped against the viewing plane. If the
line intersects the viewing plane, then the point which is behind
the viewing plane is projected to its intersection with the viewing
plane. If a line is completely behind the plane, it is not displayed.
After this clipping, the two endpoints are mapped onto the plane
using perspective projection. Finally, these points are handed
off to a 2-dimensional routine for display.
The 2-dimensional routine then clips against the right, left,
top, and bottom borders. Two equivalent ways of looking at the
viewing process can be taken: the viewer can move around the object,
or the object can be moved. In deviating from the book's (and
CORE's) decision to move the viewer, we took the philosophy that
what is most natural to a human should be used. In a system this
size, we will be looking at rather small objects. It is natural
for a human to reach out and manipulate an object, rather than
passively move around it (consider the plethora of "Don't touch"
signs we encounter in museums and expensive stores). Thus, one's
viewing plane is fixed at the plane Y=0, with border limits
of 0..1 for each side.
We found this solution to be quite acceptable, with the exception
of the case where one wanted to rotate an object to see it from
different angles--it was quite inconvenient to figure out what kind
of translation was needed to move it to the origin. We solved this
by adding the transformations "center" and "uncenter". The former
translates the object so that its center (defined as the arithmetic
mean of its X, Y, and Z componenets) was at the origin. The latter
merely undoes this affect. Thus, a common transformation to view
an object named "box" from a tilted angle might be:
xfm box center 22 xrot 22 yrot uncenter box doxfm
Which would rotate the box by 22 degrees around its center on both
the X and Y axes.
8. A nicer way to make pictures
As an application to exercise this graphics system, we implemented
a 3D turtle graphics system. In such a system, you have an entity named
the turtle which possesses a 3D location and heading. Using the
navigational terms "yaw", "pitch", and "roll", one may make the turtle
face in any direction. Then it may be moved forward with (strangely
enough) the "forward" command. These may all be embedded within
a FORTH program, gaining a surprising amount of power. The sequence:
: octa
8 0 do
10 forward
45 yaw
loop
;
will generate an octagon. Each turtle "forward" command causes a side
to be added to the current object. Thus, with the previous program
available, the sequence
newobj showoff
octa 90 roll octa
will generate a pair of octagons, sharing a common side, which
are at right angles to each other.
Funky!Stuff!
cat - << \Funky!Stuff! > doc/doc_words
The following is the list of routines, all written in forth,
which implement the 3D viewing system.
init ( Clear our graphic buffer )
This word is called once to initialize the graphics display device.
erase
This will erase the graphics display device.
plot ( fx fy -- )
Draws a point at the specified position. This word is only defined
if the device being driven does not have intrinsic line-drawing
capability. It is used by the "line" word, which is an implementation
of DDA.
line ( fx1 fy1 fx2 fy2 -- )
Implements DDA. Note that the line is NOT clipped; see 2dline
for this functionality. Generally, this word is a simple mapping onto
the escape sequences needed to display on a particular device.
rngchk ( r c -- )
An internal routine which does range checking on the indices of
a matrix element.
@elem ( v r c --- n )
Fetches the floating point element "fn" from the matrix whose
address is "v", at row "r", column "c".
!elem ( n v r c --- ) ( stores floating point value n in )
The complementary routine to "@elem@ which stores the value in
the matrix.
clrmat
Initializes all members of a matrix to 0.
ident ( v --- )
Sets the matrix to the identity matrix.
.mat ( v -- )
Prints the contents of a matrix on the screen.
matvar
Allocates space for a named matrix.
matcpy ( src dst -- )
Copies the contents of matrix "src" to "dst".
mat* ( S T --- ) ( 4x4 matrix multply: T = T * S )
Matrix multiplication: T = T * S.
fcos ( a -- fv )
Returns the floating cosin value of angle 'a', where 'a' is in degrees.
fsin ( a -- fv )
As "fcos", but does sin.
newobj
Allocates space for a new named object, and adds this object to
the object list. After creation with this routine, sides may be added
to the object with the "addside" word.
(addside) ( xf yf zf -- )
Internal routine which stores a point into memory.
addside ( x1f y1f z1f x2f y2f z2f -- )
Causes the 3-dimensional line segment to become a part of the
current object.
hide ( a -- )
Causes the object whose address is "a" to not be displayed during
display updates. Initially, an object is drawn.
show ( a -- )
Changes the attribute of the object back to "show"; undoes
the effect of a "hide".
dr-obj ( a -- )
An internal routine which draws the named object on the screen.
draw
Draws all objects whose attribute is "show".
xfm
Starts off a series of transformations. The most common use
is: xfm <transformation>,... <object> doxfm
which will cause the named object to be put through the
specified transformations.
xrot ( d -- )
yrot ( d -- )
zrot ( d -- )
Rotation of "d" degrees around the X, Y, and Z axis. Used
after "xfm" is invoked.
revarg ( xf yf zf -- zf yf xf )
A generally useful word which reverses the order of the top
three floating point numbers.
trans ( xf yf zf -- )
A translation with offsets of xf, yf, and zf is done. Used after
"xfm" is invoked.
scale ( xf yf zf -- )
Scales the X, Y, and Z coordinates by xf, yf, and zf. Used with
"xfm".
doxfm ( a -- )
Implements all pending transformations on the named object. Note
that the pending transformations may be done to several objects by
using "<object> doxfm" a number of times.
.obj ( a -- )
Prints the points which make up an object. Generally useful
only for debugging.
cenclr
An internal initialization routine for the "center" word.
center ( a -- )
Take the named object, figure out its mathematical center, and then
enter the negation of this as a translation (see "trans"). This is used
to bring an object to the origin without doing any hand calculations.
uncenter
Undoes the translation done by "center".
3dpt
Allocates space for the named 3-dimensional point.
x! ( xf a -- )
x@ ( a -- xf )
y! ( yf a -- )
y@ ( a -- yf )
z! ( zf a -- )
z@ ( a -- zf )
Fetch & store primitives which access the X, Y, and Z fields
of a 3D point.
3d! ( xf yf zf a -- )
3d@ ( a -- xf yf zf )
Fetch & store of the 3 elements of a 3D point, en masse.
3d.
Print a 3D point's values.
cright
cleft
cbot
ctop
Internal routines which clip the four sides of a 2D window.
2dline ( x1f y1f x2f y2f -- )
Draw a 2D line (by calling "line") after clipping.
intersect ( t1f t2f -- )
Internal routine to 3dline which is used for viewing-plane
intersection calculations.
3dline ( x1f y1f z1f x2f y2f z2f -- )
Plot a line expressed in 3D. This routine does front and back-plane
clipping, then calls 2dline.
gentrig ( a -- )
Internal routine which stores the sin and cosin values of angle "a"
into sintmp and costmp.
(scale) ( z y x v --- )
(trans) ( z y x v --- )
(xrot) ( d v --- )
(yrot) ( d v --- )
(zrot) ( d v --- )
Internal routines which do the actual matrix operations associated
with scaling, translating, and rotations.
dorot ( va pva angle -- nva )
Internal routine used with the turtle graphics subsystem. Does
rotations of a vector around a perpendicular vector by "angle" degrees.
3dneg ( v -- v2 )
Internal turtle graphics routine which negates a 3D vector.
forward ( d -- )
Turtle graphics. Moves the turtle "d" units forward in its
current direction.
yaw ( a -- )
Turns the turtle right or left on its current plane by 'a' degrees.
pitch ( a -- )
Tips the turtle's nose up or down by "a" degrees.
roll ( a -- )
Rolls the turtle right or left by "a" degrees.
tab
Internal routine to "vlist" which calculates tab stops.
vlist
Word which lists all the words forth currently knows about.
Funky!Stuff!
cat - << \Funky!Stuff! > figs/box
newobj box
0.25 0.25 0.1 0.25 0.75 0.1 addside
0.25 0.75 0.1 0.75 0.75 0.1 addside
0.75 0.75 0.1 0.75 0.25 0.1 addside
0.75 0.25 0.1 0.25 0.25 0.1 addside
0.25 0.25 0.9 0.25 0.75 0.9 addside
0.25 0.75 0.9 0.75 0.75 0.9 addside
0.75 0.75 0.9 0.75 0.25 0.9 addside
0.75 0.25 0.9 0.25 0.25 0.9 addside
0.25 0.25 0.1 0.25 0.25 0.9 addside
0.25 0.75 0.1 0.25 0.75 0.9 addside
0.75 0.25 0.1 0.75 0.25 0.9 addside
0.75 0.75 0.1 0.75 0.75 0.9 addside
Funky!Stuff!
cat - << \Funky!Stuff! > figs/turt_box
: box1
-90 pitch 8 forward
90 pitch 8 forward
90 pitch penup 8 forward pendown
90 pitch 8 forward 180 pitch
;
: box2
4 0 do
box1
penup 8 forward pendown
90 yaw
loop
;
Funky!Stuff!
cat - << \Funky!Stuff! > figs/turt_oct
: temp
8 0 do
10 forward
-45 pitch
10 forward
loop
;
: temp2
6 0 do
temp
30 yaw
loop
;
Funky!Stuff!
cat - << \Funky!Stuff! > figs/turt_tube
: tub1
-90 yaw
40 forward
90 yaw
10 forward
90 yaw penup
40 forward pendown
90 yaw 10 forward
180 yaw
;
: tube
8 0 do
tub1
penup 10 forward pendown
-45 pitch
loop
;
Funky!Stuff!
cat - << \Funky!Stuff! > figs/turt_tube2
: tub2
90 yaw
8 0 do
10 forward -45 pitch
loop
-90 yaw
;
: tube
10 0 do
tub2
penup 5 forward pendown
loop
;
Funky!Stuff!
cat - << \Funky!Stuff! > terms/3a.fth
( plot routines for an ADM3A ) decimal
variable scrnmem 1918 allot
42 constant plotchar ( We will plot with a star )
: init ( Clear our graphic buffer )
1920 0 do
0 i scrnmem + c!
loop
;
: erase
init 26 emit
;
: plot ( x y -- )
23.0 f* int 23 swap - ( Turn 0..1 to 23..0 )
79.0 f* int ( Turn 0..1 into 0..79 )
2dup 80 * + scrnmem + dup c@ plotchar = if
drop ( already plotted here )
2drop
else
plotchar swap c! ( mark our plot )
." =" ( 3a Cursor address command )
32 + emit 32 + emit ( emit the char )
plotchar emit ( plot our character )
endif
;
" line.fth" fload
Funky!Stuff!
cat - << \Funky!Stuff! > terms/fake_line.fth
: line ." (" 2swap f. ." ," f. ." ) to (" 2swap f. ." ," f. ." )" cr ;
Funky!Stuff!
cat - << \Funky!Stuff! > terms/grafix.fth
( Forth words to drive a victor )
: init
27 emit ." 5d " 27 emit ." m258" cr
27 emit ." 52" cr
27 emit ." 5r" cr
;
: line ( fx1 fy1 fx2 fy2 -- )
399.0 f* 399.0 2swap f- 2swap 572.0 f*
27 emit ." 5Q " int . int . cr
399.0 f* 399.0 2swap f- 2swap 572.0 f*
27 emit ." 5U " int . int . cr
;
: erase
27 emit ." 52" cr
27 emit ." 5r" cr
;
Funky!Stuff!
cat - << \Funky!Stuff! > terms/graphon.fth
( plot routines for an GRAPHON ) decimal
: init ( Clear our graphic buffer )
." 1"
;
: erase
." "
;
: plot ( fx fy -- )
( Scale Y 0..1 to 0..781 )
760.0 f* int -rot
1000.0 f* int swap
29 emit
2dup ( We have to fake a plot )
dup 2/ 2/ 2/ 2/ 2/ 31 and ( Get high 5 bits of Y component )
32 or emit ( set it up & emit it )
31 and 96 or emit ( Now emit the low four bits )
dup 2/ 2/ 2/ 2/ 2/ 31 and ( Do the same for the X component )
32 or emit
31 and 64 or emit
1+ swap 1+ swap ( We fake a plot by using a SHORT line )
dup 2/ 2/ 2/ 2/ 2/ 31 and ( Get high 5 bits of Y component )
32 or emit ( set it up & emit it )
31 and 96 or emit ( Now emit the low four bits )
dup 2/ 2/ 2/ 2/ 2/ 31 and ( Do the same for the X component )
32 or emit
31 and 64 or emit cr
;
" line.fth" fload
Funky!Stuff!
cat - << \Funky!Stuff! > terms/hp.fth
( plot routines for an HP terminal ) decimal
variable scrnmem 1918 allot
42 constant plotchar ( We will plot with a star )
: init ( Clear our graphic buffer )
1920 0 do
0 i scrnmem + c!
loop
;
: erase
init ." hJ"
;
( Plot the normal coordinate point <x,y> )
: plot ( xf yf -- )
23.0 f* f->i 23 swap - >r ( turn 0..1 to 23..0 )
79.0 f* f->i ( turn 0..1 to 0..79 )
r> 2dup 80 * + scrnmem + dup c@ plotchar = if
drop ( already plotted here )
2drop
else
plotchar swap c! ( mark our plot )
." &a" ( HP Cursor address command )
. ." r" . ." C"
plotchar emit ( plot our character )
endif
;
input terms/line.fth
Funky!Stuff!
cat - << \Funky!Stuff! > terms/hp150.fth
( plot routines for an HP terminal ) decimal
: init ( Select: display graphics & text, solid set line )
." *dace*m2a*m1b "
;
: erase ( Clear text screen & graphics )
." hJ*dA"
;
( Plot the normal coordinate pof->i <x,y> )
: line ( x1f y1f x2f y2f -- )
." *pA*d"
swap 380.0 f* f->i . ." ,"
380.0 f* f->i . ." O*pcB*d"
swap 380.0 f* f->i . ." ,"
380.0 f* f->i . ." O*pC"
;
Funky!Stuff!
cat - << \Funky!Stuff! > terms/line.fth
( words to provide line-drawing capability )
( NOTE: these routines are generally used only with low-resolution )
( terminals without intrinsic line-drawing ability. )
variable p1x ( Storage for our two points )
variable p1y
variable p2x
variable p2y
variable dx ( Holds delta-x,y )
variable dy
: line ( x2f y2f x1f y1f -- )
( Save end points )
p1y ! p1x !
p2y ! p2x !
( Calculate DX, DY )
p2x @ p1x @ f- dx !
p2y @ p1y @ f- dy !
( Calculate # steps needed )
dx @ fabs dy @ fabs fmax 132.0 f* 1.0 f+
( Scale DX, DY for this number of steps )
dx @ over f/ dx !
dy @ over f/ dy !
( For the required # of steps, do... )
f->i 0 do
( Get the current point, store it back incremented by DX,DY )
p1x @ dup dx @ f+ p1x !
p1y @ dup dy @ f+ p1y !
( Plot the point )
plot
loo ; d ; d backpder