home *** CD-ROM | disk | FTP | other *** search
/ gondwana.ecr.mu.oz.au/pub/ / Graphics.tar / Graphics / fermiVogle.tar.Z / fermiVogle.tar / devel / examples / fworld.f < prev    next >
Text File  |  1996-02-07  |  3KB  |  177 lines
  1. c
  2. c most of the things in this program have been done before but it has
  3. c a certain novelty value.
  4. c
  5.     program fworld
  6.  
  7.     integer BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE
  8.     parameter(BLACK = 0)
  9.     parameter(RED = 1)
  10.     parameter(GREEN = 2)
  11.     parameter(YELLOW = 3)
  12.     parameter(BLUE = 4)
  13.     parameter(MAGENTA = 5)
  14.     parameter(CYAN = 6)
  15.     parameter(WHITE = 7)
  16.  
  17.     integer SPHERE
  18.     real RADIUS, PI
  19.     parameter (RADIUS = 10.0, PI = 3.1415926535, SPHERE = 1)
  20.  
  21.     character *20 dev
  22.     
  23.     print*,'Enter device:'
  24.     read(*,'(a)') dev
  25.     call vinit(dev)
  26.  
  27.     call vsetflush(.false.)
  28.  
  29.     call clipping(.false.)
  30.  
  31.     call font('futura.m')
  32.  
  33.     call perspective(80.0, 1.0, 0.001, 50.0)
  34.     call lookat(13.0, 13.0, 8.0, 0.0, 0.0, 0.0, 0.0)
  35.  
  36.     call color(BLACK)
  37.     call clear
  38.  
  39.     call makesphere
  40.  
  41. c
  42. c     draw the main one in cyan
  43. c
  44.     call color(CYAN)
  45.  
  46.     call callobj(SPHERE)
  47.  
  48. c
  49. c    draw a smaller one outside the main one in white
  50. c
  51.     call color(WHITE)
  52.  
  53.     call pushmatrix
  54.         call translate(0.0, -1.4 * RADIUS, 1.4 * RADIUS)
  55.         call scale(0.3, 0.3, 0.3)
  56.         call callobj(SPHERE)
  57.     call popmatrix
  58.  
  59. c
  60. c    scale the text
  61. c
  62.     call boxfit(2.0 * PI * RADIUS, 0.25 * RADIUS, 31)
  63.  
  64. c
  65. c    now write the text in rings around the main sphere
  66. c
  67.  
  68.     call color(GREEN)
  69.     call showroundtext('Around the world in eighty days ')
  70.  
  71.     call color(BLUE)
  72. c
  73. c    note: that software text is rotated here as
  74. c    anything else would be whether you use textang
  75. c    or rotate depends on what you are trying to do.
  76. c    Experience is the best teacher here.
  77. c
  78.     call rotate(90.0, 'x')
  79.     call showroundtext('Around the world in eighty days ')
  80.  
  81.     call color(RED)
  82.     call rotate(90.0, 'z')
  83.     call showroundtext('Around the world in eighty days ')
  84.  
  85.     call getkey
  86.  
  87.     call vexit
  88.  
  89.     end
  90. c
  91. c showroundtext
  92. c
  93. c    draw string str wrapped around a circle in 3d
  94. c
  95.     subroutine showroundtext(str)
  96.     character *(*) str
  97.  
  98.     real i, inc, RADIUS
  99.     parameter (RADIUS = 10.0)
  100.     integer j
  101.  
  102.     inc = 360.0 / float(nchars(str))
  103.  
  104.     j = 1
  105.     do 10 i = 0.0, 360.0, inc
  106.         call pushmatrix
  107. c
  108. c             find the spot on the edge of the sphere
  109. c             by making it (0, 0, 0) in world coordinates
  110. c
  111.             call rotate(i, 'y')
  112.             call translate(0.0, 0.0, RADIUS)
  113.  
  114.             call move(0.0, 0.0, 0.0)
  115.  
  116.             call drawchar(str(j:j))
  117.             j = j + 1
  118.         call popmatrix
  119. 10    continue
  120.  
  121.     end
  122.  
  123. c
  124. c makesphere
  125. c
  126. c    create the sphere object
  127. c
  128.     subroutine makesphere
  129.     integer SPHERE
  130.     parameter (SPHERE = 1)
  131.     parameter(PI = 3.1415926535)
  132.     parameter(RADIUS = 10.0)
  133.     real i
  134.  
  135.     call makeobj(SPHERE)
  136.  
  137.     do 10 i = 0.0, 180.0, 20.0
  138.         call pushmatrix
  139.             call rotate(i, 'y')
  140.             call circle(0.0, 0.0, RADIUS)
  141.         call popmatrix
  142. 10    continue
  143.     
  144.     call pushmatrix
  145.         call rotate(90.0, 'x')
  146.         do 20 a = -90.0, 90.0, 20.0
  147.             r = RADIUS * cos(a*PI/180.0)
  148.             z = RADIUS * sin(a*PI/180.0)
  149.             call pushmatrix
  150.                 call translate(0.0, 0.0, -z)
  151.                 call circle(0.0, 0.0, r)
  152.             call popmatrix    
  153. 20        continue
  154.     call popmatrix
  155.  
  156.     call closeobj
  157.  
  158.     return
  159.     end
  160. c
  161. c nchars
  162. c
  163. c    find the number of characters in the string str
  164. c
  165.     integer function nchars(str)
  166.     character *(*) str
  167.     
  168.     do 10 i = len(str), 1, -1
  169.         if (str(i:i) .ne. ' ') then
  170.             nchars = i
  171.             return
  172.         end if
  173. 10    continue
  174.     nchars = 0
  175.     return
  176.     end
  177.