home *** CD-ROM | disk | FTP | other *** search
/ gondwana.ecr.mu.oz.au/pub/ / Graphics.tar / Graphics / fermiVogle.tar.Z / fermiVogle.tar / devel / examples / ftetra.f < prev    next >
Text File  |  1996-02-07  |  4KB  |  200 lines
  1. c
  2. c Demonstrate a rotating translating tetrahedron, and 
  3. c doublebuffering.
  4. c
  5.     program ftetra
  6.  
  7.     integer BLACK, GREEN, RED, BLUE
  8.     parameter (BLACK = 0, GREEN = 2, RED = 1, BLUE = 4)
  9.  
  10.     integer TETRAHEDRON
  11.     parameter (TETRAHEDRON = 1)
  12.  
  13.     real R, tx, tz, rotval, drotval, zeye
  14.     integer    i
  15.     logical back, backdir, fill
  16.     character device*50, c*1
  17.     integer checkkey, backbuffer
  18.  
  19.     call prefsize(300, 300)
  20.  
  21.     print*,'Enter output device:'
  22.     read(*,'(a)') device
  23.  
  24.     back = .true.
  25.     backdir = .true.
  26.     fill = .true.
  27.  
  28.     call vinit(device)
  29. c
  30. c Make the tetrahedral object
  31. c
  32.     call maketheobject
  33.  
  34.     rotval = 0.0
  35.     drotval = 5.0
  36.     zeye = 5.0
  37.  
  38.     R = 1.6
  39.  
  40.     tx = 0.0
  41.     tz = R
  42.  
  43. call polyfill(fill)
  44.     call backface(back)
  45.     call backfacedir(backdir)
  46.     call clipping(.false.)
  47.  
  48. c
  49. c set up a perspective projection with a field of view of
  50. c 40.0 degrees, aspect ratio of 1.0, near clipping plane 0.1,
  51. c and the far clipping plane at 1000.0.
  52. c
  53.     call perspective(40.0, 1.0, 0.001, 15.0)
  54.     call lookat(0.0, 0.0, zeye, 0.0, 0.0, 0.0, 0.0)
  55.  
  56. c
  57. c Setup drawing into the backbuffer....
  58. c
  59.     if (backbuffer().lt.0) then
  60.         call vexit
  61.         write(*,*)'Device can''t support doublebuffering'
  62.         stop
  63.     endif
  64.  
  65. c
  66. c here we loop back here adnaseum until someone hits a non interpreted key
  67. c
  68.  10    continue
  69.  
  70.       rotval = 0.0
  71.  
  72.       do 20 i = 0, int(359.0 / drotval)
  73.  
  74.         call color(BLACK)
  75.         call clear
  76.  
  77. c
  78. c Rotate the whole scene...(this acumulates - hence
  79. c drotval)
  80. c
  81.         call rotate(drotval * 0.1, 'x')
  82.         call rotate(drotval * 0.1, 'z')
  83.  
  84.         call color(RED)
  85.         call pushmatrix
  86.         call polyfill(.false.)
  87.         call rotate(90.0, 'x')
  88.         call circle(0.0, 0.0, R)
  89.         call polyfill(fill)
  90.         call popmatrix
  91.  
  92.         call color(BLUE)
  93.         call move(0.0, 0.0, 0.0)
  94.         call draw(tx, 0.0, tz)
  95.             
  96. c
  97. c Remember! The order of the transformations is
  98. c the reverse of what is specified here in between
  99. c the pushmatrix and the popmatrix. These ones don't
  100. c accumulate because of the push and pop.
  101. c
  102.  
  103.         call pushmatrix
  104.         call translate(tx, 0.0, tz)
  105.         call rotate(rotval, 'x')
  106.         call rotate(rotval, 'y')
  107.         call rotate(rotval, 'z')
  108.         call scale(0.4, 0.4, 0.4)
  109.         call callobj(TETRAHEDRON)
  110.         call popmatrix
  111.  
  112.         tz = R * cos(rotval * 3.1415926535 / 180)
  113.         tx = R * sin(rotval * 3.1415926535 / 180)
  114.  
  115.         call swapbuffers
  116.  
  117.         c = char(checkkey())
  118.         if (c .eq. 'f') then
  119.         fill = .not. fill
  120.         call polyfill(fill)
  121.         else if(c .eq. 'b') then
  122.         back = .not. back
  123.         call backface(back)
  124.         else if (c .eq. 'd') then
  125.         backdir = .not. backdir
  126.         call backfacedir(backdir)
  127.         else if (c .ne. char(0)) then
  128.         call vexit
  129.         stop
  130.         endif
  131.  
  132.         rotval = rotval + drotval
  133.  
  134.  20      continue
  135.  
  136.     goto 10
  137.         
  138.     end
  139.  
  140. c
  141. c maketheobject
  142. c
  143. c    generate a tetrahedron object as a series of move draws
  144. c
  145.     subroutine maketheobject
  146.  
  147.     integer RED, GREEN, YELLOW, CYAN, MAGENTA
  148.     parameter (RED = 1, GREEN = 2, YELLOW = 3, CYAN = 5,
  149.      +     MAGENTA = 6)
  150.  
  151.     integer TETRAHEDRON, NSIDES, NFACES, NPNTS
  152.     parameter (TETRAHEDRON = 1, NSIDES = 3, NFACES = 4, NPNTS = 4)
  153.  
  154.     integer colface(NFACES)
  155.  
  156.     real pnts(3, NPNTS)
  157.  
  158.     integer    faces(NSIDES, NFACES)
  159.  
  160.     integer i, j
  161.     real x, y, z
  162.  
  163.  
  164.     data pnts/
  165.      +    -0.5, 0.866, -0.667,
  166.      +    -0.5, -0.866, -0.667,
  167.      +     1.0, 0.0, -0.667,
  168.      +     0.0, 0.0, 1.334/
  169.  
  170.  
  171.     data colface/GREEN, YELLOW, CYAN, MAGENTA/
  172.  
  173.     data faces/
  174.      +    3, 2, 1,
  175.      +    1, 2, 4,
  176.      +    2, 3, 4,
  177.      +    3, 1, 4/
  178.  
  179.     call makeobj(TETRAHEDRON)
  180.  
  181.     do 20 i = 1, NFACES
  182.         call makepoly
  183.         call color(colface(i))
  184.         x = pnts(1, faces(1, i))
  185.         y = pnts(2, faces(1, i))
  186.         z = pnts(3, faces(1, i))
  187.         call move(x, y, z)
  188.         do 10 j = 2, NSIDES
  189.             x = pnts(1, faces(j,i))
  190.             y = pnts(2, faces(j,i))
  191.             z = pnts(3, faces(j,i))
  192.             call draw(x, y, z)
  193.  10        continue
  194.         call closepoly
  195.  20    continue
  196.  
  197.     call closeobj
  198.  
  199.     end
  200.