home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l045 / 1.ddi / BEZIDEMO.PAS next >
Encoding:
Pascal/Delphi Source File  |  1987-12-23  |  4.1 KB  |  153 lines
  1.  
  2. {           Copyright (c) 1985, 87 by Borland International, Inc.            }
  3.  
  4. program BeziDemo;
  5.  
  6. {$I Float.inc}  { Determines what type Float means. }
  7.  
  8. uses
  9.   Dos, Crt, GDriver, GKernel, GWindow, GShell;
  10.  
  11. procedure ClearToEol;
  12. { Procedure to clear to end of line }
  13. var
  14.   I : integer;
  15. begin
  16.   for I := 1 to 80 do
  17.     Write(' ');
  18. end; { ClearToEol }
  19.  
  20. procedure ReadInput(var S : WrkString);
  21. const
  22.   Cr = #13;
  23.   Bs = #8;
  24. var
  25.   Count : integer;
  26.   Ch    : char;
  27. begin
  28.   Count := 0;
  29.   S := '';
  30.   repeat
  31.     Ch := ReadKey;
  32.     case Ch of
  33.       Bs : begin
  34.              if Count > 0 then
  35.              begin
  36.                Write(Ch);
  37.                ClrEol;
  38.                Delete(S, Length(S), 1);
  39.                Dec(Count);
  40.              end;
  41.            end;
  42.     else
  43.       if Ch <> Cr then
  44.       begin
  45.         Write(Ch);
  46.         S := S + Ch;
  47.         Count := Count + 1;
  48.       end;
  49.     end;
  50.   until Ch = Cr;
  51. end; { ReadInput }
  52.  
  53. procedure BezierDem;
  54.  
  55. var
  56.   Result, I, MaxControlPoints, MaxIntPoints : integer;
  57.   DummyX, DummyY : Float;
  58.   A, B : PlotArray;
  59.   Break : boolean;
  60.   DummyS, Temp2, Temp : WrkString;
  61.  
  62. begin
  63.   MaxControlPoints := 7;               { Initialize everything }
  64.   MaxIntPoints := 15;
  65.  
  66.   A[1, 1] := 1;   A[2, 1] := 1.5; A[3, 1] := 2;   A[4, 1] := 2.5;
  67.   A[5, 1] := 3;   A[6, 1] := 4;   A[7, 1] := 5;   A[1, 2] := 2;
  68.   A[2, 2] := 1.5; A[3, 2] := 1;   A[4, 2] := 2.5; A[5, 2] := 4;
  69.   A[6, 2] := 4.5; A[7, 2] := 5;
  70.  
  71.   ClearScreen;                         { Set up screen }
  72.   SetColorWhite;
  73.   DefineWorld(1, 0, 0, 6.33, 7.0);     { Set world so rulers are good }
  74.   SelectWorld(1);
  75.   DefineWindow(1, 0, 0, XMaxGlb, 17 * YMaxGlb div 20);
  76.   SelectWindow(1);
  77.   SetBackground(0);
  78.   DrawBorder;
  79.  
  80.   Break := false;                      { Init exit flag }
  81.  
  82.   repeat
  83.     DrawAxis(7, -7, 0, 0, 0, 0, 0, 0, false);
  84.     SetLinestyle(1);                   { Draw polygon between points }
  85.     DrawPolygon(A, 1, MaxControlPoints, 4, 2, 0);
  86.     Bezier(A, MaxControlPoints, B, MaxIntPoints);  { Do bezier operation }
  87.     SetLinestyle(0);                   { Plot it }
  88.     ResetAxis;
  89.     DrawPolygon(B, 1, MaxIntPoints, 0, 0, 0);
  90.  
  91.     repeat
  92.       GotoXY(1, 24);                   { Clear out old text }
  93.       ClearToEol;
  94.       GotoXY(1, 25);
  95.       ClearToEol;
  96.       GotoXY(1, 23);
  97.       ClearToEol;
  98.       GotoXY(1, 23);                   { Get point to change }
  99.       Write('Enter the number of the point to change (0 to quit) :  ');
  100.       GotoXY(55, 23);
  101.       ReadInput(Temp);
  102.       Val(Temp, I, Result);
  103.     until I in [0..MaxControlPoints];
  104.  
  105.     if I > 0 then
  106.       begin
  107.         repeat
  108.           GotoXY(1, 24);               { Get new values for x and y }
  109.           Write('Old position : [', A[I,1]:4:2, ',', A[I,2]:4:2, ']');
  110.           GotoXY(40, 24);
  111.           Write('   New position  x:  ');
  112.           GotoXY(60, 24);
  113.           ReadInput(DummyS);
  114.           while DummyS[1] = ' ' do
  115.             Delete(DummyS, 1, 1);
  116.           Temp := DummyS;
  117.           GotoXY(40, 25);
  118.           Write('   New position  y:  ');
  119.           GotoXY(60, 25);
  120.           ReadInput(DummyS);
  121.           while DummyS[1] = ' ' do
  122.             Delete(DummyS, 1, 1);
  123.           Temp2 := DummyS;
  124.           Val(Temp, DummyX, Result);
  125.           Val(Temp2, DummyY, Result);
  126.         until ((DummyX >= X1WldGlb) and (DummyX <= X2WldGlb)) and
  127.               ((DummyY >= Y1WldGlb) and (DummyY <= Y2WldGlb));
  128.  
  129.         SetLinestyle(1);               { Erase old curve }
  130.         SetColorBlack;
  131.         DrawAxis(0, 0, 0, 0, 0, 0, 0, 0, false);
  132.         DrawPolygon(A, 1, MaxControlPoints, 4, 2, 0);
  133.         SetLinestyle(0);
  134.         DrawAxis(0, 0, 0, 0, 0, 0, 0, 0, false);
  135.         DrawPolygon(B, 1, MaxIntPoints, 0, 0, 0);
  136.         A[I, 1] := DummyX;
  137.         A[I, 2] := DummyY;
  138.         SetColorWhite;
  139.       end
  140.     else
  141.       Break := true;                   { Done }
  142.   until Break;
  143. end; { BezierDem }
  144.  
  145. begin
  146.   InitGraphic;                         { Initialize the graphics system }
  147.  
  148.   BezierDem;                           { Do the demo }
  149.  
  150.   LeaveGraphic;                        { Leave the graphics system }
  151. end. { BeziDemo }
  152.  
  153.