program maniplp2; {compile avec c:\program\exe
en exe & tpu}
uses
crt,lpm16,time,dspwxms;
const
test = true;
tab = #09;
TREP = 1;
TDEL = 2;
TESSAI = 3;
TMANIP = 4;
NBREPETE = 6; { nb iteration par
condition}
NBSTIM = 8; { nb de condition
: nbfreq*nbhp }
delta = 200; { periode
d'echantillonage pour la tete }
DUREE_APNEE = 3000;
DUREE_MANIP = 15*60*1000;
DUREE_RESET = 0;
duree_son = 5000;
duree_pause = 5000;
son0 = 'bb5sec';
sonalarme = 'su6000';
at0 = 128;
atalarme = 128;
type
typrep = record
ncycle : integer;
nprojo : byte;
freq :
string;
nrep : byte;
trep : longint;
tmin : integer;
tmax : integer;
status : boolean
end;
var
fic,frep : text;
nom,nomw : string;
spos : char;
tab_tire : array [1..NBSTIM*NBREPETE] of byte;
tabrep
: typrep;
maxtire,nson,ison: byte;
tete,vref,essai : integer;
reponse : char;
at_tete,at_son,dt_tete,dt_son,t : word;
son_on,rep_ok,fin_essai,app_on : boolean;
procedure init_tire;
var
i : byte;
begin
randomize;
maxtire := NBSTIM*NBREPETE;
for i:= 1 to maxtire do
tab_tire[i]
:= i;
end;
procedure tire(var v,it :
byte);
begin
if maxtire = 1 then
it := 1
else it := random(maxtire)+1;
v := tab_tire[it]
end;
procedure remove_tire(it :
byte);
begin
tab_tire[it] := tab_tire[maxtire];
dec(maxtire)
end;
procedure get_reponse;
var
c : byte;
begin
c := get_appui;
if c = 255 then
begin
app_on :=
false;
exit
end;
if (c in [0..7]) and (app_on = false) then
begin
writeln('reponse ',c,t:10);
writeln(fic,'r ',c,t:5);
with tabrep
do
begin
trep := t;
nrep := c;
end;
app_on :=
true;
rep_ok := true;
exit
end
end;
function get_tete :
integer;
var
v : integer;
er : boolean;
begin
v := get_adcval(0,er);
if er then v := -1;
get_tete := v - vref;
end;
procedure soundon(nw :
string;att : byte);
begin
jouewave(nw, att, att); { volume }
end;
procedure soundoff;
begin
end;
procedure
param_son(i:byte;var hp : integer;var nw : string;var a:byte);
var
f : integer;
begin
f := 0;
hp := (i - 1) div NBREPETE;
nw := son0;
a := at0;
tabrep.nprojo := hp;
tabrep.freq := nw
end;
procedure lance_chrono;
begin
start_timer(TREP);
at_tete := 0;
at_son := 0
end;
procedure lance_son(ns :
byte);
var
hp : integer;
at : byte;
begin
param_son(ns,hp,nomw,at);
ouvre_canal(hp);
son_on := true;
rep_ok := false;
fin_essai := false;
tabrep.status := rep_ok;
writeln(essai:3,' son on ',hp:3,nomw);
writeln(fic,'s ',ns:3);
app_on := (get_appui in [0..7]);
lance_chrono;
soundon(nomw,at)
end;
procedure arret_son;
begin
soundoff;
writeln(' arret son',t:10);
writeln(fic,'a ',t:5);
son_on := false;
ferme_canal
end;
procedure init_manip;
begin
clrscr;
ferme_canal;
init_timer(5);
init_tire;
essai := 0;
end;
procedure sauverep;
begin
with tabrep do
writeln(frep,ncycle,tab,nprojo,tab,freq,tab,nrep,tab,trep,tab,
tmin,tab,tmax,tab,status)
end;
procedure alarme;
var
tw,tl : longint;
apn : boolean;
c : char;
begin
clrscr;
writeln('DUREE MANIP DEPASSEE');
while keypressed do readkey;
ouvre_canal(0);
apneeon;
apn := true;
start_timer(TMANIP);
start_timer(TDEL);
repeat
tw :=
get_timer(TMANIP);
tl := get_timer(TDEL);
if tl
> 1000 then
begin
if apn = true then
begin
apneeoff;
apn := false
end
else
begin
apneeon;
apn := true
end;
start_timer(TDEL)
end;
if (tw
> 3000) and (finwave = 0) then
begin
jouewave(sonalarme,atalarme,atalarme);
start_timer(TMANIP)
end;
if
keypressed then c := readkey;
until c = #27;
outreset;
end;
procedure manip;
var
tetemax,tetemin : integer;
tm : longint;
begin
init_manip;
start_timer(TMANIP);
repeat
inc(essai);
tabrep.ncycle := essai;
tetemax := -5000;
tetemin := 5000;
tire(nson,ison);
start_timer(TESSAI);
apneeon;
repeat
t := get_timer(TESSAI)
until
t >= DUREE_APNEE;
apneeoff;
lance_son(nson);
tete
:= get_tete;
repeat
t := get_timer(TREP);
get_reponse;
dt_tete := t - at_tete;
dt_son := t -
at_son;
if dt_tete >= delta then
begin
tete := get_tete;
{ writeln('tete ',tete:10,t:10);}
writeln(fic,'t ',tete:7,t:5);
at_tete
:= t
end;
case son_on of
true : begin
if (dt_son >= duree_son) and (finwave = 0) then
begin
arret_son;
at_son := t
end;
if tete > tetemax then tetemax := tete;
if tete < tetemin then tetemin := tete
end;
false : if dt_son >= duree_pause then
begin
fin_essai := true;
if not rep_ok then
writeln('pas de reponse ')
else remove_tire(ison);
end
end;
until
fin_essai;
writeln('fin essai ',t:10);
tabrep.status := rep_ok;
tabrep.tmin := tetemin;
tabrep.tmax := tetemax;
sauverep;
writeln(fic,'f ',t:5);
start_timer(TDEL);
repeat
until get_timer(TDEL) > DUREE_RESET;
outreset;
tm :=
get_timer(TMANIP);
until (maxtire = 0) or (tm >
DUREE_MANIP);
if tm > DUREE_MANIP then alarme;
close_timer
end;
begin
clrscr;
write('nom du sujet ');
readln(nom);
vref := 0;
write('appuyer sur RC pour commencer');
readln;
{vref := get_tete; mis a 0 sur position
initiale de tete }
assign(fic,nom+'.tet');
assign(frep,nom+'.txt');
rewrite(fic);
rewrite(frep);
manip;
close(fic);
close(frep)
end.