-
Notifications
You must be signed in to change notification settings - Fork 3
/
gmouse.pas
108 lines (82 loc) · 2.1 KB
/
gmouse.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
unit gmouse;
{$L c_utils.o}
{***************************
Mouse Utilities unit for IronSeed
Channel 7
Destiny: Virtual
Copyright 1994
***************************}
interface
type
mouseicontype = array[0..15,0..15] of byte;
mousetype =
object
error: boolean;
function x:Integer;
function y:integer;
procedure setmousecursor(n: integer);
function getstatus : boolean;
end;
var
mouse: mousetype;
oldmouseexitproc: pointer;
mdefault: mouseicontype;
procedure mousehide;cdecl; external;
procedure mousesetcursor(i: mouseicontype); cdecl; external;
procedure mouseshow; cdecl; external;
procedure mousemove; cdecl; external;
implementation
function mouse_get_status: char;cdecl ; external;
function mouse_get_x: dword;cdecl ; external;
function mouse_get_y: dword;cdecl ; external;
function mousetype.getstatus:boolean;
begin
getstatus:=boolean(mouse_get_status);
end;
function mouseinitialize: boolean; external;
function mousetype.x:integer;
begin
x:=integer(mouse_get_x);
end;
function mousetype.y:integer;
begin
y:=integer(mouse_get_y);
end;
procedure errorhandler(s: string; errtype: integer);
begin
writeln;
case errtype of
1: writeln('File Error: ',s);
2: writeln('Mouse Error: ',s);
3: writeln('Sound Error: ',s);
4: writeln('EMS Error: ',s);
5: writeln('Fatal File Error: ',s);
6: writeln('Program Error: ',s);
7: writeln('Music Error: ',s);
end;
halt(4);
end;
procedure mousetype.setmousecursor(n: integer);
type
weaponicontype= array[0..19,0..19] of byte;
var i: integer;
f: file of weaponicontype;
tempicon: ^weaponicontype;
begin
new(tempicon);
assign(f,'data/weapicon.dta');
reset(f);
if ioresult<>0 then errorhandler('weapicon.dta',1);
seek(f,n+87);
if ioresult<>0 then errorhandler('weapicon.dta',5);
read(f,tempicon^);
if ioresult<>0 then errorhandler('weapicon.dta',5);
close(f);
for i:=0 to 15 do
move(tempicon^[i],mdefault[i],16);
mousesetcursor(mdefault);
dispose(tempicon);
end;
begin
mouse.setmousecursor(0);
end.