Program DeadKeys;

{
	This program simply tests the DeadKeyConvert() function,
which in turn exercises the RawKeyConvert() function.  Press keys
with the window that's opened is active, and this program will
print the converted raw keys to the standard output.
}

{$I ":Include/Exec.i" for Forbid, Permit and library things }
{$I ":Include/Ports.i" for the Message stuff }
{$I ":Include/ExecIO.i"}
{$I ":Include/ExecIOUtils.i"}
{$I ":Include/Intuition.i" for window business }
{$I ":Include/InputEvent.i"}
{$I ":Include/ConsoleUtils.i" for Open and CloseConsoleDevice}
{$I ":Include/ConsoleIO.i"}
{$I ":Include/DeadKeyConvert.i" for DeadKeyConvert}

var
    w  : WindowPtr;
    s  : ScreenPtr;

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 := "Press ESC to End the Demonstration";
	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 := 2;
	Width := 640;
	Height := 198;

	DetailPen := -1;
	BlockPen  := -1;
	IDCMPFlags := RAWKEY_f;
	Flags := SMART_REFRESH_f + ACTIVATE_f +
			BORDERLESS_f + BACKDROP_f;
	FirstGadget := Nil;
	CheckMark := Nil;
	Title := "";
	Screen := s;
	BitMap := Nil;
	MinWidth := 0;
	MaxWidth := -1;
	MinHeight := 0;
	MaxHeight := -1;
	WType := CUSTOMSCREEN_f;
    end;

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

var
    IMessage	: IntuiMessagePtr;
    Buffer	: Array [0..9] of Char;
    Length	: Integer;
    Leave	: Boolean;
    WriteReq	: IOStdReqPtr;
    WritePort	: MsgPortPtr;

Procedure OpenEverything;
var
    Error : Short;
begin
    OpenConsoleDevice;
    if OpenTheScreen then begin
	if OpenTheWindow then begin
	    WritePort := CreatePort(Nil, 0);
	    if WritePort <> Nil then begin
		WriteReq := CreateStdIO(WritePort);
		if WriteReq <> Nil then begin
		    WriteReq^.ioData := Address(w);
		    WriteReq^.ioLength := SizeOf(Window);
		    Error := OpenDevice("console.device", 0,
			IORequestPtr(WriteReq), 0);
		    if Error = 0 then
			return;
		    DeleteStdIO(WriteReq);
		    Writeln('Could not open the console.device');
		end else
		    Writeln('Could not allocate memory');
		DeletePort(WritePort);
	    end else
		Writeln('Could not allocate a message port');
	    CloseWindow(w);
	end else
	    Writeln('Could not open the window');
	CloseScreen(s);
    end else
	Writeln('Could not open the screen');
    CloseConsoleDevice;
    Exit(20);
end;

Procedure CloseEverything;
begin
    CloseDevice(IORequestPtr(WriteReq));
    DeleteStdIO(WriteReq);
    DeletePort(WritePort);
    CloseWindow(w);
    CloseScreen(s);
    CloseConsoleDevice;
end;

Procedure ConvertControl;
begin
    case Ord(Buffer[0]) of
      8 : ConPutStr(WriteReq, "\b\cP");
     13 : ConPutStr(WriteReq, "\n\cL");
     127 : ConPutStr(WriteReq, "\cP");
    else
	ConPutChar(WriteReq, Buffer[0]);
    end;
end;

Procedure ConvertTwoChar;
begin
    case Buffer[1] of
      'A'..'D' : ConWrite(WriteReq, Adr(Buffer), 2);
    end;
end;

begin
    OpenEverything;
    Leave := False;
    repeat
	IMessage := IntuiMessagePtr(WaitPort(w^.UserPort));
	IMessage := IntuiMessagePtr(GetMsg(w^.UserPort));
	if IMessage^.Class = RAWKEY_f then begin
	    if IMessage^.Code < 128 then begin { Key Down }
		Length := DeadKeyConvert(IMessage, Adr(Buffer), 10, Nil);
		case Length of
		  -MaxInt..-1 : Writeln('DeadKeyConvert error ', Length);
		   1 : if Buffer[0] = '\e' then
			   Leave := True
			else begin
			    if (Buffer[0] < ' ') or
				(Ord(Buffer[0]) > 126) then
				ConvertControl
			    else begin
				Buffer[2] := Buffer[0];
				Buffer[0] := '\c';
				Buffer[1] := '@'; { Insert }
				ConWrite(WriteReq, Adr(Buffer), 3);
			    end;
			end;
		   2 : ConvertTwoChar;
		end;
	    end;
	end else
	    Leave := True;
	ReplyMsg(MessagePtr(IMessage));
    until Leave;
    Forbid;
    repeat
	IMessage := IntuiMessagePtr(GetMsg(w^.UserPort));
    until IMessage = nil;
    Permit;
    CloseEverything;
end.