{ ------------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.                   }
{ (c) 1991-1999 Peter Mandrella                                       }
{ (c) 2000-2001 OpenXP-Team                                           }
{ (c) 2002-2025 FreeXP, http://www.freexp.de                          }
{ CrossPoint ist eine eingetragene Marke von Peter Mandrella.         }
{                                                                     }
{ Die Nutzungsbedingungen fuer diesen Quelltext finden Sie in der     }
{ Datei SLIZENZ.TXT oder auf http://www.crosspoint.de/oldlicense.html }
{ ------------------------------------------------------------------- }

(***********************************************************)
(*                                                         *)
(*                       UNIT video                        *)
(*                                                         *)
(*                   Video-BIOS-Interface                  *)
(*  7/91                                                   *)
(***********************************************************)

UNIT video;

{$I XPDEFINE.INC}
{$O+,F+,A+}


{  ==================  Interface-Teil  ===================  }

interface

uses
  xpglobal;

const DPMS_On       = 0;    { Monitor an }
      DPMS_Standby  = 1;    { Stromsparstufe 1 }
      DPMS_Suspend  = 2;    { Stromsparstufe 2 }
      DPMS_Off      = 4;    { Monitor aus }

      vrows  : word = 80;                  { Anzahl Bildspalten  }
      vrows2 : word = 160;                 { Bytes / Zeile       }
      vlines : word = 25;                  { Anzahl Bildzeilen   }

var  vbase  : word;                        { Screen-Base-Adresse }
     vtype   : byte;

function  VideoType:byte;                  { 0=Herc, 1=CGA, 2=EGA, 3=VGA }
function  GetVideoMode:byte;
procedure SetVideoMode(mode:byte);

procedure SetBorder64(color:byte);         { EGA-Rahmenfarbe einstellen }
procedure SetBorder16(color:byte);         { CGA-Rahmenfarbe einstellen }
procedure SetBackIntensity;                { heller Hintergrund setzen }

function  SetVesaDpms(mode:byte):boolean;  { Bildschirm-Stromsparmodus }

function  GetScreenLines:byte;
function  GetScreenColumns:byte;
procedure SetScreenLines(lines:byte);      { Bildschirmzeilen setzen }
function  GetScanlines:byte;
procedure SetScanlines;
{$IFNDEF NO386}
procedure GetPal;
procedure SetPal;
{$ENDIF }
{ ================= Implementation-Teil ==================  }

implementation

uses
{$IFDEF BP }
  {$IFDEF DPMI }
  WinAPI,
  {$ENDIF}
{$ENDIF }
   fileio,typeform,xpfonts,dos;

{$IFNDEF NO386}
type
  TPal1 = array[1..17] of Byte;

type
  PPalTyp = ^TPalTyp;
  TPalTyp = array[0..255, 0..2] of Byte;

  { Verwalten der DAC-Farbpalette der VGA-Karte, jede beliebige 256-Farben
    Modi. Die Farbpalette wird direkt in die Grafikkarte geschrieben.
    Das ist ntig, da die nderung ber das BIOS zu langsam ist und bei den
    meisten Grafikkarten zu einem unschnen Flimmern fhrt. Bis jetzt ist
    mir kein Rechner bekannt, bei dem das direkte schreiben nicht
    funktioniert. }

  PVGAPal = ^TVGAPal;
  TVGAPal = object
    Pal: PPalTyp;

    constructor Init;
    destructor Done; virtual;

    { Speichert die Farbpalette in Pal in der Grafikkarte ab }
    procedure SetPal;

    { Liest die Farbpalette aus der VGA-Karte wieder aus }
    procedure GetPal;
  end;

var
  Pal1: ^TPal1;
  VGAPal: PVGAPal;
{$ENDIF }
{- BIOS-Routinen ----------------------------------------------}

{ Grafikkarte ermitteln: 0=Herc, 1=CGA, 2=EGA, 3=VGA
  und in vtype speichern }
procedure GetVideotype; assembler;
asm
         push  bp
         mov    ax,40h
         mov    es,ax
         cmp    byte ptr es:[49h],7    { Hercules? }
         jnz    @noherc
         mov    vtype,0
         mov    vbase,0b000h
         jmp    @ok

@noherc: mov    vbase,0b800h
         mov    ax,$1130
         mov    bh,2                   { 8x14-Font-Zeiger holen }
         xor    cx,cx
         int    $10
         jcxz   @iscga

         mov    ax,1a00h               { Display Combination - nur VGA }
         int    $10
         mov    vtype,3
         cmp    al,1ah
         jz     @ok
         mov    vtype,2
         jmp    @ok

@isCGA:  mov    vtype,1
@ok:     pop bp
end;

function  VideoType:byte;
begin
  VideoType := vtype;
end;

{ BIOS-Mode-Nr. setzen }
procedure SetVideoMode(mode:byte); assembler;
asm
         push bp
         mov    al,mode
         mov    bx,40
         cmp    al,2
         jb     @mode40
         shl    bx,1
@mode40: mov    vrows,bx
         shl    bx,1
         mov    vrows2,bx
         mov    ah,0
         int    $10
         pop bp
end;

{ EGA-Rahmenfarbe einstellen }
procedure SetBorder64(color:byte); assembler;
asm
         mov    ax,1001h
         mov    bh,color
         int    $10
end;

{ CGA-Rahmenfarbe einstellen }
procedure SetBorder16(color:byte); assembler;
asm
         mov    ah,0bh
         mov    bh,0
         mov    bl,color
         int    $10
end;

{ hellen Hintergr. akt. }
procedure SetBackIntensity; assembler;
asm
         mov    ax,1003h
         xor    bl,bl
         int    $10
end;

function getvideomode:byte;
begin
   getvideomode:=mem[Seg0040:$49];
end;

function getscreenlines:byte;
var
  regs : registers;
begin
  if vtype<2 then
    vlines:=25
  else with regs do
  begin
    ax:=$1130;
    bh:=0;
    intr($10,regs);
    vlines:=dl+1;
  end;
  getscreenlines:=vlines;
end;

function getscreencolumns:byte;
begin
   getscreencolumns:=mem[Seg0040:$4A];
end;

{ Diese Funktion setzt die Anzahl der Bildschirmzeilen. }
{ untersttzte Werte:                                   }
{ Herc/CGA:  25                                         }
{ EGA:       25,26,29,31,35,38,43,50                    }
{ VGA:       25,26,28,30,33,36,40,44,50                 }

procedure SetScreenLines(lines:byte);
begin
  case vtype of
    0 : setvideomode(7);       { Hercules: nur 25 Zeilen }
    1 : setvideomode(3);       { CGA: nur 25 Zeilen }
    2 : begin
          setvideomode(3);
          case lines of        { EGA }
            25     : setuserchar(14);
            26     : setuserchar(13);
            27..29 : setuserchar(12);
            30..31 : setuserchar(11);
            32..35 : setuserchar(10);
            36..38 : setuserchar(9);
            39..43 : setuserchar(8);
            44..50 : setuserchar(7);
          end;
        end;
    3 : begin
          setvideomode(3);
          case lines of
            25     : setuserchar(16);
            26     : setuserchar(15);
            27..28 : setuserchar(14);
            29..30 : setuserchar(13);
            31..33 : setuserchar(12);
            34..36 : setuserchar(11);
            37..40 : setuserchar(10);
            41..44 : setuserchar(9);
            45..50 : setuserchar(8);
            51..57 : setuserchar(7);
          end;
        end;
  end;
  vlines:=lines;
end;

{ 0 = 350 Punkte (43 Zeilen), 1 = 400 Punkte }

function GetScanlines:byte;
begin
  GetScanlines:=mem[0:$489] shr 4 and 1;
end;

{ 400-Punkte-Modus setzen (wegen mglicher 43 Zeilen mit 350 Punkten) }

procedure SetScanlines; assembler;
asm
  mov ax,1202h
  mov bl,30h
  int 10h;
end;

function SetVesaDpms(mode:byte):boolean;  { Bildschirm-Stromsparmodus }
var regs : registers;
begin
  with regs do begin
    ax:=$4f10;
    bh:=mode;
    bl:=1;
    intr($10,regs);
    SetVesaDPMS:=(ax=$4f);
    end;
end;

{$IFNDEF NO386}
constructor TVGAPal.Init;
begin
  New(Pal);
end;

destructor TVGAPal.Done;
begin
  Dispose(Pal);
end;

procedure TVGAPal.SetPal; assembler;
asm
	mov al, 0
	mov dx, $03c8
	out dx, al

	push ds
	les di, Self
	lds si, es:[di].TVGAPal.Pal
	inc dx
	mov cx, 768
	rep outsb
	pop ds
end;

procedure TVGAPal.GetPal; assembler;
ASM
	mov ah, 10h
	mov al, 17h
	mov bx, 0
	mov cx, 256
	push ds
	lds si, Self
	les dx, ds:[si].TVGAPal.Pal
	int 10h
	pop ds
end;

procedure GetPal;
begin
  if vtype = 3 then
  begin
    GetMem(Pal1, SizeOf(TPal1));
    New(VGAPal, Init);
    VGAPal^.GetPal;
    asm
	    mov ax, 01009h
	    mov bx, 0
	    mov cx, 16
	    les dx, dword ptr Pal1
	    int 10h
    end;
  end;
end;

procedure SetPal;
begin
  if vtype = 3 then
  begin
   asm
	    mov ax, 01002h
	    mov bx, 0
	    mov cx, 16
	    les dx, dword ptr Pal1
	    int 10h
    end;
    VGAPal^.SetPal;
    Dispose(VGAPal, Done);
    FreeMem(pal1, SizeOf(TPal1));
  end;
end;
{$ENDIF}

begin
  getvideotype;
end.
