Delphi & Pascal (česká wiki)
{ 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 "Schner mausen" } procedure Panic(Nr:Byte); { Fur den Fall der Flle... } 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; { enthlt 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 fehlschlgt: manche VGA-Karten } { bentigen die hier und in CloseCG auskommentierten Zeilen } { Einige VGAs flimmern, wenn diese Zeilen aktiviert werden } procedure CloseCG; { und zurck } 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.