Program Bezier;

{
   This program draws Bezier curves using the degree elevation
   method.  For large numbers of points (more than 10, for
   example) this is faster than the recursive way.
}

{$I ":Include/Exec.i" for Forbid, Permit and library things }
{$I ":Include/Ports.i" for the Message stuff }
{$I ":Include/Intuition.i" for window & screen structures and functions }
{$I ":Include/Graphics.i" for drawing stuff }
{$I ":Include/Text.i" just for GText}

type
    PointRec = Record
        X, Y : Real;
    end;

Const
    w  : WindowPtr = Nil;
    s  : NewScreenPtr = Nil;

{  The following definitions mean that the start-up code will
   not create an output window for this program if it is run
   from the Workbench.  Therefore this program should NOT use
   ReadLn and WriteLn. }

    StdInName : Address = Nil;
    StdOutName: Address = Nil;

Var
    m  : MessagePtr;
    rp : RastPortPtr;

    PointCount : Short;
    Points : Array [1..200] of PointRec;

    t, tprime : Real;

    LastX, LastY : Short;

Procedure CleanUpAndDie;
begin
    if w <> Nil then begin
        Forbid;
        repeat until GetMsg(w^.UserPort) = Nil;
        CloseWindow(w);
        Permit;
    end;
    if s <> Nil then
        CloseScreen(s);
    CloseLibrary(GfxBase);
    Exit(0);
end;

Function OpenTheScreen() : Boolean;
var
    ns : NewScreenPtr;
begin
    new(ns);
    with ns^ do begin
        LeftEdge := 0;
        TopEdge  := 0;
        Width    := 640;
        Height   := 200;
        Depth    := 2;
        DetailPen := 3;
        BlockPen  := 2;
        ViewModes := 32768;
        SType     := CUSTOMSCREEN_f;
        Font      := nil;
        DefaultTitle := "Simple Bezier Curves";
        Gadgets   := nil;
        CustomBitMap := nil;
    end;
    s := OpenScreen(ns);
    dispose(ns);
    OpenTheScreen := s <> nil;
end;

Function OpenTheWindow() : Boolean;
var
    nw : NewWindowPtr;
begin
    new(nw);
    with nw^ do begin
        LeftEdge := 0;
        TopEdge := 11;
        Width := 640;
        Height := 189;

        DetailPen := -1;
        BlockPen  := -1;
        IDCMPFlags := CLOSEWINDOW_f;
        Flags := WINDOWDRAG_f + WINDOWDEPTH_f + REPORTMOUSE_f +
                 WINDOWCLOSE_f + SMART_REFRESH_f + ACTIVATE_f;
        FirstGadget := nil;
        CheckMark := nil;
        Title := "Close the Window to Quit";
        Screen := s;
        BitMap := nil;
        MinWidth := 50;
        MaxWidth := -1;
        MinHeight := 20;
        MaxHeight := -1;
        WType := CUSTOMSCREEN_f;
    end;

    w := OpenWindow(nw);
    dispose(nw);
    OpenTheWindow := w <> nil;
end;

Procedure DrawLine;
begin
    Move(rp, Trunc(Points[PointCount].X), Trunc(Points[PointCount].Y));
    Draw(rp, LastX, LastY);
end;

Procedure GetPoints;
var
    LastSeconds,
    LastMicros  : Integer;
    IM : IntuiMessagePtr;
    StoreMsg : IntuiMessage;
    Leave : Boolean;
    OutOfBounds : Boolean;
    BorderLeft, BorderRight,
    BorderTop, BorderBottom : Short;

    Procedure AddPoint;
    begin
        Inc(PointCount);
        with Points[PointCount] do begin
            X := Float(StoreMsg.MouseX);
            Y := Float(StoreMsg.MouseY);
        end;
        with StoreMsg do begin
            LastX := MouseX;
            LastY := MouseY;
            LastSeconds := Seconds;
            LastMicros := Micros;
        end;
        SetAPen(rp, 2);
        SetDrMd(rp, JAM1);
        DrawEllipse(rp, LastX, LastY, 5, 3);
        SetAPen(rp, 3);
        SetDrMd(rp, COMPLEMENT);
        DrawLine;
    end;

    Function CheckForExit : Boolean;
    {   This function determines whether the user wanted to stop
        entering points.  I added the position tests because my
        doubleclick time is too long, and I was too lazy to dig
        out Preferences to change it. }
    begin
        with StoreMsg do
            CheckForExit := DoubleClick(LastSeconds, LastMicros,
                                        Seconds, Micros) and
                            (Abs(MouseX - Trunc(Points[PointCount].X)) < 5) and
                            (Abs(MouseY - TRunc(Points[PointCount].Y)) < 3);
    end;

    Procedure ClearIt;
    {  This just clears the screen when you enter your first point }
    begin
        SetDrMd(rp, JAM1);
        SetAPen(rp, 0);
        RectFill(rp, BorderLeft, BorderTop,
                     BorderRight, BorderBottom);
        SetDrMd(rp, COMPLEMENT);
        SetAPen(rp, 3);
    end;

