home *** CD-ROM | disk | FTP | other *** search
/ gondwana.ecr.mu.oz.au/pub/ / Graphics.tar / Graphics / VOGLE.ZIP / EXAMPLES / FBALLS.FOR < prev    next >
Text File  |  2000-02-11  |  3KB  |  150 lines
  1. c
  2. c makesphere
  3. c
  4. c    make a sphere object
  5. c
  6.     subroutine makesphere
  7.  
  8.     integer SPHERE
  9.     real i, r, z, a, RADIUS, PI
  10.     parameter (PI = 3.1415926535, RADIUS = 10.0, SPHERE = 1)
  11.  
  12.     call makeobj(SPHERE)
  13.  
  14. c
  15. c create the latitudinal rings
  16. c
  17.         do 10 i = 0.0, 180.0, 20.0
  18.         call pushmatrix
  19.             call rotate(i, 'y')
  20.             call circle(0.0, 0.0, RADIUS)
  21.         call popmatrix
  22. 10        continue
  23.         
  24. c
  25. c create the longitudinal rings
  26. c
  27.         call pushmatrix
  28.         call rotate(90.0, 'x')
  29.         do 20 a = -90.0, 90.0, 20.0
  30.             r = RADIUS * cos(a * PI / 180.0)
  31.             z = RADIUS * sin(a * PI / 180.0)
  32.             call pushmatrix
  33.             call translate(0.0, 0.0, -z)
  34.             call circle(0.0, 0.0, r)
  35.             call popmatrix    
  36. 20        continue
  37.         call popmatrix
  38.  
  39.     call closeobj
  40.  
  41.     end
  42.  
  43. c
  44. c a demonstration of objects
  45. c
  46.     program fballs
  47.  
  48.     integer SPHERE
  49.     integer BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE
  50.     real RADIUS
  51.     parameter (RADIUS = 10.0)
  52.     parameter(SPHERE = 1)
  53.     parameter(BLACK = 0)
  54.     parameter(RED = 1)
  55.     parameter(GREEN = 2)
  56.     parameter(YELLOW = 3)
  57.     parameter(BLUE = 4)
  58.     parameter(MAGENTA = 5)
  59.     parameter(CYAN = 6)
  60.     parameter(WHITE = 7)
  61.     character device*50
  62.  
  63.     print*,'Enter output device:'
  64.     read(*,'(a)') device
  65.  
  66.     call vinit(device)
  67.  
  68.     call vsetflush(.false.)
  69.  
  70. c
  71. c set up our viewing transformation
  72. c
  73.     call perspective(90.0, 1.0, 0.001, 500.0)
  74.     call lookat(13.0, 13.0, 8.0, 0.0, 0.0, 0.0, 0.0)
  75.  
  76.     call color(BLACK)
  77.     call clear
  78.  
  79. c
  80. c Call a routine to make the sphere object
  81. c
  82.     call makesphere
  83.  
  84. c
  85. c Now draw the sphere object scaled down. We use the pushmatrix
  86. c and the popmatrix to preserve the transformation matrix so
  87. c that only this sphere is drawn scaled. The callobj then enables
  88. c us to draw the sphere we generated with makeobj in makesphere.
  89. c
  90.     call color(CYAN)
  91.  
  92.     call pushmatrix
  93.         call scale(0.5, 0.5, 0.5)
  94.         call callobj(SPHERE)
  95.     call popmatrix
  96.  
  97. c
  98. c now we draw the same sphere translated, with a different
  99. c scale and color.
  100. c
  101.     call color(WHITE)
  102.  
  103.     call pushmatrix
  104.         call translate(0.0, -1.4 * RADIUS, 1.4 * RADIUS)
  105.         call scale(0.3, 0.3, 0.3)
  106.         call callobj(SPHERE)
  107.     call popmatrix
  108.  
  109. c
  110. c and maybe a few more times....
  111. c
  112.  
  113.     call color(RED)
  114.  
  115.     call pushmatrix
  116.         call translate(0.0, RADIUS, 0.7 * RADIUS)
  117.         call scale(0.2, 0.2, 0.2)
  118.         call callobj(SPHERE)
  119.     call popmatrix
  120.  
  121.     call color(GREEN)
  122.  
  123.     call pushmatrix
  124.         call translate(0.0, 1.5 * RADIUS, -RADIUS)
  125.         call scale(0.15, 0.15, 0.15)
  126.         call callobj(SPHERE)
  127.     call popmatrix
  128.  
  129.     call color(YELLOW)
  130.  
  131.     call pushmatrix
  132.         call translate(0.0, -RADIUS, -RADIUS)
  133.         call scale(0.12, 0.12, 0.12)
  134.         call callobj(SPHERE)
  135.     call popmatrix
  136.  
  137.     call color(BLUE)
  138.  
  139.     call pushmatrix
  140.         call translate(0.0, -2.0*RADIUS, -RADIUS)
  141.         call scale(0.3, 0.3, 0.3)
  142.         call callobj(SPHERE)
  143.     call popmatrix
  144.  
  145.     call getkey
  146.  
  147.     call vexit
  148.  
  149.     end
  150.