home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / sampler / 03 / bezier / twocurvs.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-10-29  |  2.1 KB  |  84 lines
  1. Program twoCurvs;
  2.  
  3.    { Draw joined Bezier curves on the CGA }
  4.  
  5. USES graph, Bezier, crt;
  6.  
  7. CONST  lastPoint = 4;     { highest subscript used }
  8.  
  9. VAR  a, b                                 : vectorArray;
  10.      graphDriver, graphMode, errorCode, n : INTEGER;
  11.      wait                                 : CHAR;
  12. { --------------------------- }
  13.  
  14. PROCEDURE initPoints;     { Define control points }
  15.  
  16. VAR    n, j : INTEGER;
  17.  
  18. BEGIN
  19.   FOR n := 0 TO maxPoints DO     { Zero the array }
  20.     FOR j := 0 TO 2 DO BEGIN
  21.       a [n, j] := 0;
  22.       b [n, j] := 0;
  23.     END;
  24.   a [0, 0] :=  10;   a [0, 1] := 110;  { first hull }
  25.   a [1, 0] :=  10;   a [1, 1] :=   0;
  26.   a [2, 0] := 120;   a [2, 1] :=   0;
  27.   a [3, 0] := 180;   a [3, 1] := 110;
  28.   a [4, 0] := 240;   a [4, 1] := 110;
  29.  
  30.   b [0, 0] := 240;   b [0, 1] := 110;  { second hull }
  31.   b [1, 0] := 310;   b [1, 1] := 110;
  32.   b [2, 0] := 310;   b [2, 1] :=   0;
  33.   b [3, 0] := 180;   b [3, 1] :=   0;
  34.   b [4, 0] := 120;   b [4, 1] := 199;
  35. END;
  36. { --------------------------- }
  37.  
  38. BEGIN
  39. { Set up the screen in CGA 320 x 200 mode, palette 1 }
  40.   GraphDriver := CGA;
  41.   GraphMode   := CGAC1;
  42.   InitGraph (graphDriver, graphMode, 'C:\DRIVERS');
  43.  
  44. { Check to make sure it happened }
  45.   ErrorCode := graphResult;
  46.   IF errorCode <> grOK THEN BEGIN
  47.     WRITELN ('Graphics error ', errorCode);
  48.     WRITELN ('Program cannot run');
  49.     HALT (1);
  50.   END;
  51.  
  52. { Draw the first hull outline }
  53.   InitPoints;      { First initialize control points }
  54.   SetLineStyle (dottedLn, 0, normWidth);
  55.   SetColor (1);
  56.   MoveTo (a [0, 0], a [0, 1]);
  57.   FOR n := 1 TO lastPoint DO
  58.     LineTo (a [n, 0], a [n, 1]);
  59.  
  60. { Draw the second hull }
  61.   MoveTo (b [0, 0], b [0, 1]);
  62.   FOR n := 1 TO lastPoint DO
  63.     LineTo (b [n, 0], b [n, 1]);
  64.  
  65. { Mark the joint with a vertical line }
  66.   MoveTo (240, 100);
  67.   LineTo (240, 120);
  68.  
  69. { Now draw the first curve }
  70.   SetLineStyle (solidLn, 0, normWidth);
  71.   SetColor (2);
  72.   DrawBezier2D (a, lastPoint);
  73.  
  74. { And second curve }
  75.   SetColor (3);
  76.   DrawBezier2D (b, lastPoint);
  77.  
  78. { Clean up after a keypress }
  79.   Wait := readkey;
  80.   CloseGraph;
  81. END.
  82.  
  83.  
  84.