program ptest;
{$DEFINE DRAWASM}
uses crt, dos;
var
xoffs, yoffs: integer;
frame, nticks: longint;
opt_vsync: boolean;
sintab: array [0..512] of integer;
procedure setmode(mode: integer);
begin
asm
mov ax, mode
int 10h
end
end;
procedure setpal(idx, r, g, b: byte);
begin
asm
mov dx, 3c8h
mov al, idx
out dx, al
inc dx
mov al, r
shr al, 2
out dx, al
mov al, g
shr al, 2
out dx, al
mov al, b
shr al, 2
out dx, al
end
end;
procedure vsync;
begin
asm
mov dx, 3dah
@invb:
in al, dx
and al, 8
jnz @invb
@notvb:
in al, dx
and al, 8
jz @notvb
end
end;
procedure draw;
var
i, j, y, idx, t: integer;
vmem: ^byte;
begin
idx := frame and $1ff;
xoffs := sintab[idx] shr 1;
idx := ((frame shl 1) + 64) and $1ff;
yoffs := sintab[idx] shr 2;
frame := frame + 1;
if opt_vsync = true then vsync;
{$IFNDEF DRAWASM}
vmem := ptr($a000, 0);
for i:=0 to 199 do
begin
y := i + yoffs;
for j:=0 to 319 do
begin
vmem^ := y xor (j + xoffs);
inc(vmem);
end;
end;
{$ELSE}
asm
mov ax, 0a000h
mov es, ax
xor di, di
xor cx, cx
@yloop:
mov si, cx
add cx, yoffs
xor dx, dx
@xloop:
mov ax, dx
add ax, xoffs
mov bx, ax
xor bl, cl
inc ax
xor al, cl
mov ah, al
mov al, bl
stosw
add dx, 2
cmp dx, 320
jnz @xloop
mov cx, si
inc cx
cmp cx, 200
jnz @yloop
end
{$ENDIF}
end;
procedure calclut;
var
i: integer;
theta: real;
begin
for i:=0 to 511 do
begin
theta := i * 6.283185 / 512.0;
sintab[i] := trunc(sin(theta) * 1024.0);
end;
end;
procedure timer_intr; interrupt;
begin
inc(nticks);
end;
var
i: integer;
c: char;
done: boolean;
sec: real;
orig_timer_intr: pointer;
begin
opt_vsync := true;
calclut;
setmode($13);
for i:=0 to 127 do
begin
setpal(i, i shl 1, 0, i);
setpal(i + 128, 127 - (i shl 1), 0, i + 128)
end;
nticks := 0;
GetIntVec($1c, orig_timer_intr);
SetIntVec($1c, addr(timer_intr));
frame := 0;
done := false;
repeat
while KeyPressed do
begin
case ReadKey of
#27: done := true;
'v': opt_vsync := not opt_vsync;
end;
end;
draw;
until done = true;
SetIntVec($1c, orig_timer_intr);
setmode(3);
sec := nticks / 18.2;
write(frame, ' frames in ', sec:0:1, ' seconds: ');
writeln(frame / sec:0:2, ' fps');
end.