home *** CD-ROM | disk | FTP | other *** search
/ gondwana.ecr.mu.oz.au/pub/ / Graphics.tar / Graphics / VOGLE.ZIP / EXAMPLES / FCUBE.FOR < prev    next >
Text File  |  2000-02-11  |  5KB  |  191 lines
  1.  
  2. c
  3. c a program to demonstrate  double buffering and what happens
  4. c when you hit a clipping plane. Specifying an extra argument
  5. c turns on the filling.
  6. c
  7.     program cube
  8.     character device*30, c*1
  9.     real    r, t, dr, dt
  10.     integer nplanes
  11.     integer getdepth, backbuffer, checkkey
  12.     logical fill, back, backdir
  13.  
  14.     integer BLACK, GREEN, RED, BLUE, WHITE
  15.     parameter (BLACK = 0, GREEN = 2, RED = 1, BLUE = 4, WHITE = 7)
  16.  
  17.     print*,'Enter output device:'
  18.     read(*,'(a)') device
  19.  
  20.     call prefsize(300, 300)
  21.  
  22.     call vinit(device)
  23.  
  24.     dr = 10.0
  25.     dt = 0.2
  26.  
  27.     nplanes = getdepth()
  28.  
  29.     fill = .true.
  30.     back = .true.
  31.     backdir = .true.
  32.  
  33.     call polyfill(fill)
  34.     call backface(back)
  35.     call backfacedir(backdir)
  36.  
  37.     call color(BLACK)
  38.     call clear
  39.  
  40.     call window(-1.5, 1.5, -1.5, 1.5, 9.0, -5.0)
  41.     call lookat(0.0, 0.0, 12.0, 0.0, 0.0, 0.0, 0.0)
  42.  
  43. c
  44. c Setup drawing into the backbuffer....
  45. c
  46.     if (backbuffer().lt.0) then
  47.         call vexit
  48.         write(*,*)'Device can''t support doublebuffering'
  49.         stop
  50.     endif
  51.  
  52.     t = 0.0
  53.  
  54.     r = 0.0
  55.  
  56.  10    continue
  57.         if (r.ge.360) r = 0.0
  58.         call color(BLACK)
  59.         call clear
  60.  
  61.         call pushmatrix
  62.  
  63.         call translate(0.0, 0.0, t)
  64.         call rotate(r, 'y')
  65.         call rotate(r, 'z')
  66.         call rotate(r, 'x')
  67.         call color(WHITE)
  68.  
  69.         call drawcube(nplanes)
  70.  
  71.         if (nplanes .eq. 1 .and. fill) then
  72.             call polyfill(.false.)
  73.             call color(0)
  74.             call drawcube(nplanes)
  75.             call polyfill(fill)
  76.         endif
  77.  
  78.  
  79.         call popmatrix
  80.  
  81.         t = t + dt
  82.         if (t.gt.3.0 .or. t.lt.-18.0) dt = -dt
  83.  
  84.         call swapbuffers
  85.  
  86.         c = char(checkkey())
  87.         if (c .eq. 'f') then
  88.             fill = .not. fill
  89.             call polyfill(fill)
  90.         else if (c .eq. 'b') then
  91.             back = .not. back
  92.             call backface(back)
  93.         else if (c .eq. 'd') then
  94.             backdir = .not. backdir
  95.             call backfacedir(backdir)
  96.         else if (c .ne. char(0)) then
  97.             call vexit
  98.             stop
  99.         endif
  100.  
  101.         r = r + dr
  102.     goto 10
  103.  
  104.     end
  105.  
  106. c
  107. c this routine draws the cube, using colours if available
  108. c
  109.     subroutine drawcube(nplanes)
  110.     integer nplanes
  111.  
  112.     integer BLACK, RED, GREEN, YELLOW, BLUE
  113.     integer MAGENTA, CYAN, WHITE
  114.     parameter (BLACK = 0, RED = 1, GREEN = 2)
  115.     parameter (YELLOW = 3, BLUE = 4, MAGENTA = 5)
  116.     parameter (CYAN = 6, WHITE = 7)
  117.  
  118.     real carray(3, 8)
  119.     data carray/
  120.      +     -1.0,  -1.0,   1.0,
  121.      +      1.0,  -1.0,   1.0,
  122.      +      1.0,   1.0,   1.0,
  123.      +     -1.0,   1.0,   1.0,
  124.      +     -1.0,  -1.0,  -1.0,
  125.      +      1.0,  -1.0,  -1.0,
  126.      +      1.0,   1.0,  -1.0,
  127.      +     -1.0,   1.0,  -1.0/
  128.  
  129.     if (nplanes.gt.1) call color(RED)
  130.  
  131.     call makepoly
  132.         call move(carray(1,1), carray(2,1), carray(3,1))
  133.         call draw(carray(1,2), carray(2,2), carray(3,2))
  134.         call draw(carray(1,3), carray(2,3), carray(3,3))
  135.         call draw(carray(1,4), carray(2,4), carray(3,4))
  136.         call draw(carray(1,1), carray(2,1), carray(3,1))
  137.     call closepoly
  138.     
  139.     if (nplanes.gt.1) call color(GREEN)
  140.  
  141.     call makepoly
  142.         call move(carray(1,6), carray(2,6), carray(3,6))
  143.         call draw(carray(1,5), carray(2,5), carray(3,5))
  144.         call draw(carray(1,8), carray(2,8), carray(3,8))
  145.         call draw(carray(1,7), carray(2,7), carray(3,7))
  146.         call draw(carray(1,6), carray(2,6), carray(3,6))
  147.     call closepoly
  148.  
  149.     if (nplanes.gt.1) call color(YELLOW)
  150.  
  151.     call makepoly
  152.         call move(carray(1,2), carray(2,2), carray(3,2))
  153.         call draw(carray(1,6), carray(2,6), carray(3,6))
  154.         call draw(carray(1,7), carray(2,7), carray(3,7))
  155.         call draw(carray(1,3), carray(2,3), carray(3,3))
  156.         call draw(carray(1,2), carray(2,2), carray(3,2))
  157.     call closepoly
  158.  
  159.     if (nplanes.gt.1) call color(BLUE)
  160.  
  161.     call makepoly
  162.         call move(carray(1,1), carray(2,1), carray(3,1))
  163.         call draw(carray(1,4), carray(2,4), carray(3,4))
  164.         call draw(carray(1,8), carray(2,8), carray(3,8))
  165.         call draw(carray(1,5), carray(2,5), carray(3,5))
  166.         call draw(carray(1,1), carray(2,1), carray(3,1))
  167.     call closepoly
  168.  
  169.     if (nplanes.gt.1) call color(MAGENTA)
  170.  
  171.     call makepoly
  172.         call move(carray(1,3), carray(2,3), carray(3,3))
  173.         call draw(carray(1,7), carray(2,7), carray(3,7))
  174.         call draw(carray(1,8), carray(2,8), carray(3,8))
  175.         call draw(carray(1,4), carray(2,4), carray(3,4))
  176.         call draw(carray(1,3), carray(2,3), carray(3,3))
  177.     call closepoly
  178.     
  179.     if (nplanes.gt.1) call color(CYAN)
  180.  
  181.     call makepoly
  182.         call move(carray(1,1), carray(2,1), carray(3,1))
  183.         call draw(carray(1,5), carray(2,5), carray(3,5))
  184.         call draw(carray(1,6), carray(2,6), carray(3,6))
  185.         call draw(carray(1,2), carray(2,2), carray(3,2))
  186.         call draw(carray(1,1), carray(2,1), carray(3,1))
  187.     call closepoly
  188.  
  189.     end
  190.  
  191.