home *** CD-ROM | disk | FTP | other *** search
/ gondwana.ecr.mu.oz.au/pub/ / Graphics.tar / Graphics / VOGLE.ZIP / EXAMPLES / FCURVES.FOR < prev    next >
Text File  |  2000-02-11  |  4KB  |  189 lines
  1. c
  2. c using curves
  3. c
  4.     program fcurves
  5.  
  6.     integer i, BLACK, RED, GREEN, YELLOW, MAGENTA
  7.     parameter (BLACK = 0, RED = 1, GREEN = 2, YELLOW = 3)
  8.     parameter (MAGENTA = 5)
  9.     character buf*50
  10.     real bezier(4, 4), cardinal(4, 4), bspline(4, 4)
  11.     real geom1(3, 4), geom2(3, 6)
  12. c
  13. c curve basis types
  14. c
  15.     data bezier /
  16.      +      -1.0,    3.0,    -3.0,    1.0,
  17.      +      3.0,    -6.0,    3.0,    0.0,
  18.      +      -3.0,    3.0,    0.0,    0.0,
  19.      +      1.0,    0.0,    0.0,    0.0 
  20.      +  /
  21.  
  22.     data cardinal /
  23.      +      -0.5,    1.5,    -1.5,    0.5,
  24.      +      1.0,    -2.5,    2.0,    -0.5,
  25.      +      -0.5,    0.0,    0.5,    0.0,
  26.      +      0.0,    1.0,    0.0,    0.0
  27.      +  /
  28.  
  29.     data bspline /
  30.      +          -0.166666,     0.5,     -0.5,     0.166666,
  31.      +           0.5,         -1.0,      0.5,     0.0,
  32.      +          -0.5,          0.0,      0.5,     0.0,
  33.      +           0.166666,     0.666666, 0.166666, 0.0
  34.      +  /
  35.  
  36. c
  37. c Geometry matrix to demonstrate basic spline segments
  38. c
  39.     data geom1 /
  40.      +       -180.0, 10.0, 0.0,
  41.      +       -100.0, 110.0, 0.0,
  42.      +       -100.0, -90.0, 0.0,
  43.      +       0.0, 50.0, 0.0
  44.      +  /
  45.  
  46. c
  47. c Geometry matrix to demonstrate overlapping control points to
  48. c produce continuous (Well, except for the bezier ones) curves
  49. c from spline segments
  50. c
  51.     data geom2 /
  52.      +      200.0, 480.0, 0.0,
  53.      +      380.0, 180.0, 0.0,
  54.      +      250.0, 430.0, 0.0,
  55.      +      100.0, 130.0, 0.0,
  56.      +      50.0,  280.0, 0.0,
  57.      +      150.0, 380.0, 0.0
  58.      +  /
  59.  
  60.  
  61.     print*,'Enter output device:'
  62.     read(*,'(a)') buf
  63.  
  64.     call vinit(buf)
  65.  
  66.     call ortho2(-200.0, 400.0, -100.0, 500.0)
  67.  
  68.     call color(BLACK)
  69.     call clear()
  70.  
  71.     call color(YELLOW)
  72.  
  73.     call textsize(10.0, 10.0)
  74.  
  75. c
  76. c label the control points in geom1
  77. c
  78.     do 10 i = 1, 4
  79.         call move2(geom1(1, i), geom1(2, i))
  80.         write(buf, '(i1)')i
  81.         call drawstr(buf)
  82. 10    continue
  83.                                  
  84. c
  85. c label the control points in geom2
  86. c
  87.     do 20 i = 1, 6
  88.         call move2(geom2(1, i), geom2(2, i))
  89.         write(buf, '(i1)')i
  90.         call drawstr(buf)
  91. 20    continue
  92.  
  93. c
  94. c scale the current font so that 30 of the largest characters
  95. c in the current font will fit in a region 300 world units wide,
  96. c 20 high.
  97. c
  98.     call boxfit(300.0, 20.0, 30)
  99.  
  100. c
  101. c set the number of line segments appearing in each curve to 20
  102. c
  103.     call curveprecision(20)
  104.  
  105. c
  106. c copy the bezier basis matrix into the curve basis matrix.
  107. c
  108.     call curvebasis(bezier)
  109.  
  110.     call color(RED)
  111.  
  112. c
  113. c draw a curve using the current basis matrix (bezier in this case)
  114. c and the control points in geom1
  115. c
  116.     call curve(geom1)
  117.  
  118.     call move2(70.0, 60.0)
  119.     call drawstr('Bezier Curve Segment')
  120.  
  121.     call move2(-190.0, 450.0)
  122.     call drawstr('Three overlapping Bezier Curves')
  123.  
  124. c
  125. c curven draws overlapping curve segments according to geom2, the
  126. c number of curve segments drawn is three less than the number of
  127. c points passed, assuming there are a least four points in the
  128. c geometry matrix (in this case geom2). This call will draw 3
  129. c overlapping curve segments in the current basis matrix - still
  130. c bezier.
  131. c
  132.     call curven(6, geom2)
  133.  
  134.     call getkey
  135.  
  136. c
  137. c load in the cardinal basis matrix
  138. c
  139.     call curvebasis(cardinal)
  140.  
  141.     call color(MAGENTA)
  142.  
  143.     call move2(70.0, 10.0)
  144.     call drawstr('Cardinal Curve Segment')
  145.  
  146. c
  147. c plot out a curve segment using the cardinal basis matrix
  148. c
  149.     call curve(geom1)
  150.  
  151.     call move2(-190.0, 400.0)
  152.     call drawstr('Three overlapping Cardinal Curves')
  153.  
  154. c
  155. c now draw a bunch of them again.
  156. c
  157.     call curven(6, geom2)
  158.  
  159.     call getkey
  160.  
  161. c
  162. c change the basis matrix again
  163. c
  164.     call curvebasis(bspline)
  165.  
  166.     call color(GREEN)
  167.  
  168.     call move2(70.0, -40.0)
  169.     call drawstr('Bspline Curve Segment')
  170.  
  171. c
  172. c now draw our curve segment in the new basis...
  173. c
  174.     call curve(geom1)
  175.  
  176.     call move2(-190.0, 350.0)
  177.     call drawstr('Three overlapping Bspline Curves')
  178.  
  179. c
  180. c ...and do some overlapping ones
  181. c
  182.     call curven(6, geom2)
  183.  
  184.     call getkey
  185.  
  186.     call vexit
  187.  
  188.     end
  189.