~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to api/go32v2/keyboard.inc

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
{
2
 
  System independent keyboard interface for go32v2
3
 
 
4
 
<<<<<<< keyboard.inc
5
 
  $Id: keyboard.inc,v 1.1 2000/07/13 06:29:38 michael Exp $
6
 
 
7
 
  WARNING this code needs %fs to contain the DOS memory selector
8
 
  don't forget to reload it after calling C functions
9
 
  that could change it PM
10
 
=======
11
 
  $Id: keyboard.inc,v 1.1 2000/07/13 06:29:38 michael Exp $
12
 
>>>>>>> 1.3
13
 
}
14
 
uses
15
 
  go32;
16
 
 
17
 
procedure InitKeyboard;
18
 
begin
19
 
end;
20
 
 
21
 
procedure DoneKeyboard;
22
 
begin
23
 
end;
24
 
 
25
 
function GetKeyEvent: TKeyEvent;
26
 
var
27
 
  regs : trealregs;
28
 
begin
29
 
  if PendingKeyEvent<>0 then
30
 
   begin
31
 
     GetKeyEvent:=PendingKeyEvent;
32
 
     PendingKeyEvent:=0;
33
 
     exit;
34
 
   end;
35
 
  regs.ah:=$10;
36
 
  realintr($16,regs);
37
 
  if (regs.al=$e0) and (regs.ah<>0) then
38
 
   regs.al:=0;
39
 
  GetKeyEvent:=regs.ax or ((mem[$40:$17] and $f) shl 16);
40
 
end;
41
 
 
42
 
 
43
 
function PollKeyEvent: TKeyEvent;
44
 
var
45
 
  regs : trealregs;
46
 
begin
47
 
  if PendingKeyEvent<>0 then
48
 
   exit(PendingKeyEvent);
49
 
  regs.ah:=$11;
50
 
  realintr($16,regs);
51
 
  if (regs.realflags and zeroflag<>0) then
52
 
   exit(0);
53
 
  if (regs.al=$e0) and (regs.ah<>0) then
54
 
   regs.al:=0;
55
 
  PollKeyEvent:=regs.ax or ((mem[$40:$17] and $f) shl 16);
56
 
end;
57
 
 
58
 
 
59
 
function PollShiftStateEvent: TKeyEvent;
60
 
begin
61
 
  PollShiftStateEvent:=((mem[$40:$17] and $f) shl 16);
62
 
end;
63
 
 
64
 
 
65
 
{ Function key translation }
66
 
type
67
 
  TTranslationEntry = packed record
68
 
    Min, Max: Byte;
69
 
    Offset: Word;
70
 
  end;
71
 
const
72
 
  TranslationTableEntries = 12;
73
 
  TranslationTable: array [1..TranslationTableEntries] of TTranslationEntry =
74
 
    ((Min: $3B; Max: $44; Offset: kbdF1),   { function keys F1-F10 }
75
 
     (Min: $54; Max: $5D; Offset: kbdF1),   { Shift fn keys F1-F10 }
76
 
     (Min: $5E; Max: $67; Offset: kbdF1),   { Ctrl fn keys F1-F10 }
77
 
     (Min: $68; Max: $71; Offset: kbdF1),   { Alt fn keys F1-F10 }
78
 
     (Min: $85; Max: $86; Offset: kbdF11),  { function keys F11-F12 }
79
 
     (Min: $87; Max: $88; Offset: kbdF11),  { Shift+function keys F11-F12 }
80
 
     (Min: $89; Max: $8A; Offset: kbdF11),  { Ctrl+function keys F11-F12 }
81
 
     (Min: $8B; Max: $8C; Offset: kbdF11),  { Alt+function keys F11-F12 }
82
 
     (Min:  71; Max:  73; Offset: kbdHome), { Keypad keys kbdHome-kbdPgUp }
83
 
     (Min:  75; Max:  77; Offset: kbdLeft), { Keypad keys kbdLeft-kbdRight }
84
 
     (Min:  79; Max:  81; Offset: kbdEnd),  { Keypad keys kbdEnd-kbdPgDn }
85
 
     (Min: $52; Max: $53; Offset: kbdInsert));
86
 
 
87
 
 
88
 
function TranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
89
 
var
90
 
  I: Integer;
91
 
  ScanCode: Byte;
92
 
begin
93
 
  if KeyEvent and $03000000 = $03000000 then
94
 
   begin
95
 
     if KeyEvent and $000000FF <> 0 then
96
 
      begin
97
 
        TranslateKeyEvent := KeyEvent and $00FFFFFF;
98
 
        exit;
99
 
      end
100
 
     else
101
 
      begin
102
 
        { This is a function key }
103
 
        ScanCode := (KeyEvent and $0000FF00) shr 8;
104
 
        for I := 1 to TranslationTableEntries do
105
 
         begin
106
 
           if (TranslationTable[I].Min <= ScanCode) and (ScanCode <= TranslationTable[I].Max) then
107
 
            begin
108
 
              TranslateKeyEvent := $02000000 + (KeyEvent and $00FF0000) +
109
 
                (ScanCode - TranslationTable[I].Min) + TranslationTable[I].Offset;
110
 
              exit;
111
 
            end;
112
 
         end;
113
 
      end;
114
 
   end;
115
 
  TranslateKeyEvent := KeyEvent;
116
 
end;
117
 
 
118
 
 
119
 
function TranslateKeyEventUniCode(KeyEvent: TKeyEvent): TKeyEvent;
120
 
begin
121
 
  TranslateKeyEventUniCode := KeyEvent;
122
 
  ErrorHandler(errKbdNotImplemented, nil);
123
 
end;
124
 
 
125
 
{
126
 
  $Log: keyboard.inc,v $
127
 
  Revision 1.1  2000/07/13 06:29:38  michael
128
 
  + Initial import
129
 
 
130
 
  Revision 1.1  2000/01/06 01:20:30  peter
131
 
    * moved out of packages/ back to topdir
132
 
 
133
 
  Revision 1.2  1999/12/10 12:42:26  pierre
134
 
   * several mods to handle different keyboard layouts
135
 
 
136
 
  Revision 1.3  1999/11/24 23:36:56  peter
137
 
    * moved to packages dir
138
 
 
139
 
  Revision 1.2  1998/12/12 19:13:00  peter
140
 
    * keyboard updates
141
 
    * make test target, make all only makes units
142
 
 
143
 
  Revision 1.1  1998/12/04 12:48:27  peter
144
 
    * moved some dirs
145
 
 
146
 
  Revision 1.3  1998/11/01 20:28:26  peter
147
 
    * fixed strange al=$e0 after int $16 call
148
 
 
149
 
  Revision 1.2  1998/10/28 21:18:24  peter
150
 
    * more fixes
151
 
 
152
 
  Revision 1.1  1998/10/26 11:31:47  peter
153
 
    + inital include files
154
 
 
155
 
}