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

Does anyone have a routine to draw bezier curves ?
Or links ?




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

Quote:

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

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 ?
>Or links ?

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
  radius     = 8;            {radius of pickup circle}
  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:');
        Readln(PathToDriver);
        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;

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

FUNCTION adjasp(y:  INTEGER):  INTEGER;
BEGIN
  adjasp := (MaxY - y)
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;
  moveto(point[1].column, adjasp(point[1].row));
  t := 0;
  while t < 1 do begin
    { calculate new Bezier coordinates      }
    Bezier(t, x, y);

    { draw new Bezier curve          }
    lineto(x, adjasp(y));
    t := t + resolution;

    { save new coordinate for erase function    }
    last_Bezier_curve[Bezier_fill_pointer].column := x;
    last_Bezier_curve[Bezier_fill_pointer].row := adjasp(y);
    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
        FillEllipse (point[x].column, adjasp(point[x].row), radius,radius);
      END;
      EraseBezierCurve;      {erase old curve}

      {set new control point coordinates}
      point[point_index].row := adjasp(mouse_row);
      point[point_index].column := mouse_column;

      {draw all control points and new curve}
      FOR x := 1 TO 4 DO BEGIN
        SetColor (10+x);
        FillEllipse (point[x].column, adjasp(point[x].row), radius,radius);
      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);
  FillEllipse (point[1].column, adjasp(point[1].row), radius,radius);
  SetColor (12);
  FillEllipse (point[2].column, adjasp(point[2].row), radius,radius);
  SetColor (13);
  FillEllipse (point[3].column, adjasp(point[3].row), radius,radius);
  SetColor (14);
  FillEllipse (point[4].column, adjasp(point[4].row), radius,radius);

  {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
      IF   within(point[1].column, adjasp(point[1].row), button_column,
button_row, radius)
      THEN move_point(1);
      IF   within(point[2].column, adjasp(point[2].row), button_column,
button_row, radius)
      THEN move_point(2);
      IF   within(point[3].column,
...

read more »



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 ?
> >Or links ?

> 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.
   All Rights Reserved.  This UNIT may be freely distributed only for
   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}
      ADD DX,jMax            {jMax-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  CX,Mask
        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  
 
 [ 6 post ] 

 Relevant Pages 

1. How do I draw the Koch curve

2. Koch:s curve - needed

3. plotting Bezier curce using TP7

4. Graphics - need help on how to draw...

5. Grid custom draw - urgent help needed

6. Needed: Library/Components for drawing visual objects

7. Need a Good Search Routine

8. Need routine for printing the screen in graphics mode

9. Need help with this VESA PutPixel routine please!

10. Need a routine for rotating rectangular area

11. I need FAST putpixel and bar routines

12. Need a (very) fast write-routine for the full screen

 

 
Powered by phpBB® Forum Software