Un exemple de pilote : le pilote pour Capman
(menu Pilotes-DOS)
{$M 4096,0,4096}
(*$R+*)
program capman;
uses dos;
procedure signature;begin inline($90);inline($90);inline($90);end;
var numint:byte;
erreur:integer;
type str25=string[25];
const n0:str25='résistance 0'+chr(0);
n1:str25='résistance 1'+chr(0);
n2:str25='résistance 2'+chr(0);
n3:str25='résistance 3'+chr(0);
n1000:str25='sortie analogique nulle 0';
n2000:str25='contact 0'+chr(0);
n2001:str25='contact 1'+chr(0);
n2002:str25='contact 2'+chr(0);
n2003:str25='contact 3'+chr(0);
n3000:str25='sortie logique nulle 0';
n65535:pathstr='Capman = joystick';
Function Resistance (NumRes : byte):word;
Const ValMax = 7999;
Var Compteur,Pos : word;
Begin
Case NumRes of
0 : Pos := $01;
1 : Pos := $02;
2 : Pos := $04;
3 : Pos := $08;
end;
Compteur := 0;
Port[$201]:= Port[$201];
Repeat If Port[$201] and Pos = Pos then Inc(Compteur);
Until (Port[$201] and Pos = 0) or (Compteur >= ValMax);
Resistance:= Compteur
end;
Function Contact(NumCont : byte) : Boolean;
Begin
Case NumCont of
0 : Contact := Not(Port[$201] and $10 = $10);
1 : Contact:= Not(Port[$201] and $20 = $20);
2 : Contact:= Not(Port[$201] and $40 = $40);
3 : Contact := Not(Port[$201] and $80 = $80);
else contact := False;
end;
end;
function sortieanalogique(numero,valeur:word):word;
begin
sortieanalogique:=0;
(* il n'existe pas de sortie analogique pour Capman*)
end;
function sortielogique(numero:word;valeur:boolean):word;
begin
sortielogique:=0;
(*il n'existe pas de sortie logique pour Capman*)
end;
procedure mesure (flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp:word);interrupt;
var varloc:word;
{procédure échangeant les informations
avec le prog. principal}
begin
if cx=0 then case ax of
0..3 :begin inline($FA);varloc:=resistance(ax);inline($FB);end;
1000 : sortieanalogique(ax-1000,bx);
2000..2003 : if contact(ax-2000)
then varloc:=0 else varloc:=1;
3000 : if bx=1
then sortielogique(ax-3000,true)
else sortielogique(ax-3000,false)
else varloc:=0;
end;(*case*)
if cx>0
then case ax of
0 : varloc:=ord(n0[cx]);
1 : varloc:=ord(n1[cx]);
2 : varloc:=ord(n2[cx]);
3 : varloc:=ord(n3[cx]););
1000:varloc:=ord(n1000[cx]);
2000 : varloc:=ord(n2000[cx]);
2001 : varloc:=ord(n2001[cx]);
2002 : varloc:=ord(n2002[cx]);
2003 : varloc:=ord(n2003[cx]);
3000 : varloc:=ord(n3000[cx]);
65535 : varloc:=ord(n65535[cx]);
else varloc:=0;
end; (*case*)
bx:=varloc;
end;
procedure desinstalle;
var l_registres_8086:registers;
l_pointeur:pointer;
begin
getintvec(numint,l_pointeur);
if memw[seg(l_pointeur^):06]=$ABCD
then with l_registres_8086 do
begin
writeln('désinstalle le programme de l''interruption
',numint);
ES:=memw[seg(l_pointeur^):0];
setintvec(numint,pointer(meml[seg(l_pointeur^):02]));
es:=memw[es:$2C];
ah:=$49;
intr($21,l_registres_8086);
ES:=memw[seg(l_pointeur^):0];
ah:=$49;
intr($21,l_registres_8086);
end
else writeln('la signature n''a pas été
trouvée pour l''interruption ',numint);
end;
procedure installe;
begin
getintvec(numint,Gpointeur);
if memw[seg(Gpointeur^):06]=$ABCD
then begin writeln('j''enlève
l''ancien pilote');desinstalle;end;
memw[cseg:0]:=prefixseg;
getintvec(numint,pointer(meml[cseg:02]));
memw[cseg:06]:=$ABCD;
setintvec(numint, @mesure);
end;
begin (*programme principal du pilote*)
signature;
numint:=$FA;
writeln('Mesures par Capman ("joystick")');
if paramcount<>0 then val(paramstr(1),numint,erreur);
writeln('interruption choisie : ',numint);
if (paramcount>0) and (paramstr(paramcount)='-')
then desinstalle
else if erreur=0
then
begin
installe;
{l'interruption appellera dorénavant la procédure
"Mesure"}
writeln('prêt pour les mesures par capman');
keep(0);
end
else writeln ('erreur');
end.