program vl;
{Videotext über LPT auslesen}
{$G+}
uses crt;
function ReadByte:Byte; assembler;
{PE: DX=Portadresse LPT, VR: AX}
asm mov al,$10; out dx,al ;{TAKT=L 0 1 0 0 0 0 }
inc dx
in al,dx ;{Low-Nibble 3x21 0xxx}
dec dx
add ax,ax
add al,al
shl ax,3 ;{AH=xxxx 3210}
mov al,$14; out dx,al ;{TAKT=H 0 1 0 1 0 0 }
mov al,$10; out dx,al ;{TAKT=L 0 1 0 0 0 0 }
inc dx
in al,dx ;{High-Nibble 7x65 4xxx}
dec dx
add ax,ax ;{AX=xxx3 2107 x654 xxxx}
add al,al ;{AX=xxx3 2107 654x xxxx}
shl ax,3 ;{AH=3210 7654}
mov al,$14; out dx,al ;{TAKT=H 0 1 0 1 0 0 }
xchg al,ah
ror al,4
end;
const
IOA: Word=$378;
IRQ: Byte=7;
Stat: Byte=0;
Pref: Byte=0;
type
TVTLine=record
case integer of
0: (data: array[0..43] of Byte);
1: (ch: array[0..43] of Char);
2: (siz: Byte; {Länge der Struktur (44=2Ch)}
vsy: Byte; {umlaufende Nummer der Vertikalaustastlücke}
mag: Byte; {Magazin (Hunderter), hamming-kodiert}
lin: Byte; {Zeilennummer, hamming-kodiert}
txt: array[0..39] of Byte); {eine Videotext-Zeile, mit Parität}
end;
var
Buffer: array[0..599] of TVTLine; {1s Puffer bei 12 Zeilen pro Halbbild}
const
BufWr: Word=ofs(Buffer);
BufRd: Word=ofs(Buffer); {Ausgangspunkt: leerer Puffer}
procedure ReadRAM; assembler; { RSR RDR /OE TKT QRY RCV}
asm mov dx,[IOA]
mov al,$06; out dx,al ;{Abfr. Zähler 0 0 0 1 1 0 }
mov al,$02; out dx,al ;{TAKT=L 0 0 0 0 1 0 }
mov al,$06; out dx,al ;{TAKT=H 0 0 0 1 1 0 }
mov al,$24; out dx,al ;{/OE aktiv 1 0 0 1 0 0 }
mov al,$04; out dx,al ;{kein RSR 1 0 0 1 0 0 }
inc dx
in al,dx
dec dx
add ax,ax
add al,al
shr ax,5
and al,0Fh
jz @@nf ;{kein Fehler}
test al,3
jnz @@nf
or [Stat],1 ;{Fehler aufgetaucht}
@@nf: mov ah,al
shr ah,2 ;{tabellenfreie Konversion}
sub al,ah ;{Zeilen:=Nibble - Nibble div 3}
jz @@e
mov ch,al
mov bl,al
shl bl,4 ;{High-Nibble = Zeilen pro Austastlücke}
mov bh,[Pref]
mov al,$02; out dx,al ;{TAKT=L 0 0 0 0 1 0 }
mov al,$06; out dx,al ;{TAKT=H 0 0 0 1 1 0 }
mov di,[BufWr]
@@l2: inc bl ;{Low-Nibble = aktuelle Zeile in Lücke}
mov [di],bx
add di,2
mov cl,42
@@l1: call ReadByte
mov [di],al
inc di
dec cl
jnz @@l1
cmp di,OFFSET Buffer + TYPE Buffer
jc @@1
mov di,OFFSET Buffer
@@1: cmp di,[BufRd]
jnz @@2
or [Stat],80h ;{Puffer gerade voll}
jmp @@3
@@2: test [Stat],80h
jz @@3
or [Stat],40h ;{Pufferüberlauf}
mov [BufRd],di ;{Lesezeiger zwangsweise vorrücken}
@@3: dec ch
jnz @@l2
mov [BufWr],di
@@e: mov al,$2C; out dx,al ;{Reset RAM-Zä. 1 0 1 1 0 0 }
mov al,$0C; out dx,al ;{/OE aus 0 0 1 1 0 0 }
mov al,$0D; out dx,al ;{Empfangsbereit 0 0 1 1 0 1 }
inc [Pref]
end;
procedure EOI(IRQ:Byte); assembler; {Spezifischer IRQ, auch für "hohe" IRQs}
asm mov al,[IRQ]
cmp al,$0F
ja @@e
or al,$60
test al,$08
jz @@1
and al,$67
out $A0,al
mov al,$62
@@1: out $20,al
@@e:
end;
function HookIrq(IRQ:Byte; P:Pointer):Pointer; assembler;
asm mov al,[IRQ]
cmp al,$0F
ja @@e
add al,$08
cmp al,$10
jc @@1
add al,$60 {Hohe IRQ 70..77}
@@1: mov ah,35h
int 21h {GetIntVect ES:BX}
push ds
lds dx,[P]
mov ah,25h
int 21h
pop ds
mov dx,es
xchg bx,ax
@@e:
end;
procedure UnmaskIrq(IRQ:Byte); assembler;
asm mov cl,[IRQ]
cmp cl,$0F
ja @@e
mov ch,$FE
rol ch,cl
test cl,$08
jnz @@hi
in al,$21
and al,ch
out $21,al
jmp @@e
@@hi: in al,$A1
and al,ch
out $A1,al
@@e:
end;
procedure MaskIrq(IRQ:Byte); assembler;
asm mov cl,[IRQ]
cmp cl,$0F
ja @@e
mov ch,$01
rol ch,cl
test cl,$08
jnz @@hi
in al,$21
or al,ch
out $21,al
jmp @@e
@@hi: in al,$A1
or al,ch
out $A1,al
@@e:
end;
const
Sema:Byte=0; {Bit 0: Sperre, Bit 7: Anforderung}
function GetLine(var vl:TVTLine):Boolean; assembler;
{liest Zeile nach vl; ist keine vorhanden, dann sofortige Rückkehr mit FALSE}
asm inc [Sema]
mov si,[BufRd]
cmp si,[BufWr]
jnz @@ok
test [Stat],80h {Genau voll?}
stc
jz @@e {Genau leer und kann nichts lesen!}
@@ok: cld
les di,[vl]
mov cx,TYPE TVTLine / 2
rep movsw
cmp si,OFFSET Buffer + TYPE Buffer
jc @@1
mov si,OFFSET Buffer
@@1: mov [BufRd],si
and [Stat],7Fh {Nicht mehr voll; CY=0}
@@e: mov al,1
sbb al,0 {BOOLEAN-Meldung}
dec [Sema]
jns @@nrq
and [Sema],7Fh
push ax
inc [Sema]
call ReadRAM {ebenfalls "kritisch"}
dec [Sema]
pop ax
@@nrq:
end;
procedure Tick; assembler;
asm mov al,0A0h
out 43h,al
mov al,2
out 42h,al
end;
procedure ISR; interrupt;
begin
{ Inc(Pref);}
Tick;
{ asm sti end;}
if Sema=0 then begin
Inc(Sema);
asm sti end;
{ Write('*',Sema);}
ReadRAM;
asm cli end;
Dec(Sema);
end else begin
Sema:=Sema or $80;
end;
EOI(IRQ);
end;
procedure SetCharImg;
{zunächst ohne separierte Grafik wegen fehlender Umlaute}
procedure GenChar8x8(Code:Integer; var Buf); assembler;
asm mov ah,byte ptr Code
les di,Buf
cld
xor al,al
test ah,1 shl 6
jnz @@sep ;{Separierte Grafik}
call @@22 ;{Oberes Drittel: 3 Scanzeilen}
call @@2
call @@221 ;{Mittleres Drittel: 2 Scanzeilen}
call @@221 ;{Unteres Drittel: 3 Scanzeilen}
call @@2
jmp @@e
@@221: shr ah,2
@@22: call @@2
@@2: test ah,1
jz @@2a
or al,$F0
@@2a: test ah,2
jz @@2b
or al,$F
@@2b: stosb
xor al,al
ret
@@111:
shr ah,2
@@11: call @@1
@@1: test ah,1
jz @@1a
or al,$60
@@1a: test ah,2
jz @@2b
or al,$6
jmp @@2b
@@sep:
call @@11 ;{Oberes Drittel}
stosb ;{Leerzeile}
call @@111 ;{Mittleres Drittel}
stosb ;{Leerzeile}
call @@111 ;{Unteres Drittel}
@@e: end;
var
CharImg: array[0..1023] of Char; {Zeichenbildtabelle}
i: Integer;
SP: PChar;
begin
SP:=CharImg;
for i:=0 to 63 do begin
GenChar8x8(i,SP^);
Inc(SP,8);
end;
asm mov bx,0800h
mov cx,40h
mov dx,0A0h {Zeichen von A0h..DFh}
lea ax,[CharImg]
push bp
mov bp,ax
push ss
pop es
mov ax,1110h
int 10h
pop bp
end;
end;
var
OldInt7: Pointer;
VTLine: TVTLine;
i,m,z,x,y: Integer;
C: Char;
Str: String[40];
Old0, Old2: Byte; {Merker für Port-Zustände}
OldExit: Pointer;
Graf:Boolean;
procedure Finalizer; far; {falls Laufzeitfehler oder Fatal-Abbruch}
begin
ExitProc:=OldExit;
Port[IOA+2]:=Old2 and not $10;
MaskIrq(IRQ);
HookIrq(IRQ,OldInt7);
end;
begin
TextMode(C80+font8x8);
SetCharImg;
Old0:=Port[IOA];
Old2:=Port[IOA+2] and $1F; {nicht unbeabsichtigt tristate schalten!}
OldExit:=ExitProc;
ExitProc:=@Finalizer; {Runtime-Fehler sicher "abfangen"}
OldInt7:=HookIrq(IRQ,@ISR);
UnmaskIrq(IRQ);
EOI(IRQ);
asm sti
in al,61h {Lautsprecher aktivieren}
or al,3
out 61h,al
end;
Port[IOA+2]:=Old2 or $10;
Port[IOA]:=$0D; {Empfangsbereit}
Str[0]:=#40;
WriteLn('STAT VSY LA LC M Z Text (ESC zum Beenden mit MODE CO80)');
WriteLn('■■■■ ■■■ ■■ ■■ ■ ■■ ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■');
{Falls es gar nicht erst zu dieser Ausschrift kommt, liegt eine zu hohe
Interruptfrequenz (mit Software-Selbsterregung:-) vor}
y:=3;
repeat
if GetLine(VTLine) then begin
GotoXY(1,y);
m:=VTLine.mag shr 1 and 1 or VTLine.mag shr 2 and 2
or VTLine.mag shr 3 and 4;
z:=VTLine.mag shr 7 and 1
or VTLine.lin shr 0 and 2
or VTLine.lin shr 1 and 4
or VTLine.lin shr 2 and 8
or VTLine.lin shr 3 and 16;
Graf:=false;
for i:=0 to 39 do begin
C:=Char(VTLine.txt[i] and $7F);
if C<#32 then begin
case C of
#0..#7: Graf:=false;
#16..#23: if (1<=z) and (z<=23) then Graf:=true;
end;
C:=' ';
end else if Graf then case C of
#32..#63: C:=Char(Byte(C)+$80); {ab A0h}
#96..#127: C:=Char(Byte(C)+$60); {ab C0h}
end else case C of
'@': C:=''; {Ersetzungen für deutschen VT}
'[': C:='Ä';
'\': C:='Ö';
']': C:='Ü';
'`': C:='°';
'{': C:='ä';
'|': C:='ö';
'}': C:='ü';
'~': C:='ß';
'': C:='■';
end;
Str[i+1]:=C;
end;
if z in [25..30] then HighVideo;
Write(Stat:4,VTLine.vsy:4,VTLine.siz shr 4:3,VTLine.siz and $0F:3,
m:2,z:3,Str:41);
NormVideo;
Inc(y); if y>Hi(WindMax)+1 then y:=3;
end else asm
mov ax,1680h
int 2Fh {Soft-Windows}
end;
{ while Port[IOA+1] and $40 =0 do;
write('*');
while Port[IOA+1] and $40 <>0 do;}
until keypressed;
C:=ReadKey;
case C of
#0: readkey;
#27: TextMode(CO80);
end;
Port[IOA]:=$2C; {Stop}
Port[IOA+2]:=Old2 and not $10;
MaskIrq(IRQ);
HookIrq(IRQ,OldInt7);
ExitProc:=OldExit;
Port[IOA+2]:=Old2;
Port[IOA]:=Old0;
end.
| Vorgefundene Kodierung: OEM (CP437) | 1
|
|
|