Un exemple de pilote : le pilote pour Capman

{$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

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;

function sortieanalogique(numero,valeur:word):word;
begin

sortieanalogique:=0;
(* il n'existe pas de sortie analogique pour Capman*)

function sortielogique(numero:word;valeur:boolean):word;
begin

sortielogique:=0;
(*il n'existe pas de sortie logique pour Capman*)

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;

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);

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);

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');