← Back to branch summary

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

« back to all changes in this revision

Viewing changes to docs/go32ex/callback.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:
docs/go32ex/callback.pp
1
 
{$ASMMODE ATT}
2
 
{$MODE FPC}
3
 
 
4
 
uses
5
 
        crt,
6
 
        go32;
7
 
 
8
 
const
9
 
        mouseint = $33;
10
 
 
11
 
var
12
 
        mouse_regs    : trealregs; external name '___v2prt0_rmcb_regs';
13
 
        mouse_seginfo : tseginfo;
14
 
 
15
 
var
16
 
        mouse_numbuttons : longint;
17
 
 
18
 
        mouse_action : word;
19
 
        mouse_x, mouse_y : Word;
20
 
        mouse_b : Word;
21
 
 
22
 
        userproc_installed : Longbool;
23
 
        userproc_length : Longint;
24
 
        userproc_proc : pointer;
25
 
 
26
 
procedure callback_handler; assembler;
27
 
asm
28
 
   pushw %ds
29
 
   pushl %eax
30
 
   movw %es, %ax
31
 
   movw %ax, %ds
32
 
 
33
 
   cmpl $1, USERPROC_INSTALLED
34
 
   jne .LNoCallback
35
 
   pushal
36
 
   movw DOSmemSELECTOR, %ax
37
 
   movw %ax, %fs
38
 
   call *USERPROC_PROC
39
 
   popal
40
 
.LNoCallback:
41
 
 
42
 
   popl %eax
43
 
   popw %ds
44
 
 
45
 
   pushl %eax
46
 
   movl (%esi), %eax
47
 
   movl %eax, %es: 42(%edi)
48
 
   addw $4, %es:46(%edi)
49
 
   popl %eax
50
 
   iret
51
 
end;
52
 
procedure mouse_dummy; begin end;
53
 
 
54
 
procedure textuserproc;
55
 
begin
56
 
        mouse_b := mouse_regs.bx;
57
 
        mouse_x := (mouse_regs.cx shr 3) + 1;
58
 
        mouse_y := (mouse_regs.dx shr 3) + 1;
59
 
end;
60
 
 
61
 
procedure install_mouse(userproc : pointer; userproclen : longint);
62
 
var r : trealregs;
63
 
begin
64
 
        r.eax := $0; realintr(mouseint, r);
65
 
        if (r.eax <> $FFFF) then begin
66
 
                Writeln('No Microsoft compatible mouse found');
67
 
                Writeln('A Microsoft compatible mouse driver is necessary ',
68
 
                        'to run this example');
69
 
                halt;
70
 
        end;
71
 
        if (r.bx = $ffff) then mouse_numbuttons := 2
72
 
        else mouse_numbuttons := r.bx;
73
 
        Writeln(mouse_numbuttons, ' button Microsoft compatible mouse ',
74
 
                ' found.');
75
 
        if (userproc <> nil) then begin
76
 
                userproc_proc := userproc;
77
 
                userproc_installed := true;
78
 
                userproc_length := userproclen;
79
 
                lock_code(userproc_proc, userproc_length);
80
 
        end else begin
81
 
                userproc_proc := nil;
82
 
                userproc_length := 0;
83
 
                userproc_installed := false;
84
 
        end;
85
 
        lock_data(mouse_x, sizeof(mouse_x));
86
 
        lock_data(mouse_y, sizeof(mouse_y));
87
 
        lock_data(mouse_b, sizeof(mouse_b));
88
 
        lock_data(mouse_action, sizeof(mouse_action));
89
 
 
90
 
        lock_data(userproc_installed, sizeof(userproc_installed));
91
 
        lock_data(userproc_proc, sizeof(userproc_proc));
92
 
 
93
 
        lock_data(mouse_regs, sizeof(mouse_regs));
94
 
        lock_data(mouse_seginfo, sizeof(mouse_seginfo));
95
 
        lock_code(@callback_handler,
96
 
                longint(@mouse_dummy)-longint(@callback_handler));
97
 
        get_rm_callback(@callback_handler, mouse_regs, mouse_seginfo);
98
 
        r.eax := $0c; r.ecx := $7f;
99
 
        r.edx := longint(mouse_seginfo.offset);
100
 
        r.es := mouse_seginfo.segment;
101
 
        realintr(mouseint, r);
102
 
        r.eax := $01;
103
 
        realintr(mouseint, r);
104
 
end;
105
 
 
106
 
procedure remove_mouse;
107
 
var
108
 
        r : trealregs;
109
 
begin
110
 
        r.eax := $02; realintr(mouseint, r);
111
 
        r.eax := $0c; r.ecx := 0; r.edx := 0; r.es := 0;
112
 
        realintr(mouseint, r);
113
 
        free_rm_callback(mouse_seginfo);
114
 
        if (userproc_installed) then begin
115
 
                unlock_code(userproc_proc, userproc_length);
116
 
                userproc_proc := nil;
117
 
                userproc_length := 0;
118
 
                userproc_installed := false;
119
 
        end;
120
 
        unlock_data(mouse_x, sizeof(mouse_x));
121
 
        unlock_data(mouse_y, sizeof(mouse_y));
122
 
        unlock_data(mouse_b, sizeof(mouse_b));
123
 
        unlock_data(mouse_action, sizeof(mouse_action));
124
 
 
125
 
        unlock_data(userproc_proc, sizeof(userproc_proc));
126
 
        unlock_data(userproc_installed, sizeof(userproc_installed));
127
 
 
128
 
        unlock_data(mouse_regs, sizeof(mouse_regs));
129
 
        unlock_data(mouse_seginfo, sizeof(mouse_seginfo));
130
 
        unlock_code(@callback_handler,
131
 
                longint(@mouse_dummy)-longint(@callback_handler));
132
 
        fillchar(mouse_seginfo, sizeof(mouse_seginfo), 0);
133
 
end;
134
 
 
135
 
 
136
 
begin
137
 
        install_mouse(@textuserproc, 400);
138
 
        Writeln('Press any key to exit...');
139
 
        while (not keypressed) do begin
140
 
                gotoxy(1, wherey);
141
 
                write('MouseX : ', mouse_x:2, ' MouseY : ', mouse_y:2,
142
 
                        ' Buttons : ', mouse_b:2);
143
 
        end;
144
 
        remove_mouse;
145
 
end.
 
 
b'\\ No newline at end of file'