← Back to branch summary

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

« back to all changes in this revision

Viewing changes to docs/go32ex/callback.pas

  • 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:
docs/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'