Need routine to draw bezier curves.
Author Message
Need routine to draw bezier curves.

Does anyone have a routine to draw bezier curves ?

Wed, 18 Jun 1902 08:00:00 GMT
Need routine to draw bezier curves.

Quote:

> Does anyone have a routine to draw bezier curves ?

I have some old b-spline code that I just dug up from my old archives for my
own purposes.  Let me see if I can't clean it up a bit, and I'll post it since
it isn't too long.

--
Scott Earnest            | SPAM protection in effect. Remove  |

Wed, 18 Jun 1902 08:00:00 GMT
Need routine to draw bezier curves.

Hi Scott,

On Tue, 24 Mar 1998 02:42:12 -0500, Scott Earnest

Quote:

>I have some old b-spline code that I just dug up from my old archives for my
>own purposes.  Let me see if I can't clean it up a bit, and I'll post it since
>it isn't too long.

Did I hear b-spline? Me too! :-) Please?

Here's my code for a bezier:

CONST
{bezier curve constants}
Flatness      = 0.50;            {limit value of curvature}
MaxDepth      = 20;              {limit value for recursion}

VAR
{bezier curves}
A,B,C,                           {used for flatting}
Dist1,Dist2,                     {used for flatting}
MaxDist            :SINGLE;      {used for flatting}

FUNCTION _Real2Int(X:SINGLE):INTEGER;
{rounds and ranges a real to a integer}
BEGIN
IF X < -32768.0 THEN X := -32768;
IF X > 32767.0 THEN X := 32767;
_Real2Int := Round(X);
END; {_Real2Int}

PROCEDURE _FlattenBezier(X0,Y0,X1,Y1,X2,Y2,X3,Y3:SINGLE;Depth:WORD);
{find the flatness of the curve, as it lies within the convex hull
of its control points we just find the maximum distance of the
intermediate control points from the straight line joining the ends}
VAR N1X,N1Y,N2X,N2Y,N3X,N3Y,N4X,N4Y,N5X,N5Y:SINGLE;
BEGIN
IF Depth > MaxDepth THEN EXIT;
A := Y3-Y0;
B := X0-X3;
C := X3*Y0-X0*Y3;
Dist1   := Sqr(A*X1+B*Y1+C);
Dist2   := Sqr(A*X2+B*Y2+C);
MaxDist := Flatness*(Sqr(A)+Sqr(B));
{if the curve is not flat enough bisect it and flatten the halves}
IF (Dist1 > MaxDist) OR (Dist2 > MaxDist) THEN
BEGIN
N1X := 0.5*X0+0.5*X1;
N1Y := 0.5*Y0+0.5*Y1;
N2X := 0.25*X0+0.5*X1+0.25*X2;
N2Y := 0.25*Y0+0.5*Y1+0.25*Y2;
N3X := 0.125*X0+0.375*X1+0.375*X2+0.125*X3;
N3Y := 0.125*Y0+0.375*Y1+0.375*Y2+0.125*Y3;
N4X := 0.25*X1+0.5*X2+0.25*X3;
N4Y := 0.25*Y1+0.5*Y2+0.25*Y3;
N5X := 0.5*X2+0.5*X3;
N5Y := 0.5*Y2+0.5*Y3;
Inc(Depth);
_FlattenBezier(X0,Y0,N1X,N1Y,N2X,N2Y,N3X,N3Y,Depth);
_FlattenBezier(N3X,N3Y,N4X,N4Y,N5X,N5Y,X3,Y3,Depth);
END
ELSE {otherwise make it a straight line from 0 to 3}
BEGIN
LineTo(_Real2Int(X3),_Real2Int(Y3));
END;
END; {_FlattenBezier}

