Program NDC_Demo (Input, Output);

Uses
    Crt, NDC;

Const
    {MyPattern	: FillPattern = ($FF, $00, $FF, $00, $FF, $00, $FF, $00);}
    {MyPattern	: FillPattern = ($81, $42, $24, $18, $18, $24, $42, $81);}
    MyPattern	: FillPattern = ($7E, $BD, $DB, $E7, $E7, $DB, $BD, $7E);

Type
    JRS_ButtonType	= Record
			    Position	: Point;
			    Rect	: RectangleType;
			    Text	: String;
			    Forground	: Integer;
			    Background	: Integer;
			  End;

    JRS_ButtonBar	= Array [0..15] of JRS_ButtonType;

Var
    Done		: Boolean;
    Device		: DeviceType;
    KeyMeasure		: KeyboardMeasure;
    LocMeasure		: LocatorMeasure;
    Color		: Integer;
    LineColor		: Integer;
    Last_Position	: Point;
    Quit_Button		: JRS_ButtonType;
    Color_Menu		: JRS_ButtonBar;

(*-------------------------------------------------------------------------*)

Procedure Create_Button (Position : Point; Text : String;
			Forground, Background : Integer;
			Var Button : JRS_ButtonType);

Const
    ButtonBorder	= 0.01;

Var
    Width		: Coordinate;
    Height		: Coordinate;
    Descent		: Coordinate;

Begin
    NDC_InquireTextExtent (Button.Text, Width, Height, Descent);
    Button.Position := Position;
    Button.Text := Text;
    NDC_InquireTextExtent (Button.Text, Width, Height, Descent);
    With Position do
	NDC_DefRectangle (X - Width / 2.0 - ButtonBorder,
			  Y - Height / 2.0 - Descent - ButtonBorder,
			  X + Width / 2.0 + ButtonBorder,
			  Y + Height / 2.0 - Descent + ButtonBorder,
			  Button.Rect);
    Button.Forground := Forground;
    Button.Background := Background;
End; {Create_Button}

(*-------------------------------------------------------------------------*)

Procedure Realize_Button (Button : JRS_ButtonType);

Var
    OldColor	: Integer;

Begin
    NDC_GetColor (OldColor);
    NDC_SetColor (Button.Background);
    NDC_FillRectangle (Button.Rect);
    NDC_SetColor (Button.Forground);
    NDC_Rectangle (Button.Rect);
    NDC_Text (Button.Position, Button.Text);
    NDC_SetColor (OldColor);
End; {Realize_Button}

(*-------------------------------------------------------------------------*)

Procedure ColorBar (NColor : Integer; Var Color_Menu : JRS_ButtonBar);

Var
    I		: Integer;
    X, Y	: Real;
    Dx, Dy	: Real;
    P		: Point;

Begin
    X := 0.9;
    Dx := 0.03;
    Dy := 0.04;
    For I := 0 to NColor do Begin
	Y := I*0.0625;
	NDC_DefPoint (X + Dx/2, Y + Dy/2, P);
	Create_Button (P, '  ', White, I, Color_Menu[I]);
	Realize_Button (Color_Menu[I]);
    End; {For}
    NDC_SetFillBitmapPattern (SOLID_BIT_PATTERN);
End; {ColorBar}

(*-------------------------------------------------------------------------*)

Procedure Process_Left_Button_Press (Var P, Last_P : Point);

Const
    ColorText	= 'Current Color';

Var
    Found	: Boolean;
    I		: Integer;
    X, Y	: Real;
    Dx, Dy	: Real;
    TextLoc	: Point;
    W, H, D	: Real;

