← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcdocs/go32ex/callback.pas

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcdocs/go32ex/callback.pas
 
1
{ This program tries to give an example how to install a callback
 
2
procedure with the help of the GO32 unit.
 
3
 
 
4
It installs a callback which is supplied by any Microsoft compatible
 
5
mouse driver; at a specified mouse action this routine is called.
 
6
This callback must provide the services explained in the docs. The
 
7
main callback has to be in assembly, because it isn't possible to do
 
8
these services with pascal alone. But is written as general as
 
9
possible to provide maximum re-usability for other applications and
 
10
hence it simply calls a normal pascal user procedure in addition to
 
11
some initialization and callback service code, so you don't need to
 
12
hassle around with it too much.
 
13
 
 
14
Notes to this user procedure :
 
15
*) it should not last too long to execute it
 
16
*) ALL data and code touched in this proc MUST be locked BEFORE it is
 
17
called the first time
 
18
 
 
19
 
 
20
Used software interrupt calls (rough descriptions, only what's used):
 
21
 
 
22
Int 33h 0000h - Microsoft Mouse driver : Reset mouse
 
23
Input : AX = 0000h
 
24
Return : AX = FFFFh if successful
 
25
         BX = number of buttons (if FFFFh then mouse has 2 buttons)
 
26
 
 
27
Int 33h 0001h - Microsoft Mouse driver : Show mouse cursor
 
28
Input : AX = 0001h
 
29
Return : Mouse cursor shown on screen
 
30
 
 
31
Int 33h 0002h - Microsoft mouse driver : Hide mouse cursor
 
32
Input : AX = 0002h
 
33
Return : Hides mouse cursor again
 
34
 
 
35
 Int 33h 000Ch - Microsoft mouse driver : Install user callback
 
36
Input : AX = 000Ch
 
37
        CX = bit mask which tells the mouse driver at which actions
 
38
        the callback should be called, i.e. if button pressed, mouse
 
39
        moved etc.
 
40
        (In this example it's set to 7Fh so that the callback is
 
41
        called on every action)
 
42
        ES:EDX = pointer to callback procedure to call
 
43
 Note : The registers structure supplied to the callback contains
 
44
        valid mouse data when the handler is called.
 
45
  BX = button state information
 
46
  CX = mouse X coordinates
 
47
  DX = mouse Y coordinates
 
48
For more detailed information consult any mouse reference or
 
49
interrupt list.
 
50
}
 
51
{$ASMMODE ATT}
 
52
{$MODE FPC}
 
53
 
 
54
uses
 
55
        crt,
 
56
        go32;
 
57
 
 
58
const
 
59
        { the mouse interrupt number }
 
60
        mouseint = $33;
 
61
 
 
62
var
 
63
        { supplied register structure to the callback }
 
64
        mouse_regs    : trealregs; external name '___v2prt0_rmcb_regs';
 
65
        { real mode 48 bit pointer to the callback }
 
66
        mouse_seginfo : tseginfo;
 
67
 
 
68
var
 
69
        { number of mouse buttons }
 
70
        mouse_numbuttons : longint;
 
71
 
 
72
        { bit mask for the action which triggered the callback }
 
73
        mouse_action : word;
 
74
        { current mouse x and y coordinates }
 
75
        mouse_x, mouse_y : Word;
 
76
        { button state }
 
77
        mouse_b : Word;
 
78
 
 
79
        { is an additional user procedure installed }
 
80
        userproc_installed : Longbool;
 
81
        { length of additional user procedure }
 
82
        userproc_length : Longint;
 
83
        { pointer to user proc }
 
84
        userproc_proc : pointer;
 
85
 
 
86
{ callback control handler, calls a user procedure if installed }
 
87
 
 
88
{ callback control handler, calls a user procedure if installed }
 
89
procedure callback_handler; assembler;
 
90
asm
 
91
   pushw %ds
 
92
   pushl %eax
 
93
   movw %es, %ax
 
94
   movw %ax, %ds
 
95
 
 
96
   { give control to user procedure if installed }
 
97
   cmpl $1, USERPROC_INSTALLED
 
98
   jne .LNoCallback
 
99
   pushal
 
100
   movw DOSmemSELECTOR, %ax
 
101
   movw %ax, %fs  { set fs for FPC }
 
102
   call *USERPROC_PROC
 
103
   popal
 
104
.LNoCallback:
 
105
 
 
106
   popl %eax
 
107
   popw %ds
 
108
 
 
109
   pushl %eax
 
110
   movl (%esi), %eax
 
111
   movl %eax, %es: 42(%edi) { adjust stack }
 
112
   addw $4, %es:46(%edi)
 
113
   popl %eax
 
114
   iret
 
115
end;
 
116
{ This dummy is used to obtain the length of the callback control
 
117
function. It has to be right after the callback_handler() function.
 
118
}
 
119
procedure mouse_dummy; begin end;
 
120
 
 
121
{ This is the supplied user procedure. In this case we simply
 
122
transform the virtual 640x200 mouse coordinate system to a 80x25
 
123
text mode coordinate system }
 
124
procedure textuserproc;
 
125
begin
 
126
        { the mouse_regs record contains the real mode registers now }
 
127
        mouse_b := mouse_regs.bx;
 
128
        mouse_x := (mouse_regs.cx shr 3) + 1;
 
