keyboard.pp 2.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116
  1. {
  2. Ported to FPC by Nikolay Nikolov ([email protected])
  3. }
  4. {
  5. Keyboard example for OpenPTC 1.0 C++ Implementation
  6. Copyright (c) Glenn Fiedler ([email protected])
  7. This source code is in the public domain
  8. }
  9. Program KeyboardExample;
  10. {$MODE objfpc}
  11. Uses
  12. ptc;
  13. Var
  14. console : TPTCConsole;
  15. surface : TPTCSurface;
  16. format : TPTCFormat;
  17. color : TPTCColor;
  18. key : TPTCKey;
  19. area : TPTCArea;
  20. x, y : Integer;
  21. size : Integer;
  22. delta : Integer;
  23. Begin
  24. key := Nil;
  25. color := Nil;
  26. format := Nil;
  27. surface := Nil;
  28. console := Nil;
  29. Try
  30. Try
  31. { create key }
  32. key := TPTCKey.Create;
  33. { create console }
  34. console := TPTCConsole.Create;
  35. { create format }
  36. format := TPTCFormat.Create(32, $00FF0000, $0000FF00, $000000FF);
  37. { open the console }
  38. console.open('Keyboard example', format);
  39. { create surface matching console dimensions }
  40. surface := TPTCSurface.Create(console.width, console.height, format);
  41. { setup cursor data }
  42. x := surface.width Div 2;
  43. y := surface.height Div 2;
  44. size := surface.width Div 10;
  45. color := TPTCColor.Create(1, 1, 1);
  46. { main loop }
  47. Repeat
  48. { check for key press }
  49. If console.KeyPressed Then
  50. Begin
  51. { read console key press }
  52. console.ReadKey(key);
  53. { shift modifier }
  54. If key.shift Then
  55. { move fast }
  56. delta := 10
  57. Else
  58. { move slow }
  59. delta := 1;
  60. { handle cursor keys }
  61. Case key.code Of
  62. PTCKEY_LEFT : Dec(x, delta);
  63. PTCKEY_RIGHT : Inc(x, delta);
  64. PTCKEY_UP : Dec(y, delta);
  65. PTCKEY_DOWN : Inc(y, delta);
  66. { exit when escape is pressed }
  67. PTCKEY_ESCAPE : Break;
  68. End;
  69. End;
  70. { clear surface }
  71. surface.clear;
  72. { setup cursor area }
  73. area := TPTCArea.Create(x - size, y - size, x + size, y + size);
  74. Try
  75. { draw cursor as a quad }
  76. surface.clear(color, area);
  77. Finally
  78. area.Free;
  79. End;
  80. { copy to console }
  81. surface.copy(console);
  82. { update console }
  83. console.update;
  84. Until False;
  85. Finally
  86. color.Free;
  87. console.close;
  88. console.Free;
  89. surface.Free;
  90. key.Free;
  91. format.Free;
  92. End;
  93. Except
  94. On error : TPTCError Do
  95. { report error }
  96. error.report;
  97. End;
  98. End.