begin
    ModifyIDCMP(w, CLOSEWINDOW_f + MOUSEBUTTONS_f + MOUSEMOVE_f);
    SetDrMd(rp, COMPLEMENT);
    PointCount := 0;
    Leave := False;
    OutOfBounds := False;
    BorderLeft := w^.BorderLeft;
    BorderRight := 639 - w^.BorderRight;
    BorderTop := w^.BorderTop;
    BorderBottom := 189 - w^.BorderBottom;
    repeat
        IM := IntuiMessagePtr(WaitPort(w^.UserPort));
        IM := IntuiMessagePtr(GetMsg(w^.UserPort));
        StoreMsg := IM^;
        ReplyMsg(MessagePtr(IM));
        case StoreMsg.Class of
           MOUSEMOVE_f : if PointCount > 0 then begin
                             if not OutOfBounds then
                                 DrawLine;
                             LastX := StoreMsg.MouseX;
                             LastY := StoreMsg.MouseY;
                             if (LastX > BorderLeft) and
                                (LastX < BorderRight) and
                                (LastY > BorderTop) and
                                (LastY < BorderBottom) then begin
                                 DrawLine;
                                 OutOfBounds := False;
                             end else
                                 OutOfBounds := True;
                         end;
           MOUSEBUTTONS_f : if StoreMsg.Code = SELECTUP then begin
                                if PointCount > 0 then
                                    Leave := CheckForExit
                                else
                                    ClearIt;
                                if (not Leave) and (not OutOfBounds) then
                                    AddPoint;
                            end;
           CLOSEWINDOW_f : CleanUpAndDie;
        end;
    until Leave or (PointCount > 50);
    if not Leave then
        DrawLine;
    ModifyIDCMP(w, CLOSEWINDOW_f);
    SetDrMd(rp, JAM1);
    SetAPen(rp, 1);
end;

Procedure Elevate;
var
    t, tprime,
    RealPoints : Real;
    i : Integer;
begin
    Inc(PointCount);
    RealPoints := Float(PointCount);
    Points[PointCount] := Points[Pred(PointCount)];
    for i := Pred(PointCount) downto 2 do
        with Points[i] do begin
            t := Float(i) / RealPoints;
            tprime := 1.0 - t;
            X := t * Points[Pred(i)].X + tprime * X;
            Y := t * Points[Pred(i)].Y + tprime * Y;
        end;
end;

Procedure DrawCurve;
var
    i : Integer;
begin
    Move(rp, Trunc(Points[1].X), Trunc(Points[1].Y));
    for i := 2 to PointCount do
        Draw(rp, Round(Points[i].X), Round(Points[i].Y));
end;

Procedure DrawBezier;
var
    i : Short;
begin
    SetAPen(rp, 2);
    while PointCount < 100 do begin
        Elevate;
        DrawCurve;
        if GetMsg(w^.UserPort) <> Nil then
            CleanUpAndDie;
    end;
    SetAPen(rp, 1);
    DrawCurve;
end;

begin
    GfxBase := OpenLibrary("graphics.library", 0);
    if GfxBase <> nil then begin
        if OpenTheScreen() then begin
            if OpenTheWindow() then begin
                rp := w^.RPort;
                Move(rp, 252, 20);
                GText(rp, "Enter points by pressing the left mouse button", 46);
                Move(rp, 252, 30);
                GText(rp, "Double click on the last point to begin drawing", 47);
                repeat
                    GetPoints;  { Both these routines will quit if }
                    DrawBezier; { the window is closed. }
                until False;
            end;
            CloseScreen(s);
        end;
        CloseLibrary(GfxBase);
    end;
end.