Begin
    I := -1;
    Repeat
	I := I + 1;
	With Color_Menu[I].Rect do
	    Found := (BottomLeft.X <= P.X) and (P.X <= TopRight.X) and
		     (BottomLeft.Y <= P.Y) and (P.Y <= TopRight.Y);
    Until Found or (I = 15);
    If Found then Begin
	NDC_SetColor (Color_Menu[I].Background);
	NDC_InquireTextExtent (ColorText, W, H, D);
	NDC_DefPoint (W / 2.0, 1.0 - H / 2.0, TextLoc);
	NDC_Text (TextLoc, ColorText);
    End Else Begin
	With Quit_Button.Rect do
	    Found := (BottomLeft.X <= P.X) and (P.X <= TopRight.X) and
		     (BottomLeft.Y <= P.Y) and (P.Y <= TopRight.Y);
	If Found then Begin
	    I := Quit_Button.Forground;
	    Quit_Button.Forground := Quit_Button.Background;
	    Quit_Button.Background := I;
	    NDC_SetFillBitmapPattern (SOLID_BIT_PATTERN);
	    Realize_Button (Quit_Button);
	End Else Begin
	    NDC_Line (Last_P, P);
	    Last_P := P;
	End; {Else}
    End; {Else}
End; {Process_Left_Button_Press}

(*-------------------------------------------------------------------------*)

Procedure Process_Left_Button_Release (Var P, Last_P : Point);

Var
    Found	: Boolean;
    I		: Integer;

Begin
    With Quit_Button.Rect do
	Found := (BottomLeft.X <= P.X) and (P.X <= TopRight.X) and
		 (BottomLeft.Y <= P.Y) and (P.Y <= TopRight.Y);
    If Found then Begin
	I := Quit_Button.Forground;
	Quit_Button.Forground := Quit_Button.Background;
	Quit_Button.Background := I;
	NDC_SetFillBitmapPattern (SOLID_BIT_PATTERN);
	Realize_Button (Quit_Button);
	Done := True;
    End; {If}
End; {Process_Left_Button_Release}

(*-------------------------------------------------------------------------*)
(*-------------------------------------------------------------------------*)
(*-------------------------------------------------------------------------*)

Begin
    ClrScr;
    Writeln ('Demonstration Program for NDC Package');
    Writeln;
    Writeln ('Type q or Q to Quit');
    Writeln;
    Writeln ('Left-hand mouse button:');
    Writeln ('      Outside color squares: Line from center of screen to current position');
    Writeln ('      Inside color square:   Select color for subsequent lines');
    Writeln;
    Writeln ('Right-hand mouse button:');
    Writeln ('      Quit');
    Writeln;
    Write ('Press Return to continue...');
    Readln;

    NDC_Begin (640, 480);
    NDC_SetInputMode (KEYBOARD, EVENT);
    NDC_SetKeyboardProcessingMode (RAW);
    NDC_SetInputMode (LOCATOR, EVENT);
    NDC_SetLocatorButtonMask ([LEFT_BUTTON, RIGHT_BUTTON]);
    NDC_SetFont (0);
    NDC_SetMarker ('*');

    Last_Position.X := 0.5;
    Last_Position.Y := 0.5;
    Create_Button (Last_Position, 'Quit', Yellow, Red, Quit_Button);
    NDC_SetFillBitmapPattern (SOLID_BIT_PATTERN);
    Realize_Button (Quit_Button);

    NDC_SetFillStyle (BITMAP_PATTERN_OPAQUE);
    NDC_LoadBitmapPattern (6, MyPattern);
    NDC_SetFillBitmapPattern (6); {(BRICK_BIT_PATTERN);}
    ColorBar (15, Color_Menu);

    Color := 1;
    LineColor := White;
    Done := False;
    Repeat
	NDC_WaitEvent (INDEFINITE, Device);
	Case Device of
	    KEYBOARD:
		Begin
		    NDC_GetKeyboard (KeyMeasure);
		    Done := (KeyMeasure[1] = 'q') or (KeyMeasure[1] = 'Q');
		End; {KEYBOARD}
	    LOCATOR:
		Begin
		    NDC_GetLocator (LocMeasure);
		    With LocMeasure do
			Case ButtonOfMostRecentTransition of
			    LEFT_BUTTON:
				If (ButtonChord[LEFT_BUTTON] = DOWN) then Begin
				    Process_Left_Button_Press (Position,
				    			Last_Position);
				End Else Begin
				    Process_Left_Button_Release (Position,
				    			Last_Position);
				End; {Else}
			    RIGHT_BUTTON:
				Done := True;
			End; {Case}
		End; {LOCATOR}
	End; {Case}
    Until Done;
    NDC_End;
End.