SecondReality/WATER/KOE.PAS
2017-09-24 01:45:36 +02:00

66 lines
No EOL
1.4 KiB
ObjectPascal

uses crt;
type pbuf = ^buf;
buf = array[0..64000] of byte;
var r,g,b : pbuf;
x,y : word;
f : file;
pal : array[0..768] of byte;
row : array[0..320*3-1] of byte;
procedure setrgb(c,r,g,b:byte);
begin
port[$3c8] := c;
port[$3c9] := r;
port[$3c9] := g;
port[$3c9] := b;
end;
procedure waitk;
var ch : char;
begin
ch := readkey;
if ch = #0 then ch := readkey;
end;
begin
asm
mov ax,$13
int $10
end;
getmem(r,64000);
getmem(g,64000);
getmem(b,64000);
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:k1.mtv');
reset(f,1);
seek(f,8);
for y := 0 to 199 do
begin
blockread(f,row,320*3);
for x := 0 to 319 do r^[x+y*320] := row[x*3+0];
for x := 0 to 319 do g^[x+y*320] := row[x*3+1];
for x := 0 to 319 do b^[x+y*320] := row[x*3+2];
end;
close(f);
{ move(g^,mem[$a000:0],64000);}
for y := 250 downto 1 do
for x := 0 to 64000 do if (r^[x] = y) and (g^[x] and 1 = 1) then mem[$a000:x] := 255;
waitk;
freemem(r,64000);
freemem(g,64000);
freemem(b,64000);
end.