home *** CD-ROM | disk | FTP | other *** search
/ gondwana.ecr.mu.oz.au/pub/ / Graphics.tar / Graphics / VOGLE.ZIP / VOGLE / EXAMPLES / FCIRCTXT.FOR < prev    next >
Text File  |  2000-02-11  |  3KB  |  167 lines
  1. c
  2. c display all the hershey fonts and demonstrate textang
  3. c
  4.     program fcirctxt
  5.  
  6.     character*40 str1, str2, str3, str4, fonts(22)
  7.     character*100 buf
  8.     character*1 c
  9.     integer BLACK, YELLOW, GREEN
  10.     integer i, getkey
  11.     parameter (BLACK = 0, YELLOW = 3, GREEN = 2)
  12.     data fonts/ 'astrology', 'cursive', 'futura.l',
  13.      +      'futura.m', 'gothic.eng', 'gothic.ger',
  14.      +      'gothic.ita', 'greek', 'japanese', 'markers',
  15.      +      'math.low', 'math.upp', 'meteorology', 'music',
  16.      +      'cyrillic', 'script', 'symbolic', 'times.g',
  17.      +      'times.ib', 'times.i', 'times.r', 'times.rb' /
  18.  
  19.     data str1/ 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
  20.     data str2/ 'abcdefghijklmnopqrstuvwxyz' /
  21.     data str3/ '1234567890+-=!@#$%^&*(){}[]' /
  22.     data str4/ '<>,./?~`\|_BONK,blark' /
  23.  
  24.     print*,'Enter output device:'
  25.     read(*,'(a)')buf
  26.  
  27.     call vinit(buf)
  28.  
  29.     call vsetflush(.false.)
  30.  
  31.     call color(BLACK)
  32.     call clear
  33.  
  34. c
  35. c define the world space
  36. c
  37.     call ortho2(-14.0, 14.0, -14.0, 14.0)
  38.  
  39.     do 10 i = 1, 22
  40.  
  41. c
  42. c textang is used to specify the orientation of text. As
  43. c we want the title to come out straight we make sure it is
  44. c zero each time we go through this loop.
  45. c
  46.         call textang(0.0)
  47.  
  48. c
  49. c do the title
  50. c
  51.         call color(YELLOW)
  52.         call font('futura.m')
  53.         write(buf, '(''This is Hershey font '',a)') fonts(i)
  54.         call boxtext(-11.0, 12.0, 20.0, 1.0, buf)
  55.  
  56. c
  57. c draw a box around the title
  58. c
  59.         call rect(-11.0, 12.0, 9.0, 13.0)
  60.  
  61.         call color(GREEN)
  62.  
  63. c
  64. c grab a font from the table
  65. c
  66.         call font(fonts(i))
  67.  
  68. c
  69. c show the outer ring
  70. c
  71.         call textsize(1.5, 1.5)
  72.         call ShowCircularText(11.0, str1)
  73.  
  74. c
  75. c show the second ring
  76. c
  77.         call textsize(1.3, 1.3)
  78.         call ShowCircularText(8.5, str2)
  79.  
  80. c
  81. c show the third ring
  82. c
  83.         call textsize(1.1, 1.1)
  84.         call ShowCircularText(7.0, str3)
  85.  
  86. c
  87. c show the inside ring
  88. c
  89.         call textsize(0.9, 0.9)
  90.         call ShowCircularText(5.0, str4)
  91.  
  92.         c = char(getkey())
  93.  
  94.         if (c .eq. 'q') then
  95.         call vexit
  96.         stop
  97.         end if
  98.  
  99.         call color(BLACK)
  100.         call clear
  101. 10    continue
  102.  
  103.     call vexit
  104.  
  105.     end
  106. c
  107. c nchars
  108. c
  109. c return the real length of a string padded with blanks
  110. c
  111.     integer function nchars(str)
  112.     character *(*) str
  113.  
  114.     do 10 i = len(str), 1, -1
  115.         if (str(i:i) .ne. ' ') then
  116.             nchars = i
  117.             return
  118.         end if
  119. 10      continue
  120.  
  121.     nchars = 0
  122.  
  123.     return
  124.  
  125.     end
  126. c
  127. c ShowCircularText
  128. c
  129. c    show a ring of text
  130. c
  131.     subroutine ShowCircularText(r, str)
  132.     real r
  133.     character*(*) str
  134.  
  135.     real i, inc, x, y, a, pi
  136.     integer j
  137.     character*1 c
  138.     parameter (pi = 3.1415926535)
  139.  
  140.     j = 1
  141.     inc = 360.0 / nchars(str)
  142.  
  143.     do 10 i = 0, 360.0, inc
  144. c
  145. c calculate the next drawing position
  146. c
  147.         c = str(j:j)
  148.         x = r * cos(i * pi / 180.0)
  149.         y = r * sin(i * pi / 180.0)
  150.         call move2(x, y)
  151. c
  152. c calculate angle for next character
  153. c
  154.         a = 90.0 + i
  155. c
  156. c set the orientation of the next character
  157. c
  158.         call textang(a)
  159. c
  160. c draw the character
  161. c
  162.         call drawchar(c)
  163.         j = j + 1
  164. 10    continue
  165.  
  166.     end
  167.