PROCEDURE Bezier(X0,Y0,X1,Y1,X2,Y2,X3,Y3:INTEGER);
{draw a bezier curve, overflow protection is installed,
I know it's not very efficient, sorry for that...}
BEGIN
MoveTo(X0,Y0);
_FlattenBezier(X0,Y0,X1,Y1,X2,Y2,X3,Y3,0);
END; {Bezier}

Peter de Jong,

Wed, 18 Jun 1902 08:00:00 GMT
Need routine to draw bezier curves.

Quote:

>Does anyone have a routine to draw bezier curves ?

Here's a file dated 7/1/91.  I don't remember where I got it.
===============================================

PROGRAM BezierCurves;
{Demonstrate use of mouse object and Bezier spline curves}
{Benjamin R. Peart                                       }

USES
Crt,
Graph,
Mouse;

CONST
resolution = 0.025;        {resolution of Bezier curve approximation}

TYPE
coordinate =
RECORD
row   : INTEGER;
column: INTEGER
END;

VAR
Bezier_fill_pointer:  INTEGER;
{array size = 1 / resolution + 2}
last_Bezier_curve  :  ARRAY[1..42] OF coordinate;
MaxX, MaxY         :  WORD;          {The maximum resolution of the
screen}
OldExitProc        :  POINTER;       {Saves exit procedure address}
point              :  ARRAY[1..4] OF coordinate;   {end and control
points}

{???????????????????????????????????????????????????????????????????????}

{\$F+} PROCEDURE MyExitProc; {\$F-}
BEGIN
ExitProc := OldExitProc;   {Restore exit procedure address}
CloseGraph                 {Shut down the graphics system }
END;

{???????????????????????????????????????????????????????????????????????}

PROCEDURE Initialize;
{Initialize graphics and report any errors that may occur}
VAR
GraphDriver   :  integer;  {The Graphics device driver}
GraphMode     :  integer;  {The Graphics mode value}
ErrorCode     :  integer;  {Reports any graphics errors}
InGraphicsMode:  boolean;  {Flags initialization of graphics mode}
PathToDriver  :  string;   {Stores the DOS path to *.BGI & *.CHR}
xasp, yasp    :  word;
BEGIN
{when using Crt and graphics, turn off Crt's memory-mapped writes}
DirectVideo := False;
OldExitProc := ExitProc;   {save previous exit proc}

PathToDriver := 'C:\TP\BGI';

REPEAT

{\$IFDEF Use8514}                       {check for Use8514 \$DEFINE}
GraphDriver := IBM8514;
GraphMode := IBM8514Hi;
{\$ELSE}
GraphDriver := Detect;             {use autodetection}
{\$ENDIF}

InitGraph(GraphDriver, GraphMode, PathToDriver);
ErrorCode := GraphResult;          {preserve error return}
IF   ErrorCode <> grOK             {error?}
THEN BEGIN
WRITELN ('Graphics error: ', GraphErrorMsg(ErrorCode));
IF   ErrorCode = grFileNotFound  {Can't find driver file}
THEN BEGIN
WRITELN ('Enter full path to BGI driver or type <Ctrl-Break> to
quit:');
WRITELN
END
ELSE BEGIN
Halt(1)                        {Some other error:  terminate}
END
END
UNTIL ErrorCode = grOK;

MaxX := GetMaxX;          {Get screen resolution values}
MaxY := GetMaxY;

SetLineStyle (SolidLn, SolidFill, NormWidth)
END;

{???????????????????????????????????????????????????????????????????????}

BEGIN
END;

{???????????????????????????????????????????????????????????????????????}

FUNCTION pow(x:  REAL;  y: WORD):  REAL;
{compute x to the y}
VAR
count :  WORD;
result:  REAL;
BEGIN
result := 1;
FOR count := 1 to y DO
result := result * x;
pow := result;
END;

{???????????????????????????????????????????????????????????????????????}

FUNCTION within(x1, y1, x2, y2, radius:  INTEGER):  BOOLEAN;
{check to see if point is within control point circle}
BEGIN
within := (sqrt(abs(sqr(x2 - x1) + sqr(y2 - y1))) <= radius)
END;

{???????????????????????????????????????????????????????????????????????}

PROCEDURE Bezier (t:  REAL; VAR x, y:  INTEGER);
{ compute actual Bezier coordinates for 0 <= t <= 1 and current }
{ control points.  The Bezier spline curve function is:         }
{                                                               }
{                3              2       2             3         }
{  x(t) = (1 - t) X  + 3t(1 - t) X  + 3t (1 - t)X  + t X        }
{                  0              1              2      3       }
{                                                               }
{                3              2       2             3         }
{  y(t) = (1 - t) Y  + 3t(1 - t) Y  + 3t (1 - t)Y  + t Y        }
{                  0              1              2      3       }
BEGIN
x := ROUND(pow(1 - t, 3) * point[1].column +
3 * t *  pow(1 - t, 2) * point[2].column +
3 * t * t * (1 - t) * point[3].column +
pow(t, 3) * point[4].column);
y := ROUND(pow(1 - t, 3) * point[1].row +
3 * t * pow(1 - t, 2) * point[2].row +
3 * t * t * (1 - t) * point[3].row +
pow(t, 3) * point[4].row)
END;

{???????????????????????????????????????????????????????????????????????}

PROCEDURE EraseBezierCurve;
{erase old Bezier curve stored in last_Bezier_curve array}
VAR x:  INTEGER;
BEGIN
MoveTo (last_Bezier_curve[1].column, last_Bezier_curve[1].row);
FOR x := 2 TO Bezier_fill_pointer DO
LineTo(last_Bezier_curve[x].column, last_Bezier_curve[x].row)
END;

{???????????????????????????????????????????????????????????????????????}

PROCEDURE DrawBezierCurve;
{calculate, draw and save new Bezier curve}
var
t : real;
x, y : integer;
begin
Bezier_fill_pointer := 1;
t := 0;
while t < 1 do begin
{ calculate new Bezier coordinates      }
Bezier(t, x, y);

{ draw new Bezier curve          }
t := t + resolution;

{ save new coordinate for erase function    }
last_Bezier_curve[Bezier_fill_pointer].column := x;
inc(Bezier_fill_pointer);
end;
end;

{???????????????????????????????????????????????????????????????????????}

PROCEDURE move_point(point_index:  INTEGER);
{redraw Bezier curve as a control point is moved}
VAR
x                              :  INTEGER;
status                         :  INTEGER;
mouse_row, mouse_column        :  INTEGER;
old_mouse_row, old_mouse_column:  INTEGER;
BEGIN
{initialize "old" mouse positions}
MouseGetStatus(status, old_mouse_row, old_mouse_column);
REPEAT
{get mouse position}
MouseGetStatus(status, mouse_row, mouse_column);

{ redraw new Bezier curve only if mouse has been moved  }
IF (mouse_row <> old_mouse_row) OR (mouse_column <> old_mouse_column)
THEN BEGIN
old_mouse_row := mouse_row;
old_mouse_column := mouse_column;

{hide mouse while updating screen}
MouseHide;

{erase old control points and Bezier curve}
SetColor(0);
FOR x := 1 TO 4 DO BEGIN
END;
EraseBezierCurve;      {erase old curve}

{set new control point coordinates}
point[point_index].column := mouse_column;

{draw all control points and new curve}
FOR x := 1 TO 4 DO BEGIN
SetColor (10+x);
END;
SetColor (15);
SetBkColor(1);
DrawBezierCurve;

{show mouse now that updates have been written to screen}
MouseShow;
END;

{this just prevents mouse run-on when button has been released}
MouseGetStatus(status, mouse_row, mouse_column)
UNTIL status AND \$01 = 0;
END;

{???????????????????????????????????????????????????????????????????????}

VAR
c            :  CHAR;
done         :  BOOLEAN;
status       :  INTEGER;
button_row   :  INTEGER;
button_column:  INTEGER;

BEGIN
{check for mouse driver}
IF    NOT MouseExists
THEN BEGIN
WRITELN ('Error:  this program requires the use of a mouse');
HALT (1);
END;

{initialize graphics system}
Initialize;

ColRange (0,MaxX-8);
RowRange (0,MaxY-8);

{setup origional Bezier curve control points}
point[1].column := MaxX - MaxX div 4;
point[1].row    := MaxY div 4;

point[2].column := 10;
point[2].row    := MaxY - 10;

point[3].column := MaxX - 10;
point[3].row    := MaxY - 10;

point[4].column := MaxX div 4;
point[4].row    := MaxY div 4;

{draw original Bezier curve control points}
SetColor (11);
SetColor (12);
SetColor (13);
SetColor (14);

{draw original Bezier curve}
SetColor (15);
DrawBezierCurve;

{show mouse pointer}
IF   MouseExists
THEN MouseShow;

done := FALSE;
REPEAT
MouseGetStatus(status, button_row, button_column);

{ if button one pushed then check if in control point  }
IF   status and \$01 <> 0
THEN BEGIN
THEN move_point(1);
THEN move_point(2);
IF   within(point[3].column,
...

Wed, 18 Jun 1902 08:00:00 GMT
Need routine to draw bezier curves.

That's a program that uses MOUSE.TPU. For which version of TP is this program
written. Is the mouse unit included in some version of TP?

...

Quote:

> >Does anyone have a routine to draw bezier curves ?

> Here's a file dated 7/1/91.  I don't remember where I got it.
> ===============================================

> PROGRAM BezierCurves;
>   {Demonstrate use of mouse object and Bezier spline curves}
>   {Benjamin R. Peart                                       }

> USES
>   Crt,
>   Graph,
>   Mouse;

...

Thanks
--
Herman SERRAS
Universiteit Gent

Wed, 18 Jun 1902 08:00:00 GMT
Need routine to draw bezier curves.

Quote:

>That's a program that uses MOUSE.TPU. For which version of TP is this
program
>written. Is the mouse unit included in some version of TP?

>> Here's a file dated 7/1/91.  I don't remember where I got it.
>> ===============================================

>> PROGRAM BezierCurves;

Herman,

I think I got the Bezier code from Compuserve, but I dropped my
membership there a year or two ago.  I don't know if I ever
compiled the code.

I do have a mouse.pas that I wrote, but it's probably not
compatible with that earlier code.  So here's a mouse.pas
to start with (or do a Deja New search -- especially in the
"old" database -- for other mouse units).  This mouse unit
has worked in TP 5.5 - TP 7.0.

----------------------------------------------------------------------------
--------

UNIT Mouse;

{(C) Copyright 1991-1992.  Earl F. Glynn, Overland Park, KS.  CIS
73257,3527.
non-commercial use.

The abbreviation "MMPR" below means "Microsoft Mouse Programmer's
Reference", Microsoft Press, 1989}

{}

INTERFACE

CONST
CursorPositionChanged   = \$01;     {Interrupt Mask:  see p. 151, MMPR}
LeftButtonPressed       = \$02;
LeftButtonReleased      = \$04;
RightButtonPressed      = \$08;
RightButtonReleased     = \$10;

BothButtonsUp           = \$00;     {Button Status:  see p. 126, MMPR}
LeftButtonDown          = \$01;
RightButtonDown         = \$02;
BothButtonsDown         = \$03;

PROCEDURE ResetMouse;                           {Function 0}

PROCEDURE Show;                                 {Function 1}
PROCEDURE Hide;                                 {Function 2}

PROCEDURE Position (VAR status,i,j:  INTEGER);  {Function 3}
{Function 4}
PROCEDURE MoveTo (i,j: INTEGER);
PROCEDURE Window (i1,i2, j1,j2:  INTEGER);      {Functions 7 & 8}

{Function 12}
PROCEDURE RegisterISR (Mask, ISRSegment, ISROffset:  WORD);
{Function 36}
PROCEDURE GetDriverVersion (VAR major,minor,
MouseType,IRQnumber:  BYTE);

FUNCTION  Exists:   BOOLEAN;
FUNCTION  Visible:  BOOLEAN;
FUNCTION  MousejMax:  WORD;
PROCEDURE WindowMax (iMaxWindow,jMaxWindow:  WORD);

VAR
HiddenMouseEvents:  WORD;

{}

IMPLEMENTATION

CONST
MouseInterrupt = \$33;

VAR
ExitSave         :  POINTER;
iMax             :  WORD;
jMax             :  WORD;
MouseExists      :  BOOLEAN;
MouseVisible     :  BOOLEAN;

{????  Function 0:  Mouse Reset and Status (p. 116, MMPR)  ?????????????}

PROCEDURE ResetMouse;
ASSEMBLER;                   {See p. 303, Turbo Pascal 6 "Programmer's
Guide}
ASM                          {for info about "ASSEMBLER" procedure.}
MOV AX,\$0000
INT MouseInterrupt
CMP AX,\$0000

MOV MouseExists,TRUE

END {ResetMouse};

{????  Function 1:  Show Cursor (p. 122, MMPR)  ????????????????????????}

PROCEDURE Show;
BEGIN
IF  MouseExists AND NOT MouseVisible
THEN BEGIN
ASM
MOV AX,\$01
INT MouseInterrupt
END;
MouseVisible := TRUE
END
END {Show};

{????  Function 2:  Hide Cursor (p. 124, MMPR)  ????????????????????????}

PROCEDURE Hide;
BEGIN
IF   MouseExists AND MouseVisible
THEN BEGIN

ASM
MOV AX,\$0002
INT MouseInterrupt
END;

HiddenMouseEvents := 0;
MouseVisible := FALSE
END;
END {Hide};

{?????  Function 3:  Get Mouse Position/Button Status (p. 126, MMPR)  ??}

PROCEDURE Position (VAR status,i,j:  INTEGER);  {Function 3}
BEGIN
IF   MouseExists
THEN BEGIN

ASM
MOV AX,\$0003
INT MouseInterrupt

MOV AX,BX              {save status in temporary}

LES BX,status          {See pp. 295-296, Turbo Pascal 6   }
MOV ES:[BX],AX         {"Programmer's Guide" for treatment}
{of VAR parameters.                }
LES BX,i
MOV ES:[BX],CX

NEG DX                 {-j}
LES BX,j
MOV ES:[BX],DX
END

END
ELSE BEGIN
status := -1;
i      := -1;
j      := -1
END

END {Position};

{?????  Function 4:  Set Mouse Cursor Position (p. 129, MMPR)  ?????????}

PROCEDURE MoveTo(i,j: INTEGER);
BEGIN
IF   MouseExists
THEN BEGIN

ASM
MOV AX,\$0004
MOV CX,i
MOV DX,jMax
SUB DX,j          {jMax - j}
INT MouseInterrupt
END

END
END {MoveTo};

{????  Functions 7 & 8:  Set Min and Max Positions (pp. 137-139, MMPR)  }

PROCEDURE Window (i1,i2, j1,j2:  INTEGER);
BEGIN
IF   MouseExists
THEN BEGIN

ASM
MOV AX,\$0007      {Set Min and Max Horizontal Position}
MOV CX,i1
MOV DX,i2
INT MouseInterrupt

MOV AX,\$0008      {Set Min and Max Vertical Position}
MOV CX,jMax
MOV DX,CX
SUB CX,j2         {jMax - j2}
SUB DX,j1         {jMax - j1}
INT MouseInterrupt
END;

END
END {Window};

{?????  Function 12:  Set Interrupt Subroutine Call (p. 151, MMPR)  ????}

{See pp. 106-107 of MMPR:  Strongly suggest Function 20 or 24 over 12}

PROCEDURE RegisterISR (Mask, ISRSegment, ISROffset:  WORD);
BEGIN
IF   MouseExists
THEN BEGIN
ASM
MOV  AX,\$000C
MOV  ES,ISRSegment
MOV  DX,ISROffset
INT  MouseInterrupt
END
END
END {RegisterISR};

{?????  Function 36:  Get Driver Version, Mouse Type (p. 203, MMPR)  ????}

PROCEDURE GetDriverVersion (VAR major,minor,
MouseType,IRQnumber:  BYTE);
BEGIN
ASM
MOV  AX,\$0024
INT  MouseInterrupt

MOV  AX,BX

LES  BX,major
MOV  ES:[BX],AH

LES  BX,minor
MOV  ES:[BX],AL

LES  BX,MouseType
MOV  ES:[BX],CH

LES  BX,IRQnumber
MOV  ES:[BX],CL
END
END {RegisterISR};

{????  Exists  ?????????????????????????????????????????????????????????}

FUNCTION  Exists:  BOOLEAN;
BEGIN
Exists := MouseExists
END {Exists};

{????  Visible  ????????????????????????????????????????????????????????}

FUNCTION  Visible:  BOOLEAN;
BEGIN
Visible := MouseVisible
END {Visible};

{????  MousejMax  ??????????????????????????????????????????????????????}

FUNCTION  MousejMax:  WORD;     {For use by MouseISR}
BEGIN
MousejMax := jMax
END {Exists};

{????  WindowMax  ??????????????????????????????????????????????????????}

PROCEDURE WindowMax (iMaxWindow,jMaxWindow:  WORD);
BEGIN
iMax := iMaxWindow;
jMax := jMaxWindow
END {WindowMax};

{????  Exit  ???????????????????????????????????????????????????????????}

{\$F+} PROCEDURE UnitExit;
BEGIN
ExitProc := ExitSave; {Chain to other exit PROCEDUREs}
ResetMouse
END;
{\$F-}

{????  Initialization  ?????????????????????????????????????????????????}

BEGIN
ResetMouse;

Mouse.WindowMax (639, 479);  {Assume VGA for now}

ExitSave := ExitProc;

MouseVisible  := FALSE;
HiddenMouseEvents := 0;
END.

-----------------------------------------------------------

efg
_________________________________________
efg's Computer Lab:  http://infomaster.net/external/efg

MedTech Research Corporation, Lenexa, KS  USA

Wed, 18 Jun 1902 08:00:00 GMT

 Page 1 of 1 [ 6 post ]

Relevant Pages