home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
gondwana.ecr.mu.oz.au/pub/
/
Graphics.tar
/
Graphics
/
VOGLE.ZIP
/
VOGLE
/
EXAMPLES
/
FPATCHES.FOR
< prev
next >
Wrap
Text File
|
2000-02-11
|
6KB
|
258 lines
c
c Draws patches of various bases
c
program fpatch
character *20 dev
integer BLACK, RED, GREEN, YELLOW, BLUE,
+ CYAN, WHITE
parameter (BLACK = 0, RED = 1, GREEN = 2,
+ YELLOW = 3, BLUE = 4, CYAN = 5, WHITE = 7)
c
c patch basis types
c
real bezier(4,4), cardinal(4, 4), bspline(4, 4)
real power(4, 4)
real x1(4, 4), y1(4, 4), z1(4, 4)
real x2(4, 4), y2(4, 4), z2(4, 4)
character *50 labels(4)
real basis(64)
equivalence (basis(1), bezier(1, 1))
equivalence (basis(17), cardinal(1, 1))
equivalence (basis(33), bspline(1, 1))
equivalence (basis(49), power(1, 1))
data bezier/
+ -1.0, 3.0, -3.0, 1.0,
+ 3.0, -6.0, 3.0, 0.0,
+ -3.0, 3.0, 0.0, 0.0,
+ 1.0, 0.0, 0.0, 0.0/
data cardinal/
+ -0.5, 1.5, -1.5, 0.5,
+ 1.0, -2.5, 2.0, -0.5,
+ -0.5, 0.0, 0.5, 0.0,
+ 0.0, 1.0, 0.0, 0.0/
data bspline/
+ -0.166666, 0.5, -0.5, 0.166666,
+ 0.5, -1.0, 0.5, 0.0,
+ -0.5, 0.0, 0.5, 0.0,
+ 0.166666, 0.666666, 0.166666, 0.0 /
data power/
+ 1.0, 0.0, 0.0, 0.0,
+ 0.0, 1.0, 0.0, 0.0,
+ 0.0, 0.0, 1.0, 0.0,
+ 0.0, 0.0, 0.0, 1.0/
data x1 /
+ 0.0, 0.2588, 0.5, 0.7071,
+ 0.0, 0.51764, 1.0, 1.4142,
+ 0.0, 0.51764, 1.0, 1.4142,
+ 0.0, 0.2588, 0.5, 0.7071/
data y1 /
+ 1.0, 0.966, 0.866, 0.7071,
+ 2.0, 1.9318, 1.732, 1.4142,
+ 2.0, 1.9318, 1.732, 1.4142,
+ 1.0, 0.966, 0.866, 0.7071/
data z1 /
+ 1.0, 1.0, 1.0, 1.0,
+ 1.0, 1.0, 1.0, 1.0,
+ 0.0, 0.0, 0.0, 0.0,
+ 0.0, 0.0, 0.0, 0.0/
data x2 /
+ 0.7071, 0.8660, 0.9660, 1.0,
+ 1.4142, 1.7320, 1.932, 2.0,
+ 1.4142, 1.7320, 1.932, 2.0,
+ 0.7071, 0.8660, 0.9660, 1.0/
data y2 /
+ 0.7071, 0.5, 0.2588, 0.0,
+ 1.4142, 1.0, 0.5176, 0.0,
+ 1.4142, 1.0, 0.5176, 0.0,
+ 0.7071, 0.5, 0.2588, 0.0/
data z2 /
+ 1.0, 1.0, 1.0, 1.0,
+ 1.0, 1.0, 1.0, 1.0,
+ 0.0, 0.0, 0.0, 0.0,
+ 0.0, 0.0, 0.0, 0.0/
data labels /
+ 'Bezier Patch(es)',
+ 'Cardinal Patch(es)',
+ 'B-Spline Patch(es)',
+ '''Power'' Patch(es)' /
c
c demonstrate patches
c
write (*,*)'Enter device:'
read(*,'(a)') dev
call vinit(dev)
call vsetflush(.false.)
call color(BLACK)
call clear
c
c Set up two viewports (They actually overlap)
c
call viewport(-1.0, 0.3, -1.0, 0.3)
call ortho(-2.0, 5.0, -2.0, 5.0, -2.0, 5.0)
call lookat(0.0, 0.0, 0.0, -3.0, 2.0, -4.0, 0.0)
c
c Save it
c
call pushviewport
call pushmatrix
call viewport(-0.3, 1.0, -0.3, 1.0)
call ortho(-2.0, 5.0, -2.0, 5.0, -2.0, 5.0)
call lookat(0.0, 0.0, 0.0, 3.0, 2.0, -4.0, 0.0)
call textsize(0.4, 0.4)
c
c patchcurves provides a number of curves in the t and u
c directions. patchprecision gives the minimum number of line
c segments making up the curves in the t and u directions. The
c actual number of linesegments in t or u is equal to the closest
c integer multiple of the number of curves, > nsegs, in t or u,
c greater than or equal to the number set by patchprecision in u or
c t. eg. curves in t will be made up of 21 line segments so that we
c can match up the 7 curves in u; curves in u will have 24 as 4 by 5
c gives 20.
c
call patchcurves(4, 7)
call patchprecision(20, 20)
do 10 i = 0, 3
call axes
c
c patchbasis sets the basis matrices for the t and u
c functions
c
c
call patchbasis(basis(i*16 + 1), basis(i*16 + 1))
c
c Draw with viewport 2
c
call move(0.0, 4.0, 0.0)
call drawstr(labels(i+1))
c
c Now draw the patches according to the geometry matrices in
c x1, y1, and z1, x2, y2, z2.
c
call drawhull(x1, y1, z1)
call patch(x1, y1, z1)
call drawhull(x2, y2, z2)
call patch(x2, y2, z2)
c
c Now with viewport 1
c
call popviewport
call popmatrix
call axes
call move(0.0, 4.0, 0.0)
call drawstr(labels(i + 1))
c
c now draw the patches according to the geometry matrices in
c x1, y1, and z1, x2, y2, z2.
c
call drawhull(x1, y1, z1)
call patch(x1, y1, z1)
call drawhull(x2, y2, z2)
call patch(x2, y2, z2)
call getkey
c
c Save viewport 1 again and reset to viewport 2
c
call pushviewport
call pushmatrix
call viewport(-0.3, 1.0, -0.3, 1.0)
call ortho(-1.5, 5.0, -1.5, 5.0, -1.5, 5.0)
call lookat(0.0, 0.0, 0.0, 3.0, 2.0, -4.0, 0.0)
call color(BLACK)
call clear
10 continue
call vexit
end
subroutine drawhull(x, y, z)
real x(4,4), y(4,4), z(4,4)
integer MAGENTA, WHITE, GREEN
parameter (MAGENTA = 5, WHITE = 7, GREEN = 2)
call color(MAGENTA)
do 10 i = 1,4
call move(x(i,1), y(i,1), z(i,1))
do 5 j = 1,4
call draw(x(i,j), y(i,j), z(i,j))
5 continue
10 continue
do 20 i = 1,4
call move(x(1,i), y(1,i), z(1,i))
do 15 j = 1,4
call draw(x(j,i), y(j,i), z(j,i))
15 continue
20 continue
call color(GREEN)
end
c
c axes
c
c draw the axes
c
subroutine axes
integer YELLOW
parameter (YELLOW = 3)
call color(YELLOW)
call move(0.0, 0.0, 0.0)
call draw(4.0, 0.0, 0.0)
call move(0.0, 0.0, 0.0)
call draw(0.0, 4.0, 0.0)
call move(0.0, 0.0, 0.0)
call draw(0.0, 0.0, 4.0)
end