home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / OOPMOU_A.ZIP / BEZIER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-25  |  8.9 KB  |  286 lines
  1. program BezierCurves;
  2. { program that demonstrates use of the mouse object and Bezier spline curves }
  3.  
  4. uses
  5.   Crt,
  6.   Graph,
  7.   MouseUnit;
  8.  
  9. const
  10.   radius = 5;                      { radius of pickup circle    }
  11.   resolution = 0.025;         { resolution of Bezier curve approximation    }
  12.  
  13. type
  14.   coordinate = record
  15.     row    : integer;
  16.     column    : integer;
  17.   end;
  18.  
  19. var
  20.   OldExitProc    : Pointer;         { Saves exit procedure address    }
  21.   last_Bezier_curve : array[1..42] of coordinate; { array size = 1 / resolution + 2 }
  22.   Bezier_fill_pointer : integer;
  23.   mouse        : mouse_object;                 { mouse object    }
  24.   MaxX, MaxY    : word;          { The maximum resolution of the screen    }
  25.   point        : array[1..4] of coordinate;   { end and control points    }
  26.  
  27. {-----------------------------------------------------------------------}
  28.  
  29. {$F+} procedure MyExitProc; {$F-}
  30. begin
  31.     ExitProc := OldExitProc;       { Restore exit procedure address    }
  32.     CloseGraph;            { Shut down the graphics system    }
  33. end; { MyExitProc }
  34.  
  35. {-----------------------------------------------------------------------}
  36.  
  37. procedure Initialize;
  38. { Initialize graphics and report any errors that may occur }
  39. var
  40.   GraphDriver    : integer;           { The Graphics device driver    }
  41.   GraphMode    : integer;              { The Graphics mode value    }
  42.   ErrorCode    : integer;          { Reports any graphics errors    }
  43.   InGraphicsMode : boolean; { Flags initialization of graphics mode }
  44.   PathToDriver   : string;  { Stores the DOS path to *.BGI & *.CHR }
  45.   xasp, yasp : word;
  46. begin
  47.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  48.   DirectVideo := False;
  49.   OldExitProc := ExitProc;                { save previous exit proc }
  50.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  51.   PathToDriver := 'c:\lang\bgi';
  52.   repeat
  53.  
  54. {$IFDEF Use8514}                          { check for Use8514 $DEFINE }
  55.     GraphDriver := IBM8514;
  56.     GraphMode := IBM8514Hi;
  57. {$ELSE}
  58.     GraphDriver := Detect;                { use autodetection }
  59. {$ENDIF}
  60.  
  61.     InitGraph(GraphDriver, GraphMode, PathToDriver);
  62.     ErrorCode := GraphResult;             { preserve error return }
  63.     if ErrorCode <> grOK then             { error? }
  64.     begin
  65.       Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  66.       if ErrorCode = grFileNotFound then  { Can't find driver file }
  67.       begin
  68.         Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
  69.         Readln(PathToDriver);
  70.         Writeln;
  71.       end
  72.       else
  73.         Halt(1);                          { Some other error: terminate }
  74.     end;
  75.   until ErrorCode = grOK;
  76.  
  77.   MaxX := GetMaxX;                        { Get screen resolution values }
  78.   MaxY := GetMaxY;
  79.  
  80.   Mouse.ColRange(0,MaxX);                 { Set mouse screen size! }
  81.   Mouse.RowRange(0,MaxY);                 { M. Warot - 11-25-89    }
  82.  
  83.   SetLineStyle ( SolidLn, SolidFill, NormWidth );
  84. end; { Initialize }
  85.  
  86. {-----------------------------------------------------------------------}
  87.  
  88. function adjasp(y : integer) : integer;
  89. begin
  90.     adjasp := (MaxY - y);
  91. end;
  92.  
  93. {-----------------------------------------------------------------------}
  94.  
  95. function pow(x : real; y : word) : real;
  96. { compute x to the y                            }
  97. var
  98.   count : word;
  99.   result : real;
  100. begin
  101.     result := 1;
  102.     for count := 1 to y do
  103.         result := result * x;
  104.     pow := result;
  105. end;
  106.  
  107. {-----------------------------------------------------------------------}
  108.  
  109. function within(x1, y1, x2, y2, radius : integer) : boolean;
  110. { check to see if point is within control point circle            }
  111. begin
  112.     if (sqrt(abs(sqr(x2 - x1) + sqr(y2 - y1))) <= radius) then
  113.         within := true
  114.     else
  115.         within := false;
  116. end;
  117.  
  118. {-----------------------------------------------------------------------}
  119.  
  120. procedure Bezier(t : real; var x, y : integer);
  121. { compute actual Bezier coordinates for 0 <= t <= 1 and current control    }
  122. { points.  The Bezier spline curve function is:                }
  123. {                                    }
  124. {              3             2         2           3        }
  125. {    x(t) = (1 - t) X  + 3t(1 - t) X  + 3t (1 - t)X  + t X        }
  126. {            0              1          2         3        }
  127. {                                    }
  128. {              3             2         2           3        }
  129. {    y(t) = (1 - t) Y  + 3t(1 - t) Y  + 3t (1 - t)Y  + t Y        }
  130. {            0              1          2         3        }
  131. {                                    }
  132. begin
  133.     x := round(pow(1 - t, 3) * point[1].column +
  134.         3 * t *    pow(1 - t, 2) * point[2].column +
  135.         3 * t * t * (1 - t) * point[3].column +
  136.         pow(t, 3) * point[4].column);
  137.     y := round(pow(1 - t, 3) * point[1].row +
  138.         3 * t * pow(1 - t, 2) * point[2].row +
  139.         3 * t * t * (1 - t) * point[3].row +
  140.         pow(t, 3) * point[4].row);
  141. end;
  142.  
  143. {-----------------------------------------------------------------------}
  144.  
  145. procedure EraseBezierCurve;
  146. { erase old Bezier curve stored in last_Bezier_curve array        }
  147. var x : integer;
  148. begin
  149.     moveto(last_Bezier_curve[1].column, last_Bezier_curve[1].row);
  150.     for x := 2 to Bezier_fill_pointer do
  151.         lineto(last_Bezier_curve[x].column, last_Bezier_curve[x].row);
  152. end;
  153.  
  154. {-----------------------------------------------------------------------}
  155.  
  156. procedure DrawBezierCurve;
  157. { calculate, draw and save new Bezier curve                }
  158. var
  159.     t : real;
  160.     x, y : integer;
  161. begin
  162.     Bezier_fill_pointer := 1;
  163.     moveto(point[1].column, adjasp(point[1].row));
  164.     t := 0;
  165.     while t < 1 do begin
  166.         { calculate new Bezier coordinates            }
  167.         Bezier(t, x, y);
  168.  
  169.         { draw new Bezier curve                    }
  170.         lineto(x, adjasp(y));
  171.         t := t + resolution;
  172.  
  173.         { save new coordinate for erase function        }
  174.         last_Bezier_curve[Bezier_fill_pointer].column := x;
  175.         last_Bezier_curve[Bezier_fill_pointer].row := adjasp(y);
  176.         inc(Bezier_fill_pointer);
  177.     end;
  178. end;
  179.  
  180. {-----------------------------------------------------------------------}
  181.  
  182. procedure move_point(point_index : integer);
  183. { redraw Bezier curve as a control point is moved            }
  184. var
  185.   x        : integer;
  186.   status    : integer;
  187.   mouse_row, mouse_column : integer;
  188.   old_mouse_row, old_mouse_column : integer;
  189. begin
  190.     { initialize "old" mouse positions                }
  191.     mouse.GetStatus(status, old_mouse_row, old_mouse_column);
  192.     repeat
  193.       { get mouse position                        }
  194.       mouse.GetStatus(status, mouse_row, mouse_column);
  195.  
  196.       { redraw new Bezier curve only if mouse has been moved    }
  197.       if (mouse_row <> old_mouse_row) or (mouse_column <> old_mouse_column) then begin
  198.         old_mouse_row := mouse_row;
  199.         old_mouse_column := mouse_column;
  200.  
  201.         { hide mouse while updating screen                }
  202.         mouse.Hide;
  203.  
  204.         { erase old control point and Bezier curve            }
  205.         setcolor(0);
  206.         circle(point[point_index].column, adjasp(point[point_index].row), radius);
  207.         EraseBezierCurve;            { erase old curve    }
  208.  
  209.         { set new control point coordinates                }
  210.         point[point_index].row := adjasp(mouse_row);
  211.         point[point_index].column := mouse_column;
  212.  
  213.         { draw all control points and new curve            }
  214.         setcolor(GetMaxColor);
  215.         for x := 1 to 4 do
  216.             circle(point[x].column, adjasp(point[x].row), radius);
  217.         DrawBezierCurve;
  218.  
  219.         { show mouse now that updates have been written to screen    }
  220.         mouse.Show;
  221.       end;
  222.  
  223.       { this just prevents mouse run-on when button has been released}
  224.           mouse.GetStatus(status, mouse_row, mouse_column);
  225.     until status and $01 = 0;
  226. end;
  227.  
  228. {-----------------------------------------------------------------------}
  229.  
  230. var
  231.   ch : char;
  232.   done        : boolean;
  233.   status    : integer;
  234.   button_row    : integer;
  235.   button_column : integer;
  236. begin
  237.     { check for mouse driver                    }
  238.     if not mouse.Exists then begin
  239.         writeln('Error:  this program requires the use of a mouse');
  240.         halt(1);
  241.     end;
  242.  
  243.     { initialize graphics system                    }
  244.     Initialize;
  245.  
  246.     { setup origional Bezier curve control points            }
  247.     point[1].column := MaxX - MaxX div 4;    point[1].row := MaxY div 4;
  248.     point[2].column :=  10;            point[2].row := MaxY - 10;
  249.     point[3].column := MaxX - 10;        point[3].row := MaxY - 10;
  250.     point[4].column := MaxX div 4;        point[4].row := MaxY div 4;
  251.  
  252.     { draw origional Bezier curve control points            }
  253.     circle(point[1].column, adjasp(point[1].row), radius);
  254.     circle(point[2].column, adjasp(point[2].row), radius);
  255.     circle(point[3].column, adjasp(point[3].row), radius);
  256.     circle(point[4].column, adjasp(point[4].row), radius);
  257.  
  258.     { draw origional Bezier curve                    }
  259.     DrawBezierCurve;
  260.  
  261.     { show mouse pointer                        }
  262.     if mouse.Exists then mouse.show;
  263.  
  264.     done := false;
  265.         repeat
  266.         mouse.GetStatus(status, button_row, button_column);
  267.         { if button one pushed then check if in control point    }
  268.         if status and $01 <> 0 then begin
  269.             if within(point[1].column, adjasp(point[1].row), button_column, button_row, radius)
  270.             then move_point(1);
  271.             if within(point[2].column, adjasp(point[2].row), button_column, button_row, radius)
  272.             then move_point(2);
  273.             if within(point[3].column, adjasp(point[3].row), button_column, button_row, radius)
  274.             then move_point(3);
  275.             if within(point[4].column, adjasp(point[4].row), button_column, button_row, radius)
  276.             then move_point(4);
  277.         end;
  278.  
  279.         { repeat until ESC pressed                }
  280.                 if keypressed then begin
  281.           ch := readkey;
  282.           if ch = #27 then done := true;
  283.         end;
  284.     until done;
  285. end.
  286.