129
        mouse_y := (mouse_regs.dx shr 3) + 1;
 
130
end;
 
131
 
 
132
{ Description : Installs the mouse callback control handler and
 
133
handles all necessary mouse related initialization.
 
134
  Input : userproc - pointer to a user procedure, nil if none
 
135
          userproclen - length of user procedure
 
136
}
 
137
procedure install_mouse(userproc : pointer; userproclen : longint);
 
138
var r : trealregs;
 
139
begin
 
140
        { mouse driver reset }
 
141
        r.eax := $0; realintr(mouseint, r);
 
142
        if (r.eax <> $FFFF) then begin
 
143
                Writeln('No Microsoft compatible mouse found');
 
144
                Writeln('A Microsoft compatible mouse driver is necessary ',
 
145
                        'to run this example');
 
146
                halt;
 
147
        end;
 
148
        { obtain number of mouse buttons }
 
149
        if (r.bx = $ffff) then mouse_numbuttons := 2
 
150
        else mouse_numbuttons := r.bx;
 
151
        Writeln(mouse_numbuttons, ' button Microsoft compatible mouse ',
 
152
                ' found.');
 
153
        { check for additional user procedure, and install it if
 
154
        available }
 
155
        if (userproc <> nil) then begin
 
156
                userproc_proc := userproc;
 
157
                userproc_installed := true;
 
158
                userproc_length := userproclen;
 
159
                { lock code for user procedure }
 
160
                lock_code(userproc_proc, userproc_length);
 
161
        end else begin
 
162
                { clear variables }
 
163
                userproc_proc := nil;
 
164
                userproc_length := 0;
 
165
                userproc_installed := false;
 
166
        end;
 
167
        { lock code & data which is touched in the callback handler }
 
168
        lock_data(mouse_x, sizeof(mouse_x));
 
169
        lock_data(mouse_y, sizeof(mouse_y));
 
170
        lock_data(mouse_b, sizeof(mouse_b));
 
171
        lock_data(mouse_action, sizeof(mouse_action));
 
172
 
 
173
        lock_data(userproc_installed, sizeof(userproc_installed));
 
174
        lock_data(userproc_proc, sizeof(userproc_proc));
 
175
 
 
176
        lock_data(mouse_regs, sizeof(mouse_regs));
 
177
        lock_data(mouse_seginfo, sizeof(mouse_seginfo));
 
178
        lock_code(@callback_handler,
 
179
                longint(@mouse_dummy)-longint(@callback_handler));
 
180
        { allocate callback (supply registers structure) }
 
181
        get_rm_callback(@callback_handler, mouse_regs, mouse_seginfo);
 
182
        { install callback }
 
183
        r.eax := $0c; r.ecx := $7f;
 
184
        r.edx := longint(mouse_seginfo.offset);
 
185
        r.es := mouse_seginfo.segment;
 
186
        realintr(mouseint, r);
 
187
        { show mouse cursor }
 
188
        r.eax := $01;
 
189
        realintr(mouseint, r);
 
190
end;
 
191
 
 
192
procedure remove_mouse;
 
193
var
 
194
        r : trealregs;
 
195
begin
 
196
        { hide mouse cursor }
 
197
        r.eax := $02; realintr(mouseint, r);
 
198
        { remove callback handler }
 
199
        r.eax := $0c; r.ecx := 0; r.edx := 0; r.es := 0;
 
200
        realintr(mouseint, r);
 
201
        { free callback }
 
202
        free_rm_callback(mouse_seginfo);
 
203
        { check if additional userproc is installed, and clean up if
 
204
        needed }
 
205
        if (userproc_installed) then begin
 
206
                unlock_code(userproc_proc, userproc_length);
 
207
                userproc_proc := nil;
 
208
                userproc_length := 0;
 
209
                userproc_installed := false;
 
210
        end;
 
211
        { unlock used code & data }
 
212
        unlock_data(mouse_x, sizeof(mouse_x));
 
213
        unlock_data(mouse_y, sizeof(mouse_y));
 
214
        unlock_data(mouse_b, sizeof(mouse_b));
 
215
        unlock_data(mouse_action, sizeof(mouse_action));
 
216
 
 
217
        unlock_data(userproc_proc, sizeof(userproc_proc));
 
218
        unlock_data(userproc_installed, sizeof(userproc_installed));
 
219
 
 
220
        unlock_data(mouse_regs, sizeof(mouse_regs));
 
221
        unlock_data(mouse_seginfo, sizeof(mouse_seginfo));
 
222
        unlock_code(@callback_handler,
 
223
                longint(@mouse_dummy)-longint(@callback_handler));
 
224
        fillchar(mouse_seginfo, sizeof(mouse_seginfo), 0);
 
225
end;
 
226
 
 
227
 
 
228
begin
 
229
        install_mouse(@textuserproc, 400);
 
230
        Writeln('Press any key to exit...');
 
231
        while (not keypressed) do begin
 
232
                { write mouse state info }
 
233
                gotoxy(1, wherey);
 
234
                write('MouseX : ', mouse_x:2, ' MouseY : ', mouse_y:2,
 
235
                        ' Buttons : ', mouse_b:2);
 
236
        end;
 
237
        remove_mouse;
 
238
end.
 
 
b'\\ No newline at end of file'