Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
{ TXTVGA.PAS                                                         }
{ Fonty pre teletext.                                                }
{                                                                    }
{ Datum:14.12.2017                              http://www.trsek.com }
 
{***************************************************************************}
{*******         INCLUDE - DATEI fur TOPTEXT-VGAfunktionen           *******}
{***************************************************************************}
{***************************************************************************}
procedure txtfonty;
BEGIN
  assign(f,'txtcz.vga');
  OpenCG;
 
{$I-} reset(f);
      errtest;
      read(f,cg);
      errtest; {$I+}
  CloseCG; close(f);
end;
 
{***************************************************************************}
procedure Normfonty;
BEGIN
  panic (0);
END;
 
{***************************************************************************}
procedure Matrix8x16;
ASSEMBLER;
  ASM
    CLI              {Interrupts sperren}
    mov   dx, $3cc
    in    al, dx
    and   al, $F3    {Clock 25,175 MHz}
    mov   dx, $3C2
    out   dx, al
    mov   dx, $3C4
    xor   al, al
    out   dx, al      {Index Reset Register}
    inc   dx
    inc   al
    out   dx, al      {Synchroner Sequencer-Reset}
    dec   dx
    out   dx, al      {Index Clocking Mode Register}
    inc   dx
    in    al, dx
    or    al, 1
    out   dx, al      {Bit 1 = 1, 8x16 Zeichenbox}
    xor   al, al
    dec   dx
    out   dx, al      { Index Reset Register }
    mov   al, 3
    inc   dx
    out   dx, al      {Reset Zustand beenden}
    sti               {Interrupts erlauben}
  end;
 
{***************************************************************************}
procedure Matrix9x16;
ASSEMBLER;
  ASM
    CLI              {Interrupts sperren}
    mov   dx, $3cc
    in    al, dx
    or    al, $4     {Clock 28,322 MHz}
    mov   dx, $3C2
    out   dx, al
    mov   dx, $3C4
    xor   al, al
    out   dx, al      {Index Reset Register}
    inc   dx
    inc   al
    out   dx, al      {Synchroner Sequencer-Reset}
    dec   dx
    out   dx, al      {Index Clocking Mode Register}
    inc   dx
    in    al, dx
    and   al, $FE
    out   dx, al      {Bit 1 = 1, 8x16 Zeichenbox}
    xor   al, al
    dec   dx
    out   dx, al      { Index Reset Register }
    mov   al, 3
    inc   dx
    out   dx, al      {Reset Zustand beenden}
    sti               {Interrupts erlauben}
  end;
 
{***************************************************************************}
Procedure txtbarvy;
ASSEMBLER;
ASM
  mov    dx, $3DA
  in     al, dx
  mov    dx, $3c0
  mov    al, brown
  out    dx, al
  mov    al, 62         {Gelb}
  out    dx, al
  mov    al, lightgray
  out    dx, al
  mov    al, 63         {Weiss}
  out    dx, al
  mov    al, red
  out    dx, al
  mov    al, 36         {hellrot}
  out    dx, al
  mov    al, $20
  out    dx, al
  mov    dx, $3DA
  in     al, dx         {Videozugriff-Freigabe}
end;
 
{***************************************************************************}
Procedure VGAbarvy;
ASSEMBLER;
ASM
  mov    dx, $3DA
  in     al, dx
  mov    dx, $3c0
  mov    al, brown
  out    dx, al
  mov    al, brown      {braun}
  out    dx, al
  mov    al, lightgray
  out    dx, al
  mov    al, lightgray  {hellgrau}
  out    dx, al
  mov    al, red
  out    dx, al
  mov    al, red        {rot}
  out    dx, al
  mov    al, $20
  out    dx, al
  mov    dx, $3DA
  in     al, dx         {Videozugriff-Freigabe}
end;
 
{***************************************************************************}
Procedure initScr(mode:boolean);
BEGIN
  IF mode THEN begin txtfonty; txtbarvy; matrix8x16 end
  else begin normfonty; vgabarvy; textmode(co80) end;
END;