Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
{ VGAPROG.PAS                                                        }
{ Rutiny obsuhujuce VGA pre teletext.                                }
{                                                                    }
{ Datum:14.12.2017                              http://www.trsek.com }
 
unit vgaprog;
{ $D-,L-,R-,N-,E-,I+,V-,B-,S-,G+}
 
interface
  procedure OpenCG;             { Details siehe c't 12/91 im }
  procedure CloseCG;              { Artikel "Sch”ner mausen" }
  procedure Panic(Nr:Byte);      { Fur den Fall der F„lle... }
  procedure ErrTest;           { Abbruch bei File-I/O-Fehler }
 
  type  cg_ber = array[0..$1FFF] of byte;
 
  var   cg : cg_ber absolute $A000:0; { Zeichengenerator VGA }
        f  : file of cg_ber;          { enth„lt Zeichensatz  }
 
implementation
uses dos;
 
var regs:registers;
 
procedure OpenCG; { VGA-RAM von Zeichendarstellung auf }
begin INLINE              { Zeichengenerator umstellen }
( $FA/                {CLI}
  $1E/                {PUSH  DS}
  $8C/$C8/            {MOV   AX,CS}
  $8E/$D8/            {MOV   DS,AX}
  $BA/$C4/$03/        {MOV   DX,03C4}
  $B8/$00/$01/$EF/    {OUT   DX,0100}
  $B8/$02/$04/$EF/    {OUT   DX,0402}
  $B8/$04/$07/$EF/    {OUT   DX,0704}
  $B8/$00/$03/$EF/    {OUT   DX,0300}
  $FB/                {STI}
  $B2/$CE/            {MOV   DL,CE}
  $B8/$04/$02/$EF/    {OUT   DX,0204}
  $B8/$05/$00/$EF/    {OUT   DX,0005}
  $B8/$06/$00/$EF/    {OUT   DX,0006}
  $1F);               {POP   DS}
end; { Falls das Font-Žndern fehlschl„gt: manche VGA-Karten }
{ ben”tigen die hier und in CloseCG auskommentierten Zeilen }
{ Einige VGAs flimmern, wenn diese Zeilen aktiviert werden  }
 
procedure CloseCG; { und zurck }
begin inline
( $FA/                {CLI}
  $1E/                {PUSH  DS}
  $8C/$C8/            {MOV   AX,CS}
  $8E/$D8/            {MOV   DS,AX}
  $BA/$C4/$03/        {MOV   DX,03C4}
  $B8/$00/$01/$EF/    {OUT   DX,0100}
  $B8/$02/$03/$EF/    {OUT   DX,0302}
  $B8/$04/$03/$EF/    {OUT   DX,0304}
  $B8/$00/$03/$EF/    {OUT   DX,0300}
  $FB/                {STI}
  $B2/$CE/            {MOV   DL,CE}
  $B8/$04/$00/$EF/    {OUT   DX,0004}
  $B8/$05/$10/$EF/    {OUT   DX,1005}
  $B8/$06/$0E/$EF/    {OUT   DX,0E06}
  $B4/$0F/            {MOV   AH,0F}
  $CD/$10/            {INT   10}
  $3C/$07/            {CMP   AL,07}
  $75/$04/            {JNZ   +4}
  $B8/$06/$08/$EF/    {OUT   DX,0806}
  $1F);               {POP   DS}
end;
 
procedure Panic (Nr : Byte);
{Zeichensatz wieder in Ordnung bringen}
{ ax = $11 : Zeichensatz setzen
  al =   4 : Blockmatrix 8*16
  bl =   x  : Zeichensatz x }
begin
  IF Nr > 7 THEN Nr := 0;
  with regs do begin
    ax :=$1104; bl :=Nr; Intr($10,regs);
  end;
end;
 
procedure ErrTest;
{ Bei Dateifehlern harter Ausstieg mit Meldung }
VAR Fehler : Word;
begin
  Fehler := IOResult;
  if Fehler <> 0 then begin
     Panic(0); writeln ('Dateifehler : ',Fehler:3,#7); halt (1);
  end;
end;
 
begin
end.