{$N+,A+,G+,F+,D-,E-,L-,R-,S-,Q-,Y-,I-}
unit screen;

interface

CONST
 VGA = $a000;

procedure set60hz;
procedure WaitVR;
procedure FlipScreen(source, dest : word);
procedure FlipScreen2(t, r, rand, from, where:word); {req precals rand-table}
procedure Clear(col:byte; size, where:word);
procedure DrawBarBG(move,col1,col2, h_bars:byte; where:word);
procedure set_border_color(col:byte);
procedure set_border_color_bios(col:byte);
procedure WriteFps(color:byte; curtime, T1, Aantal, where:word);
procedure Table_for_FlipScreen2(tip:byte; e:single; where:word);


implementation

uses text;

procedure set60hz;
begin
    port  [$3D4]:= $11;
    port  [$3D5]:= port[$3D5] and $7F;
    port  [$3C2]:= $E3;
    portw [$3D4]:= $0B06;
    portw [$3D4]:= $3E07;
    portw [$3D4]:= $C310;
    portw [$3D4]:= $8C11;
    portw [$3D4]:= $8F12;
    portw [$3D4]:= $9015;
    portw [$3D4]:= $0B16;
end;


procedure set60hz_alt;
begin
    port [$3D4]:= $11;
    port  [$3D5]:= port[$3D5] and $7F;
    port  [$3C2]:= port[$3CC] or $C0;
    portw [$3D4]:= $0B06;
    portw [$3D4]:= $3E07;
    portw [$3D4]:= $C310;
    portw [$3D4]:= $8C11;
    portw [$3D4]:= $8F12;
    portw [$3D4]:= $9015;
    portw [$3D4]:= $0B16;
end;



procedure WaitVR; Assembler;
ASM
  mov  dx, 3DAh
@w1:
    in   al, dx
    test al, 8h
  jnz  @w1
@w2:
    in   al, dx
    test al, 8h
  jz   @w2
End;

procedure FlipScreen(source, dest : word); Assembler;
asm
  mov dx, ds
  mov es, dest
  mov ds, source
  xor si, si
  xor di, di
  mov cx, 16000
  cld
  db $66; rep movsw
  mov ds, dx
end;


procedure Table_for_FlipScreen2(tip:byte; e:single; where:word);
var n,m:integer;
d:shortint;
begin
     case tip of
        {random table for glitch-effect}
     0: for n:=0 to 15 do for m:=0 to 255 do mem[where:word(m+n*256)]:=random(1+n);
     1:
        for n:=0 to 15 do for m:=0 to 255 do begin
            d:=round(sin(m/40)*n/e+n/e);
            if d<0 then d:=0;
            mem[where:word(m+n*256)]:=byte(d);
            end;
     end;
end;

procedure FlipScreen2(t ,r, rand, from, where:word); {req precals rand-table}
var y,vsi,vdi:word;
begin
vdi:=0;
for y:=0 to 199 do begin
    vsi:=vdi + mem[rand:(y+t shl 1) and 255+ (r shl 8)];
    asm
       push ds
       mov si, vsi
       mov di, vdi
       mov es, where
       mov ds, from
       mov cx, 320/4
       db $66; rep movsw
       pop ds
    end;
vdi:=vdi+320;
end;
end;


procedure Clear(col:byte; size, where:word);assembler;
asm
  mov es, where
  mov al, col
  mov ah, al
  mov bx, ax
  db $66; shl ax, 16
  mov ax, bx
  mov cx, size
  shr cx, 2
  xor di,di
  cld
  db $66; rep stosw
END;

procedure DrawBarBG(move,col1,col2, h_bars:byte; where:word);assembler;
asm
    mov es, where
{----------------------self_modify------------------------}
    mov dl, h_bars
    mov cs:[offset @h_bars+2], dl
    jmp @clear_prefetch; @clear_prefetch:
{---------------------------------------------------------}
    mov dh, move
    mov bl, col1
    mov bh, bl
    mov ax, bx
    db $66; shl ax, 16
    mov ax, bx
    mov cl, col2
    mov ch, cl
    mov bx, cx
    db $66; shl bx, 16
    mov bx, cx
    push bp
    db $66; mov bp, ax

    xor di, di
    xor si, si
    mov dl, 200
    @l:
       {poloski}
       db $66; mov ax, bp
       @h_bars: test dh, 16
       jz @skip_bar
       db $66; mov ax, bx
       @skip_bar:

       mov cx, 320/4
       db $66; rep stosw
    inc dh
    dec dl
    jnz @l
    pop bp
end;


procedure set_border_color(col:byte);assembler;
asm {set border color}
  cli
  mov dx, 3dah  { Input status register}
  in al,  dx    { Reading from this register resets attribute controller address/value flip-flop}
  mov dx, 3c0h  { Set dx to 0x3c0 == attribute controller port address}
  mov al, 31h   { Register number for overscan colour}
  out dx, al    { Set attribute address number}
  mov al, col   { The colour you want for overscan (index into external palette)}
  out dx, al    { Set attribute controller data register}
  sti
end;

procedure set_border_color_bios(col:byte);assembler;
asm
mov ax, 1001h
mov bh, col
int 10h
end;

var
start_time:word;
fps_str:string[6];
procedure WriteFps(color:byte; curtime, T1, Aantal, where:word);
var numframes:word;
begin
  numframes:=aantal and 127;
  if numframes = 0 then start_time:=curtime;
  if (curtime<>start_time) and (numframes>60) then begin
     str( round((60*numframes/ (curtime-start_time)) ), fps_str);
  end;

   DrawString_6x6_d(fps_str, 2,2, color,  where);
end;



end.