← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to rtl/win32/wincrt.pp

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/win32/wincrt.pp
1
 
{
2
 
    $Id: wincrt.pp,v 1.6 2005/02/14 17:13:32 peter Exp $
3
 
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 1999-2000 by Florian Klaempfl
5
 
    member of the Free Pascal development team
6
 
 
7
 
    This is unit implements some of the crt functionality
8
 
    for the gui win32 graph unit implementation
9
 
 
10
 
    See the file COPYING.FPC, included in this distribution,
11
 
    for details about the copyright.
12
 
 
13
 
    This program is distributed in the hope that it will be useful,
14
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
15
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
16
 
 
17
 
 **********************************************************************}
18
 
unit wincrt;
19
 
 
20
 
  interface
21
 
 
22
 
    function readkey : char;
23
 
    function keypressed : boolean;
24
 
    procedure delay(ms : word);
25
 
 
26
 
    { dummy }
27
 
    procedure textmode(mode : integer);
28
 
 
29
 
    { plays the windows standard sound }
30
 
    { hz is ignored (at least on win95 }
31
 
    procedure sound(hz : word);
32
 
 
33
 
    { dummy }
34
 
    procedure nosound;
35
 
 
36
 
 
37
 
  var
38
 
     directvideo : boolean;
39
 
 
40
 
     { dummy }
41
 
     lastmode : word;
42
 
 
43
 
  implementation
44
 
 
45
 
    uses
46
 
       windows,graph;
47
 
 
48
 
    const
49
 
       keybuffersize = 32;
50
 
 
51
 
    var
52
 
       keyboardhandling : TCriticalSection;
53
 
       keybuffer : array[1..keybuffersize] of char;
54
 
       nextfree,nexttoread : longint;
55
 
 
56
 
    procedure inccyclic(var i : longint);
57
 
 
58
 
      begin
59
 
         inc(i);
60
 
         if i>keybuffersize then
61
 
           i:=1;
62
 
      end;
63
 
 
64
 
    procedure addchar(c : char);
65
 
 
66
 
      begin
67
 
         EnterCriticalSection(keyboardhandling);
68
 
         keybuffer[nextfree]:=c;
69
 
         inccyclic(nextfree);
70
 
         { skip old chars }
71
 
         if nexttoread=nextfree then
72
 
           begin
73
 
              // special keys are started by #0
74
 
              // so we've to remove two chars
75
 
              if keybuffer[nexttoread]=#0 then
76
 
                inccyclic(nexttoread);
77
 
              inccyclic(nexttoread);
78
 
           end;
79
 
         LeaveCriticalSection(keyboardhandling);
80
 
      end;
81
 
 
82
 
    function readkey : char;
83
 
 
84
 
      begin
85
 
         while true do
86
 
           begin
87
 
              EnterCriticalSection(keyboardhandling);
88
 
              if nexttoread<>nextfree then
89
 
                begin
90
 
                   readkey:=keybuffer[nexttoread];
91
 
                   inccyclic(nexttoread);
92
 
                   LeaveCriticalSection(keyboardhandling);
93
 
                   exit;
94
 
                end;
95
 
              LeaveCriticalSection(keyboardhandling);
96
 
              { give other threads a chance }
97
 
              Windows.Sleep(10);
98
 
           end;
99
 
      end;
100
 
 
101
 
    function keypressed : boolean;
102
 
 
103
 
      begin
104
 
         EnterCriticalSection(keyboardhandling);
105
 
         keypressed:=nexttoread<>nextfree;
106
 
         LeaveCriticalSection(keyboardhandling);
107
 
      end;
108
 
 
109
 
    procedure delay(ms : word);
110
 
 
111
 
      begin
112
 
         Sleep(ms);
113
 
      end;
114
 
 
115
 
    procedure textmode(mode : integer);
116
 
 
117
 
      begin
118
 
      end;
119
 
 
120
 
    procedure sound(hz : word);
121
 
 
122
 
      begin
123
 
         Windows.Beep(hz,500);
124
 
      end;
125
 
 
126
 
    procedure nosound;
127
 
 
128
 
      begin
129
 
      end;
130
 
 
131
 
    procedure addextchar(c : char);
132
 
 
133
 
      begin
134
 
         addchar(#0);
135
 
         addchar(c);
136
 
      end;
137
 
 
138
 
    const
139
 
       altkey : boolean = false;
140
 
       ctrlkey : boolean = false;
141
 
       shiftkey : boolean = false;
142
 
 
143
 
    function msghandler(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): Longint; stdcall;
144
 
 
145
 
      begin
146
 
         case amessage of
147
 
           WM_CHAR:
148
 
             begin
149
 
                addchar(chr(wparam));
150
 
             end;
151
 
           WM_KEYDOWN:
152
 
             begin
153
 
                case wparam of
154
 
                   VK_LEFT:
155
 
                     addextchar(#75);
156
 
                   VK_RIGHT:
157
 
                     addextchar(#77);
158
 
                   VK_DOWN:
159
 
                     addextchar(#80);
160
 
                   VK_UP:
161
 
                     addextchar(#72);
162
 
                   VK_INSERT:
163
 
                     addextchar(#82);
164
 
                   VK_DELETE:
165
 
                     addextchar(#83);
166
 
                   VK_END:
167
 
                     addextchar(#79);
168
 
                   VK_HOME:
169
 
                     addextchar(#71);
170
 
                   VK_PRIOR:
171
 
                     addextchar(#73);
172
 
                   VK_NEXT:
173
 
                     addextchar(#81);
174
 
                   VK_F1..VK_F10:
175
 
                     begin
176
 
                        if ctrlkey then
177
 
                          addextchar(chr(wparam+24))
178
 
                        else if altkey then
179
 
                          addextchar(chr(wparam+34))
180
 
                        else
181
 
                          addextchar(chr(wparam-11));
182
 
                     end;
183
 
                   VK_CONTROL:
184
 
                     ctrlkey:=true;
185
 
                   VK_MENU:
186
 
                     altkey:=true;
187
 
                   VK_SHIFT:
188
 
                     shiftkey:=true;
189
 
                end;
190
 
             end;
191
 
           WM_KEYUP:
192
 
             begin
193
 
                case wparam of
194
 
                   VK_CONTROL:
195
 
                     ctrlkey:=false;
196
 
                   VK_MENU:
197
 
                     altkey:=false;
198
 
                   VK_SHIFT:
199
 
                     shiftkey:=false;
200
 
                end;
201
 
             end;
202
 
         end;
203
 
         msghandler:=0;
204
 
      end;
205
 
 
206
 
    var
207
 
       oldexitproc : pointer;
208
 
 
209
 
    procedure myexitproc;
210
 
 
211
 
      begin
212
 
         exitproc:=oldexitproc;
213
 
         charmessagehandler:=nil;
214
 
         DeleteCriticalSection(keyboardhandling);
215
 
      end;
216
 
 
217
 
begin
218
 
   charmessagehandler:=@msghandler;
219
 
   nextfree:=1;
220
 
   nexttoread:=1;
221
 
   InitializeCriticalSection(keyboardhandling);
222
 
   oldexitproc:=exitproc;
223
 
   exitproc:=@myexitproc;
224
 
   lastmode:=0;
225
 
end.
226
 
{
227
 
  $Log: wincrt.pp,v $
228
 
  Revision 1.6  2005/02/14 17:13:32  peter
229
 
    * truncate log
230
 
 
231
 
}