+ added required units to compile IDE

    they're a total mess ATM, under fixing/cleanup, but IDE start up at least

git-svn-id: trunk@6086 -

.gitattributes

@@ -4769,7 +4769,10 @@ rtl/morphos/graphics.pas svneol=native#text/plain
 rtl/morphos/hardware.pas svneol=native#text/plain
 rtl/morphos/inputevent.pas svneol=native#text/plain
 rtl/morphos/intuition.pas svneol=native#text/plain
+rtl/morphos/keyboard.pp svneol=native#text/plain
+rtl/morphos/kvm.pp svneol=native#text/plain
 rtl/morphos/layers.pas svneol=native#text/plain
+rtl/morphos/mouse.pp svneol=native#text/plain
 rtl/morphos/mui.pas -text
 rtl/morphos/muihelper.pas -text
 rtl/morphos/prt0.as -text
@@ -4791,6 +4794,7 @@ rtl/morphos/utild2.inc svneol=native#text/plain
 rtl/morphos/utilf.inc svneol=native#text/plain
 rtl/morphos/utility.pp svneol=native#text/plain
 rtl/morphos/varutils.pp svneol=native#text/plain
+rtl/morphos/video.pp svneol=native#text/plain
 rtl/nds/Makefile svneol=native#text/plain
 rtl/nds/Makefile.fpc -text
 rtl/nds/classes.pp -text

rtl/morphos/Makefile.fpc

@@ -14,8 +14,10 @@ units=$(SYSTEMUNIT) objpas macpas strings \
       variants types rtlconsts sysconst dateutil objects \
       exec timer doslib utility hardware inputevent graphics layers \
       intuition aboxlib mui \
+# these units are here, because they depend on system interface units above
+      kvm video keyboard mouse \
 # these can be moved to packages later
-      clipboard datatypes asl ahi tinygl get9 muihelper \
+      clipboard datatypes asl ahi tinygl get9 muihelper
 rsts=math rtlconsts varutils typinfo variants classes sysconst dateutil
 
 [require]
@@ -222,3 +224,15 @@ tinygl$(PPUEXT): tinygl.pp exec$(PPUEXT)
 get9$(PPUEXT): get9.pas exec$(PPUEXT)
 
 muihelper$(PPUEXT): muihelper.pas intuition$(PPUEXT) mui$(PPUEXT) doslib$(PPUEXT) utility$(PPUEXT)
+
+
+kvm$(PPUEXT) : kvm.pp
+
+video$(PPUEXT) : video.pp 
+#windows$(PPUEXT) dos$(PPUEXT)
+
+mouse$(PPUEXT) : mouse.pp 
+#windows$(PPUEXT) dos$(PPUEXT) winevent$(PPUEXT)
+
+keyboard$(PPUEXT) : keyboard.pp 
+#windows$(PPUEXT) dos$(PPUEXT) winevent$(PPUEXT)

rtl/morphos/keyboard.pp

