Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume1 / 8707 / 53 < prev next >

Wrap

Internet Message Format | 1990-07-13 | 34.5 KB

From: vandys@lindy.stanford.edu (Andy Valencia) Newsgroups: comp.sources.misc Subject: 3d Graphics System in Forth Message-ID: <2932@ncoast.UUCP> Date: 18 Jul 87 00:30:07 GMT Sender: allbery@ncoast.UUCP Lines: 1460 Approved: allbery@ncoast.UUCP X-Archive: comp.sources.misc/8707/53 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 ( Store the three elements of a 3D point ) 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 loop ; Funky!Stuff!