home *** CD-ROM | disk | FTP | other *** search
/ gondwana.ecr.mu.oz.au/pub/ / Graphics.tar / Graphics / avogl.tar.gz / avogl.tar / vogl / examples / ftetra.for < prev    next >
Text File  |  1992-09-22  |  3KB  |  176 lines
  1. c
  2. c Demonstrate a rotating translating tetrahedron, and 
  3. c doublebuffering.
  4. c
  5.     program ftetra
  6.  
  7. $INCLUDE: 'fvogl.h'
  8. $INCLUDE: 'fvodevic.h'
  9.  
  10.     integer TETRAHEDRON
  11.     parameter (TETRAHEDRON = 1)
  12.  
  13.     real R, tx, tz, zeye
  14.     integer rotval, drotval
  15.     logical    dobackface, dofill
  16.     character ans*1
  17.  
  18.     call prefsi(300, 300)
  19.  
  20.     print*,'Backfacing ON or OFF (Y/N)?'
  21.     read(*, '(a)') ans
  22.     dobackface = (ans .eq. 'y' .or. ans .eq. 'Y')
  23.  
  24.     print*,'Fill the polygons (Y/N)?'
  25.     read(*, '(a)') ans
  26.     dofill = (ans .eq. 'y' .or. ans .eq. 'Y')
  27.  
  28.     call winope('ftetra', 6)
  29.  
  30.     call double
  31.     call gconfi
  32.  
  33.     call unqdev(INPUTC)
  34.     call qdevic(QKEY)
  35.     call qdevic(ESCKEY)
  36. c
  37. c Make the tetrahedral object
  38. c
  39.     call makeit
  40.  
  41.     rotval = 0
  42.     drotval = 10
  43.     zeye = 5.0
  44.  
  45.     R = 1.6
  46.  
  47.     tx = 0.0
  48.     tz = R
  49.  
  50.     call polymo(PYM_LI)
  51.     if (dofill) call polymo(PYM_FI)
  52.     if (dobackface) call backfa(.true.)
  53.  
  54. c
  55. c set up a perspective projection with a field of view of
  56. c 40.0 degrees, aspect ratio of 1.0, near clipping plane 0.1,
  57. c and the far clipping plane at 1000.0.
  58. c
  59.     call perspe(400, 1.0, 0.001, 15.0)
  60.     call lookat(0.0, 0.0, zeye, 0.0, 0.0, 0.0, 0)
  61.  
  62.  
  63. c
  64. c here we loop back here adnaseum until someone hits a key
  65. c
  66.  10    continue
  67.  
  68.       rotval = 0
  69.  
  70.       do 20 i = 0, int(3590 / drotval)
  71.  
  72.         call color(BLACK)
  73.         call clear
  74.  
  75. c
  76. c Rotate the whole scene...(this acumulates - hence
  77. c drotval)
  78. c
  79.         call rotate(drotval, 'x')
  80.         call rotate(drotval, 'z')
  81.  
  82.         call color(RED)
  83.         call pushma
  84.         call rotate(900, 'x')
  85.         call circ(0.0, 0.0, R)
  86.         call popmat
  87.  
  88.         call color(BLUE)
  89.         call move(0.0, 0.0, 0.0)
  90.         call draw(tx, 0.0, tz)
  91.             
  92. c
  93. c Remember! The order of the transformations is
  94. c the reverse of what is specified here in between
  95. c the pushmatrix and the popmatrix. These ones don't
  96. c accumulate because of the push and pop.
  97. c
  98.  
  99.         call pushma
  100.         call transl(tx, 0.0, tz)
  101.         call rotate(rotval, 'x')
  102.         call rotate(rotval, 'y')
  103.         call rotate(rotval, 'z')
  104.         call scale(0.4, 0.4, 0.4)
  105.          call callob(TETRAHEDRON)
  106.         call popmat
  107.  
  108.         tz = R * cos(rotval * 3.1415926535 / 180)
  109.         tx = R * sin(rotval * 3.1415926535 / 180)
  110.  
  111.         call swapbu
  112.  
  113.         if (qtest()) then
  114.         call gexit
  115.         stop
  116.         endif
  117.  
  118.         rotval = rotval + drotval
  119.         if (rotval .gt. 3600) rotval = 3600
  120.  
  121.  20      continue
  122.  
  123.     goto 10
  124.         
  125.     end
  126.  
  127. c
  128. c maketheobject
  129. c
  130. c    generate a tetrahedron object as a series of move draws
  131. c
  132.     subroutine makeit
  133.  
  134. $INCLUDE: 'fvogl.h'
  135.     integer TETRAHEDRON, NSIDES, NFACES, NPNTS
  136.     parameter (TETRAHEDRON = 1, NSIDES = 3, NFACES = 4, NPNTS = 4)
  137.  
  138.     integer colface(NFACES)
  139.  
  140.     real points(3, NPNTS), tmp(3)
  141.  
  142.     integer    faces(NSIDES, NFACES)
  143.  
  144.     integer i, j
  145.     real x, y, z
  146.  
  147.       data points/
  148.      +    -0.5, 0.866, -0.667,
  149.      +    -0.5, -0.866, -0.667,
  150.      +     1.0, 0.0, -0.667,
  151.      +     0.0, 0.0, 1.334/
  152.  
  153.  
  154.     data colface/GREEN, YELLOW, CYAN, MAGENT/
  155.  
  156.     data faces/
  157.      +    3, 2, 1,
  158.      +    1, 2, 4,
  159.      +    2, 3, 4,
  160.      +    3, 1, 4/
  161.  
  162.      call makeob(TETRAHEDRON)
  163.  
  164.        do 20 i = 1, NFACES
  165.                 call color(colface(i))
  166.                 call bgnpol
  167.                 do 10 j = 1, NSIDES
  168.                     call v3f(points(1, faces(j, i)))
  169.  10             continue
  170.                 call endpol
  171.  20     continue
  172.  
  173.      call closeo
  174.     end
  175.  
  176.