program fbtest;
uses dos;
const
LptBase: Word=$378;
SC=$40; {D6, Serieller Takt}
SD=$20; {D5, Serielle Daten}
TA=$40; {ACK, Tastenabfrage}
A=$02;
B=$08;
C=$10;
D=$40;
E=$20;
F=$01;
G=$04;
H=$80;
Ziffer: array[0..35] of Byte=(
A+B+C+D+E+F , {0}
B+C, {1}
A+B+ D+E+ G, {2}
A+B+C+D+ G, {3}
B+C+ F+G, {4}
A+ C+D+ F+G, {5}
A+ C+D+E+F+G, {6}
A+B+C , {7}
A+B+C+D+E+F+G, {8}
A+B+C+D+ F+G, {9}
A+B+C+ E+F+G, {A}
C+D+E+F+G, {b}
A+ D+E+F , {C}
B+C+D+E+ G, {d}
A+ D+E+F+G, {E}
A+ E+F+G, {F}
A+ C+D+E+F , {G}
B+C+ E+F+G, {H}
E+F , {I}
A+B+C+D+E , {J}
A+ C+ E+F+G, {K}
D+E+F , {L}
A+B+C+ E+F , {M}
C+ E+ G, {n}
C+D+E+ G, {o}
A+B+ E+F+G, {P}
A+B+C+ F+G, {q}
E+ G, {r}
A+ C+D+ F+G, {S=5}
D+E+F+G, {t}
B+C+D+E+F , {U}
C+D+E , {v}
B+C+D+E+F+G, {W}
G, {X=-}
B+C+D+ F+G, {Y}
A+B+ D+E+ G); {Z=2}
var
ShiftBits: array[0..4] of Byte;
KeyBits,KeyNew,KeyLast,KeyRepeat: Byte;
procedure SetNumber(i,b,d:Word); assembler;
{Ausgabe der Zahl i mit Zahlenbasis b auf das Display mit d Stellen
rechtsbündig}
asm mov ax,[i]
mov bx,[b] {Basis 10 oder 16}
mov di,offset ShiftBits
mov cx,[d]
@@l: xor dx,dx
div bx {AX=Ergebnis, DX=Rest}
mov si,dx
mov dl,byte ptr [Ziffer+si]
mov [di],dl
inc di
loop @@l
end;
procedure SetString(s: PChar); assembler;
asm les si,[s]
mov di,offset ShiftBits+3
mov bx,offset Ziffer
mov cx,4
@@l: mov al,es:[si]
or al,al
jz @@leer
inc si
sub al,'0'
cmp al,10
jc @@1
sub al,7
@@1: xlat {al:=[bx+(unsigned)al]}
@@leer: mov [di],al
dec di
loop @@l
end;
procedure ShiftOut; assembler;
asm mov dx,[LptBase]
mov bx,offset ShiftBits
in al,dx
mov cl,5
@@la: mov ch,80h
@@li: and al,not (SD or SC)
test [bx],ch
jnz @@1
or al,SD
@@1: out dx,al
or al,SC
out dx,al {Low-High-Flanke setzt Daten}
shr ch,1
jnz @@li
inc bx
loop @@la
or al,SD
out dx,al
end;
procedure WaitTick; assembler;
asm mov es,[Seg0040]
mov ax,es:[6Ch]
@@l: cmp ax,es:[6Ch]
jz @@l
end;
procedure star; begin write('*'); end;
procedure CheckKey; assembler;
asm mov dx,[LptBase]
mov [KeyBits],0
in al,dx
{ or al,SD
out dx,al {Datenleitung hochnehmen}
xchg ah,al
inc dx
in al,dx
dec dx
and al,TA {Taste abfragen, hier: 0 wenn Taste gedrückt}
xchg ah,al
jnz @@nokey
mov cx,7
@@l2: and al,not SC
out dx,al
or al,SC
out dx,al
loop @@l2 {Tastenbits auf 01111111 setzen}
and al,not (SC or SD)
out dx,al
or al,SC
out dx,al
or al,SD {und Datenleitung hochnehmen}
out dx,al
mov ch,80h
@@l3:
xchg ah,al
inc dx
mov cl,16
@@w1: in al,dx
dec cl
jnz @@w1
dec dx
and al,TA
xchg ah,al
jnz @@no3
or byte ptr [KeyBits],ch
@@no3:
and al,not SC
out dx,al
or al,SC {diese einzelne Null durchschieben}
out dx,al
shr ch,1
jnz @@l3
@@nokey:
end;
var
i: Integer;
th,tm,ts,ts100: Word;
curs: Byte;
flash: Byte;
freq: Word; {Hypothetische Frequenz}
anzmode: byte; {0=Frequenz, 1="FrEq"}
procedure HandleKey(Keys:Byte);
var
i,add: Word;
begin
if Keys and $11 <>0 then begin
if curs=$FF then curs:=0;
if (Keys and $01 <>0) and (curs>0) then dec(curs);
if (Keys and $10 <>0) and (curs<3) then inc(curs);
end;
if Keys and $42 <>0 then begin
add:=1;
for i:=curs downto 1 do add:=add*10;
if Keys and $40 <>0 then inc(freq,add) else dec(freq,add);
flash:=0;
end;
if Keys and $80 <>0 then begin
if curs<>$FF then curs:=$FF
else begin
boolean(anzmode):=not boolean(anzmode);
end;
end;
{ Write(Keys:4);}
end;
begin
ShiftBits[4]:=$FF;
GetTime(th,tm,ts,ts100);
freq:=th*100+tm;
repeat
case anzmode of
0: SetNumber(freq,10,4);
1: SetString('FREQ');
end;
if curs in [0..3] then begin
if flash=0 then flash:=9;
Dec(flash);
if flash<5 then ShiftBits[curs]:=ShiftBits[curs] and H;
end;
CheckKey;
if KeyBits<>0 then begin
Dec(KeyRepeat);
if (KeyRepeat=0) and (KeyLast<>0) then begin
HandleKey(KeyLast);
KeyRepeat:=2;
end;
KeyNew:=KeyBits and not KeyLast;
if KeyNew<>0 then begin
HandleKey(KeyNew);
KeyRepeat:=9;
end;
end;
KeyLast:=KeyBits;
ShiftOut;
WaitTick;
until KeyBits and $20 <>0;
end.
| Vorgefundene Kodierung: OEM (CP437) | 1
|
|
|