fpc/packages/ptc/examples/keyboard.pp

{
Ported to FPC by Nikolay Nikolov (nickysn@users.sourceforge.net)
}

{
 Keyboard example for OpenPTC 1.0 C++ Implementation
 Copyright (c) Glenn Fiedler (ptc@gaffer.org)
 This source code is in the public domain
}

Program KeyboardExample;

{$MODE objfpc}

Uses
  ptc;

Var
  console : TPTCConsole;
  surface : TPTCSurface;
  format : TPTCFormat;
  color : TPTCColor;
  key : TPTCKey;
  area : TPTCArea;
  x, y : Integer;
  size : Integer;
  delta : Integer;

Begin
  key := Nil;
  color := Nil;
  format := Nil;
  surface := Nil;
  console := Nil;
  Try
    Try
      { create key }
      key := TPTCKey.Create;
      
      { create console }
      console := TPTCConsole.Create;

      { create format }
      format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);

      { open the console }
      console.open('Keyboard example', format);

      { create surface matching console dimensions }
      surface := TPTCSurface.Create(console.width, console.height, format);

      { setup cursor data }
      x := surface.width Div 2;
      y := surface.height Div 2;
      size := surface.width Div 10;
      color := TPTCColor.Create(1, 1, 1);

      { main loop }
      Repeat
        { check for key press }
        If console.KeyPressed Then
        Begin
          { read console key press }
          console.ReadKey(key);
	
          { shift modifier }
	  If key.shift Then
            { move fast }
	    delta := 10
	  Else
            { move slow }
	    delta := 1;

          { handle cursor keys }
          Case key.code Of
            PTCKEY_LEFT : Dec(x, delta);
            PTCKEY_RIGHT : Inc(x, delta);
            PTCKEY_UP : Dec(y, delta);
            PTCKEY_DOWN : Inc(y, delta);
            { exit when escape is pressed }
            PTCKEY_ESCAPE : Break;
          End;
        End;

        { clear surface }
        surface.clear;

        { setup cursor area }
        area := TPTCArea.Create(x - size, y - size, x + size, y + size);
        Try
          { draw cursor as a quad }
          surface.clear(color, area);
        Finally
          area.Free;
        End;

        { copy to console }
        surface.copy(console);

        { update console }
        console.update;
      Until False;
    Finally
      color.Free;
      console.close;
      console.Free;
      surface.Free;
      key.Free;
      format.Free;
    End;
  Except
    On error : TPTCError Do
      { report error }
      error.report;
  End;
End.