keyboard.pp 31 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2006 by Karoly Balogh
  4. Keyboard unit for MorphOS and Amiga
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit Keyboard;
  12. interface
  13. {$ifdef DEBUG}
  14. //uses
  15. // windows;
  16. //var
  17. // last_ir : Input_Record;
  18. {$endif DEBUG}
  19. {$i keybrdh.inc}
  20. implementation
  21. { WARNING: Keyboard-Drivers (i.e. german) will only work under WinNT.
  22. 95 and 98 do not support keyboard-drivers other than us for win32
  23. console-apps. So we always get the keys in us-keyboard layout
  24. from Win9x.
  25. }
  26. //uses
  27. {ifndef DEBUG}
  28. // Windows,
  29. {endif DEBUG}
  30. // Dos,
  31. // WinEvent;
  32. uses
  33. video,
  34. exec,intuition;
  35. {$i keyboard.inc}
  36. {*
  37. const MaxQueueSize = 120;
  38. FrenchKeyboard = $040C040C;
  39. var
  40. keyboardeventqueue : array[0..maxqueuesize] of TKeyEventRecord;
  41. nextkeyevent,nextfreekeyevent : longint;
  42. newKeyEvent : THandle; {sinaled if key is available}
  43. lockVar : TCriticalSection; {for queue access}
  44. lastShiftState : byte; {set by handler for PollShiftStateEvent}
  45. altNumActive : boolean; {for alt+0..9}
  46. altNumBuffer : string [3];
  47. { used for keyboard specific stuff }
  48. KeyBoardLayout : HKL;
  49. Inited : Boolean;
  50. HasAltGr : Boolean = false;
  51. procedure incqueueindex(var l : longint);
  52. begin
  53. inc(l);
  54. { wrap around? }
  55. if l>maxqueuesize then
  56. l:=0;
  57. end;
  58. function keyEventsInQueue : boolean;
  59. begin
  60. keyEventsInQueue := (nextkeyevent <> nextfreekeyevent);
  61. end;
  62. function rightistruealt(dw:cardinal):boolean; // inline ?
  63. // used to wrap checks for right alt/altgr.
  64. begin
  65. rightistruealt:=true;
  66. if hasaltgr then
  67. rightistruealt:=(dw and RIGHT_ALT_PRESSED)=0;
  68. end;
  69. { gets or peeks the next key from the queue, does not wait for new keys }
  70. function getKeyEventFromQueue (VAR t : TKeyEventRecord; Peek : boolean) : boolean;
  71. begin
  72. if not Inited then
  73. begin
  74. getKeyEventFromQueue := false;
  75. exit;
  76. end;
  77. EnterCriticalSection (lockVar);
  78. if keyEventsInQueue then
  79. begin
  80. t := keyboardeventqueue[nextkeyevent];
  81. if not peek then incqueueindex (nextkeyevent);
  82. getKeyEventFromQueue := true;
  83. if not keyEventsInQueue then ResetEvent (newKeyEvent);
  84. end else
  85. begin
  86. getKeyEventFromQueue := false;
  87. ResetEvent (newKeyEvent);
  88. end;
  89. LeaveCriticalSection (lockVar);
  90. end;
  91. { gets the next key from the queue, does wait for new keys }
  92. function getKeyEventFromQueueWait (VAR t : TKeyEventRecord) : boolean;
  93. begin
  94. if not Inited then
  95. begin
  96. getKeyEventFromQueueWait := false;
  97. exit;
  98. end;
  99. WaitForSingleObject (newKeyEvent, dword(INFINITE));
  100. getKeyEventFromQueueWait := getKeyEventFromQueue (t, false);
  101. end;
  102. { translate win32 shift-state to keyboard shift state }
  103. function transShiftState (ControlKeyState : dword) : byte;
  104. var b : byte;
  105. begin
  106. b := 0;
  107. if ControlKeyState and SHIFT_PRESSED <> 0 then { win32 makes no difference between left and right shift }
  108. b := b or kbShift;
  109. if (ControlKeyState and LEFT_CTRL_PRESSED <> 0) or
  110. (ControlKeyState and RIGHT_CTRL_PRESSED <> 0) then
  111. b := b or kbCtrl;
  112. if (ControlKeyState and LEFT_ALT_PRESSED <> 0) or
  113. (ControlKeyState and RIGHT_ALT_PRESSED <> 0) then
  114. b := b or kbAlt;
  115. transShiftState := b;
  116. end;
  117. { The event-Handler thread from the unit event will call us if a key-event
  118. is available }
  119. procedure HandleKeyboard(var ir:INPUT_RECORD);
  120. var
  121. i : longint;
  122. c : word;
  123. altc : char;
  124. addThis: boolean;
  125. begin
  126. with ir.Event.KeyEvent do
  127. begin
  128. { key up events are ignored (except alt) }
  129. if bKeyDown then
  130. begin
  131. EnterCriticalSection (lockVar);
  132. for i:=1 to wRepeatCount do
  133. begin
  134. addThis := true;
  135. if (dwControlKeyState and LEFT_ALT_PRESSED <> 0) or
  136. (dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then {alt pressed}
  137. if ((wVirtualKeyCode >= $60) and (wVirtualKeyCode <= $69)) or
  138. ((dwControlKeyState and ENHANCED_KEY = 0) and
  139. (wVirtualKeyCode in [$C{VK_CLEAR generated by keypad 5},
  140. $21 {VK_PRIOR (PgUp) 9},
  141. $22 {VK_NEXT (PgDown) 3},
  142. $23 {VK_END 1},
  143. $24 {VK_HOME 7},
  144. $25 {VK_LEFT 4},
  145. $26 {VK_UP 8},
  146. $27 {VK_RIGHT 6},
  147. $28 {VK_DOWN 2},
  148. $2D {VK_INSERT 0}])) then {0..9 on NumBlock}
  149. begin
  150. if length (altNumBuffer) = 3 then
  151. delete (altNumBuffer,1,1);
  152. case wVirtualKeyCode of
  153. $60..$69 : altc:=char (wVirtualKeyCode-48);
  154. $c : altc:='5';
  155. $21 : altc:='9';
  156. $22 : altc:='3';
  157. $23 : altc:='1';
  158. $24 : altc:='7';
  159. $25 : altc:='4';
  160. $26 : altc:='8';
  161. $27 : altc:='6';
  162. $28 : altc:='2';
  163. $2D : altc:='0';
  164. end;
  165. altNumBuffer := altNumBuffer + altc;
  166. altNumActive := true;
  167. addThis := false;
  168. end else
  169. begin
  170. altNumActive := false;
  171. altNumBuffer := '';
  172. end;
  173. if addThis then
  174. begin
  175. keyboardeventqueue[nextfreekeyevent]:=
  176. ir.Event.KeyEvent;
  177. incqueueindex(nextfreekeyevent);
  178. end;
  179. end;
  180. lastShiftState := transShiftState (dwControlKeyState); {save it for PollShiftStateEvent}
  181. SetEvent (newKeyEvent); {event that a new key is available}
  182. LeaveCriticalSection (lockVar);
  183. end
  184. else
  185. begin
  186. lastShiftState := transShiftState (dwControlKeyState); {save it for PollShiftStateEvent}
  187. {for alt-number we have to look for alt-key release}
  188. if altNumActive then
  189. begin
  190. if (wVirtualKeyCode = $12) then {alt-released}
  191. begin
  192. if altNumBuffer <> '' then {numbers with alt pressed?}
  193. begin
  194. Val (altNumBuffer, c, i);
  195. if (i = 0) and (c <= 255) then {valid number?}
  196. begin {add to queue}
  197. fillchar (ir, sizeof (ir), 0);
  198. bKeyDown := true;
  199. AsciiChar := char (c);
  200. {and add to queue}
  201. EnterCriticalSection (lockVar);
  202. keyboardeventqueue[nextfreekeyevent]:=ir.Event.KeyEvent;
  203. incqueueindex(nextfreekeyevent);
  204. SetEvent (newKeyEvent); {event that a new key is available}
  205. LeaveCriticalSection (lockVar);
  206. end;
  207. end;
  208. altNumActive := false; {clear alt-buffer}
  209. altNumBuffer := '';
  210. end;
  211. end;
  212. end;
  213. end;
  214. end;
  215. *}
  216. {*
  217. procedure CheckAltGr;
  218. var ahkl : HKL;
  219. i : integer;
  220. begin
  221. HasAltGr:=false;
  222. ahkl:=GetKeyboardLayout(0);
  223. i:=$20;
  224. while i<$100 do
  225. begin
  226. // <MSDN>
  227. // For keyboard layouts that use the right-hand ALT key as ashift key
  228. // (for example, the French keyboard layout), the shift state is
  229. // represented by the value 6, because the right-hand ALT key is
  230. // converted internally into CTRL+ALT.
  231. // </MSDN>
  232. if (HIBYTE(VkKeyScanEx(chr(i),ahkl))=6) then
  233. begin
  234. HasAltGr:=true;
  235. break;
  236. end;
  237. inc(i);
  238. end;
  239. end;
  240. *}
  241. procedure SysInitKeyboard;
  242. begin
  243. writeln('sysinitkeyboard');
  244. {*
  245. KeyBoardLayout:=GetKeyboardLayout(0);
  246. lastShiftState := 0;
  247. FlushConsoleInputBuffer(StdInputHandle);
  248. newKeyEvent := CreateEvent (nil, // address of security attributes
  249. true, // flag for manual-reset event
  250. false, // flag for initial state
  251. nil); // address of event-object name
  252. if newKeyEvent = INVALID_HANDLE_VALUE then
  253. begin
  254. // what to do here ????
  255. RunError (217);
  256. end;
  257. InitializeCriticalSection (lockVar);
  258. altNumActive := false;
  259. altNumBuffer := '';
  260. nextkeyevent:=0;
  261. nextfreekeyevent:=0;
  262. checkaltgr;
  263. SetKeyboardEventHandler (@HandleKeyboard);
  264. Inited:=true;
  265. *}
  266. end;
  267. procedure SysDoneKeyboard;
  268. begin
  269. {*
  270. SetKeyboardEventHandler(nil); {hangs???}
  271. DeleteCriticalSection (lockVar);
  272. FlushConsoleInputBuffer(StdInputHandle);
  273. closeHandle (newKeyEvent);
  274. Inited:=false;
  275. *}
  276. end;
  277. {$define USEKEYCODES}
  278. {Translatetable Win32 -> Dos for Special Keys = Function Key, Cursor Keys
  279. and Keys other than numbers on numblock (to make fv happy) }
  280. {combinations under dos: Shift+Ctrl: same as Ctrl
  281. Shift+Alt : same as alt
  282. {* Ctrl+Alt : nothing (here we get it like alt)}
  283. {ifdef USEKEYCODES}
  284. { use positive values for ScanCode we want to set
  285. 0 for key where we should leave the scancode
  286. -1 for OEM specifc keys
  287. -2 for unassigned
  288. -3 for Kanji systems ???
  289. }
  290. const
  291. Unassigned = -2;
  292. Kanji = -3;
  293. OEM_specific = -1;
  294. KeyToQwertyScan : array [0..255] of integer =
  295. (
  296. { 00 } 0,
  297. { 01 VK_LBUTTON } 0,
  298. { 02 VK_RBUTTON } 0,
  299. { 03 VK_CANCEL } 0,
  300. { 04 VK_MBUTTON } 0,
  301. { 05 unassigned } -2,
  302. { 06 unassigned } -2,
  303. { 07 unassigned } -2,
  304. { 08 VK_BACK } $E,
  305. { 09 VK_TAB } $F,
  306. { 0A unassigned } -2,
  307. { 0B unassigned } -2,
  308. { 0C VK_CLEAR ?? } 0,
  309. { 0D VK_RETURN } 0,
  310. { 0E unassigned } -2,
  311. { 0F unassigned } -2,
  312. { 10 VK_SHIFT } 0,
  313. { 11 VK_CONTROL } 0,
  314. { 12 VK_MENU (Alt key) } 0,
  315. { 13 VK_PAUSE } 0,
  316. { 14 VK_CAPITAL (Caps Lock) } 0,
  317. { 15 Reserved for Kanji systems} -3,
  318. { 16 Reserved for Kanji systems} -3,
  319. { 17 Reserved for Kanji systems} -3,
  320. { 18 Reserved for Kanji systems} -3,
  321. { 19 Reserved for Kanji systems} -3,
  322. { 1A unassigned } -2,
  323. { 1B VK_ESCAPE } $1,
  324. { 1C Reserved for Kanji systems} -3,
  325. { 1D Reserved for Kanji systems} -3,
  326. { 1E Reserved for Kanji systems} -3,
  327. { 1F Reserved for Kanji systems} -3,
  328. { 20 VK_SPACE} 0,
  329. { 21 VK_PRIOR (PgUp) } 0,
  330. { 22 VK_NEXT (PgDown) } 0,
  331. { 23 VK_END } 0,
  332. { 24 VK_HOME } 0,
  333. { 25 VK_LEFT } 0,
  334. { 26 VK_UP } 0,
  335. { 27 VK_RIGHT } 0,
  336. { 28 VK_DOWN } 0,
  337. { 29 VK_SELECT ??? } 0,
  338. { 2A OEM specific !! } -1,
  339. { 2B VK_EXECUTE } 0,
  340. { 2C VK_SNAPSHOT } 0,
  341. { 2D VK_INSERT } 0,
  342. { 2E VK_DELETE } 0,
  343. { 2F VK_HELP } 0,
  344. { 30 VK_0 '0' } 11,
  345. { 31 VK_1 '1' } 2,
  346. { 32 VK_2 '2' } 3,
  347. { 33 VK_3 '3' } 4,
  348. { 34 VK_4 '4' } 5,
  349. { 35 VK_5 '5' } 6,
  350. { 36 VK_6 '6' } 7,
  351. { 37 VK_7 '7' } 8,
  352. { 38 VK_8 '8' } 9,
  353. { 39 VK_9 '9' } 10,
  354. { 3A unassigned } -2,
  355. { 3B unassigned } -2,
  356. { 3C unassigned } -2,
  357. { 3D unassigned } -2,
  358. { 3E unassigned } -2,
  359. { 3F unassigned } -2,
  360. { 40 unassigned } -2,
  361. { 41 VK_A 'A' } $1E,
  362. { 42 VK_B 'B' } $30,
  363. { 43 VK_C 'C' } $2E,
  364. { 44 VK_D 'D' } $20,
  365. { 45 VK_E 'E' } $12,
  366. { 46 VK_F 'F' } $21,
  367. { 47 VK_G 'G' } $22,
  368. { 48 VK_H 'H' } $23,
  369. { 49 VK_I 'I' } $17,
  370. { 4A VK_J 'J' } $24,
  371. { 4B VK_K 'K' } $25,
  372. { 4C VK_L 'L' } $26,
  373. { 4D VK_M 'M' } $32,
  374. { 4E VK_N 'N' } $31,
  375. { 4F VK_O 'O' } $18,
  376. { 50 VK_P 'P' } $19,
  377. { 51 VK_Q 'Q' } $10,
  378. { 52 VK_R 'R' } $13,
  379. { 53 VK_S 'S' } $1F,
  380. { 54 VK_T 'T' } $14,
  381. { 55 VK_U 'U' } $16,
  382. { 56 VK_V 'V' } $2F,
  383. { 57 VK_W 'W' } $11,
  384. { 58 VK_X 'X' } $2D,
  385. { 59 VK_Y 'Y' } $15,
  386. { 5A VK_Z 'Z' } $2C,
  387. { 5B unassigned } -2,
  388. { 5C unassigned } -2,
  389. { 5D unassigned } -2,
  390. { 5E unassigned } -2,
  391. { 5F unassigned } -2,
  392. { 60 VK_NUMPAD0 NumKeyPad '0' } 11,
  393. { 61 VK_NUMPAD1 NumKeyPad '1' } 2,
  394. { 62 VK_NUMPAD2 NumKeyPad '2' } 3,
  395. { 63 VK_NUMPAD3 NumKeyPad '3' } 4,
  396. { 64 VK_NUMPAD4 NumKeyPad '4' } 5,
  397. { 65 VK_NUMPAD5 NumKeyPad '5' } 6,
  398. { 66 VK_NUMPAD6 NumKeyPad '6' } 7,
  399. { 67 VK_NUMPAD7 NumKeyPad '7' } 8,
  400. { 68 VK_NUMPAD8 NumKeyPad '8' } 9,
  401. { 69 VK_NUMPAD9 NumKeyPad '9' } 10,
  402. { 6A VK_MULTIPLY } 0,
  403. { 6B VK_ADD } 0,
  404. { 6C VK_SEPARATOR } 0,
  405. { 6D VK_SUBSTRACT } 0,
  406. { 6E VK_DECIMAL } 0,
  407. { 6F VK_DIVIDE } 0,
  408. { 70 VK_F1 'F1' } $3B,
  409. { 71 VK_F2 'F2' } $3C,
  410. { 72 VK_F3 'F3' } $3D,
  411. { 73 VK_F4 'F4' } $3E,
  412. { 74 VK_F5 'F5' } $3F,
  413. { 75 VK_F6 'F6' } $40,
  414. { 76 VK_F7 'F7' } $41,
  415. { 77 VK_F8 'F8' } $42,
  416. { 78 VK_F9 'F9' } $43,
  417. { 79 VK_F10 'F10' } $44,
  418. { 7A VK_F11 'F11' } $57,
  419. { 7B VK_F12 'F12' } $58,
  420. { 7C VK_F13 } 0,
  421. { 7D VK_F14 } 0,
  422. { 7E VK_F15 } 0,
  423. { 7F VK_F16 } 0,
  424. { 80 VK_F17 } 0,
  425. { 81 VK_F18 } 0,
  426. { 82 VK_F19 } 0,
  427. { 83 VK_F20 } 0,
  428. { 84 VK_F21 } 0,
  429. { 85 VK_F22 } 0,
  430. { 86 VK_F23 } 0,
  431. { 87 VK_F24 } 0,
  432. { 88 unassigned } -2,
  433. { 89 VK_NUMLOCK } 0,
  434. { 8A VK_SCROLL } 0,
  435. { 8B unassigned } -2,
  436. { 8C unassigned } -2,
  437. { 8D unassigned } -2,
  438. { 8E unassigned } -2,
  439. { 8F unassigned } -2,
  440. { 90 unassigned } -2,
  441. { 91 unassigned } -2,
  442. { 92 unassigned } -2,
  443. { 93 unassigned } -2,
  444. { 94 unassigned } -2,
  445. { 95 unassigned } -2,
  446. { 96 unassigned } -2,
  447. { 97 unassigned } -2,
  448. { 98 unassigned } -2,
  449. { 99 unassigned } -2,
  450. { 9A unassigned } -2,
  451. { 9B unassigned } -2,
  452. { 9C unassigned } -2,
  453. { 9D unassigned } -2,
  454. { 9E unassigned } -2,
  455. { 9F unassigned } -2,
  456. { A0 unassigned } -2,
  457. { A1 unassigned } -2,
  458. { A2 unassigned } -2,
  459. { A3 unassigned } -2,
  460. { A4 unassigned } -2,
  461. { A5 unassigned } -2,
  462. { A6 unassigned } -2,
  463. { A7 unassigned } -2,
  464. { A8 unassigned } -2,
  465. { A9 unassigned } -2,
  466. { AA unassigned } -2,
  467. { AB unassigned } -2,
  468. { AC unassigned } -2,
  469. { AD unassigned } -2,
  470. { AE unassigned } -2,
  471. { AF unassigned } -2,
  472. { B0 unassigned } -2,
  473. { B1 unassigned } -2,
  474. { B2 unassigned } -2,
  475. { B3 unassigned } -2,
  476. { B4 unassigned } -2,
  477. { B5 unassigned } -2,
  478. { B6 unassigned } -2,
  479. { B7 unassigned } -2,
  480. { B8 unassigned } -2,
  481. { B9 unassigned } -2,
  482. { BA OEM specific } 0,
  483. { BB OEM specific } 0,
  484. { BC OEM specific } 0,
  485. { BD OEM specific } 0,
  486. { BE OEM specific } 0,
  487. { BF OEM specific } 0,
  488. { C0 OEM specific } 0,
  489. { C1 unassigned } -2,
  490. { C2 unassigned } -2,
  491. { C3 unassigned } -2,
  492. { C4 unassigned } -2,
  493. { C5 unassigned } -2,
  494. { C6 unassigned } -2,
  495. { C7 unassigned } -2,
  496. { C8 unassigned } -2,
  497. { C9 unassigned } -2,
  498. { CA unassigned } -2,
  499. { CB unassigned } -2,
  500. { CC unassigned } -2,
  501. { CD unassigned } -2,
  502. { CE unassigned } -2,
  503. { CF unassigned } -2,
  504. { D0 unassigned } -2,
  505. { D1 unassigned } -2,
  506. { D2 unassigned } -2,
  507. { D3 unassigned } -2,
  508. { D4 unassigned } -2,
  509. { D5 unassigned } -2,
  510. { D6 unassigned } -2,
  511. { D7 unassigned } -2,
  512. { D8 unassigned } -2,
  513. { D9 unassigned } -2,
  514. { DA unassigned } -2,
  515. { DB OEM specific } 0,
  516. { DC OEM specific } 0,
  517. { DD OEM specific } 0,
  518. { DE OEM specific } 0,
  519. { DF OEM specific } 0,
  520. { E0 OEM specific } 0,
  521. { E1 OEM specific } 0,
  522. { E2 OEM specific } 0,
  523. { E3 OEM specific } 0,
  524. { E4 OEM specific } 0,
  525. { E5 unassigned } -2,
  526. { E6 OEM specific } 0,
  527. { E7 unassigned } -2,
  528. { E8 unassigned } -2,
  529. { E9 OEM specific } 0,
  530. { EA OEM specific } 0,
  531. { EB OEM specific } 0,
  532. { EC OEM specific } 0,
  533. { ED OEM specific } 0,
  534. { EE OEM specific } 0,
  535. { EF OEM specific } 0,
  536. { F0 OEM specific } 0,
  537. { F1 OEM specific } 0,
  538. { F2 OEM specific } 0,
  539. { F3 OEM specific } 0,
  540. { F4 OEM specific } 0,
  541. { F5 OEM specific } 0,
  542. { F6 unassigned } -2,
  543. { F7 unassigned } -2,
  544. { F8 unassigned } -2,
  545. { F9 unassigned } -2,
  546. { FA unassigned } -2,
  547. { FB unassigned } -2,
  548. { FC unassigned } -2,
  549. { FD unassigned } -2,
  550. { FE unassigned } -2,
  551. { FF unassigned } -2
  552. );
  553. {$endif USEKEYCODES}
  554. type TTEntryT = packed record
  555. n,s,c,a : byte; {normal,shift, ctrl, alt, normal only for f11,f12}
  556. end;
  557. *}
  558. {*
  559. CONST
  560. DosTT : ARRAY [$3B..$58] OF TTEntryT =
  561. ((n : $3B; s : $54; c : $5E; a: $68), {3B F1}
  562. (n : $3C; s : $55; c : $5F; a: $69), {3C F2}
  563. (n : $3D; s : $56; c : $60; a: $6A), {3D F3}
  564. (n : $3E; s : $57; c : $61; a: $6B), {3E F4}
  565. (n : $3F; s : $58; c : $62; a: $6C), {3F F5}
  566. (n : $40; s : $59; c : $63; a: $6D), {40 F6}
  567. (n : $41; s : $5A; c : $64; a: $6E), {41 F7}
  568. (n : $42; s : $5B; c : $65; a: $6F), {42 F8}
  569. (n : $43; s : $5C; c : $66; a: $70), {43 F9}
  570. (n : $44; s : $5D; c : $67; a: $71), {44 F10}
  571. (n : $45; s : $00; c : $00; a: $00), {45 ???}
  572. (n : $46; s : $00; c : $00; a: $00), {46 ???}
  573. (n : $47; s : $47; c : $77; a: $97), {47 Home}
  574. (n : $48; s : $00; c : $8D; a: $98), {48 Up}
  575. (n : $49; s : $49; c : $84; a: $99), {49 PgUp}
  576. (n : $4A; s : $00; c : $8E; a: $4A), {4A -}
  577. (n : $4B; s : $4B; c : $73; a: $9B), {4B Left}
  578. (n : $4C; s : $00; c : $00; a: $00), {4C ???}
  579. (n : $4D; s : $4D; c : $74; a: $9D), {4D Right}
  580. (n : $4E; s : $00; c : $90; a: $4E), {4E +}
  581. (n : $4F; s : $4F; c : $75; a: $9F), {4F End}
  582. (n : $50; s : $50; c : $91; a: $A0), {50 Down}
  583. (n : $51; s : $51; c : $76; a: $A1), {51 PgDown}
  584. (n : $52; s : $52; c : $92; a: $A2), {52 Insert}
  585. (n : $53; s : $53; c : $93; a: $A3), {53 Del}
  586. (n : $54; s : $00; c : $00; a: $00), {54 ???}
  587. (n : $55; s : $00; c : $00; a: $00), {55 ???}
  588. (n : $56; s : $00; c : $00; a: $00), {56 ???}
  589. (n : $85; s : $87; c : $89; a: $8B), {57 F11}
  590. (n : $86; s : $88; c : $8A; a: $8C)); {58 F12}
  591. DosTT09 : ARRAY [$02..$0F] OF TTEntryT =
  592. ((n : $00; s : $00; c : $00; a: $78), {02 1 }
  593. (n : $00; s : $00; c : $00; a: $79), {03 2 }
  594. (n : $00; s : $00; c : $00; a: $7A), {04 3 }
  595. (n : $00; s : $00; c : $00; a: $7B), {05 4 }
  596. (n : $00; s : $00; c : $00; a: $7C), {06 5 }
  597. (n : $00; s : $00; c : $00; a: $7D), {07 6 }
  598. (n : $00; s : $00; c : $00; a: $7E), {08 7 }
  599. (n : $00; s : $00; c : $00; a: $7F), {09 8 }
  600. (n : $00; s : $00; c : $00; a: $80), {0A 9 }
  601. (n : $00; s : $00; c : $00; a: $81), {0B 0 }
  602. (n : $00; s : $00; c : $00; a: $82), {0C ß }
  603. (n : $00; s : $00; c : $00; a: $00), {0D}
  604. (n : $00; s : $09; c : $00; a: $00), {0E Backspace}
  605. (n : $00; s : $0F; c : $94; a: $00)); {0F Tab }
  606. *}
  607. {*
  608. function TranslateKey (t : TKeyEventRecord) : TKeyEvent;
  609. var key : TKeyEvent;
  610. ss : byte;
  611. {$ifdef USEKEYCODES}
  612. ScanCode : byte;
  613. {$endif USEKEYCODES}
  614. b : byte;
  615. begin
  616. Key := 0;
  617. if t.bKeyDown then
  618. begin
  619. { ascii-char is <> 0 if not a specal key }
  620. { we return it here otherwise we have to translate more later }
  621. if t.AsciiChar <> #0 then
  622. begin
  623. if (t.dwControlKeyState and ENHANCED_KEY <> 0) and
  624. (t.wVirtualKeyCode = $DF) then
  625. begin
  626. t.dwControlKeyState:=t.dwControlKeyState and not ENHANCED_KEY;
  627. t.wVirtualKeyCode:=VK_DIVIDE;
  628. t.AsciiChar:='/';
  629. end;
  630. {drivers needs scancode, we return it here as under dos and linux
  631. with $03000000 = the lowest two bytes is the physical representation}
  632. {$ifdef USEKEYCODES}
  633. Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
  634. If ScanCode>0 then
  635. t.wVirtualScanCode:=ScanCode;
  636. Key := byte (t.AsciiChar) + (t.wVirtualScanCode shl 8) + $03000000;
  637. ss := transShiftState (t.dwControlKeyState);
  638. key := key or (ss shl 16);
  639. if (ss and kbAlt <> 0) and rightistruealt(t.dwControlKeyState) then
  640. key := key and $FFFFFF00;
  641. {$else not USEKEYCODES}
  642. Key := byte (t.AsciiChar) + ((t.wVirtualScanCode AND $00FF) shl 8) + $03000000;
  643. {$endif not USEKEYCODES}
  644. end else
  645. begin
  646. {$ifdef USEKEYCODES}
  647. Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
  648. If ScanCode>0 then
  649. t.wVirtualScanCode:=ScanCode;
  650. {$endif not USEKEYCODES}
  651. translateKey := 0;
  652. { ignore shift,ctrl,alt,numlock,capslock alone }
  653. case t.wVirtualKeyCode of
  654. $0010, {shift}
  655. $0011, {ctrl}
  656. $0012, {alt}
  657. $0014, {capslock}
  658. $0090, {numlock}
  659. $0091, {scrollock}
  660. { This should be handled !! }
  661. { these last two are OEM specific
  662. this is not good !!! }
  663. $00DC, {^ : next key i.e. a is modified }
  664. { Strange on my keyboard this corresponds to double point over i or u PM }
  665. $00DD: exit; {´ and ` : next key i.e. e is modified }
  666. end;
  667. key := $03000000 + (t.wVirtualScanCode shl 8); { make lower 8 bit=0 like under dos }
  668. end;
  669. { Handling of ~ key as AltGr 2 }
  670. { This is also French keyboard specific !! }
  671. { but without this I can not get a ~ !! PM }
  672. { MvdV: not rightruealtised, since it already has frenchkbd guard}
  673. if (t.wVirtualKeyCode=$32) and
  674. (KeyBoardLayout = FrenchKeyboard) and
  675. (t.dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then
  676. key:=(key and $ffffff00) or ord('~');
  677. { ok, now add Shift-State }
  678. ss := transShiftState (t.dwControlKeyState);
  679. key := key or (ss shl 16);
  680. { Reset Ascii-Char if Alt+Key, fv needs that, may be we
  681. need it for other special keys too
  682. 18 Sept 1999 AD: not for right Alt i.e. for AltGr+ß = \ on german keyboard }
  683. if ((ss and kbAlt <> 0) and rightistruealt(t.dwControlKeyState)) or
  684. (*
  685. { yes, we need it for cursor keys, 25=left, 26=up, 27=right,28=down}
  686. {aggg, this will not work because esc is also virtualKeyCode 27!!}
  687. {if (t.wVirtualKeyCode >= 25) and (t.wVirtualKeyCode <= 28) then}
  688. no VK_ESCAPE is $1B !!
  689. there was a mistake :
  690. VK_LEFT is $25 not 25 !! *)
  691. { not $2E VK_DELETE because its only the Keypad point !! PM }
  692. (t.wVirtualKeyCode in [$21..$28,$2C,$2D,$2F]) then
  693. { if t.wVirtualScanCode in [$47..$49,$4b,$4d,$4f,$50..$53] then}
  694. key := key and $FFFFFF00;
  695. {and translate to dos-scancodes to make fv happy, we will convert this
  696. back in translateKeyEvent}
  697. if rightistruealt(t.dwControlKeyState) then {not for alt-gr}
  698. if (t.wVirtualScanCode >= low (DosTT)) and
  699. (t.wVirtualScanCode <= high (dosTT)) then
  700. begin
  701. b := 0;
  702. if (ss and kbAlt) <> 0 then
  703. b := DosTT[t.wVirtualScanCode].a
  704. else
  705. if (ss and kbCtrl) <> 0 then
  706. b := DosTT[t.wVirtualScanCode].c
  707. else
  708. if (ss and kbShift) <> 0 then
  709. b := DosTT[t.wVirtualScanCode].s
  710. else
  711. b := DosTT[t.wVirtualScanCode].n;
  712. if b <> 0 then
  713. key := (key and $FFFF00FF) or (longint (b) shl 8);
  714. end;
  715. {Alt-0 to Alt-9}
  716. if rightistruealt(t.dwControlKeyState) then {not for alt-gr}
  717. if (t.wVirtualScanCode >= low (DosTT09)) and
  718. (t.wVirtualScanCode <= high (dosTT09)) then
  719. begin
  720. b := 0;
  721. if (ss and kbAlt) <> 0 then
  722. b := DosTT09[t.wVirtualScanCode].a
  723. else
  724. if (ss and kbCtrl) <> 0 then
  725. b := DosTT09[t.wVirtualScanCode].c
  726. else
  727. if (ss and kbShift) <> 0 then
  728. b := DosTT09[t.wVirtualScanCode].s
  729. else
  730. b := DosTT09[t.wVirtualScanCode].n;
  731. if b <> 0 then
  732. key := (key and $FFFF0000) or (longint (b) shl 8);
  733. end;
  734. TranslateKey := key;
  735. end;
  736. translateKey := Key;
  737. end;
  738. *}
  739. //#define IsMsgPortEmpty(x) (((x)->mp_MsgList.lh_TailPred) == (struct Node *)(&(x)->mp_MsgList))
  740. function IsMsgPortEmpty(port: PMsgPort): boolean;
  741. begin
  742. IsMsgPortEmpty:=(port^.mp_MsgList.lh_TailPred = @(port^.mp_MsgList));
  743. end;
  744. var
  745. KeyQueue: TKeyEvent;
  746. function SysPollKeyEvent: TKeyEvent;
  747. //var t : TKeyEventRecord;
  748. // k : TKeyEvent;
  749. var
  750. iMsg : PIntuiMessage;
  751. KeyCode: longint;
  752. begin
  753. KeyCode:=0;
  754. SysPollKeyEvent:=0;
  755. if KeyQueue<>0 then begin
  756. SysPollKeyEvent:=KeyQueue;
  757. exit;
  758. end;
  759. // writeln('keyboard/SysPollKeyEvent');
  760. if videoWindow<>nil then begin
  761. if IsMsgPortEmpty(videoWindow^.UserPort) then exit;
  762. end;
  763. PMessage(iMsg):=GetMsg(videoWindow^.UserPort);
  764. if (iMsg<>nil) then begin
  765. // writeln('got msg!');
  766. case (iMsg^.iClass) of
  767. IDCMP_VANILLAKEY: begin
  768. writeln('vanilla keycode: ',iMsg^.code);
  769. KeyCode:=iMsg^.code;
  770. case (iMsg^.code) of
  771. 09: KeyCode:=$0F09; // Tab
  772. 13: KeyCode:=$1C0D; // Enter
  773. 27: KeyCode:=$011B; // ESC
  774. 127: KeyCode:=$5300; // Del
  775. 164: KeyCode:=$1200; // Alt-E
  776. 215: KeyCode:=$2D00; // Alt-X
  777. end;
  778. end;
  779. IDCMP_RAWKEY: begin
  780. writeln('raw keycode: ',iMsg^.code);
  781. case (iMsg^.code) of
  782. 35: KeyCode:=$2100; // Alt-F
  783. 71: KeyCode:=$5200; // Ins (Alt/Shift/Ctrl codes needs processing!)
  784. 72: KeyCode:=$4900; // PgUP
  785. 73: KeyCode:=$5100; // PgDOWN
  786. 76: KeyCode:=$4800; // UP
  787. 77: KeyCode:=$5000; // DOWN
  788. 78: KeyCode:=$4D00; // RIGHT
  789. 79: KeyCode:=$4B00; // LEFT
  790. 80..89: KeyCode:=($3B+(iMsg^.code-80)) shl 8; // F1..F10
  791. 112: KeyCode:=$4700; // HOME
  792. 113: KeyCode:=$4F00; // END
  793. else
  794. KeyCode:=-1;
  795. end;
  796. end;
  797. else begin
  798. KeyCode:=-1;
  799. end;
  800. end;
  801. ReplyMsg(PMessage(iMsg));
  802. end;
  803. // end;
  804. // XXX: huh :)
  805. if KeyCode>=0 then begin
  806. SysPollKeyEvent:=KeyCode or (kbPhys shl 24);
  807. end else begin
  808. SysPollKeyEvent:=0;
  809. end;
  810. KeyQueue:=SysPollKeyEvent;
  811. {*
  812. SysPollKeyEvent := 0;
  813. if getKeyEventFromQueue (t, true) then
  814. begin
  815. { we get an enty for shift, ctrl, alt... }
  816. k := translateKey (t);
  817. while (k = 0) do
  818. begin
  819. getKeyEventFromQueue (t, false); {remove it}
  820. if not getKeyEventFromQueue (t, true) then exit;
  821. k := translateKey (t)
  822. end;
  823. SysPollKeyEvent := k;
  824. end;
  825. *}
  826. end;
  827. function SysGetKeyEvent: TKeyEvent;
  828. //var t : TKeyEventRecord;
  829. // key : TKeyEvent;
  830. var
  831. iMsg : PIntuiMessage;
  832. res : TKeyEvent;
  833. begin
  834. {*
  835. key := 0;
  836. repeat
  837. if getKeyEventFromQueueWait (t) then
  838. key := translateKey (t);
  839. until key <> 0;
  840. {$ifdef DEBUG}
  841. last_ir.Event.KeyEvent:=t;
  842. {$endif DEBUG}
  843. SysGetKeyEvent := key;
  844. *}
  845. // writeln('keyboard/SysGetKeyEvent');
  846. if videoWindow<>nil then begin
  847. if KeyQueue <> 0 then begin
  848. SysGetKeyEvent := KeyQueue;
  849. KeyQueue:=0;
  850. exit;
  851. end;
  852. repeat
  853. WaitPort(videoWindow^.UserPort);
  854. res:=SysPollKeyEvent;
  855. until res<>0;
  856. end;
  857. SysGetKeyEvent:=res;
  858. {*
  859. if videoWindow<>nil then begin
  860. WaitPort(videoWindow^.UserPort);
  861. PMessage(iMsg):=GetMsg(videoWindow^.UserPort);
  862. if (iMsg<>nil) then begin
  863. writeln('got msg!');
  864. ReplyMsg(PMessage(iMsg));
  865. end;
  866. end;
  867. *}
  868. end;
  869. function SysTranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
  870. begin
  871. {*
  872. if KeyEvent and $03000000 = $03000000 then
  873. begin
  874. if KeyEvent and $000000FF <> 0 then
  875. begin
  876. SysTranslateKeyEvent := KeyEvent and $00FFFFFF;
  877. exit;
  878. end;
  879. {translate function-keys and other specials, ascii-codes are already ok}
  880. case (KeyEvent AND $0000FF00) shr 8 of
  881. {F1..F10}
  882. $3B..$44 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $3B + $02000000;
  883. {F11,F12}
  884. $85..$86 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $85 + $02000000;
  885. {Shift F1..F10}
  886. $54..$5D : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $54 + $02000000;
  887. {Shift F11,F12}
  888. $87..$88 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $87 + $02000000;
  889. {Alt F1..F10}
  890. $68..$71 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $68 + $02000000;
  891. {Alt F11,F12}
  892. $8B..$8C : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $8B + $02000000;
  893. {Ctrl F1..F10}
  894. $5E..$67 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $5E + $02000000;
  895. {Ctrl F11,F12}
  896. $89..$8A : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $89 + $02000000;
  897. {normal,ctrl,alt}
  898. $47,$77,$97 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdHome + $02000000;
  899. $48,$8D,$98 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdUp + $02000000;
  900. $49,$84,$99 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgUp + $02000000;
  901. $4b,$73,$9B : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdLeft + $02000000;
  902. $4d,$74,$9D : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdRight + $02000000;
  903. $4f,$75,$9F : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdEnd + $02000000;
  904. $50,$91,$A0 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDown + $02000000;
  905. $51,$76,$A1 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgDn + $02000000;
  906. $52,$92,$A2 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdInsert + $02000000;
  907. $53,$93,$A3 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDelete + $02000000;
  908. else
  909. SysTranslateKeyEvent := KeyEvent;
  910. end;
  911. end else
  912. SysTranslateKeyEvent := KeyEvent;
  913. *}
  914. end;
  915. function SysGetShiftState: Byte;
  916. begin
  917. {may be better to save the last state and return that if no key is in buffer???}
  918. // SysGetShiftState:= lastShiftState;
  919. end;
  920. Const
  921. SysKeyboardDriver : TKeyboardDriver = (
  922. InitDriver : @SysInitKeyBoard;
  923. DoneDriver : @SysDoneKeyBoard;
  924. GetKeyevent : @SysGetKeyEvent;
  925. PollKeyEvent : @SysPollKeyEvent;
  926. GetShiftState : @SysGetShiftState;
  927. // TranslateKeyEvent : @SysTranslateKeyEvent;
  928. TranslateKeyEvent : Nil;
  929. TranslateKeyEventUnicode : Nil;
  930. );
  931. begin
  932. SetKeyBoardDriver(SysKeyBoardDriver);
  933. end.