@@ -0,0 +1,998 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
+
+    Keyboard unit for Win32
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Keyboard;
+interface
+{$ifdef DEBUG}
+//uses
+//  windows;
+
+//var
+//  last_ir : Input_Record;
+{$endif DEBUG}
+
+{$i keybrdh.inc}
+
+implementation
+
+{ WARNING: Keyboard-Drivers (i.e. german) will only work under WinNT.
+           95 and 98 do not support keyboard-drivers other than us for win32
+           console-apps. So we always get the keys in us-keyboard layout
+           from Win9x.
+}
+
+//uses
+{ifndef DEBUG}
+//   Windows,
+{endif DEBUG}
+//   Dos,
+//   WinEvent;
+uses
+   video,
+   exec,intuition;
+
+{$i keyboard.inc}
+
+{*
+const MaxQueueSize = 120;
+      FrenchKeyboard = $040C040C;
+
+var
+   keyboardeventqueue : array[0..maxqueuesize] of TKeyEventRecord;
+   nextkeyevent,nextfreekeyevent : longint;
+   newKeyEvent    : THandle;            {sinaled if key is available}
+   lockVar        : TCriticalSection;   {for queue access}
+   lastShiftState : byte;               {set by handler for PollShiftStateEvent}
+   altNumActive   : boolean;            {for alt+0..9}
+   altNumBuffer   : string [3];
+   { used for keyboard specific stuff }
+   KeyBoardLayout : HKL;
+   Inited : Boolean;
+   HasAltGr  : Boolean = false;
+
+
+
+procedure incqueueindex(var l : longint);
+
+  begin
+     inc(l);
+     { wrap around? }
+     if l>maxqueuesize then
+       l:=0;
+  end;
+
+function keyEventsInQueue : boolean;
+begin
+  keyEventsInQueue := (nextkeyevent <> nextfreekeyevent);
+end;
+
+function rightistruealt(dw:cardinal):boolean; // inline ?
+// used to wrap checks for right alt/altgr.
+begin
+  rightistruealt:=true;
+  if hasaltgr then
+    rightistruealt:=(dw and RIGHT_ALT_PRESSED)=0;
+end;
+
+
+{ gets or peeks the next key from the queue, does not wait for new keys }
+function getKeyEventFromQueue (VAR t : TKeyEventRecord; Peek : boolean) : boolean;
+begin
+  if not Inited then
+    begin
+    getKeyEventFromQueue := false;
+    exit;
+    end;
+  EnterCriticalSection (lockVar);
+  if keyEventsInQueue then
+  begin
+    t := keyboardeventqueue[nextkeyevent];
+    if not peek then incqueueindex (nextkeyevent);
+    getKeyEventFromQueue := true;
+    if not keyEventsInQueue then ResetEvent (newKeyEvent);
+  end else
+  begin
+    getKeyEventFromQueue := false;
+    ResetEvent (newKeyEvent);
+  end;
+  LeaveCriticalSection (lockVar);
+end;
+
+
+{ gets the next key from the queue, does wait for new keys }
+function getKeyEventFromQueueWait (VAR t : TKeyEventRecord) : boolean;
+begin
+  if not Inited then
+    begin
+      getKeyEventFromQueueWait := false;
+      exit;
+    end;
+  WaitForSingleObject (newKeyEvent, dword(INFINITE));
+  getKeyEventFromQueueWait := getKeyEventFromQueue (t, false);
+end;
+
+{ translate win32 shift-state to keyboard shift state }
+function transShiftState (ControlKeyState : dword) : byte;
+var b : byte;
+begin
+  b := 0;
+  if ControlKeyState and SHIFT_PRESSED <> 0 then  { win32 makes no difference between left and right shift }
+    b := b or kbShift;
+  if (ControlKeyState and LEFT_CTRL_PRESSED <> 0) or
+     (ControlKeyState  and RIGHT_CTRL_PRESSED <> 0) then
+    b := b or kbCtrl;
+  if (ControlKeyState and LEFT_ALT_PRESSED <> 0) or
+     (ControlKeyState and RIGHT_ALT_PRESSED <> 0) then
+    b := b or kbAlt;
+  transShiftState := b;
+end;
+
+{ The event-Handler thread from the unit event will call us if a key-event
+  is available }
+
+procedure HandleKeyboard(var ir:INPUT_RECORD);
+var
+   i      : longint;
+   c      : word;
+   altc : char;
+   addThis: boolean;
+begin
+         with ir.Event.KeyEvent do
+           begin
+              { key up events are ignored (except alt) }
+              if bKeyDown then
+                begin
+                   EnterCriticalSection (lockVar);
+                   for i:=1 to wRepeatCount do
+                     begin
+                        addThis := true;
+                        if (dwControlKeyState and LEFT_ALT_PRESSED <> 0) or
+                           (dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then            {alt pressed}
+                          if ((wVirtualKeyCode >= $60) and (wVirtualKeyCode <= $69)) or
+                             ((dwControlKeyState and ENHANCED_KEY = 0) and
+                              (wVirtualKeyCode in [$C{VK_CLEAR generated by keypad 5},
+                                                   $21 {VK_PRIOR (PgUp) 9},
+                                                   $22 {VK_NEXT (PgDown) 3},
+                                                   $23 {VK_END 1},
+                                                   $24 {VK_HOME 7},
+                                                   $25 {VK_LEFT 4},
+                                                   $26 {VK_UP 8},
+                                                   $27 {VK_RIGHT 6},
+                                                   $28 {VK_DOWN 2},
+                                                   $2D {VK_INSERT 0}])) then   {0..9 on NumBlock}
+                          begin
+                            if length (altNumBuffer) = 3 then
+                              delete (altNumBuffer,1,1);
+                            case wVirtualKeyCode of
+                              $60..$69 : altc:=char (wVirtualKeyCode-48);
+                              $c  : altc:='5';
+                              $21 : altc:='9';
+                              $22 : altc:='3';
+                              $23 : altc:='1';
+                              $24 : altc:='7';
+                              $25 : altc:='4';
+                              $26 : altc:='8';
+                              $27 : altc:='6';
+                              $28 : altc:='2';
+                              $2D : altc:='0';
+                            end;
+                            altNumBuffer := altNumBuffer + altc;
+                            altNumActive   := true;
+                            addThis := false;
+                          end else
+                          begin
+                            altNumActive   := false;
+                            altNumBuffer   := '';
+                          end;
+                        if addThis then
+                        begin
+                          keyboardeventqueue[nextfreekeyevent]:=
+                            ir.Event.KeyEvent;
+                          incqueueindex(nextfreekeyevent);
+                        end;
+                     end;
+
+                   lastShiftState := transShiftState (dwControlKeyState);  {save it for PollShiftStateEvent}
+                   SetEvent (newKeyEvent);             {event that a new key is available}
+                   LeaveCriticalSection (lockVar);
+                end
+              else
+                begin
+                  lastShiftState := transShiftState (dwControlKeyState);   {save it for PollShiftStateEvent}
+                  {for alt-number we have to look for alt-key release}
+                  if altNumActive then
+                   begin
+                     if (wVirtualKeyCode = $12) then    {alt-released}
+                      begin
+                        if altNumBuffer <> '' then       {numbers with alt pressed?}
+                         begin
+                           Val (altNumBuffer, c, i);
+                           if (i = 0) and (c <= 255) then {valid number?}
+                            begin                          {add to queue}
+                              fillchar (ir, sizeof (ir), 0);
+                              bKeyDown := true;
+                              AsciiChar := char (c);
+                                                       {and add to queue}
+                              EnterCriticalSection (lockVar);
+                              keyboardeventqueue[nextfreekeyevent]:=ir.Event.KeyEvent;
+                              incqueueindex(nextfreekeyevent);
+                              SetEvent (newKeyEvent);      {event that a new key is available}
+                              LeaveCriticalSection (lockVar);
+                            end;
+                         end;
+                        altNumActive   := false;         {clear alt-buffer}
+                        altNumBuffer   := '';
+                      end;
+                   end;
+                end;
+           end;
+end;
+*}
+
+{*
+procedure CheckAltGr;
+
+var ahkl : HKL;
+    i    : integer;
+
+ begin
+   HasAltGr:=false;
+
+   ahkl:=GetKeyboardLayout(0);
+   i:=$20;
+   while i<$100 do
+     begin
+       // <MSDN>
+       // For keyboard layouts that use the right-hand ALT key as ashift key
+       // (for example, the French keyboard layout), the shift state is
+       // represented by the value 6, because the right-hand ALT key is
+       // converted internally into CTRL+ALT.
+       // </MSDN>
+      if (HIBYTE(VkKeyScanEx(chr(i),ahkl))=6) then
+        begin
+          HasAltGr:=true;
+          break;
+        end;
+     inc(i);
+    end;
+end;
+*}
+
+
+
+procedure SysInitKeyboard;
+begin
+  writeln('sysinitkeyboard');
+{*
+   KeyBoardLayout:=GetKeyboardLayout(0);
+   lastShiftState := 0;
+   FlushConsoleInputBuffer(StdInputHandle);
+   newKeyEvent := CreateEvent (nil,        // address of security attributes
+                               true,       // flag for manual-reset event
+                               false,      // flag for initial state
+                               nil);       // address of event-object name
+   if newKeyEvent = INVALID_HANDLE_VALUE then
+    begin
+      // what to do here ????
+      RunError (217);
+    end;
+   InitializeCriticalSection (lockVar);
+   altNumActive := false;
+   altNumBuffer := '';
+
+   nextkeyevent:=0;
+   nextfreekeyevent:=0;
+   checkaltgr;
+   SetKeyboardEventHandler (@HandleKeyboard);
+   Inited:=true;
+*}
+end;
+
+procedure SysDoneKeyboard;
+begin
+{*
+  SetKeyboardEventHandler(nil);     {hangs???}
+  DeleteCriticalSection (lockVar);
+  FlushConsoleInputBuffer(StdInputHandle);
+  closeHandle (newKeyEvent);
+  Inited:=false;
+*}
+end;
+
+{$define USEKEYCODES}
+
+{Translatetable Win32 -> Dos for Special Keys = Function Key, Cursor Keys
+ and Keys other than numbers on numblock (to make fv happy) }
+{combinations under dos: Shift+Ctrl: same as Ctrl
+                         Shift+Alt : same as alt
+ 
+{*                        Ctrl+Alt  : nothing (here we get it like alt)}
+{ifdef USEKEYCODES}
+   { use positive values for ScanCode we want to set
+   0 for key where we should leave the scancode
+   -1 for OEM specifc keys
+   -2 for unassigned
+   -3 for Kanji systems ???
+   }
+
+const
+  Unassigned = -2;
+  Kanji = -3;
+  OEM_specific = -1;
+  KeyToQwertyScan : array [0..255] of integer =
+  (
+  { 00 } 0,
+  { 01 VK_LBUTTON } 0,
+  { 02 VK_RBUTTON } 0,
+  { 03 VK_CANCEL } 0,
+  { 04 VK_MBUTTON } 0,
+  { 05 unassigned } -2,
+  { 06 unassigned } -2,
+  { 07 unassigned } -2,
+  { 08 VK_BACK } $E,
+  { 09 VK_TAB } $F,
+  { 0A unassigned } -2,
+  { 0B unassigned } -2,
+  { 0C VK_CLEAR ?? } 0,
+  { 0D VK_RETURN } 0,
+  { 0E unassigned } -2,
+  { 0F unassigned } -2,
+  { 10 VK_SHIFT } 0,
+  { 11 VK_CONTROL } 0,
+  { 12 VK_MENU (Alt key) } 0,
+  { 13 VK_PAUSE } 0,
+  { 14 VK_CAPITAL (Caps Lock) } 0,
+  { 15 Reserved for Kanji systems} -3,
+  { 16 Reserved for Kanji systems} -3,
+  { 17 Reserved for Kanji systems} -3,
+  { 18 Reserved for Kanji systems} -3,
+  { 19 Reserved for Kanji systems} -3,
+  { 1A unassigned } -2,
+  { 1B VK_ESCAPE } $1,
+  { 1C Reserved for Kanji systems} -3,
+  { 1D Reserved for Kanji systems} -3,
+  { 1E Reserved for Kanji systems} -3,
+  { 1F Reserved for Kanji systems} -3,
+  { 20 VK_SPACE} 0,
+  { 21 VK_PRIOR (PgUp) } 0,
+  { 22 VK_NEXT (PgDown) } 0,
+  { 23 VK_END } 0,
+  { 24 VK_HOME } 0,
+  { 25 VK_LEFT } 0,
+  { 26 VK_UP } 0,
+  { 27 VK_RIGHT } 0,
+  { 28 VK_DOWN } 0,
+  { 29 VK_SELECT ??? } 0,
+  { 2A OEM specific !! } -1,
+  { 2B VK_EXECUTE } 0,
+  { 2C VK_SNAPSHOT } 0,
+  { 2D VK_INSERT } 0,
+  { 2E VK_DELETE } 0,
+  { 2F VK_HELP } 0,
+  { 30 VK_0 '0' } 11,
+  { 31 VK_1 '1' } 2,
+  { 32 VK_2 '2' } 3,
+  { 33 VK_3 '3' } 4,
+  { 34 VK_4 '4' } 5,
+  { 35 VK_5 '5' } 6,
+  { 36 VK_6 '6' } 7,
+  { 37 VK_7 '7' } 8,
+  { 38 VK_8 '8' } 9,
+  { 39 VK_9 '9' } 10,
+  { 3A unassigned } -2,
+  { 3B unassigned } -2,
+  { 3C unassigned } -2,
+  { 3D unassigned } -2,
+  { 3E unassigned } -2,
+  { 3F unassigned } -2,
+  { 40 unassigned } -2,
+  { 41 VK_A 'A' } $1E,
+  { 42 VK_B 'B' } $30,
+  { 43 VK_C 'C' } $2E,
+  { 44 VK_D 'D' } $20,
+  { 45 VK_E 'E' } $12,
+  { 46 VK_F 'F' } $21,
+  { 47 VK_G 'G' } $22,
+  { 48 VK_H 'H' } $23,
+  { 49 VK_I 'I' } $17,
+  { 4A VK_J 'J' } $24,
+  { 4B VK_K 'K' } $25,
+  { 4C VK_L 'L' } $26,
+  { 4D VK_M 'M' } $32,
+  { 4E VK_N 'N' } $31,
+  { 4F VK_O 'O' } $18,
+  { 50 VK_P 'P' } $19,
+  { 51 VK_Q 'Q' } $10,
+  { 52 VK_R 'R' } $13,
+  { 53 VK_S 'S' } $1F,
+  { 54 VK_T 'T' } $14,
+  { 55 VK_U 'U' } $16,
+  { 56 VK_V 'V' } $2F,
+  { 57 VK_W 'W' } $11,
+  { 58 VK_X 'X' } $2D,
+  { 59 VK_Y 'Y' } $15,
+  { 5A VK_Z 'Z' } $2C,
+  { 5B unassigned } -2,
+  { 5C unassigned } -2,
+  { 5D unassigned } -2,
+  { 5E unassigned } -2,
+  { 5F unassigned } -2,
+  { 60 VK_NUMPAD0 NumKeyPad '0' } 11,
+  { 61 VK_NUMPAD1 NumKeyPad '1' } 2,
+  { 62 VK_NUMPAD2 NumKeyPad '2' } 3,
+  { 63 VK_NUMPAD3 NumKeyPad '3' } 4,
+  { 64 VK_NUMPAD4 NumKeyPad '4' } 5,
+  { 65 VK_NUMPAD5 NumKeyPad '5' } 6,
+  { 66 VK_NUMPAD6 NumKeyPad '6' } 7,
+  { 67 VK_NUMPAD7 NumKeyPad '7' } 8,
+  { 68 VK_NUMPAD8 NumKeyPad '8' } 9,
+  { 69 VK_NUMPAD9 NumKeyPad '9' } 10,
+  { 6A VK_MULTIPLY } 0,
+  { 6B VK_ADD } 0,
+  { 6C VK_SEPARATOR } 0,
+  { 6D VK_SUBSTRACT } 0,
+  { 6E VK_DECIMAL } 0,
+  { 6F VK_DIVIDE } 0,
+  { 70 VK_F1 'F1' } $3B,
+  { 71 VK_F2 'F2' } $3C,
+  { 72 VK_F3 'F3' } $3D,
+  { 73 VK_F4 'F4' } $3E,
+  { 74 VK_F5 'F5' } $3F,
+  { 75 VK_F6 'F6' } $40,
+  { 76 VK_F7 'F7' } $41,
+  { 77 VK_F8 'F8' } $42,
+  { 78 VK_F9 'F9' } $43,
+  { 79 VK_F10 'F10' } $44,
+  { 7A VK_F11 'F11' } $57,
+  { 7B VK_F12 'F12' } $58,
+  { 7C VK_F13 } 0,
+  { 7D VK_F14 } 0,
+  { 7E VK_F15 } 0,
+  { 7F VK_F16 } 0,
+  { 80 VK_F17 } 0,
+  { 81 VK_F18 } 0,
+  { 82 VK_F19 } 0,
+  { 83 VK_F20 } 0,
+  { 84 VK_F21 } 0,
+  { 85 VK_F22 } 0,
+  { 86 VK_F23 } 0,
+  { 87 VK_F24 } 0,
+  { 88 unassigned } -2,
+  { 89 VK_NUMLOCK } 0,
+  { 8A VK_SCROLL } 0,
+  { 8B unassigned } -2,
+  { 8C unassigned } -2,
+  { 8D unassigned } -2,
+  { 8E unassigned } -2,
+  { 8F unassigned } -2,
+  { 90 unassigned } -2,
+  { 91 unassigned } -2,
+  { 92 unassigned } -2,
+  { 93 unassigned } -2,
+  { 94 unassigned } -2,
+  { 95 unassigned } -2,
+  { 96 unassigned } -2,
+  { 97 unassigned } -2,
+  { 98 unassigned } -2,
+  { 99 unassigned } -2,
+  { 9A unassigned } -2,
+  { 9B unassigned } -2,
+  { 9C unassigned } -2,
+  { 9D unassigned } -2,
+  { 9E unassigned } -2,
+  { 9F unassigned } -2,
+  { A0 unassigned } -2,
+  { A1 unassigned } -2,
+  { A2 unassigned } -2,
+  { A3 unassigned } -2,
+  { A4 unassigned } -2,
+  { A5 unassigned } -2,
+  { A6 unassigned } -2,
+  { A7 unassigned } -2,
+  { A8 unassigned } -2,
+  { A9 unassigned } -2,
+  { AA unassigned } -2,
+  { AB unassigned } -2,
+  { AC unassigned } -2,
+  { AD unassigned } -2,
+  { AE unassigned } -2,
+  { AF unassigned } -2,
+  { B0 unassigned } -2,
+  { B1 unassigned } -2,
+  { B2 unassigned } -2,
+  { B3 unassigned } -2,
+  { B4 unassigned } -2,
+  { B5 unassigned } -2,
+  { B6 unassigned } -2,
+  { B7 unassigned } -2,
+  { B8 unassigned } -2,
+  { B9 unassigned } -2,
+  { BA OEM specific } 0,
+  { BB OEM specific } 0,
+  { BC OEM specific } 0,
+  { BD OEM specific } 0,
+  { BE OEM specific } 0,
+  { BF OEM specific } 0,
+  { C0 OEM specific } 0,
+  { C1 unassigned } -2,
+  { C2 unassigned } -2,
+  { C3 unassigned } -2,
+  { C4 unassigned } -2,
+  { C5 unassigned } -2,
+  { C6 unassigned } -2,
+  { C7 unassigned } -2,
+  { C8 unassigned } -2,
+  { C9 unassigned } -2,
+  { CA unassigned } -2,
+  { CB unassigned } -2,
+  { CC unassigned } -2,
+  { CD unassigned } -2,
+  { CE unassigned } -2,
+  { CF unassigned } -2,
+  { D0 unassigned } -2,
+  { D1 unassigned } -2,
+  { D2 unassigned } -2,
+  { D3 unassigned } -2,
+  { D4 unassigned } -2,
+  { D5 unassigned } -2,
+  { D6 unassigned } -2,
+  { D7 unassigned } -2,
+  { D8 unassigned } -2,
+  { D9 unassigned } -2,
+  { DA unassigned } -2,
+  { DB OEM specific } 0,
+  { DC OEM specific } 0,
+  { DD OEM specific } 0,
+  { DE OEM specific } 0,
+  { DF OEM specific } 0,
+  { E0 OEM specific } 0,
+  { E1 OEM specific } 0,
+  { E2 OEM specific } 0,
+  { E3 OEM specific } 0,
+  { E4 OEM specific } 0,
+  { E5 unassigned } -2,
+  { E6 OEM specific } 0,
+  { E7 unassigned } -2,
+  { E8 unassigned } -2,
+  { E9 OEM specific } 0,
+  { EA OEM specific } 0,
+  { EB OEM specific } 0,
+  { EC OEM specific } 0,
+  { ED OEM specific } 0,
+  { EE OEM specific } 0,
+  { EF OEM specific } 0,
+  { F0 OEM specific } 0,
+  { F1 OEM specific } 0,
+  { F2 OEM specific } 0,
+  { F3 OEM specific } 0,
+  { F4 OEM specific } 0,
+  { F5 OEM specific } 0,
+  { F6 unassigned } -2,
+  { F7 unassigned } -2,
+  { F8 unassigned } -2,
+  { F9 unassigned } -2,
+  { FA unassigned } -2,
+  { FB unassigned } -2,
+  { FC unassigned } -2,
+  { FD unassigned } -2,
+  { FE unassigned } -2,
+  { FF unassigned } -2
+  );
+{$endif  USEKEYCODES}
+type TTEntryT = packed record
+                  n,s,c,a : byte;   {normal,shift, ctrl, alt, normal only for f11,f12}
+                end;
+*}
+{*
+CONST
+ DosTT : ARRAY [$3B..$58] OF TTEntryT =
+  ((n : $3B; s : $54; c : $5E; a: $68),      {3B F1}
+   (n : $3C; s : $55; c : $5F; a: $69),      {3C F2}
+   (n : $3D; s : $56; c : $60; a: $6A),      {3D F3}
+   (n : $3E; s : $57; c : $61; a: $6B),      {3E F4}
+   (n : $3F; s : $58; c : $62; a: $6C),      {3F F5}
+   (n : $40; s : $59; c : $63; a: $6D),      {40 F6}
+   (n : $41; s : $5A; c : $64; a: $6E),      {41 F7}
+   (n : $42; s : $5B; c : $65; a: $6F),      {42 F8}
+   (n : $43; s : $5C; c : $66; a: $70),      {43 F9}
+   (n : $44; s : $5D; c : $67; a: $71),      {44 F10}
+   (n : $45; s : $00; c : $00; a: $00),      {45 ???}
+   (n : $46; s : $00; c : $00; a: $00),      {46 ???}
+   (n : $47; s : $47; c : $77; a: $97),      {47 Home}
+   (n : $48; s : $00; c : $8D; a: $98),      {48 Up}
+   (n : $49; s : $49; c : $84; a: $99),      {49 PgUp}
+   (n : $4A; s : $00; c : $8E; a: $4A),      {4A -}
+   (n : $4B; s : $4B; c : $73; a: $9B),      {4B Left}
+   (n : $4C; s : $00; c : $00; a: $00),      {4C ???}
+   (n : $4D; s : $4D; c : $74; a: $9D),      {4D Right}
+   (n : $4E; s : $00; c : $90; a: $4E),      {4E +}
+   (n : $4F; s : $4F; c : $75; a: $9F),      {4F End}
+   (n : $50; s : $50; c : $91; a: $A0),      {50 Down}
+   (n : $51; s : $51; c : $76; a: $A1),      {51 PgDown}
+   (n : $52; s : $52; c : $92; a: $A2),      {52 Insert}
+   (n : $53; s : $53; c : $93; a: $A3),      {53 Del}
+   (n : $54; s : $00; c : $00; a: $00),      {54 ???}
+   (n : $55; s : $00; c : $00; a: $00),      {55 ???}
+   (n : $56; s : $00; c : $00; a: $00),      {56 ???}
+   (n : $85; s : $87; c : $89; a: $8B),      {57 F11}
+   (n : $86; s : $88; c : $8A; a: $8C));     {58 F12}
+
+ DosTT09 : ARRAY [$02..$0F] OF TTEntryT =
+  ((n : $00; s : $00; c : $00; a: $78),      {02 1 }
+   (n : $00; s : $00; c : $00; a: $79),      {03 2 }
+   (n : $00; s : $00; c : $00; a: $7A),      {04 3 }
+   (n : $00; s : $00; c : $00; a: $7B),      {05 4 }
+   (n : $00; s : $00; c : $00; a: $7C),      {06 5 }
+   (n : $00; s : $00; c : $00; a: $7D),      {07 6 }
+   (n : $00; s : $00; c : $00; a: $7E),      {08 7 }
+   (n : $00; s : $00; c : $00; a: $7F),      {09 8 }
+   (n : $00; s : $00; c : $00; a: $80),      {0A 9 }
+   (n : $00; s : $00; c : $00; a: $81),      {0B 0 }
+   (n : $00; s : $00; c : $00; a: $82),      {0C ß }
+   (n : $00; s : $00; c : $00; a: $00),      {0D}
+   (n : $00; s : $09; c : $00; a: $00),      {0E Backspace}
+   (n : $00; s : $0F; c : $94; a: $00));     {0F Tab }
+
+*}
+
+{*
+function TranslateKey (t : TKeyEventRecord) : TKeyEvent;
+var key : TKeyEvent;
+    ss  : byte;
+{$ifdef  USEKEYCODES}
+    ScanCode  : byte;
+{$endif  USEKEYCODES}
+    b   : byte;
+begin
+  Key := 0;
+  if t.bKeyDown then
+  begin
+    { ascii-char is <> 0 if not a specal key }
+    { we return it here otherwise we have to translate more later }
+    if t.AsciiChar <> #0 then
+    begin
+      if (t.dwControlKeyState and ENHANCED_KEY <> 0) and
+         (t.wVirtualKeyCode = $DF) then
+        begin
+          t.dwControlKeyState:=t.dwControlKeyState and not ENHANCED_KEY;
+          t.wVirtualKeyCode:=VK_DIVIDE;
+          t.AsciiChar:='/';
+        end;
+      {drivers needs scancode, we return it here as under dos and linux
+       with $03000000 = the lowest two bytes is the physical representation}
+{$ifdef  USEKEYCODES}
+      Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
+      If ScanCode>0 then
+        t.wVirtualScanCode:=ScanCode;
+      Key := byte (t.AsciiChar) + (t.wVirtualScanCode shl 8) + $03000000;
+      ss := transShiftState (t.dwControlKeyState);
+      key := key or (ss shl 16);
+      if (ss and kbAlt <> 0) and rightistruealt(t.dwControlKeyState) then
+        key := key and $FFFFFF00;
+{$else not USEKEYCODES}
+      Key := byte (t.AsciiChar) + ((t.wVirtualScanCode AND $00FF) shl 8) + $03000000;
+{$endif not USEKEYCODES}
+    end else
+    begin
+{$ifdef  USEKEYCODES}
+      Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
+      If ScanCode>0 then
+        t.wVirtualScanCode:=ScanCode;
+{$endif not USEKEYCODES}
+      translateKey := 0;
+      { ignore shift,ctrl,alt,numlock,capslock alone }
+      case t.wVirtualKeyCode of
+        $0010,         {shift}
+        $0011,         {ctrl}
+        $0012,         {alt}
+        $0014,         {capslock}
+        $0090,         {numlock}
+        $0091,         {scrollock}
+        { This should be handled !! }
+        { these last two are OEM specific
+          this is not good !!! }
+        $00DC,         {^ : next key i.e. a is modified }
+        { Strange on my keyboard this corresponds to double point over i or u PM }
+        $00DD: exit;   {´ and ` : next key i.e. e is modified }
+      end;
+
+      key := $03000000 + (t.wVirtualScanCode shl 8);  { make lower 8 bit=0 like under dos }
+    end;
+    { Handling of ~ key as AltGr 2 }
+    { This is also French keyboard specific !! }
+    { but without this I can not get a ~ !! PM }
+    { MvdV: not rightruealtised, since it already has frenchkbd guard}
+    if (t.wVirtualKeyCode=$32) and
+       (KeyBoardLayout = FrenchKeyboard) and
+       (t.dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then
+      key:=(key and $ffffff00) or ord('~');
+    { ok, now add Shift-State }
+    ss := transShiftState (t.dwControlKeyState);
+    key := key or (ss shl 16);
+
+    { Reset Ascii-Char if Alt+Key, fv needs that, may be we
+      need it for other special keys too
+      18 Sept 1999 AD: not for right Alt i.e. for AltGr+ß = \ on german keyboard }
+    if ((ss and kbAlt <> 0) and rightistruealt(t.dwControlKeyState)) or
+    (*
+      { yes, we need it for cursor keys, 25=left, 26=up, 27=right,28=down}
+      {aggg, this will not work because esc is also virtualKeyCode 27!!}
+      {if (t.wVirtualKeyCode >= 25) and (t.wVirtualKeyCode <= 28) then}
+        no VK_ESCAPE is $1B !!
+        there was a mistake :
+         VK_LEFT is $25 not 25 !! *)
+       { not $2E VK_DELETE because its only the Keypad point !! PM }
+      (t.wVirtualKeyCode in [$21..$28,$2C,$2D,$2F]) then
+      { if t.wVirtualScanCode in [$47..$49,$4b,$4d,$4f,$50..$53] then}
+        key := key and $FFFFFF00;
+
+    {and translate to dos-scancodes to make fv happy, we will convert this
+     back in translateKeyEvent}
+
+     if rightistruealt(t.dwControlKeyState) then {not for alt-gr}
+     if (t.wVirtualScanCode >= low (DosTT)) and
+        (t.wVirtualScanCode <= high (dosTT)) then
+     begin
+       b := 0;
+       if (ss and kbAlt) <> 0 then
+         b := DosTT[t.wVirtualScanCode].a
+       else
+       if (ss and kbCtrl) <> 0 then
+         b := DosTT[t.wVirtualScanCode].c
+       else
+       if (ss and kbShift) <> 0 then
+         b := DosTT[t.wVirtualScanCode].s
+       else
+         b := DosTT[t.wVirtualScanCode].n;
+       if b <> 0 then
+         key := (key and $FFFF00FF) or (longint (b) shl 8);
+     end;
+
+     {Alt-0 to Alt-9}
+     if rightistruealt(t.dwControlKeyState) then {not for alt-gr}
+       if (t.wVirtualScanCode >= low (DosTT09)) and
+          (t.wVirtualScanCode <= high (dosTT09)) then
+       begin
+         b := 0;
+         if (ss and kbAlt) <> 0 then
+           b := DosTT09[t.wVirtualScanCode].a
+         else
+         if (ss and kbCtrl) <> 0 then
+           b := DosTT09[t.wVirtualScanCode].c
+         else
+         if (ss and kbShift) <> 0 then
+           b := DosTT09[t.wVirtualScanCode].s
+         else
+           b := DosTT09[t.wVirtualScanCode].n;
+         if b <> 0 then
+           key := (key and $FFFF0000) or (longint (b) shl 8);
+       end;
+
+     TranslateKey := key;
+  end;
+  translateKey := Key;
+end;
+*}
+
+
+//#define IsMsgPortEmpty(x)  (((x)->mp_MsgList.lh_TailPred) == (struct Node *)(&(x)->mp_MsgList))
+
+function IsMsgPortEmpty(port: PMsgPort): boolean;
+begin
+  IsMsgPortEmpty:=(port^.mp_MsgList.lh_TailPred = @(port^.mp_MsgList));
+end;
+
+
+function SysPollKeyEvent: TKeyEvent;
+//var t   : TKeyEventRecord;
+//    k   : TKeyEvent;
+var
+  iMsg : PIntuiMessage;
+  KeyCode: longint;
+begin
+  KeyCode:=0;
+  SysPollKeyEvent:=0;
+//  writeln('keyboard/SysPollKeyEvent');
+  if videoWindow<>nil then begin
+    if IsMsgPortEmpty(videoWindow^.UserPort) then exit;
+  end;
+    PMessage(iMsg):=GetMsg(videoWindow^.UserPort);
+    if (iMsg<>nil) then begin
+//      writeln('got msg!');
+      case (iMsg^.iClass) of
+        IDCMP_VANILLAKEY: begin
+            writeln('vanilla keycode: ',iMsg^.code);
+            KeyCode:=iMsg^.code;
+            case (iMsg^.code) of
+               09: KeyCode:=$0F09; // Tab
+               13: KeyCode:=$1C0D; // Enter 
+               27: KeyCode:=$011B; // ESC
+              
+              127: KeyCode:=$5300; // Del
+
+              164: KeyCode:=$1200; // Alt-E
+              215: KeyCode:=$2D00; // Alt-X
+
+            end;
+          end;
+        IDCMP_RAWKEY: begin
+            writeln('raw keycode: ',iMsg^.code);
+            case (iMsg^.code) of
+               35: KeyCode:=$2100; // Alt-F
+               
+               71: KeyCode:=$5200; // Ins (Alt/Shift/Ctrl codes needs processing!)
+
+               72: KeyCode:=$4900; // PgUP
+               73: KeyCode:=$5100; // PgDOWN
+
+               76: KeyCode:=$4800; // UP
+               77: KeyCode:=$5000; // DOWN
+               78: KeyCode:=$4D00; // RIGHT
+               79: KeyCode:=$4B00; // LEFT
+
+               80..89: KeyCode:=($3B+(iMsg^.code-80)) shl 8; // F1..F10
+
+              112: KeyCode:=$4700; // HOME
+              113: KeyCode:=$4F00; // END
+
+              else
+                KeyCode:=-1;
+            end;
+          end;
+        else begin
+            KeyCode:=-1;
+          end;
+      end;
+      ReplyMsg(PMessage(iMsg));
+    end;
+//  end;
+
+  // XXX: huh :)
+  if KeyCode>=0 then begin
+    SysPollKeyEvent:=KeyCode or (kbPhys shl 24);
+  end else begin
+    SysPollKeyEvent:=0;
+  end;
+{*
+  SysPollKeyEvent := 0;
+  if getKeyEventFromQueue (t, true) then
+  begin
+    { we get an enty for shift, ctrl, alt... }
+    k := translateKey (t);
+    while (k = 0) do
+    begin
+      getKeyEventFromQueue (t, false);  {remove it}
+      if not getKeyEventFromQueue (t, true) then exit;
+      k := translateKey (t)
+    end;
+    SysPollKeyEvent := k;
+  end;
+*}
+end;
+
+
+
+function SysGetKeyEvent: TKeyEvent;
+//var t   : TKeyEventRecord;
+//    key : TKeyEvent;
+var
+  iMsg : PIntuiMessage;
+  res: TKeyEvent;
+begin
+{*
+  key := 0;
+  repeat
+     if getKeyEventFromQueueWait (t) then
+       key := translateKey (t);
+  until key <> 0;
+{$ifdef DEBUG}
+  last_ir.Event.KeyEvent:=t;
+{$endif DEBUG}
+  SysGetKeyEvent := key;
+*}
+
+//  writeln('keyboard/SysGetKeyEvent');
+  if videoWindow<>nil then begin
+    repeat
+      WaitPort(videoWindow^.UserPort);
+      res:=SysPollKeyEvent;
+    until res<>0;
+  end;
+{*
+  if videoWindow<>nil then begin
+    WaitPort(videoWindow^.UserPort);
+    PMessage(iMsg):=GetMsg(videoWindow^.UserPort);
+    if (iMsg<>nil) then begin
+      writeln('got msg!');
+      ReplyMsg(PMessage(iMsg));
+    end;
+  end;
+*}
+end;
+
+
+
+function SysTranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
+begin
+{*
+  if KeyEvent and $03000000 = $03000000 then
+   begin
+     if KeyEvent and $000000FF <> 0 then
+     begin
+       SysTranslateKeyEvent := KeyEvent and $00FFFFFF;
+       exit;
+     end;
+     {translate function-keys and other specials, ascii-codes are already ok}
+     case (KeyEvent AND $0000FF00) shr 8 of
+       {F1..F10}
+       $3B..$44     : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $3B + $02000000;
+       {F11,F12}
+       $85..$86     : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $85 + $02000000;
+       {Shift F1..F10}
+       $54..$5D     : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $54 + $02000000;
+       {Shift F11,F12}
+       $87..$88     : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $87 + $02000000;
+       {Alt F1..F10}
+       $68..$71     : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $68 + $02000000;
+       {Alt F11,F12}
+       $8B..$8C     : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $8B + $02000000;
+       {Ctrl F1..F10}
+       $5E..$67     : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $5E + $02000000;
+       {Ctrl F11,F12}
+       $89..$8A     : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $89 + $02000000;
+
+       {normal,ctrl,alt}
+       $47,$77,$97  : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdHome + $02000000;
+       $48,$8D,$98  : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdUp + $02000000;
+       $49,$84,$99  : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgUp + $02000000;
+       $4b,$73,$9B  : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdLeft + $02000000;
+       $4d,$74,$9D  : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdRight + $02000000;
+       $4f,$75,$9F  : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdEnd + $02000000;
+       $50,$91,$A0  : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDown + $02000000;
+       $51,$76,$A1  : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgDn + $02000000;
+       $52,$92,$A2  : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdInsert + $02000000;
+       $53,$93,$A3  : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDelete + $02000000;
+     else
+       SysTranslateKeyEvent := KeyEvent;
+     end;
+   end else
+     SysTranslateKeyEvent := KeyEvent;
+*}
+end;
+
+
+function SysGetShiftState: Byte;
+
+begin
+  {may be better to save the last state and return that if no key is in buffer???}
+//  SysGetShiftState:= lastShiftState;
+end;
+
+Const
+  SysKeyboardDriver : TKeyboardDriver = (
+    InitDriver : @SysInitKeyBoard;
+    DoneDriver : @SysDoneKeyBoard;
+    GetKeyevent : @SysGetKeyEvent;
+    PollKeyEvent : @SysPollKeyEvent;
+    GetShiftState : @SysGetShiftState;
+//    TranslateKeyEvent : @SysTranslateKeyEvent;
+    TranslateKeyEvent : Nil;
+    TranslateKeyEventUnicode : Nil;
+  );
+
+
+begin
+  SetKeyBoardDriver(SysKeyBoardDriver);
+end.

rtl/morphos/kvm.pp

@@ -0,0 +1,78 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2006 Karoly Balogh
+    member of the Free Pascal Development Team
+
+    Keyboard/Video/Mouse helper unit for Amiga/MorphOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit kvm;
+
+interface
+
+uses
+  exec, intuition, graphics;
+
+
+function initKVM: boolean;
+procedure doneKVM;
+
+
+
+implementation
+
+
+var
+  kvmWindow: PWindow;
+
+const
+  DEFAULT_WINWIDTH  = 80;
+  DEFAULT_WINHEIGHT = 25;
+
+const
+  CHAR_XSIZE = 8;
+  CHAR_YSIZE = 16;
+
+
+
+
+function initKVM: boolean;
+begin
+  initKVM:=false;
+  kvmWindow:=OpenWindowTags(nil, [
+      WA_Left,50,
+      WA_Top, 50,
+      WA_InnerWidth, DEFAULT_WINWIDTH *CHAR_XSIZE,
+      WA_InnerHeight,DEFAULT_WINHEIGHT*CHAR_YSIZE,
+      WA_IDCMP, IDCMP_VANILLAKEY or IDCMP_RAWKEY,
+      WA_Title,DWord(PChar('Free Pascal Video Output')),
+      WA_Flags,(WFLG_GIMMEZEROZERO or 
+                WFLG_SMART_REFRESH or 
+                WFLG_NOCAREREFRESH or 
+                WFLG_ACTIVATE      or 
+                WFLG_DRAGBAR       or 
+                WFLG_DEPTHGADGET)
+    ]);
+
+  if kvmWindow<>nil then initKVM:=true;
+end;
+
+
+procedure doneKVM;
+begin
+  if kvmWindow <> nil then CloseWindow(kvmWindow);
+end;
+
+
+begin
+  InitGraphicsLibrary;
+  InitIntuitionLibrary;
+end.

rtl/morphos/mouse.pp

@@ -0,0 +1,275 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2006 Karoly Balogh
+    member of the Free Pascal development team
+
+    Mouse unit for Amiga/MorphOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Mouse;
+interface
+
+{$i mouseh.inc}
+
+implementation
+
+//uses
+//   windows,dos,Winevent;
+
+{$i mouse.inc}
+
+//var
+//   ChangeMouseEvents : TCriticalSection;
+//   LastHandlerMouseEvent : TMouseEvent;
+
+{
+procedure MouseEventHandler(var ir:INPUT_RECORD);
+  var
+     e : TMouseEvent;
+
+  begin
+    EnterCriticalSection(ChangeMouseEvents);
+    e.x:=ir.Event.MouseEvent.dwMousePosition.x;
+    e.y:=ir.Event.MouseEvent.dwMousePosition.y;
+    e.buttons:=0;
+    e.action:=0;
+    if (ir.Event.MouseEvent.dwButtonState and FROM_LEFT_1ST_BUTTON_PRESSED<>0) then
+      e.buttons:=e.buttons or MouseLeftButton;
+    if (ir.Event.MouseEvent.dwButtonState and FROM_LEFT_2ND_BUTTON_PRESSED<>0) then
+      e.buttons:=e.buttons or MouseMiddleButton;
+    if (ir.Event.MouseEvent.dwButtonState and RIGHTMOST_BUTTON_PRESSED<>0) then
+      e.buttons:=e.buttons or MouseRightButton;
+
+    if (Lasthandlermouseevent.x<>e.x) or (LasthandlerMouseEvent.y<>e.y) then
+      e.Action:=MouseActionMove;
+    if (LastHandlerMouseEvent.Buttons<>e.Buttons) then
+     begin
+      if (LasthandlerMouseEvent.Buttons and e.buttons<>LasthandlerMouseEvent.Buttons) then
+        e.Action:=MouseActionUp
+      else
+        e.Action:=MouseActionDown;
+     end;
+
+
+//
+//  The mouse event compression here was flawed and could lead
+//  to "zero" mouse actions if the new (x,y) was the same as the
+//  previous one. (bug 2312)
+//
+
+     { can we compress the events? }
+   if (PendingMouseEvents>0) and
+      (e.buttons=PendingMouseTail^.buttons) and
+      (e.action=PendingMouseTail^.action) then
+      begin
+         PendingMouseTail^.x:=e.x;
+         PendingMouseTail^.y:=e.y;
+      end
+    else
+      begin
+         if e.action<>0 then
+           begin
+             LastHandlermouseEvent:=e;
+
+             { what till there is again space in the mouse event queue }
+             while PendingMouseEvents>=MouseEventBufSize do
+               begin
+                 LeaveCriticalSection(ChangeMouseEvents);
+                 sleep(0);
+                 EnterCriticalSection(ChangeMouseEvents);
+               end;
+
+             PutMouseEvent(e);
+           end;
+         // this should be done in PutMouseEvent, now it is PM
+         // inc(PendingMouseEvents);
+      end;
+    LastMouseEvent:=e;
+    LeaveCriticalSection(ChangeMouseEvents);
+  end;
+}
+procedure SysInitMouse;
+
+var
+   mode : dword;
+
+begin
+{
+  // enable mouse events
+  GetConsoleMode(StdInputHandle,@mode);
+  mode:=mode or ENABLE_MOUSE_INPUT;
+  SetConsoleMode(StdInputHandle,mode);
+
+  PendingMouseHead:=@PendingMouseEvent;
+  PendingMouseTail:=@PendingMouseEvent;
+  PendingMouseEvents:=0;
+  FillChar(LastMouseEvent,sizeof(TMouseEvent),0);
+  InitializeCriticalSection(ChangeMouseEvents);
+  SetMouseEventHandler(@MouseEventHandler);
+  ShowMouse;
+}
+end;
+
+
+procedure SysDoneMouse;
+var
+   mode : dword;
+begin
+{
+  HideMouse;
+  // disable mouse events
+  GetConsoleMode(StdInputHandle,@mode);
+  mode:=mode and (not ENABLE_MOUSE_INPUT);
+  SetConsoleMode(StdInputHandle,mode);
+
+  SetMouseEventHandler(nil);
+  DeleteCriticalSection(ChangeMouseEvents);
+}
+end;
+
+
+function SysDetectMouse:byte;
+var
+  num : dword;
+begin
+  // Under Amiga/MorphOS, mouse is always there, and it's unable to easily
+  // detect number of buttons. So lets report 3, which is common nowadays. (KB)
+  SysDetectMouse:=3;
+end;
+
+
+procedure SysGetMouseEvent(var MouseEvent: TMouseEvent);
+
+var
+   b : byte;
+
+begin
+{
+  repeat
+    EnterCriticalSection(ChangeMouseEvents);
+    b:=PendingMouseEvents;
+    LeaveCriticalSection(ChangeMouseEvents);
+    if b>0 then
+      break
+    else
+      sleep(50);
+  until false;
+  EnterCriticalSection(ChangeMouseEvents);
+  MouseEvent:=PendingMouseHead^;
+  inc(PendingMouseHead);
+  if ptrint(PendingMouseHead)=ptrint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
+   PendingMouseHead:=@PendingMouseEvent;
+  dec(PendingMouseEvents);
+
+  { LastMouseEvent is already set at the end of the mouse event handler,
+    so this code might compare LastMouseEvent with itself leading to
+    "empty" events (FK)
+
+  if (LastMouseEvent.x<>MouseEvent.x) or (LastMouseEvent.y<>MouseEvent.y) then
+   MouseEvent.Action:=MouseActionMove;
+  if (LastMouseEvent.Buttons<>MouseEvent.Buttons) then
+   begin
+     if (LastMouseEvent.Buttons and MouseEvent.buttons<>LastMouseEvent.Buttons) then
+       MouseEvent.Action:=MouseActionUp
+     else
+       MouseEvent.Action:=MouseActionDown;
+   end;
+  if MouseEvent.action=0 then
+    MousEevent.action:=MouseActionMove; // can sometimes happen due to compression of events.
+  LastMouseEvent:=MouseEvent;
+  }
+
+  LeaveCriticalSection(ChangeMouseEvents);
+}
+end;
+
+
+function SysPollMouseEvent(var MouseEvent: TMouseEvent):boolean;
+begin
+{
+  EnterCriticalSection(ChangeMouseEvents);
+  if PendingMouseEvents>0 then
+   begin
+     MouseEvent:=PendingMouseHead^;
+     SysPollMouseEvent:=true;
+   end
+  else
+   SysPollMouseEvent:=false;
+  LeaveCriticalSection(ChangeMouseEvents);
+}
+end;
+
+
+procedure SysPutMouseEvent(const MouseEvent: TMouseEvent);
+begin
+{
+  if PendingMouseEvents<MouseEventBufSize then
+   begin
+     PendingMouseTail^:=MouseEvent;
+     inc(PendingMouseTail);
+     if ptrint(PendingMouseTail)=ptrint(@PendingMouseEvent)+sizeof(PendingMouseEvent) then
+      PendingMouseTail:=@PendingMouseEvent;
+      { why isn't this done here ?
+        so the win32 version do this by hand:}
+       inc(PendingMouseEvents);
+   end;
+}
+end;
+
+
+function SysGetMouseX:word;
+begin
+{
+  EnterCriticalSection(ChangeMouseEvents);
+  SysGetMouseX:=LastMouseEvent.x;
+  LeaveCriticalSection(ChangeMouseEvents);
+}
+end;
+
+
+function SysGetMouseY:word;
+begin
+{
+  EnterCriticalSection(ChangeMouseEvents);
+  SysGetMouseY:=LastMouseEvent.y;
+  LeaveCriticalSection(ChangeMouseEvents);
+}
+end;
+
+
+function SysGetMouseButtons:word;
+begin
+{
+  EnterCriticalSection(ChangeMouseEvents);
+  SysGetMouseButtons:=LastMouseEvent.Buttons;
+  LeaveCriticalSection(ChangeMouseEvents);
+}
+end;
+
+const
+  SysMouseDriver : TMouseDriver = (
+    UseDefaultQueue : False;
+    InitDriver      : @SysInitMouse;
+    DoneDriver      : @SysDoneMouse;
+    DetectMouse     : @SysDetectMouse;
+    ShowMouse       : Nil;
+    HideMouse       : Nil;
+    GetMouseX       : @SysGetMouseX;
+    GetMouseY       : @SysGetMouseY;
+    GetMouseButtons : @SysGetMouseButtons;
+    SetMouseXY      : Nil;
+    GetMouseEvent   : @SysGetMouseEvent;
+    PollMouseEvent  : @SysPollMouseEvent;
+    PutMouseEvent   : @SysPutMouseEvent;
+  );
+
+begin
+  SetMouseDriver(SysMouseDriver);
+end.

rtl/morphos/video.pp

@@ -0,0 +1,428 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2006 by Karoly Balogh
+    member of the Free Pascal development team
+
+    Video unit for Amiga and MorphOS
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit Video;
+
+interface
+
+uses
+  intuition;
+
+{$i videoh.inc}
+
+var
+   videoWindow   : pWindow; 
+
+implementation
+
+uses
+//   dos
+   exec,graphics;
+
+{$i video.inc}
+
+{$i videodata.inc}
+
+const
+    LastCursorType: word = crUnderline;
+    OrigScreen: PVideoBuf = nil;
+    OrigScreenSize: cardinal = 0;
+
+var
+   videoColorMap : pColorMap;
+   videoPens     : array[0..15] of longint;
+
+   oldCursorX, oldCursorY: longint;
+   visibleCursor: boolean;
+   oldvisibleCursor: boolean;
+
+procedure SysInitVideo;
+var counter: longint;
+begin
+   writeln('sysinitvideo');
+   InitGraphicsLibrary;
+   InitIntuitionLibrary;
+{
+  ScreenColor:=true;
+  GetConsoleScreenBufferInfo(TextRec(Output).Handle, OrigConsoleInfo);
+  GetConsoleCursorInfo(TextRec(Output).Handle, OrigConsoleCursorInfo);
+  OrigCP := GetConsoleCP;
+  ConsoleInfo:=OrigConsoleInfo;
+  ConsoleCursorInfo:=OrigConsoleCursorInfo;
+  {
+    About the ConsoleCursorInfo record: There are 3 possible
+    structures in it that can be regarded as the 'screen':
+    - dwsize   : contains the cols & row in current screen buffer.
+    - srwindow : Coordinates (relative to buffer) of upper left
+                 & lower right corners of visible console.
+    - dmMaximumWindowSize : Maximal size of Screen buffer.
+    The first implementation of video used srWindow. After some
+    bug-reports, this was switched to dwMaximumWindowSize.
+  }
+  with ConsoleInfo.dwMaximumWindowSize do
+    begin
+    ScreenWidth:=X;
+    ScreenHeight:=Y;
+    end;
+  { TDrawBuffer only has FVMaxWidth elements
+    larger values lead to crashes }
+  if ScreenWidth> FVMaxWidth then
+    ScreenWidth:=FVMaxWidth;
+  CursorX:=ConsoleInfo.dwCursorPosition.x;
+  CursorY:=ConsoleInfo.dwCursorPosition.y;
+  if not ConsoleCursorInfo.bvisible then
+    CursorLines:=0
+  else
+    CursorLines:=ConsoleCursorInfo.dwSize;
+}
+   videoWindow:=OpenWindowTags(Nil, [
+      WA_Left,50,
+      WA_Top,50,
+      WA_InnerWidth,80*8,
+      WA_InnerHeight,25*16,
+//      WA_IDCMP,IDCMP_MOUSEBUTTONS Or IDCMP_RAWKEYS,
+      WA_IDCMP,IDCMP_VANILLAKEY Or IDCMP_RAWKEY,
+      WA_Title,DWord(PChar('Free Pascal Video Output')),
+      WA_Flags,(WFLG_GIMMEZEROZERO Or WFLG_SMART_REFRESH Or WFLG_NOCAREREFRESH Or WFLG_ACTIVATE Or WFLG_DRAGBAR Or WFLG_DEPTHGADGET)
+   ]);
+
+   ScreenWidth := 80;
+   ScreenHeight := 25;
+
+   videoColorMap := pScreen(videoWindow^.WScreen)^.ViewPort.ColorMap;
+   for counter:=0 to 15 do begin
+     videoPens[counter]:=ObtainPen(videoColorMap,-1,
+         vgacolors[counter,0] shl 24,vgacolors[counter,1] shl 24,vgacolors[counter,2] shl 24,
+         PEN_EXCLUSIVE);
+//     writeln(videoPens[counter]);
+     // XXX: do checks for -1 colors (KB)
+   end;
+
+   CursorX:=0;
+   CursorY:=0;
+   oldCursorX:=0;
+   oldCursorY:=0;
+   visibleCursor:=true;
+   oldvisibleCursor:=true;
+end;
+
+
+procedure SysDoneVideo;
+var counter: longint;
+begin
+   if videoWindow<>nil then CloseWindow(videoWindow);
+   for counter:=0 to 15 do ReleasePen(videoColorMap,videoPens[counter]);
+ 
+{
+  SetConsoleScreenBufferSize (TextRec (Output).Handle, OrigConsoleInfo.dwSize);
+  SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, OrigConsoleInfo.srWindow);
+  SetConsoleCursorInfo(TextRec(Output).Handle, OrigConsoleCursorInfo);
+  SetConsoleCP(OrigCP);
+}
+end;
+
+
+
+function SysVideoModeSelector (const VideoMode: TVideoMode): boolean;
+
+{
+var MI: Console_Screen_Buffer_Info;
+    C: Coord;
+    SR: Small_Rect;
+}
+begin
+{
+  if not (GetConsoleScreenBufferInfo (TextRec (Output).Handle, MI)) then
+    SysVideoModeSelector := false
+  else
+    begin
+      with MI do
+        begin
+          C.X := VideoMode.Col;
+          C.Y := VideoMode.Row;
+        end;
+      with SR do
+        begin
+          Top := 0;
+          Left := 0;
+          { First, we need to make sure we reach the minimum window size
+            to always fit in the new buffer after changing buffer size. }
+          Right := MI.srWindow.Right - MI.srWindow.Left;
+          if VideoMode.Col <= Right then
+            Right := Pred (VideoMode.Col);
+          Bottom := MI.srWindow.Bottom - MI.srWindow.Top;
+          if VideoMode.Row <= Bottom then
+            Bottom := Pred (VideoMode.Row);
+        end;
+      if SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, SR) then
+        if SetConsoleScreenBufferSize (TextRec (Output).Handle, C) then
+          begin
+            with SR do
+              begin
+                { Now, we can resize the window to the final size. }
+                Right := Pred (VideoMode.Col);
+                Bottom := Pred (VideoMode.Row);
+              end;
+            if SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, SR) then
+              begin
+                SysVideoModeSelector := true;
+                SetCursorType (LastCursorType);
+                ClearScreen;
+              end
+            else
+              begin
+                SysVideoModeSelector := false;
+                SetConsoleScreenBufferSize (TextRec (Output).Handle, MI.dwSize);
+                SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, MI.srWindow);
+                SetCursorType (LastCursorType);
+              end
+          end
+        else
+          begin
+            SysVideoModeSelector := false;
+            SetConsoleWindowInfo (cardinal (TextRec (Output).Handle), true, MI.srWindow);
+            SetCursorType (LastCursorType);
+          end
+      else
+        SysVideoModeSelector := false;
+    end;
+}
+end;
+
+Const
+  SysVideoModeCount = 6;
+  SysVMD : Array[0..SysVideoModeCount-1] of TVideoMode = (
+   (Col: 40; Row: 25; Color: True),
+   (Col: 80; Row: 25; Color: True),
+   (Col: 80; Row: 30; Color: True),
+   (Col: 80; Row: 43; Color: True),
+   (Col: 80; Row: 50; Color: True),
+   (Col: 80; Row: 25; Color: True) // Reserved for TargetEntry
+  );
+
+
+Function SysSetVideoMode (Const Mode : TVideoMode) : Boolean;
+
+Var
+  I : Integer;
+
+begin
+{
+  I:=SysVideoModeCount-1;
+  SysSetVideoMode:=False;
+  While (I>=0) and Not SysSetVideoMode do
+    If (Mode.col=SysVMD[i].col) and
+       (Mode.Row=SysVMD[i].Row) and
+       (Mode.Color=SysVMD[i].Color) then
+      SysSetVideoMode:=True
+    else
+      Dec(I);
+  If SysSetVideoMode then
+    begin
+    if SysVideoModeSelector(Mode) then
+      begin
+      ScreenWidth:=SysVMD[I].Col;
+      ScreenHeight:=SysVMD[I].Row;
+      ScreenColor:=SysVMD[I].Color;
+      end else SysSetVideoMode := false;
+    end;
+}
+end;
+
+Function SysGetVideoModeData (Index : Word; Var Data : TVideoMode) : boolean;
+
+begin
+  SysGetVideoModeData:=(Index<=high(SysVMD));
+  If SysGetVideoModeData then
+    Data:=SysVMD[Index];
+end;
+
+Function SysGetVideoModeCount : Word;
+
+begin
+  SysGetVideoModeCount:=SysVideoModeCount;
+end;
+
+procedure SysClearScreen;
+begin
+  UpdateScreen(true);
+end;
+
+
+procedure DrawChar(x,y: longint; bitmap: pBitmap; drawCursor: boolean);
+var tmpCharData: word;
+    tmpChar    : byte;
+    tmpRow     : byte;
+    tmpFGColor : byte;
+    tmpBGColor : byte;
+var
+    counterX, counterY:longint;
+    sX,sY: longint;
+begin
+  tmpCharData:=VideoBuf^[y*ScreenWidth+x];
+  tmpChar    :=tmpCharData and $0ff;
+  tmpFGColor :=(tmpCharData shr 8) and %00001111;
+  tmpBGColor :=(tmpCharData shr 12) and %00000111;
+  
+//  write('"',char(tmpChar),'" ',tmpChar);
+  sX:=x*8;
+  sY:=y*16;
+
+  SetAPen(videoWindow^.RPort,videoPens[tmpBGColor]);
+  RectFill(videoWindow^.RPort, sX, sY, sX + 7, sY + 15);
+
+  SetAPen(videoWindow^.Rport,videoPens[tmpFGColor]);
+  for counterY:=0 to 15 do begin
+    tmpRow:=vgafont[tmpChar,counterY];
+    if (tmpRow>0) then begin
+      for counterX:=0 to 7 do begin
+         if ((tmpRow and (1 shl counterX)) > 0) then
+            WritePixel(videoWindow^.RPort,sX+counterX,sY+counterY);
+      end;
+    end;
+  end;
+  if drawCursor then begin
+     gfxMove(videoWindow^.RPort,sX,sY+14); Draw(videoWindow^.RPort,sX+7,sY+14);
+     gfxMove(videoWindow^.RPort,sX,sY+15); Draw(videoWindow^.RPort,sX+7,sY+15);
+  end;
+
+end;
+
+
+procedure SysUpdateScreen(force: boolean);
+var
+   BufCounter  : Longint;
+   smallforce  : boolean;
+
+   counter, counterX, counterY: longint;
+var
+   tmpBitmap   : tBitmap;
+begin
+  if force then
+    smallforce:=true
+  else begin
+    counter:=0;
+    while not smallforce and (counter<(VideoBufSize div 4)-1) do begin
+      if PDWord(VideoBuf)[counter]<>PDWord(OldVideoBuf)[counter] then smallforce:=true;
+      counter+=1;
+    end;
+  end;
+
+  BufCounter:=0;
+  if smallforce then begin
+    for counterY:=0 to ScreenHeight-1 do begin
+      for counterX:=0 to ScreenWidth-1 do begin
+        if VideoBuf^[BufCounter]<>OldVideoBuf^[BufCounter] then
+          DrawChar(counterX,counterY,@tmpBitmap,false);
+        Inc(BufCounter);
+      end;
+    end;
+    move(VideoBuf^,OldVideoBuf^,VideoBufSize);
+  end;
+
+  if (oldvisibleCursor<>visibleCursor) or (CursorX<>oldCursorX) or (CursorY<>oldCursorY) then begin
+    writeln('kurzor:',cursorx,' ',cursory);
+    DrawChar(oldCursorY,oldCursorX,@tmpBitmap,false);
+    DrawChar(CursorY,CursorX,@tmpBitmap,visibleCursor);
+    oldCursorX:=CursorX;
+    oldCursorY:=CursorY;
+    oldVisibleCursor:=visibleCursor;
+  end;
+end;
+
+
+procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
+begin
+  CursorX:=NewCursorY;
+  CursorY:=NewCursorX;
+  SysUpdateScreen(false);
+end;
+
+function SysGetCapabilities: Word;
+begin
+  SysGetCapabilities:=cpColor or cpChangeCursor;
+end;
+
+function SysGetCursorType: Word;
+begin
+  if not visibleCursor then SysGetCursorType:=crHidden 
+                       else SysGetCursorType:=crUnderline;
+ 
+{
+   GetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
+   if not ConsoleCursorInfo.bvisible then
+     SysGetCursorType:=crHidden
+   else
+     case ConsoleCursorInfo.dwSize of
+        1..30:
+          SysGetCursorType:=crUnderline;
+        31..70:
+          SysGetCursorType:=crHalfBlock;
+        71..100:
+          SysGetCursorType:=crBlock;
+     end;
+}
+end;
+
+
+procedure SysSetCursorType(NewType: Word);
+begin
+  if newType=crHidden then visibleCursor:=false
+                      else visibleCursor:=true;
+  SysUpdateScreen(false);
+{
+   GetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
+   if newType=crHidden then
+     ConsoleCursorInfo.bvisible:=false
+   else
+     begin
+        ConsoleCursorInfo.bvisible:=true;
+        case NewType of
+           crUnderline:
+             ConsoleCursorInfo.dwSize:=10;
+
+           crHalfBlock:
+             ConsoleCursorInfo.dwSize:=50;
+
+           crBlock:
+             ConsoleCursorInfo.dwSize:=99;
+        end
+     end;
+   SetConsoleCursorInfo(TextRec(Output).Handle,ConsoleCursorInfo);
+}
+end;
+
+
+
+const
+  SysVideoDriver : TVideoDriver = (
+    InitDriver : @SysInitVideo;
+    DoneDriver : @SysDoneVideo;
+    UpdateScreen : @SysUpdateScreen;
+    ClearScreen : @SysClearScreen;
+    SetVideoMode : @SysSetVideoMode;
+    GetVideoModeCount : @SysGetVideoModeCount;
+    GetVideoModeData : @SysGetVideoModeData;
+    SetCursorPos : @SysSetCursorPos;
+    GetCursorType : @SysGetCursorType;
+    SetCursorType : @SysSetCursorType;
+    GetCapabilities : @SysGetCapabilities
+
+  );
+
+
+initialization
+  SetVideoDriver(SysVideoDriver);
+end.