forked from mtuomi/SecondReality
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathTESTI.PAS
executable file
·110 lines (97 loc) · 1.98 KB
/
TESTI.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
109
110
uses crt;
var f : file;
buf : array[0..41000] of byte;
pal : array[0..768] of byte;
font : array[0..320*38] of byte;
kuva : pointer;
x : word;
procedure setrgb(c,r,g,b:byte);
begin
port[$3c8] := c;
port[$3c9] := r;
port[$3c9] := g;
port[$3c9] := b;
end;
procedure waitr;
begin
setrgb(0,0,0,0);
asm
mov dx,$3da
@@13: in al,dx
test al,8
jnz @@13
@@14: in al,dx
test al,8
jz @@14
end;
setrgb(0,43,0,0);
end;
procedure joku;
begin
asm
mov ax,$a000
mov es,ax
mov si,offset buf
mov bx,offset font
mov dx,158*37
@a: lodsw
or ax,ax
je @no
mov cx,ax
@b: lodsw
mov di,ax
mov al,byte ptr ds:[bx]
mov byte ptr es:[di],al
loop @b
@no:
inc bx
dec dx
jnz @a
end;
end;
var a: byte;
begin
getmem(kuva,64000);
asm
mov ax,$13
int $10
end;
fillchar(font,sizeof(font),#15);
for x := 0 to sizeof(font) do font[x] := x and 15;
assign(f,'bkg.clx');
reset(f,1);
seek(f,10);
blockread(f,pal,768);
for x := 0 to 255 do setrgb(x,pal[x*3+0],pal[x*3+1],pal[x*3+2]);
{ blockread(f,mem[$a000:0],64000);}
close(f);
{
assign(f,'o:wat4.dat');
reset(f,1);
blockread(f,buf,filesize(f));
close(f);
joku;
assign(f,'o:wat3.dat');
reset(f,1);
blockread(f,buf,filesize(f));
close(f);
joku;
assign(f,'o:wat2.dat');
reset(f,1);
blockread(f,buf,filesize(f));
close(f);
joku;
}
assign(f,'o:\wat1.dat');
reset(f,1);
blockread(f,buf,filesize(f));
close(f);
{ joku;}
a := 157;
repeat
waitr;
joku;
for x := 0 to 38 do font[x*158+a] := x+1;
dec(a);
until keypressed;
end.