program fbtest;
{$M $800,0,0}
{$S-}
uses uninst,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}
{Tasten}
const
ESC=$20;
CUU=$40;
INS=$80;
CUL=$10;
CUD=$02;
CUR=$01;
var
ShiftBits: array[0..4] of Byte;
KeyBits,KeyNew,KeyLast,KeyRepeat: Byte;
schieb: Byte; {Rechtsverschiebung auf Display}
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 cl,[schieb]
xor ch,ch
jcxz @@1
@@0: xor dx,dx
div bx
loop @@0
@@1: 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
@@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 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 (CUL+CUR+CUU+CUD) <>0 then begin
if anzmode and 1 =0 then begin
asm and curs,7Fh end;
if Keys and CUR <>0 then case curs of
1..4: dec(curs);
end;
if Keys and CUL <>0 then case curs of
0..3: inc(curs);
end;
if Keys and (CUU+CUD) <>0 then begin
add:=1;
for i:=curs downto 1 do add:=add*10;
if Keys and CUU <>0 then inc(freq,add) else dec(freq,add);
flash:=0;
end;
end else begin
if keys and (CUR+CUD) <>0 then anzmode:=(anzmode+2) mod 10;
if keys and (CUL+CUU) <>0 then anzmode:=(anzmode+8) mod 10;
end;
end;
if Keys and ESC <>0 then begin
curs:=curs xor $80; {Cursor ein/aus}
end;
if Keys and INS <>0 then begin
anzmode:=anzmode xor 1;
end;
end;
var
OldInt08: procedure;
function GetBiosTime:Word; assembler;
asm mov es,[Seg0040]
mov ax,es:[6Ch] {Ticks}
mov dx,60
mul dx {in DX die Minuten}
mov cx,dx
mov ax,es:[6Eh] {Stunden}
mov dx,100
mul dx
add ax,cx
end;
function HalfSecond:Boolean; assembler;
asm mov es,[Seg0040]
mov ax,es:[6Ch] {Ticks}
mov dx,60*60
mul dx {in DX die Sekunden}
shr ax,15 {MSB zu Bool(ean)}
end;
procedure NewInt08; interrupt;
begin
asm pushf end;
OldInt08;
case anzmode of
0,2,4,6: begin
schieb:=0;
if freq>9999 then schieb:=1;
if curs=0 then schieb:=0;
if curs=4 then schieb:=1;
SetNumber(freq,10,4);
ShiftBits[2-schieb]:=ShiftBits[2-schieb] or H;
if curs in [0..4] then begin
if flash=0 then flash:=9;
Dec(flash);
if flash<5 then ShiftBits[curs-schieb]:=ShiftBits[curs-schieb] and H;
end;
end;
8: begin
schieb:=0;
SetNumber(GetBiosTime,10,4);
if HalfSecond then ShiftBits[2]:=ShiftBits[2] or H;
end;
1: SetString('FREQ');
3: SetString('ANGL');
5: SetString('C');
7: SetString('PROG');
9: begin SetString('UHR'); ShiftBits[2]:=ShiftBits[2] and not B; end;
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;
end;
begin
RegisterTSR($0405); (*am Anfang mit zufälliger Zahl registrieren
Die wirkliche Uniquität ist nicht ganz so wichtig,
jedoch sollte die Zahl verändert werden:
- bei jedem neuen Programmprojekt
- bei Hinzunahme weiterer Interrupts im Projekt *)
if ParamStr(1)='/u' then begin
i:= RemoveTSR; (*TSR entfernen (das ist alles!)*)
case i of
-1: writeln('TSR entfernt');
-2: writeln('TSR nicht installiert - nichts zu entfernen');
-3: writeln('Speicherfehler beim Deinstallieren');
else writeln('Andere TSR stört, Interrupt ',i,' (dez!!) geklaut!');
end;
end else begin
if Installed then writeln('Ich bin schon installiert')
else begin
ShiftBits[4]:=$FF;
GetTime(th,tm,ts,ts100);
freq:=th*100+tm;
GetIntVec($08,@OldInt08);
uninst.SetIntVec($08,@NewInt08);
writeln('Ich residiere');
uninst.keep(0);
end;
end;
end.
| Vorgefundene Kodierung: OEM (CP437) | 1
|
|
|