unit Hilb2F;
//*******************************************************
// Example program demonstrating non-recursive Hilbert
// curves.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ExtCtrls, Math;

const
    STACK_SIZE = 10; // Maximum depth of recursion.

type
  THilb2Form = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuExit: TMenuItem;
    Help1: TMenuItem;
    mnuAbout: TMenuItem;
    Label1: TLabel;
    LevelEdit: TEdit;
    CmdDraw: TButton;
    DrawArea: TImage;
    procedure mnuExitClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure NumbersOnly(Sender: TObject; var Key: Char);
    procedure CmdDrawClick(Sender: TObject);
    procedure DrawCurve;
    procedure DrawHilbert(depth, dx, dy : Integer);
    procedure PushValues(pc, depth, dx, dy : Integer);
    procedure PopValues(var pc, depth, dx, dy : Integer);
  private
    { Private declarations }
    pc_stack, depth_stack : Array[1..STACK_SIZE] of Integer;
    dx_stack, dy_stack    : Array[1..STACK_SIZE] of Integer;
    top_of_stack          : Integer;
  public
    { Public declarations }
  end;

var
  Hilb2Form: THilb2Form;

implementation

{$R *.DFM}

procedure THilb2Form.mnuExitClick(Sender: TObject);
begin
    Close;
end;

procedure THilb2Form.mnuAboutClick(Sender: TObject);
const
    CRCR = #13#10#13#10;
begin
    MessageDlg(
        'This program draws Hilbert curves non-recursively.' + CRCR +
        'Enter the maximum depth of recursion for the curve (start small) and click the Draw button.'
        , mtInformation, [mbOK], 0);
end;

procedure THilb2Form.NumbersOnly(Sender: TObject; var Key: Char);
begin
    if (Key = #8) then exit; // Backspace.
    if ((Key >= '0') and (Key <= '9')) then exit;
    Key := #0;
end;

procedure THilb2Form.CmdDrawClick(Sender: TObject);
begin
    DrawCurve;
end;

// Draw the curve.
procedure THilb2Form.DrawCurve;
var
    depth, gaps, dist, margin : Integer;
    rect                      : TRect;
begin
    if (LevelEdit.Text = '') then exit;
    depth := StrToInt(LevelEdit.Text);
    if ((depth < 1) or (depth > 10)) Then
    begin
        ShowMessage('Level should be between 1 and 10');
        exit;
    end;

    Screen.Cursor := crHourGlass;
    Update;

    // See how long each segment should be to fill the
    // drawing area.
    margin := 5;
    gaps := Round(IntPower(2, depth) - 1);
    dist := (DrawArea.ClientWidth - 2 * margin) div gaps;

    rect.Left := 0;
    rect.Right := DrawArea.ClientWidth;
    rect.Top := 0;
    rect.Bottom := DrawArea.ClientWidth;
    DrawArea.Canvas.FillRect(rect);
    DrawArea.Canvas.MoveTo(margin, margin);

    DrawHilbert(depth, dist, 0);

    Screen.Cursor := crDefault;
end;

// Draw the Hilbert curve. dx and dy indicate the
// direction for the first part of the curve. In other
// words, if the curve starts at (x, y) it should finish
// at (x + dx, y + dy) after it has drawn the first third
// of the curve.
procedure THilb2Form.DrawHilbert(depth, dx, dy : Integer);
var
    pc, tmp : Integer;
begin
    pc := 1;
    with DrawArea.Canvas do
        while (True) do
        begin
            Case pc of
            1:
                begin
                    if (depth > 1) then // Recurse.
                    begin
                        // Save the current values.
                        PushValues(2, depth, dx, dy);
                        // Prepare for the recursion.
                        depth := depth - 1;
                        tmp := dx;
                        dx := dy;
                        dy := tmp;
                        pc := 1; // Go to start of recursive call.
                    end else begin  // Base case.
                        // We have recursed deeply enough.
                        // Continue with code block 2.
                        pc := 2;
                    end;
                end;
            2:
                begin
                    LineTo(PenPos.X + dx, PenPos.Y + dy);
                    if (depth > 1) then // Recurse.
                    begin
                        // Save the current values.
                        PushValues(3, depth, dx, dy);
                        // Prepare for the recursion.
                        depth := depth - 1;
                        // dx and dy remain the same.
                        pc := 1  // Go to start of recursive call.
                    end else begin // Base case.
                        // We have recursed deeply enough.
                        // Continue with code block 3.
                        pc := 3;
                    end;
                end;
            3:
                begin
                    LineTo(PenPos.X + dy, PenPos.Y + dx);
                    if (depth > 1) then // Recurse.
                    begin
                        // Save the current values.
                        PushValues(4, depth, dx, dy);
                        // Prepare for the recursion.
                        depth := depth - 1;
                        // dx and dy remain the same.
                        pc := 1;  // Go to start of recursive call.
                    end else begin // Base case.
                        // We have recursed deeply enough.
                        // Continue with code block 4.
                        pc := 4;
                    end;
                end;
            4:
                begin
                    LineTo(PenPos.X - dx, PenPos.Y - dy);
                    if (depth > 1) then  // Recurse.
                    begin
                        // Save the current values.
                        PushValues(0, depth, dx, dy);
                        // Prepare for the recursion.
                        depth := depth - 1;
                        tmp := dx;
                        dx := -dy;
                        dy := -tmp;
                        pc := 1; // Go to start of recursive call.
                    end else begin // Base case.
                        // We have recursed deeply enough.
                        // This is the end of this recursive call.
                        pc := 0;
                    end;
                end;
            0: // Return from recursion.
                begin
                    if (top_of_stack > 0) then
                        PopValues(pc, depth, dx, dy)
                else
                    // The stack is empty. We are done.
                    break;
            end; // End case pc of
        end; // End while (True)
    end; // End with DrawArea.Canvas do
end;

// Push values onto the stacks.
procedure THilb2Form.PushValues(pc, depth, dx, dy : Integer);
begin
    top_of_stack := top_of_stack + 1;
    depth_stack[top_of_stack] := depth;
    dx_stack[top_of_stack] := dx;
    dy_stack[top_of_stack] := dy;
    pc_stack[top_of_stack] := pc;
end;

// Pop values off of the stacks.
procedure THilb2Form.PopValues(var pc, depth, dx, dy : Integer);
begin
    depth := depth_stack[top_of_stack];
    dx := dx_stack[top_of_stack];
    dy := dy_stack[top_of_stack];
    pc := pc_stack[top_of_stack];
    top_of_stack := top_of_stack - 1;
end;

end.
