3 (***************************************************************************)
\r
4 (* Programme de syst
\8ame de fenetrage avec boutons et gestion de la souris *)
\r
5 (* ainsi que de simulation d'un r
\82seau routier en ville. *)
\r
6 (* BARETS Olivier & PATAUD Fr
\82d
\82ric & PEYRAT Fran
\87ois 1993/1994 *)
\r
7 (* plateforme : PC-DOS_386 avec clavier 102 touches / mode VGA / souris *)
\r
8 (* PC 486DX33 16Mo Ram *)
\r
9 (***************************************************************************)
\r
12 Pref iiuwgraph block
\r
17 Const Noir = 0, Bleu = 1, Vert = 2, Cyan = 3,
\r
18 Rouge = 4, Magenta = 5, Marron = 6, GrisClair = 7,
\r
19 GrisFonce = 8, BleuClair = 9, VertClair =10, CyanClair =11,
\r
20 RougeClair =12, MagentaClair=13, Jaune =14, Blanc =15;
\r
22 Const T_F1 =315, T_F2 =316, T_F3 =317, T_F4 =318,
\r
23 T_F5 =319, T_F6 =320, T_F7 =321, T_F8 =322,
\r
24 T_F9 =323, T_F10 =324, T_SHFTF1 =340, T_SHFTF2 =341,
\r
25 T_SHFTF3 =342, T_SHFTF4 =343, T_SHFTF5 =344, T_SHFTF6 =345,
\r
26 T_SHFTF7 =346, T_SHFTF8 =347, T_SHFTF9 =348, T_SHFTF10=349,
\r
27 T_CTRLF1 =350, T_CTRLF2 =351, T_CTRLF3 =352, T_CTRLF4 =353,
\r
28 T_CTRLF5 =354, T_CTRLF6 =355, T_CTRLF7 =356, T_CTRLF8 =357,
\r
29 T_CTRLF9 =358, T_CTRLF10=359, T_ALTF1 =360, T_ALTF2 =361,
\r
30 T_ALTF3 =362, T_ALTF4 =363, T_ALTF5 =364, T_ALTF6 =365,
\r
31 T_ALTF7 =366, T_ALTF8 =367, T_ALTF9 =368, T_ALTF10 =369,
\r
32 Tou_Ent =013, T_ESC =027, T_N =078, T_Y =089,
\r
33 T_FLGCH =331, T_FLDTE =333, T_FLHAU =328, T_FLBAS =336,
\r
34 T_ALT1 =376, T_ALT2 =377, T_PGUP =329, T_PGDOWN =337;
\r
36 Var SIZEX : integer,
\r
40 (* les variables du syst
\8ame de fenetrage *)
\r
43 Larg_Vil : integer, (* largeur de la ville *)
\r
44 Haut_Vil : integer, (* Hauteur de la ville *)
\r
45 Larg_Aff : integer, (* largeur de l'interieur de la fenetre maine *)
\r
46 Haut_Aff : integer, (* hauteur de l'interieur de la fenetre maine *)
\r
47 Xdep_Aff : integer, (* Point de depart de l'affichage en X ds maine *)
\r
48 Ydep_Aff : integer, (* point de depart de l'affichage en Y ds maine *)
\r
49 COEF_X : real, (* coeficient de zoom en x *)
\r
50 COEF_Y : real, (* coeficient de zoom en y *)
\r
51 COORD_X : integer, (* coordonn
\82e en X de Xdep_Aff en relatif *)
\r
52 COORD_Y : integer, (* coordonn
\82e en Y de Ydep_Aff en relatif *)
\r
59 (* les variables de la simulation *)
\r
61 Var RaciSomm : Sommets,
\r
63 NbCarActiv : integer,
\r
64 NBSOMMETS : integer;
\r
66 Unit pointeur : class;
\r
71 (***************************************************************************)
\r
72 (* definition des classes et procedures de simprocess *)
\r
73 (***************************************************************************)
\r
76 UNIT PRIORITYQUEUE: CLASS;
\r
78 (* HEAP AS BINARY LINKED TREE WITH FATHER LINK*)
\r
81 UNIT QUEUEHEAD: CLASS;
\r
82 (* HEAP ACCESING MODULE *)
\r
85 UNIT MIN: FUNCTION: ELEM;
\r
87 IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;
\r
90 UNIT INSERT: PROCEDURE(R:ELEM);
\r
91 (* INSERTION INTO HEAP *)
\r
97 ROOT.LEFT,ROOT.RIGHT,LAST:=ROOT
\r
113 LAST.LEFT.RIGHT:=X;
\r
118 CALL CORRECT(R,FALSE)
\r
121 UNIT DELETE: PROCEDURE(R: ELEM);
\r
138 LAST.NS:= LAST.NS-1;
\r
141 IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)
\r
142 ELSE CALL CORRECT(X.EL,TRUE) FI;
\r
145 UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN);
\r
146 (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *)
\r
147 VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN;
\r
152 IF Z.NS =0 THEN FIN:=TRUE ELSE
\r
153 IF Z.NS=1 THEN X:=Z.LEFT ELSE
\r
154 IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT
\r
156 IF Z.LESS(X) THEN FIN:=TRUE ELSE
\r
167 IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;
\r
176 IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);
\r
185 UNIT NODE: CLASS (EL:ELEM);
\r
186 (* ELEMENT OF THE HEAP *)
\r
187 VAR LEFT,RIGHT,UP: NODE, NS:INTEGER;
\r
188 UNIT LESS: FUNCTION(X:NODE): BOOLEAN;
\r
190 IF X= NONE THEN RESULT:=FALSE
\r
191 ELSE RESULT:=EL.LESS(X.EL) FI;
\r
196 UNIT ELEM: CLASS(PRIOR:REAL);
\r
197 (* PREFIX OF INFORMATION TO BE STORED IN NODE *)
\r
199 UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;
\r
201 IF X=NONE THEN RESULT:= FALSE ELSE
\r
202 RESULT:= PRIOR< X.PRIOR FI;
\r
205 LAB:= NEW NODE(THIS ELEM);
\r
213 UNIT SIMULATION: PRIORITYQUEUE CLASS;
\r
214 (* THE LANGUAGE FOR SIMULATION PURPOSES *)
\r
216 VAR CURR: SIMPROCESS, (*ACTIVE PROCESS *)
\r
217 PQ:QUEUEHEAD, (* THE TIME AXIS *)
\r
218 MAINPR: MAINPROGRAM;
\r
221 UNIT SIMPROCESS: pointeur COROUTINE;
\r
222 (* USER PROCESS PREFIX *)
\r
223 VAR EVENT, (* ACTIVATION MOMENT NOTICE *)
\r
224 EVENTAUX: EVENTNOTICE,
\r
225 (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)
\r
226 (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS *)
\r
229 UNIT IDLE: FUNCTION: BOOLEAN;
\r
231 RESULT:= EVENT= NONE;
\r
234 UNIT TERMINATED: FUNCTION :BOOLEAN;
\r
239 UNIT EVTIME: FUNCTION: REAL;
\r
240 (* TIME OF ACTIVATION *)
\r
242 IF IDLE THEN CALL ERROR1;
\r
244 RESULT:= EVENT.EVENTTIME;
\r
247 UNIT ERROR1:PROCEDURE;
\r
250 WRITELN(" AN ATTEMPT TO ACCESS AN IDLE PROCESS TIME");
\r
253 UNIT ERROR2:PROCEDURE;
\r
256 WRITELN(" AN ATTEMPT TO ACCESS A TERMINATED PROCESS TIME");
\r
268 UNIT EVENTNOTICE: ELEM CLASS;
\r
269 (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *)
\r
270 VAR EVENTTIME: REAL, PROC: SIMPROCESS;
\r
272 UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;
\r
273 (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)
\r
275 IF X=NONE THEN RESULT:= FALSE ELSE
\r
276 RESULT:= EVENTTIME< X.EVENTTIME OR
\r
277 (EVENTTIME=X.EVENTTIME AND PRIOR< X.PRIOR); FI;
\r
283 UNIT MAINPROGRAM: SIMPROCESS CLASS;
\r
284 (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)
\r
286 DO ATTACH(MAIN) OD;
\r
289 UNIT TIME:FUNCTION:REAL;
\r
290 (* CURRENT VALUE OF SIMULATION TIME *)
\r
292 RESULT:=CURRENT.EVTIME
\r
295 UNIT CURRENT: FUNCTION: SIMPROCESS;
\r
296 (* THE FIRST PROCESS ON THE TIME AXIS *)
\r
301 UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);
\r
302 (* ACTIVATION OF PROCESS P AT TIME T AND DEFINITION OF "PRIOR"- PRIORITY *)
\r
303 (* WITHIN TIME MOMENT T *)
\r
305 IF T<TIME THEN T:= TIME FI;
\r
306 IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE
\r
307 IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)
\r
308 P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);
\r
311 IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN
\r
312 P.EVENT:= P.EVENTAUX;
\r
313 P.EVENT.PRIOR:=RANDOM;
\r
315 (* NEW SCHEDULING *)
\r
316 P.EVENT.PRIOR:=RANDOM;
\r
317 CALL PQ.DELETE(P.EVENT)
\r
319 P.EVENT.EVENTTIME:= T;
\r
320 CALL PQ.INSERT(P.EVENT) FI;
\r
323 UNIT HOLD:PROCEDURE(T:REAL);
\r
324 (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)
\r
325 (* REDEFINE PRIOR *)
\r
327 CALL PQ.DELETE(CURRENT.EVENT);
\r
328 CURRENT.EVENT.PRIOR:=RANDOM;
\r
329 IF T<0 THEN T:=0; FI;
\r
330 CURRENT.EVENT.EVENTTIME:=TIME+T;
\r
331 CALL PQ.INSERT(CURRENT.EVENT);
\r
332 CALL CHOICEPROCESS;
\r
335 UNIT PASSIVATE: PROCEDURE;
\r
336 (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)
\r
338 CALL PQ.DELETE(CURRENT.EVENT);
\r
339 CURRENT.EVENT:=NONE;
\r
343 UNIT RUN: PROCEDURE(P:SIMPROCESS);
\r
344 (* ACTIVATE P IMMEDIATELY AND DELAY THE FORMER FIRST PROCESS BY REDEFINING*)
\r
347 CURRENT.EVENT.PRIOR:=RANDOM;
\r
350 P.EVENT.EVENTTIME:=TIME;
\r
351 CALL PQ.CORRECT(P.EVENT,FALSE)
\r
353 IF P.EVENTAUX=NONE THEN
\r
354 P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);
\r
355 P.EVENT.EVENTTIME:=TIME;
\r
357 CALL PQ.INSERT(P.EVENT)
\r
359 P.EVENT:=P.EVENTAUX;
\r
361 P.EVENT.EVENTTIME:=TIME;
\r
363 CALL PQ.INSERT(P.EVENT);
\r
365 CALL CHOICEPROCESS;
\r
368 UNIT CANCEL:PROCEDURE(P: SIMPROCESS);
\r
369 (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)
\r
371 IF P= CURRENT THEN CALL PASSIVATE ELSE
\r
372 CALL PQ.DELETE(P.EVENT);
\r
376 UNIT CHOICEPROCESS:PROCEDURE;
\r
377 (* CHOOSE THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)
\r
381 CURR:= PQ.MIN QUA EVENTNOTICE.PROC;
\r
382 IF CURR=NONE THEN WRITE(" ERROR IN THE HEAP"); WRITELN;
\r
384 ELSE ATTACH(CURR); FI;
\r
388 PQ:=NEW QUEUEHEAD; (* SIMULATION TIME AXIS*)
\r
389 CURR,MAINPR:=NEW MAINPROGRAM;
\r
390 MAINPR.EVENT,MAINPR.EVENTAUX:=NEW EVENTNOTICE(0);
\r
391 MAINPR.EVENT.EVENTTIME:=0;
\r
392 MAINPR.EVENT.PROC:=MAINPR;
\r
393 CALL PQ.INSERT(MAINPR.EVENT);
\r
394 (* THE FIRST PROCESS TO BE ACTIVATED IS MAIN PROGRAM *)
\r
401 UNIT LISTS:SIMULATION CLASS;
\r
402 (* WE WISH TO USE LISTS FOR QUEUEING PROCESSES DURING SIMULATION*)
\r
404 UNIT LINKAGE:CLASS;
\r
405 (*WE WILL USE TWO WAY LISTS *)
\r
406 VAR SUC1,PRED1:LINKAGE;
\r
408 UNIT HEAD:LINKAGE CLASS;
\r
409 (* EACH LIST WILL HAVE ONE ELEMENT ESTABLISHED *)
\r
410 UNIT FIRST:FUNCTION:LINK;
\r
412 IF SUC1 IN LINK THEN RESULT:=SUC1
\r
413 ELSE RESULT:=NONE FI;
\r
415 UNIT EMPTY:FUNCTION:BOOLEAN;
\r
417 RESULT:=SUC1=THIS LINKAGE;
\r
420 SUC1,PRED1:=THIS LINKAGE;
\r
423 UNIT LINK:LINKAGE CLASS;
\r
424 (* ORDINARY LIST ELEMENT PREFIX *)
\r
425 UNIT OUT:PROCEDURE;
\r
427 IF SUC1=/=NONE THEN
\r
430 SUC1,PRED1:=NONE FI;
\r
432 UNIT INTO:PROCEDURE(S:HEAD);
\r
437 IF S.SUC1=/=NONE THEN
\r
440 PRED1.SUC1:=THIS LINKAGE;
\r
441 S.PRED1:=THIS LINKAGE;
\r
446 UNIT ELEM:LINK CLASS(SPROCESS:SIMPROCESS);
\r
447 (* USER DEFINED PROCESS WILL BE JOINED INTO LISTS *)
\r
452 (***************************************************************************)
\r
453 (* definition des procedures de lecture des fichiers de donn
\82es et mise en *)
\r
454 (* m
\82moire des structures de la ville. *)
\r
455 (***************************************************************************)
\r
457 (***************************************************************************)
\r
458 (* Structure d une place de parking *)
\r
459 (***************************************************************************)
\r
461 Unit Place : class (N : integer );
\r
462 var P1 : arrayof boolean;
\r
464 array P1 dim (1:N);
\r
467 (***************************************************************************)
\r
468 (* Structure de la liste des arc qui peuvent etre atteind *)
\r
469 (***************************************************************************)
\r
471 Unit Liste : class;
\r
472 var pointeur: Arcs,
\r
476 (***************************************************************************)
\r
477 (* Structure des arcs *)
\r
478 (***************************************************************************)
\r
480 Var Numero : integer, (* Identification de l'arc *)
\r
481 Initial : Sommets, (* Sommet initial *)
\r
482 Final : Sommets, (* Sommet final *)
\r
483 Sens : integer, (* Sens de circulation *)
\r
484 Distance : integer, (* Distance de initial a final*)
\r
485 NbvoieIF : integer, (* Nombre de voie dans le sens 1 *)
\r
486 NbvoieFI : integer, (* Nombre de voie dans le sens -1 *)
\r
488 (* pointeur sera de type car lors des affectations *)
\r
489 occpsens : arrayof pointeur, (*si <>none alors il y a une voiture cette place*)
\r
490 occpinve : arrayof pointeur; (*en sens inverse de initial final *)
\r
493 (***************************************************************************)
\r
494 (* Structure des sommets *)
\r
495 (***************************************************************************)
\r
497 Unit Sommets : class;
\r
498 var Nom : char, (* Nom du sommet *)
\r
499 typecar : integer, (* Type carrefour 0:feu , 1:priorite , 2:stop *)
\r
500 afftype : integer, (* type carrefour 1..9 pour affichage *)
\r
501 Ligne : integer, (* Correspond a la position en Y sur ecran *)
\r
502 Colonne : integer, (* Correspond a la position en X sur ecran *)
\r
503 etat : integer, (* Etat du carrefour *)
\r
504 ptrarc : Liste, (* Pointeur sur la liste pointant sur les arcs *)
\r
505 suivant : Sommets; (* Pointeur sur les suivants *)
\r
508 (***************************************************************************)
\r
509 (* Procedure creant la liste des Sommets *)
\r
510 (* Ici il y a juste creation d un liste simple de sommet en mode pile *)
\r
511 (***************************************************************************)
\r
513 Unit CreeSomm : procedure( f: file);
\r
514 var Noeud : Sommets,
\r
524 if ( tampon <> '.') then
\r
525 Noeud := new Sommets;
\r
526 NBSOMMETS:=NBSOMMETS+1; (* on comptabilise le nombre de sommets*)
\r
527 Noeud.Nom := tampon;
\r
528 read(f,Noeud.typecar);
\r
529 read(f,Noeud.afftype);
\r
530 read(f,Noeud.colonne);
\r
531 if(Noeud.colonne>Larg_Vil) then Larg_Vil:=Noeud.colonne; fi;
\r
532 readln(f,Noeud.ligne);
\r
533 if(Noeud.ligne>Haut_Vil) then Haut_Vil:=Noeud.ligne; fi;
\r
535 Noeud.ptrarc := none;
\r
536 Noeud.Suivant := RaciSomm;
\r
538 else arret := true;
\r
544 (***************************************************************************)
\r
545 (* Procedure affichant chaque sommet ainsi que les arcs que l'on peut *)
\r
546 (* prendre depuis ce sommet en considerant les sens de circulation etc... *)
\r
547 (***************************************************************************)
\r
548 Unit ParcSomm : procedure;
\r
549 var Noeud : Sommets;
\r
550 var parcours : Liste;
\r
553 while (Noeud <> none)
\r
556 writeln(Noeud.Nom);
\r
557 writeln("X : ",Noeud.Colonne);
\r
558 writeln("Y : ",Noeud.ligne);
\r
559 parcours := Noeud.ptrarc;
\r
560 while (parcours <> none )
\r
562 writeln("Arc: ",parcours.pointeur.Numero);
\r
563 parcours := parcours.suivante;
\r
565 Noeud := Noeud.suivant;
\r
570 (***************************************************************************)
\r
571 (* Procedure creant la liste des Arc *)
\r
572 (* Ici on cree la liste des Arc sur la base d'une pile, puis il y a *)
\r
573 (* rattachement des pointeurs final et initial avec la liste des sommets *)
\r
574 (* et ce grace a la procedure rattache. *)
\r
575 (***************************************************************************)
\r
577 Unit CreeArcs : procedure( f: file);
\r
586 while ( not(eof(f)))
\r
592 call outstring("coucou");
\r
596 read(f,Noeud.Numero);
\r
602 read(f,Noeud.Sens);
\r
603 read(f,Noeud.distance);
\r
604 array Noeud.occpsens dim (1:Noeud.distance); (* on met la voie en place*)
\r
605 array Noeud.occpinve dim (1:Noeud.distance);
\r
606 read(f,Noeud.NbvoieIF);
\r
607 readln(f,Noeud.NbvoieFI);
\r
608 Noeud.Initial := none;
\r
609 Noeud.Final := none;
\r
610 Noeud.Suivants:= RaciArcs;
\r
612 Call rattache(Noeud,aux1,aux2);
\r
616 (***************************************************************************)
\r
617 (* Rattachement du pointeur arc avec le sommet *)
\r
618 (* Cette procedure rattache les pointeurs final et initial des arcs avec *)
\r
619 (* un sommet de la liste des sommets. *)
\r
620 (* Puis il y a la procedure creant la liste des arcs que l'on peut *)
\r
621 (* emprunter depuis ce sommet. Cette procedure est appele ici. *)
\r
622 (* Pour l appelle de cette procedure RattaListe nous verifions le sens de *)
\r
623 (* circulation dans les arcs, en effet des arcs ne peuvent pas etre pris a *)
\r
624 (* partir de certain sommets, donc il ne doivent pas figurer dans cette *)
\r
625 (* liste( Sens interdits ). *)
\r
626 (***************************************************************************)
\r
627 Unit Rattache : procedure ( inout Noeud : Arcs ; aux1,aux2:char);
\r
628 var Parcours : Sommets;
\r
631 Parcours := RaciSomm;
\r
632 while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))
\r
634 Parcours := Parcours.suivant;
\r
636 if Parcours.Nom = aux1
\r
638 Noeud.Initial := Parcours;
\r
639 if Noeud.Sens <> -1
\r
641 Call rattaListe(Parcours,Noeud);
\r
643 else if Parcours.Nom = aux2
\r
645 Noeud.Final := Parcours;
\r
648 Call rattaListe(Parcours,Noeud);
\r
651 write("ERREUR de rattachement initial");
\r
655 Parcours := Parcours.suivant;
\r
656 while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))
\r
658 Parcours := Parcours.suivant;
\r
660 if Parcours.Nom = aux1
\r
662 Noeud.Initial := Parcours;
\r
663 if Noeud.Sens <> -1
\r
665 Call rattaListe(Parcours,Noeud);
\r
667 else if Parcours.Nom = aux2
\r
669 Noeud.final := parcours;
\r
672 Call rattaListe(Parcours,Noeud);
\r
675 write("ERREUR de rattachement du final");
\r
680 (***************************************************************************)
\r
681 (* Rattachement des sommets a la liste des arc qui peuvent etres atteinds *)
\r
682 (***************************************************************************)
\r
683 Unit RattaListe : procedure (inout NoeudSom : sommets; NoeudArc : Arcs);
\r
687 Noeud := new Liste;
\r
688 Noeud.suivante := NoeudSom.ptrarc;
\r
689 Noeud.pointeur := NoeudArc;
\r
690 NoeudSom.ptrarc := Noeud;
\r
694 (***************************************************************************)
\r
695 (* Procedure de lecture de la ville appell
\82e par bo_load *)
\r
696 (***************************************************************************)
\r
698 Unit Lit_Ville : procedure( fenet : Windows);
\r
699 var fichier : file,
\r
700 flagbool : boolean;
\r
705 open (fichier,text,unpack("Ville.dat"));
\r
706 call color(VertClair);
\r
707 flagbool:=fenet.outgtext(".",1);
\r
708 call reset (fichier);
\r
709 call color(VertClair);
\r
710 flagbool:=fenet.outgtext("..",2);
\r
711 Call CreeSomm(fichier);
\r
712 call color(VertClair);
\r
713 flagbool:=fenet.outgtext("..",2);
\r
714 Call CreeArcs(fichier);
\r
715 call color(VertClair);
\r
716 flagbool:=fenet.outgtext("..",2);
\r
719 (***************************************************************************)
\r
720 (* definition des procedures d'utilitaires graphiques *)
\r
721 (***************************************************************************)
\r
723 (***************************************************************************)
\r
724 Unit Line : procedure (x1,y1,x2,y2,c : integer);
\r
731 (***************************************************************************)
\r
732 Unit Linep : procedure (x1,y1,x2,y2,c,s :integer);
\r
734 Begin (* ne fonctionne que pour des horizontales ou des verticales *)
\r
736 then for i:=y1 step s*2 to y2
\r
738 call line(x1,i,x1,i+s,c);
\r
741 then for i:=x1 step s*2 to x2
\r
743 call line(i,y1,i+s,y1,c);
\r
749 (***************************************************************************)
\r
750 Unit Rectangle : procedure (x1,y1,x2,y2,c : integer);
\r
760 (***************************************************************************)
\r
761 Unit Rectanglef : procedure (x1,y1,x2,y2,c : integer);
\r
766 call Line(x1,i,x2,i,c);
\r
770 (****************************************************************************)
\r
771 Unit Readcara : function (x,y,col_f,col_e : integer) : integer;
\r
782 call outstring("_");
\r
783 for i:=1 to 300 do od;
\r
786 call outstring("_");
\r
787 for i:=1 to 100 do od;
\r
792 call outstring("_");
\r
798 (****************************************************************************)
\r
799 (* lecture d'un entier en mode graphique, esc revient au debut de saisie *)
\r
800 (****************************************************************************)
\r
801 Unit gscanf : function (rangmin,rangmax : integer) : integer;
\r
802 Var valeur : integer,
\r
812 flag:=readcara(inxpos,inypos,Noir,BleuClair);
\r
813 if (flag>=48 and flag<=57)
\r
814 then valeur:=valeur*10+flag-48;
\r
815 call move(inxpos,inypos);
\r
818 if (flag=13) then exit; fi;
\r
819 if (flag=27) (* on a demand
\82 annulation *)
\r
821 call rectanglef(sauvx-1,sauvy-1,inxpos,sauvy+13,Noir);
\r
822 call color(BleuClair);
\r
823 call move(sauvx,sauvy);
\r
826 if (valeur>=rangmin and valeur<=rangmax)
\r
828 else call rectanglef(sauvx-1,sauvy-1,inxpos,sauvy+13,Noir);
\r
829 call color(BleuClair);
\r
830 call move(sauvx,sauvy);
\r
837 (***************************************************************************)
\r
838 (* definition des classes d'
\82l
\82ments des listes *)
\r
839 (***************************************************************************)
\r
841 Unit Elmt : class(id : integer);
\r
844 Unit elm : Elmt class(x1,y1,x2,y2 :integer);
\r
847 (***************************************************************************)
\r
848 (* definition de la classe Bottons *)
\r
849 (***************************************************************************)
\r
851 Unit Bottons : Elmt class(touche,x1,y1,x2,y2 : integer);
\r
852 (* x2-x1 et y2-y1 doit au mini etre de 8*)
\r
853 (* x1,y1 : integer coordonn
\82es du point haut gauche *)
\r
854 (* x2,y2 : integer coordonn
\82es du point bas droit *)
\r
855 Var etat : boolean; (* true si bouton enable *)
\r
857 Unit affiche : procedure;
\r
859 call Line(x1,y1,x2,y1,Blanc); (* Lignes en blanc *)
\r
860 call Line(x1,y1+1,x2-1,y1+1,Blanc);
\r
861 call Line(x1,y1,x1,y2,Blanc);
\r
862 call Line(x1+1,y1+2,x1+1,y2-1,Blanc);
\r
863 call Line(x1+1,y2,x2,y2,GrisFonce); (* Lignes en gris fonce *)
\r
864 call Line(x1+2,y2-1,x2,y2-1,GrisFonce);
\r
865 call Line(x2,y2,x2,y1+1,GrisFonce);
\r
866 call Line(x2-1,y2-1,x2-1,y1+2,GrisFonce);
\r
867 call Rectanglef(x1+2,y1+2,x2-2,y2-2,GrisClair); (* centre en gris *)
\r
871 Unit virtual AfficheSuite : procedure;
\r
874 Unit virtual bot_enable : procedure;
\r
877 Unit virtual bot_disable : procedure;
\r
882 (***************************************************************************)
\r
883 (* definition de la classe Menu derivant de Bottons *)
\r
884 (***************************************************************************)
\r
886 Unit Menu : Bottons class;
\r
887 Var cnom : integer, (* couleur du nom du bouton *)
\r
888 nom : string; (* nom du bouton *)
\r
890 Unit affiche_nom : procedure;
\r
892 call move(x1+5,y1+(y2-y1)/4);
\r
894 call outstring(nom);
\r
897 Unit virtual bot_enable : procedure;
\r
901 e:=new elm(id,x1,y1,x2,y2);
\r
902 call clics.Insert(e);
\r
904 then call Keys.Insert(new elmt(touche));
\r
909 Unit virtual bot_disable : procedure;
\r
913 e:=new elm(id,x1,y1,x2,y2);
\r
914 call clics.Delete(e);
\r
916 then call Keys.delete(new elmt(touche));
\r
921 Unit virtual AfficheSuite : procedure;
\r
924 then call bot_enable;
\r
925 else call bot_disable;
\r
931 (***************************************************************************)
\r
932 (* definition de la classe Racc derivant de Bottons *)
\r
933 (***************************************************************************)
\r
935 Unit Racc : Bottons class (procedure sprite(x1,y1,x2,y2,col :integer));
\r
937 Unit virtual bot_enable : procedure;
\r
940 e:=new elm(id,x1,y1,x2,y2);
\r
941 call clics.Insert(e);
\r
943 then call Keys.Insert(new elmt(touche));
\r
947 Unit virtual bot_disable : procedure;
\r
950 e:=new elm(id,x1,y1,x2,y2);
\r
951 call clics.Delete(e);
\r
953 then call Keys.delete(new elmt(touche));
\r
957 Unit virtual AfficheSuite : procedure;
\r
960 then call bot_enable;
\r
961 call sprite(x1,y1,x2,y2,Noir);
\r
962 else call bot_disable;
\r
963 call sprite(x1,y1,x2,y2,GrisFonce);
\r
969 (***************************************************************************)
\r
970 (* definition de la classe Windows *)
\r
971 (***************************************************************************)
\r
973 Unit Windows : class(numero,x1,y1,x2,y2,lborder : integer;
\r
974 r1,r2,r3 : boolean);
\r
976 (* x2-x1 et y2-y1 doit au mini etre 33 *)
\r
977 Var cborder : integer, (* couleur du pourtour *)
\r
978 cnom : integer, (* couleur du nom de la fenetre *)
\r
980 Bout : ListBot, (* liste des boutons rattaches *)
\r
981 Hauteur : integer, (* hauteur de la bande *)
\r
982 Largeur : integer, (* largeur des raccourcis *)
\r
983 cbande : integer, (* couleur de la bande *)
\r
984 WhereXd : integer, (* position en x de depart dans la fenetre *)
\r
985 WhereX : integer, (* position courante en X dans la fenetre *)
\r
986 WhereYd : integer, (* position en y de depart dans la fenetre *)
\r
987 WhereY : integer; (* position courante en Y dans la fenetre *)
\r
988 var B : arrayof Racc, (* variables locales *)
\r
992 Unit affiche : procedure;
\r
995 call rectanglef(x1,y1,x2,y2,Noir);
\r
996 for i:=0 to lborder
\r
998 call rectangle(x1+i,y1+i,x2-i,y2-i,cborder);
\r
1000 call Line(x1+16,y1,x1+16,y1+lborder,Noir); (* Lignes noires *)
\r
1001 call Line(x2-16,y1,x2-16,y1+lborder,Noir);
\r
1002 call Line(x1+16,y2,x1+16,y2-lborder,Noir);
\r
1003 call Line(x2-16,y2,x2-16,y2-lborder,Noir);
\r
1004 call Line(x1,y1+16,x1+lborder,y1+16,Noir);
\r
1005 call Line(x1,y2-16,x1+lborder,y2-16,Noir);
\r
1006 call Line(x2,y1+16,x2-lborder,y1+16,Noir);
\r
1007 call Line(x2,y2-16,x2-lborder,y2-16,Noir);
\r
1008 call Rectanglef(x1+lborder+1,y1+lborder+1,x2-lborder-1,
\r
1009 y1+lborder+hauteur+1,cbande);
\r
1010 call move(x1+(x2-x1)/3,y1+lborder+hauteur/4);
\r
1012 call outstring(nom);
\r
1016 Unit virtual AffSuite : procedure;
\r
1019 Unit virtual clear : procedure;
\r
1022 Unit gestionnaire : function : integer;
\r
1023 Var l,r,c : boolean,
\r
1029 call getpress(0,x,y,nbbot,l,r,c);
\r
1030 if (l) and (clics<>none)
\r
1031 then result:=clics.Appartient(x,y); exit;
\r
1034 if (rep>=97 and rep<=122) (* passe les lettres en majuscule *)
\r
1037 if keys.Appartient(rep)
\r
1038 then result:=rep; exit;
\r
1043 Unit moveto : function (x,y :integer) : boolean;
\r
1045 if (x>0 and x<(x2-x1)) and (y>0 and y<y2-y1)
\r
1046 then WhereX:=WhereXd+x;
\r
1047 WhereY:=WhereYd+y;
\r
1048 call move(WhereX,WhereY);
\r
1050 else result:=False;
\r
1054 Unit outgtext : function (chaine : string; long : integer) : boolean;
\r
1056 if (long*8+WhereX)<(x2-lborder-5)
\r
1057 then call move(WhereX,WhereY);
\r
1058 call outstring(chaine);
\r
1059 WhereX:=WhereX+long*8;
\r
1060 if WhereX>= x2-lborder-16
\r
1061 then WhereX:=WhereXd;
\r
1062 WhereY:=WhereY+16;
\r
1065 else result:=False;
\r
1069 Unit outchar : function (tmp : char) : boolean;
\r
1071 if (10+WhereX)<(x2-lborder-5-largeur)
\r
1072 then call move(WhereX,WhereY);
\r
1073 call hascii(ord(tmp));
\r
1074 WhereX:=WhereX+10;
\r
1075 if WhereX>= x2-lborder-16-largeur
\r
1076 then WhereX:=WhereXd;
\r
1077 WhereY:=WhereY+16;
\r
1080 else result:=False;
\r
1086 Bout:=new ListBot;
\r
1087 Keys:=new ListKey;
\r
1089 array B dim (0:2);
\r
1091 x:=x2-Larg_bot-lborder-1;
\r
1095 B(2):=new Racc(numero+3,-1,x,y,xp,yp,spr_upper);
\r
1097 call Bout.Insert(B(2));
\r
1101 B(1):=new Racc(numero+2,-1,x,y,xp,yp,spr_lower);
\r
1103 call Bout.Insert(B(1));
\r
1107 B(0):=new Racc(numero+1,-1,x,y,xp,yp,spr_close);
\r
1109 call Bout.Insert(B(0));
\r
1113 (***************************************************************************)
\r
1114 (* definition de main d
\82rivant de la classe Windows *)
\r
1115 (***************************************************************************)
\r
1117 Unit Maine : Windows class;
\r
1118 var icname : string, (* nom une fois iconise *)
\r
1119 Lwind : ListW, (* liste des fenetres filles *)
\r
1120 Horiz : AccelerateH, (* accelerateur horizontal *)
\r
1121 Verti : AccelerateV; (* accelerateur vertical *)
\r
1123 Unit virtual AffSuite : procedure;
\r
1125 call Rectanglef(x1+lborder+1,y1+lborder+hauteur+3,
\r
1126 x2-lborder-1,y1+lborder+2*(hauteur+2),cbande);
\r
1128 then call Horiz.affiche;
\r
1131 then call Verti.affiche;
\r
1133 Bout.Courant:=Bout.head;
\r
1134 while(Bout.Courant<>none)
\r
1136 call Bout.Courant.data qua Bottons.affiche;
\r
1137 Bout.Courant:=Bout.Courant.next;
\r
1139 call Keys.Insert(new elmt(T_ALTF4)); (* alt/f4 pour quitter *)
\r
1142 Unit virtual clear : procedure;
\r
1143 Var xf,yf : integer;
\r
1145 if Verti<>none then xf:=Verti.x1-1;
\r
1146 else xf:=x2-lborder-1;
\r
1148 if Horiz<>none then yf:=Horiz.y1-1;
\r
1149 else yf:=y2-lborder-1;
\r
1151 call Rectanglef(x1+lborder+1,y1+lborder+2*(hauteur+2)+1,xf,yf,Noir);
\r
1156 Unit iconify : procedure;
\r
1166 call rectangle(1,SIZEY-40,40,SIZEY,BleuClair);
\r
1167 call rectangle(2,SIZEY-39,39,SIZEY-1,BleuClair);
\r
1168 call move(5,SIZEY-20);
\r
1169 call outstring(icname);
\r
1172 call getpress(0,x,y,nboot,l,r,c);
\r
1174 then if(x>=1 and x<=40 and y<=SIZEY and y>=SIZEY-40)
\r
1179 if (rep=13) (* validation *)
\r
1185 clics:=new cliquer;
\r
1190 WhereXd:=x1+lborder+5;
\r
1191 WhereYd:=y1+lborder+2*(Haut_Bot+2)+5+8;
\r
1196 (***************************************************************************)
\r
1197 (* definition de la classe Son d
\82rivant des classes Windows et elmt *)
\r
1198 (***************************************************************************)
\r
1200 Unit Son : Windows coroutine;
\r
1202 Horiz : AccelerateH, (* accelerateur horizontal *)
\r
1203 Verti : AccelerateV; (* accelerateur vertical *)
\r
1205 Unit virtual AffSuite : procedure;
\r
1208 then call Horiz.affiche;
\r
1211 then call Verti.affiche;
\r
1213 Bout.Courant:=Bout.Head;
\r
1214 while(Bout.Courant<>none)
\r
1216 call Bout.Courant.data qua Bottons.affiche;
\r
1217 Bout.Courant:=bout.Courant.next;
\r
1221 Unit virtual clear : procedure;
\r
1222 Var xf,yf : integer;
\r
1224 if Verti<>none then xf:=Verti.x1-1;
\r
1225 else xf:=x2-lborder-1;
\r
1227 if Horiz<>none then yf:=Horiz.y1-1;
\r
1228 else yf:=y2-lborder-1;
\r
1230 call Rectanglef(x1+lborder+1,y1+lborder+(hauteur+1)+1,xf,yf,Noir);
\r
1237 pref Elmt(0) block
\r
1240 WhereXd:=x1+lborder+5;
\r
1241 WhereYd:=y1+lborder+(Haut_Bot+1)+5+8;
\r
1249 (***************************************************************************)
\r
1250 (* definition de Accelerate d
\82rivant des classes Windows et Bottons *)
\r
1251 (***************************************************************************)
\r
1253 Unit Accelerate : Bottons class(mother : Windows);
\r
1254 Var Bs : arrayof Racc,
\r
1258 C : integer; (* valeur du pas d'affichage *)
\r
1260 Unit virtual AfficheSuite : procedure; (* descend de bottons *)
\r
1263 Unit virtual bot_enable : procedure;
\r
1265 call mother.Bout.Insert(Bs(1));
\r
1266 call mother.Bout.Insert(Bs(2));
\r
1267 Call mother.Bout.Insert(Bs(3));
\r
1271 Unit virtual bot_disable : procedure;
\r
1273 call mother.Bout.Delete(Bs(1));
\r
1274 call mother.Bout.Delete(Bs(2));
\r
1275 call mother.Bout.Delete(Bs(3));
\r
1280 Unit virtual Deplacer : procedure( i :integer);
\r
1283 Unit virtual Reset_Bot : procedure;
\r
1287 C:=5; (* valeur par defaut *)
\r
1292 (***************************************************************************)
\r
1293 (* definition de AccelerateH d
\82rivant de Accelerate *)
\r
1294 (***************************************************************************)
\r
1296 Unit AccelerateH : Accelerate class;
\r
1301 Unit virtual AfficheSuite : procedure; (* descend de bottons *)
\r
1303 call Rectanglef(x1+18,y1+3,x2-18,y2-3,Noir);
\r
1308 Unit DeplacerLeft : procedure;
\r
1311 call Bs(2).bot_disable;
\r
1312 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1316 Bs(1).etat:=False;
\r
1317 call Bs(1).bot_disable;
\r
1319 if not (Bs(3).etat)
\r
1320 then Bs(3).etat:=True;
\r
1321 call Bs(3).bot_enable;
\r
1323 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
1324 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
1325 call Bs(2).affiche;
\r
1328 Unit virtual Deplacer : procedure (x : integer);
\r
1330 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1332 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
1333 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
1334 call Bs(2).affiche;
\r
1337 Unit DeplacerRight : procedure;
\r
1340 call Bs(2).bot_disable;
\r
1341 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1345 Bs(3).etat:=False;
\r
1346 call Bs(3).bot_disable;
\r
1348 if not (Bs(1).etat)
\r
1349 then Bs(1).etat:=True;
\r
1350 call Bs(1).bot_enable;
\r
1352 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
1353 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
1354 call Bs(2).affiche;
\r
1355 End DeplacerRight;
\r
1357 Unit virtual Reset_Bot : procedure;
\r
1359 call Bs(2).bot_disable;
\r
1360 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1368 Bs(2).x2:=PosX+LX;
\r
1369 Bs(2).y2:=PosY+LY;
\r
1370 call Bs(2).affiche;
\r
1374 array Bs dim (1:3);
\r
1375 Bs(1):=new Racc(id+1,T_FLDTE,x1+2,y1+2,x1+15,y1+15,spr_right);
\r
1382 Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);
\r
1384 Bs(3):=new Racc(id+3,T_FLGCH,x2-15,y2-16,x2-2,y2-3,spr_left);
\r
1388 (***************************************************************************)
\r
1389 (* definition de AccelerateV d
\82rivant de Accelerate *)
\r
1390 (***************************************************************************)
\r
1392 Unit AccelerateV : Accelerate class;
\r
1397 Unit virtual AfficheSuite : procedure; (* descend de bottons *)
\r
1399 call Rectanglef(x1+3,y1+18,x2-3,y2-18,Noir);
\r
1404 Unit DeplacerUp : procedure;
\r
1407 call Bs(2).bot_disable;
\r
1408 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1412 Bs(1).etat:=False;
\r
1413 call Bs(1).bot_disable;
\r
1415 if not (Bs(3).etat)
\r
1416 then Bs(3).etat:=True;
\r
1417 call Bs(3).bot_enable;
\r
1419 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
1420 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
1421 call Bs(2).affiche;
\r
1424 Unit virtual Deplacer : procedure (y : integer);
\r
1426 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1428 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
1429 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
1430 call Bs(2).affiche;
\r
1433 Unit DeplacerDown : procedure;
\r
1436 call Bs(2).bot_disable;
\r
1437 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1441 Bs(3).etat:=False;
\r
1442 call Bs(3).bot_disable;
\r
1444 if not (Bs(1).etat)
\r
1445 then Bs(1).etat:=True;
\r
1446 call Bs(1).bot_enable;
\r
1448 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
1449 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
1450 call Bs(2).affiche;
\r
1453 Unit virtual Reset_Bot : procedure;
\r
1455 call Bs(2).bot_disable;
\r
1456 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1464 Bs(2).x2:=PosX+LX;
\r
1465 Bs(2).y2:=PosY+LY;
\r
1466 call Bs(2).affiche;
\r
1470 array Bs dim (1:3);
\r
1471 Bs(1):=new Racc(id+1,T_FLHAU,x1+2,y1+2,x1+15,y1+15,spr_upper);
\r
1478 Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);
\r
1480 Bs(3):=new Racc(id+3,T_FLBAS,x2-15,y2-16,x2-2,y2-3,spr_lower);
\r
1485 (***************************************************************************)
\r
1486 (* definition de la classe Ensemble (c'est une liste) *)
\r
1487 (***************************************************************************)
\r
1489 Unit Ensemble : class;
\r
1494 Unit Node : class(data : elmt);
\r
1498 Unit virtual egalite : function (x,y : elmt) :boolean;
\r
1501 Unit Empty : function : boolean;
\r
1504 then result:=True;
\r
1505 else result:=False;
\r
1509 Unit Member : function (n : elmt) : boolean;
\r
1516 While (Courant<>none)
\r
1518 if not egalite(Courant.data,n)
\r
1519 then saveCou:=Courant; Courant:=Courant.next;
\r
1520 else bl:=True; exit;
\r
1527 Unit Insert : procedure (n : elmt);
\r
1533 then Head:=new Node(n); Last:=Head;
\r
1534 else Last.next:=new Node(n);
\r
1540 Unit Delete : procedure (n : elmt);
\r
1546 then flag:=Courant.next;
\r
1548 then Last:=Courant; courant.next:=none; kill(flag);
\r
1549 else if Courant.next<>none
\r
1550 then Courant.next:=Courant.next.next; kill(flag);
\r
1558 (***************************************************************************)
\r
1559 (* definition de la classe cliquer derivant de la classe ensemble *)
\r
1560 (***************************************************************************)
\r
1562 Unit cliquer : Ensemble class;
\r
1564 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
1567 then result:=True;
\r
1568 else result:=False;
\r
1572 Unit Appartient : function(x,y : integer) : integer;
\r
1577 while (Courant<>none)
\r
1579 if(x<(Courant.data qua elm.x2) and x>(Courant.data qua elm.x1) and
\r
1580 y<(Courant.data qua elm.y2) and y>(Courant.data qua elm.y1))
\r
1581 then bl:=True; exit;
\r
1582 else Courant:=Courant.next;
\r
1586 then result:=Courant.data qua elm.id;
\r
1593 (***************************************************************************)
\r
1594 (* definition de la classe Listbot d
\82rivant de ensemble *)
\r
1595 (***************************************************************************)
\r
1597 Unit Listbot : Ensemble class;
\r
1599 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
1601 if (x.id) = (y.id)
\r
1602 then result:=True;
\r
1603 else result:=False;
\r
1609 (***************************************************************************)
\r
1610 (* definition de la classe ListKey d
\82rivant de ensemble *)
\r
1611 (***************************************************************************)
\r
1613 Unit ListKey : Ensemble class;
\r
1615 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
1617 if (x.id) = (y.id)
\r
1618 then result:=True;
\r
1619 else result:=False;
\r
1623 Unit Appartient : function(x : integer) : boolean;
\r
1628 while (Courant<>none)
\r
1630 if(Courant.data.id = x)
\r
1631 then bl:=True; exit;
\r
1632 else Courant:=Courant.next;
\r
1640 (***************************************************************************)
\r
1641 (* definition de la classe ListW d
\82rivant de ensemble *)
\r
1642 (***************************************************************************)
\r
1644 Unit ListW : Ensemble class;
\r
1646 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
1648 (* if (x qua Son.numero) = (y qua Son.numero)
\r
1649 then result:=True;
\r
1650 else result:=False;
\r
1656 (***************************************************************************)
\r
1657 (* procedure d'affichage des sprites des boutons *)
\r
1658 (***************************************************************************)
\r
1660 (***************************************************************************)
\r
1661 Unit spr_upper : procedure(x1,y1,x2,y2,couleur : integer);
\r
1662 var i,x,y : integer;
\r
1668 call Line(x1+x-i/2,y1+y/2+i,x1+x+i/2,y1+y/2+i,couleur);
\r
1672 (***************************************************************************)
\r
1673 Unit spr_lower : procedure(x1,y1,x2,y2,couleur : integer);
\r
1674 var i,x,y : integer;
\r
1680 call Line(x1+x-i/2,y2-y/2-i,x1+x+i/2,y2-y/2-i,couleur);
\r
1684 (***************************************************************************)
\r
1685 Unit spr_left : procedure(x1,y1,x2,y2,couleur : integer);
\r
1686 var i,x,y : integer;
\r
1692 call Line(x2-x/2-i,y1+y-i/2,x2-x/2-i,y1+y+i/2,couleur);
\r
1696 (***************************************************************************)
\r
1697 Unit spr_right : procedure(x1,y1,x2,y2,couleur : integer);
\r
1698 var i,x,y : integer;
\r
1704 call Line(x1+x/2+i,y1+y-i/2,x1+x/2+i,y1+y+i/2,couleur);
\r
1708 (***************************************************************************)
\r
1709 Unit spr_close : procedure(x1,y1,x2,y2,couleur : integer);
\r
1713 call Rectanglef(x1+3,y1+y-1,x2-3,y1+y+1,couleur);
\r
1716 (***************************************************************************)
\r
1717 Unit spr_point : procedure(x1,y1,x2,y2,couleur : integer);;
\r
1718 var x,y : integer;
\r
1722 call Rectanglef(x1+x-1,y1+y-1,x1+x+1,y1+y+1,couleur);
\r
1725 (***************************************************************************)
\r
1726 (* procedure de gestion des boutons *)
\r
1727 (***************************************************************************)
\r
1729 (***************************************************************************)
\r
1730 Unit Bot_Load : procedure;
\r
1731 Const Largeur=300,
\r
1735 Posx,Posy : integer,
\r
1737 flagbool : boolean;
\r
1741 Posx:=x-Largeur/2;
\r
1742 Posy:=y-Hauteur/2;
\r
1743 fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
\r
1744 2,False,False,False);
\r
1746 fenet.hauteur:=Haut_Bot;
\r
1747 fenet.cborder:=RougeClair;
\r
1748 fenet.cbande:=Rouge;
\r
1750 clics:=new cliquer;
\r
1751 call fenet.affiche;
\r
1752 flagbool:=fenet.moveto(10,10);
\r
1753 call color(BleuClair);
\r
1754 flagbool:=fenet.outgtext("Chargement de Ville.dat en cours",32);
\r
1755 flagbool:=fenet.moveto(10,25);
\r
1756 call color(VertClair);
\r
1757 flagbool:=fenet.outgtext(".",1);
\r
1758 call Lit_Ville(fenet);
\r
1759 flagbool:=fenet.moveto(10,40);
\r
1760 call color(BleuClair);
\r
1761 flagbool:=fenet.outgtext("Chargement termine : 'Enter'",28);
\r
1762 fenet.B(0).etat:=True;
\r
1763 call fenet.bout.insert(fenet.B(0));
\r
1764 call fenet.B(0).affiche;
\r
1765 call keys.insert(new elmt(Tou_Ent));
\r
1768 code:=fenet.gestionnaire;
\r
1769 if code=Tou_Ent or code=11 then exit fi;
\r
1775 clics:=new cliquer;
\r
1777 call Etat_Menu(True,True,False,False,True);
\r
1779 COEF_X:=Larg_Aff/Larg_Vil;
\r
1780 COEF_Y:=Haut_Aff/Haut_Vil;
\r
1782 call Ville_aff(1);
\r
1786 (***************************************************************************)
\r
1787 Unit Bot_Run : procedure;
\r
1788 Const Largeur=330,
\r
1792 Posx,Posy : integer,
\r
1794 flagbool : boolean,
\r
1799 Posx:=x-Largeur/2;
\r
1800 Posy:=y-Hauteur/2;
\r
1801 fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
\r
1802 2,False,False,False);
\r
1804 fenet.hauteur:=Haut_Bot;
\r
1805 fenet.cborder:=RougeClair;
\r
1806 fenet.cbande:=Rouge;
\r
1808 clics:=new cliquer;
\r
1809 call fenet.affiche;
\r
1810 call color(BleuClair);
\r
1811 flagbool:=fenet.moveto(10,10);
\r
1812 flagbool:=fenet.outgtext("Entrez le nombre de voitures (1-50)",32);
\r
1813 flagbool:=fenet.moveto(145,30);
\r
1814 nbcar:=gscanf(1,50);
\r
1815 call prg.generator(nbcar);
\r
1819 clics:=new cliquer;
\r
1821 call Etat_Menu(False,False,True,False,False);
\r
1823 call Ville_aff(1);
\r
1826 (***************************************************************************)
\r
1827 Unit Bot_Stop : procedure;
\r
1828 Const Largeur=280,
\r
1832 Posx,Posy : integer,
\r
1834 flagbool : boolean;
\r
1838 Posx:=x-Largeur/2;
\r
1839 Posy:=y-Hauteur/2;
\r
1840 fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
\r
1841 2,False,False,False);
\r
1843 fenet.hauteur:=Haut_Bot;
\r
1844 fenet.cborder:=RougeClair;
\r
1845 fenet.cbande:=Rouge;
\r
1847 clics:=new cliquer;
\r
1848 call fenet.affiche;
\r
1849 call color(BleuClair);
\r
1850 flagbool:=fenet.moveto(60,10);
\r
1851 flagbool:=fenet.outgtext("Simulation stopp
\82e",18);
\r
1852 flagbool:=fenet.moveto(40,30);
\r
1853 flagbool:=fenet.outgtext("Appuyez sur une touche",22);
\r
1856 if code<>0 then exit; fi;
\r
1861 clics:=new cliquer;
\r
1863 call Etat_Menu(True,False,False,True,True);
\r
1865 call Ville_aff(1);
\r
1868 (***************************************************************************)
\r
1869 Unit Bot_continue : procedure;
\r
1870 Const Largeur=300,
\r
1874 Posx,Posy : integer,
\r
1876 flagbool : boolean;
\r
1880 Posx:=x-Largeur/2;
\r
1881 Posy:=y-Hauteur/2;
\r
1882 fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
\r
1883 2,False,False,False);
\r
1885 fenet.hauteur:=Haut_Bot;
\r
1886 fenet.cborder:=RougeClair;
\r
1887 fenet.cbande:=Rouge;
\r
1889 clics:=new cliquer;
\r
1890 call fenet.affiche;
\r
1893 if code=13 then exit fi;
\r
1898 clics:=new cliquer;
\r
1900 call Etat_Menu(False,False,True,False,False);
\r
1902 call Ville_aff(1);
\r
1905 (***************************************************************************)
\r
1906 Unit Bot_Quit : function : boolean;
\r
1907 Const Largeur=300,
\r
1911 Posx,Posy : integer,
\r
1918 Posx:=x-Largeur/2;
\r
1919 Posy:=y-Hauteur/2;
\r
1920 fenet:=new Son(10,Posx,Posy,Posx+Largeur,Posy+hauteur,2,True,False,False);
\r
1922 fenet.hauteur:=Haut_Bot;
\r
1923 fenet.cborder:=RougeClair;
\r
1924 fenet.nom:="Q U I T";
\r
1925 fenet.cnom:=RougeClair;
\r
1926 fenet.cbande:=Rouge;
\r
1928 clics:=new cliquer;
\r
1929 Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);
\r
1932 call fenet.Bout.Insert(Yes);
\r
1933 No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);
\r
1936 call fenet.Bout.Insert(No);
\r
1937 call fenet.affiche;
\r
1938 call move(Posx+10,Posy+35);
\r
1939 call color(BleuClair);
\r
1940 call outstring("Do you want to quit the application");
\r
1941 call Keys.Insert(new elmt(T_ESC));
\r
1944 code:=fenet.gestionnaire;
\r
1946 when T_ESC : fin:=False; exit; (* touche racc exit *)
\r
1947 when T_Y : fin:=True; exit; (* touche Y *)
\r
1948 when T_N : fin:=False; exit; (* touche N *)
\r
1949 when 1 : fin:=True; exit; (* bouton yes *)
\r
1950 when 2 : fin:=False; exit; (* bouton no *)
\r
1951 when 11 : fin:=False; exit; (* racc exit *)
\r
1956 then attach(fenet);
\r
1959 clics:=new cliquer;
\r
1962 call Ville_aff(1);
\r
1964 else result:=True;
\r
1969 (***************************************************************************)
\r
1970 Unit Bot_Help : procedure;
\r
1971 Const Largeur=410,
\r
1974 x,y,i,j : integer,
\r
1976 COORD_Y : integer,
\r
1979 boolaff : boolean,
\r
1980 help : arrayof arrayof char,
\r
1981 nb_lign_hlp : integer;
\r
1984 Unit affiche_hlp : procedure;
\r
1987 call color(BleuClair);
\r
1988 for i:=COORD_Y to imin(COORD_Y+18,nb_lign_hlp)
\r
1992 if (ord(help(i,j))>=28 and ord(help(i,j))<=255)
\r
1993 then boolaff:=fen.outchar(help(i,j));
\r
2002 fen:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,2,
\r
2003 True,False,False);
\r
2005 fen.cnom:=RougeClair;
\r
2006 fen.nom:="H E L P";
\r
2007 fen.hauteur:=Haut_Bot;
\r
2008 fen.largeur:=Larg_Bot;
\r
2009 fen.cborder:=RougeClair;
\r
2010 fen.cbande:=Rouge;
\r
2012 clics:=new cliquer;
\r
2014 Keys:=new ListKey;
\r
2015 x:=fen.x2-fen.lborder-1-fen.hauteur;
\r
2016 y:=fen.y1+fen.hauteur+fen.lborder+1;
\r
2017 fen.Verti:=new AccelerateV(20,-1,x,y,x+fen.largeur,fen.y2-fen.lborder-1,fen);
\r
2019 call fen.Verti.deplacer(fen.Verti.MinY);
\r
2020 call Keys.Insert(new elmt(T_ESC)); (* pour sortir de la fenetre *)
\r
2021 call Keys.Insert(new elmt(T_PGUP)); (* page up *)
\r
2022 call Keys.Insert(new elmt(T_PGDOWN)); (* page dow *)
\r
2024 open(fp,text,unpack("simula.hlp"));
\r
2026 readln(fp,nb_lign_hlp);
\r
2027 array help dim (1:nb_lign_hlp);
\r
2028 for i:=1 to nb_lign_hlp
\r
2030 array help(i) dim (1:38);
\r
2032 call color(BleuClair);
\r
2037 read(fp,help(i,j));
\r
2039 if j=39 then j:=1;
\r
2044 call setposition(fen.x1,fen.y1);
\r
2047 code:=fen.gestionnaire;
\r
2049 if (code=T_ESC) or (code=11) then exit;
\r
2051 if (code=21) or (code=T_FLHAU) then COORD_Y:=COORD_Y-5;
\r
2052 if COORD_Y<=0 then COORD_Y:=1; fi;
\r
2053 call fen.Verti.DeplacerUp;
\r
2056 if (code=22) then COORD_Y:=1;
\r
2057 call fen.Verti.Reset_Bot;
\r
2060 if (code=23) or (code=T_FLBAS) then COORD_Y:=COORD_Y+5;
\r
2061 if COORD_Y>(nb_lign_hlp-5)
\r
2062 then COORD_Y:=nb_lign_hlp-5;
\r
2064 call fen.Verti.DeplacerDown;
\r
2067 if (code=T_PGUP) then COORD_Y:=COORD_Y-19;
\r
2070 call fen.Verti.Deplacer(fen.Verti.MinY);
\r
2071 else call fen.Verti.DeplacerDown;
\r
2075 if (code=T_PGDOWN) then COORD_Y:=COORD_Y+19;
\r
2076 if COORD_Y>(nb_lign_hlp-5)
\r
2077 then COORD_Y:=nb_lign_hlp-5;
\r
2078 call fen.Verti.Deplacer(fen.Verti.MaxY);
\r
2079 else call fen.Verti.DeplacerDown;
\r
2090 attach(fen); (* correspond a la 1ere etape kill *)
\r
2093 clics:=new cliquer; (* on prepare pour la 'resurection' *)
\r
2095 Keys:=new ListKey;
\r
2098 call Ville_aff(1);
\r
2101 (***************************************************************************)
\r
2102 Unit Etat_Menu : procedure (ml,mr,ms,mc,mq : boolean);
\r
2104 if (ml and not M(1).etat) (* load devient enable *)
\r
2105 then M(1).etat:=True;
\r
2106 M(1).Touche:=T_F1;
\r
2107 call M(1).bot_enable;
\r
2109 if (not ml and M(1).etat) (* load devient disable *)
\r
2110 then M(1).etat:=False;
\r
2112 call M(1).bot_disable;
\r
2114 if (mr and not M(2).etat) (* run devient enable *)
\r
2115 then M(2).etat:=True;
\r
2116 M(2).Touche:=T_F2;
\r
2117 call M(2).bot_enable;
\r
2119 if (not mr and M(2).etat) (* run devient disable *)
\r
2120 then M(2).etat:=False;
\r
2122 call M(2).bot_disable;
\r
2124 if (ms and not M(3).etat) (* stop devient enable *)
\r
2125 then M(3).etat:=True;
\r
2126 M(3).Touche:=T_F3;
\r
2127 call M(3).bot_enable;
\r
2129 if (not ms and M(3).etat) (* stop devient disable *)
\r
2130 then M(3).etat:=False;
\r
2132 call M(3).bot_disable;
\r
2134 if (mc and not M(4).etat) (* continue devient enable *)
\r
2135 then M(4).etat:=True;
\r
2136 M(4).Touche:=T_F4;
\r
2137 call M(4).bot_enable;
\r
2139 if (not mc and M(4).etat) (* continue devient disable *)
\r
2140 then M(4).etat:=False;
\r
2142 call M(4).bot_disable;
\r
2144 if (mq and not M(5).etat) (* quit devient enable *)
\r
2145 then M(5).etat:=True;
\r
2146 M(5).Touche:=T_F5;
\r
2147 call M(5).bot_enable;
\r
2149 if (not mq and M(5).etat) (* quit devient disable *)
\r
2150 then M(5).etat:=False;
\r
2152 call M(5).bot_disable;
\r
2156 (***************************************************************************)
\r
2157 (* procedure d'affichage de la ville - on deborde de l'ecran *)
\r
2158 (* tracer d'une ligne verticale qui peut depasser le cadre *)
\r
2159 (***************************************************************************)
\r
2161 Unit Trace_Vil1 : procedure (x1,y1,x2,y2 : real ; zoom : integer);
\r
2169 min_x:=imin(x1,x2);
\r
2170 max_x:=imax(x1,x2);
\r
2171 min_y:=imin(y1,y2);
\r
2172 max_y:=imax(y1,y2);
\r
2173 if (min_y>=Ydep_Aff and max_y<=(Ydep_Aff+Haut_Aff))
\r
2174 then (* on est en plein dans le cadre, on peut tracer normalement *)
\r
2175 call line(x1-C,imin(y1,y2)+C,x2-C,imax(y1,y2)-C,GrisClair);
\r
2176 call linep(x1,imin(y1,y2)+C,x2,imax(y1,y2)-C,Blanc,C);
\r
2177 call line(x1+C,imin(y1,y2)+C,x2+C,imax(y1,y2)-C,GrisClair);
\r
2178 else if (min_y<Ydep_Aff) (* c'est le minimum qui pose pb *)
\r
2179 then call line(x1-C,Ydep_Aff+C,x2-C,imax(y1,y2)-C,GrisClair);
\r
2180 call linep(x1,Ydep_Aff+C,x2,imax(y1,y2)-C,Blanc,C);
\r
2181 call line(x1+C,Ydep_Aff+C,x2+C,imax(y1,y2)-C,GrisClair);
\r
2182 else call line(x1-C,imin(y1,y2)+C,x2-C,Ydep_Aff+Haut_Aff-C,GrisClair);
\r
2183 call linep(x1,imin(y1,y2)+C,x2,Ydep_Aff+Haut_Aff-C,Blanc,C);
\r
2184 call line(x1+C,imin(y1,y2)+C,x2+C,Ydep_Aff+Haut_Aff-C,GrisClair);
\r
2190 (***************************************************************************)
\r
2191 (* procedure d'affichage de la ville - on deborde de l'ecran *)
\r
2192 (* tracer d'une ligne horizontale qui peut depasser le cadre *)
\r
2193 (***************************************************************************)
\r
2195 Unit Trace_Vil2 : procedure (x1,y1,x2,y2 : real ; zoom : integer);
\r
2203 min_x:=imin(x1,x2);
\r
2204 max_x:=imax(x1,x2);
\r
2205 min_y:=imin(y1,y2);
\r
2206 max_y:=imax(y1,y2);
\r
2207 if (min_x>=Xdep_Aff and max_x<=(Xdep_Aff+Larg_Aff))
\r
2208 then (* on est en plein dans le cadre, on peut tracer normalement *)
\r
2209 call line(imin(x1,x2)+C,y1-C,imax(x2,x1)-C,y2-C,GrisClair);
\r
2210 call linep(imin(x1,x2)+C,y1,imax(x2,x1)-C,y2,Blanc,C);
\r
2211 call line(imin(x1,x2)+C,y1+C,imax(x1,x2)-C,y2+C,GrisClair);
\r
2212 else if (min_x<Xdep_Aff) (* c'est le minimum qui pose pb *)
\r
2213 then call line(Xdep_Aff+C,y1-C,imax(x1,x2)-C,y2-C,GrisClair);
\r
2214 call linep(Xdep_Aff+C,y1,imax(x1,x2)-C,y2,Blanc,C);
\r
2215 call line(Xdep_Aff+C,y1+C,imax(x1,x2)-C,y2+C,GrisClair);
\r
2216 else call line(imin(x1,x2)+C,y1-C,Xdep_Aff+Larg_Aff-C,y2-C,GrisClair);
\r
2217 call linep(imin(x1,x2)+C,y1,Xdep_Aff+Larg_Aff-C,y2,Blanc,C);
\r
2218 call line(imin(x1,x2)+C,y1+C,Xdep_Aff+Larg_Aff-C,y2+C,GrisClair);
\r
2223 (***************************************************************************)
\r
2224 (* procedure d'affichage de la ville *)
\r
2225 (***************************************************************************)
\r
2226 Unit Ville_Aff : procedure(zoom : integer);
\r
2244 x1:=Xdep_Aff+COORD_X+(r.initial.colonne*COEF_X*zoom);
\r
2245 y1:=Ydep_Aff+COORD_Y+(r.initial.Ligne*COEF_Y*zoom);
\r
2246 x2:=Xdep_Aff+COORD_X+(r.final.colonne*COEF_X*zoom);
\r
2247 y2:=Ydep_Aff+COORD_Y+(r.final.Ligne*COEF_Y*zoom);
\r
2248 min_x:=imin(x1,x2);
\r
2249 max_x:=imax(x1,x2);
\r
2250 min_y:=imin(y1,y2);
\r
2251 max_y:=imax(y1,y2);
\r
2252 if(x1=x2) (* c'est une ligne verticale *)
\r
2254 if (x1<Xdep_Aff or x2>(Xdep_Aff+Larg_Aff)) (* on est hors de l'ecran*)
\r
2255 then (* on ne fait rien *)
\r
2256 else (* on va peut etre afficher qqch *)
\r
2257 if (max_y<Ydep_Aff or min_y>(Ydep_Aff+Haut_Aff))
\r
2258 then (* on ne doit rien afficher *)
\r
2259 else (* on va afficher qqch *)
\r
2260 call trace_vil1(x1,y1,x2,y2,zoom);
\r
2264 if(y1=y2) (* c'est une ligne horizontale *)
\r
2266 if (y1<Ydep_Aff or y2>(Ydep_Aff+Haut_Aff)) (* on est hors de l'ecran*)
\r
2267 then (*on ne fait rien *)
\r
2268 else (*on va peut etre afficher qqch *)
\r
2269 if (max_x<Xdep_Aff or min_x>(Xdep_Aff+Larg_Aff))
\r
2270 then (* on ne doit rien afficher *)
\r
2271 else (* on va afficher qqch *)
\r
2272 call trace_vil2(x1,y1,x2,y2,zoom);
\r
2282 x1:=Xdep_Aff+COORD_X+(s.colonne*COEF_X*zoom);
\r
2283 y1:=Ydep_Aff+COORD_Y+(s.Ligne*COEF_Y*zoom);
\r
2284 if (x1>=Xdep_Aff and x1<=(Xdep_Aff+Larg_Aff)
\r
2285 and y1>=Ydep_Aff and y1<=(Ydep_Aff+Haut_Aff))
\r
2286 then case s.afftype
\r
2287 when 1 : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
\r
2288 call line(x1+C,y1-C,x1+C,y1+C,GrisClair);
\r
2289 when 2 : call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
\r
2290 call line(x1+C,y1+C,x1+C,y1-C,GrisClair);
\r
2291 when 3 : call line(x1-C,y1+C,x1-C,y1-C,GrisClair);
\r
2292 call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
\r
2293 when 4 : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);
\r
2294 call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
\r
2295 when 5 : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
\r
2296 when 6 : call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
\r
2297 when 7 : call line(x1+C,y1-C,x1+C,y1+C,GrisClair);
\r
2298 when 8 : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);
\r
2300 when 10 : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
\r
2301 call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
\r
2302 when 11 : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);
\r
2303 call line(x1+C,y1-C,x1+C,y1+C,GrisClair);
\r
2311 (***************************************************************************)
\r
2313 (***************************************************************************)
\r
2314 Unit prog : Lists class;
\r
2316 (***************************************************************************)
\r
2317 (* procedure de mise en route du generateur de voitures *)
\r
2318 (***************************************************************************)
\r
2319 Unit generator : procedure (nbcar : integer);
\r
2321 call schedule(new Generate(nbcar),time);
\r
2325 (***************************************************************************)
\r
2326 (* simprocess de generation des voitures *)
\r
2327 (***************************************************************************)
\r
2328 Unit Generate : Simprocess class(nbcar : integer);
\r
2331 if NbCarActiv<=nbcar
\r
2332 then call schedule(new car,time);
\r
2333 NbCarActiv:=NbCarActiv+1;
\r
2339 (***************************************************************************)
\r
2340 (* simprocess des voitures *)
\r
2341 (* on se limite au cas o
\97 toutes les voies sont
\85 double sens *)
\r
2342 (***************************************************************************)
\r
2343 Unit Car : Simprocess class;
\r
2345 (* procedure d'affichage de la voiture dans la ville *)
\r
2346 Unit affiche_car : procedure;
\r
2351 (* fonction se deplacant dans l'arc courant *)
\r
2352 Unit avance : function : boolean;
\r
2355 then arccour.occpsens(km):=none;
\r
2357 if km<=arccour.distance
\r
2358 then arccour.occpsens(km):=this car;
\r
2359 result:=True; (* on n'a pas encore fini *)
\r
2360 else result:=False; (* on est arrive au sommet final *)
\r
2362 else arccour.occpinve(km):=none;
\r
2364 if km<=arccour.distance
\r
2365 then arccour.occpinve(km):=this car;
\r
2366 result:=True; (* on n'a pas encore fini *)
\r
2367 else result:=False; (* on est arrive au sommet final *)
\r
2370 call affiche_car;
\r
2373 (* fonction choisissant le sommet de depart *)
\r
2374 Unit choix_sommet : function : sommets;
\r
2375 var som : sommets,
\r
2380 ch:=RANDOM*NBSOMMETS+1; (* on choisit le numero du sommet *)
\r
2388 (* fonction choisissant l'arc suivant que l'on va prendre *)
\r
2389 Unit choix_arc : function : arcs;
\r
2392 numarcdep : integer,
\r
2396 if (dep.afftype<=8 and dep.afftype>=5)
\r
2397 then nbarcs:=nbarcs+1;
\r
2398 else if dep.afftype=9
\r
2399 then nbarcs:=nbarcs+2;
\r
2402 numarcdep:=RANDOM*nbarcs+1;
\r
2404 for i:=1 to numarcdep-1 (* on recherche cet arc dans la liste *)
\r
2406 lst:=lst.suivante;
\r
2408 km:=1; (* kilometrage dans l'arc *)
\r
2409 result:=lst.pointeur; (* on poss
\8ade l'arc *)
\r
2410 if result.initial=dep
\r
2416 Var dep : sommets, (* sommet de depart du voyage *)
\r
2417 arccour : arcs, (* arc de depart du voyage *)
\r
2419 sens : integer, (* 1 si ini-fin , -1 si fin-ini *)
\r
2420 km : integer; (* distance ds l'arc courant depuis sommet initial*)
\r
2422 dep:=choix_sommet;
\r
2423 arccour:=choix_arc;
\r
2425 boo:=avance; (* on avance d'un pas *)
\r
2426 if boo (* on est
\85 la fin de l'arc, il faut savoir si on va en *)
\r
2427 (* prendre un autre *)
\r
2428 then km:=RANDOM*100;
\r
2430 then arccour:=choix_arc; (* on a 60% de chance de continuer *)
\r
2431 boo:=True; (* on doit donc continuer *)
\r
2432 else boo:=False; (* on s'arrete *)
\r
2435 if boo (* si boo alors on n'est pas encore au point d'arrivee *)
\r
2436 then call hold(100);
\r
2440 NbCarActiv:=NbCarActiv-1;
\r
2445 (***************************************************************************)
\r
2446 (* simprocess de gestion de l'affichage *)
\r
2447 (***************************************************************************)
\r
2448 Unit affichage : simprocess class;
\r
2451 code:=W.Gestionnaire;
\r
2453 if (code=T_F1) or (code=1) then call Bot_Load;
\r
2455 if (code=T_F5) or (code=5) then if Bot_Quit then fin:=True; exit; fi;
\r
2457 if (code=T_F8) or (code=8) then call Bot_help;
\r
2459 if (code=T_ALTF4) then if Bot_Quit then fin:=True; exit; fi;
\r
2461 if (code=T_F2) or (code=2) then call Bot_Run;
\r
2463 if (code=T_F3) or (code=3) then call Bot_Stop;
\r
2465 if (code=T_f4) or (code=4) then call Bot_Continue;
\r
2467 if (code=T_FLGCH) or (code=51) then call W.Horiz.DeplacerLeft;
\r
2468 COORD_X:=COORD_X+30;
\r
2469 call Ville_Aff(ZOOM);
\r
2471 if (code=T_FLDTE) or (code=53) then call W.Horiz.DeplacerRight;
\r
2472 COORD_X:=COORD_X-30;
\r
2473 call Ville_Aff(ZOOM);
\r
2475 if (code=T_FLHAU) or (code=61) then call W.Verti.DeplacerUp;
\r
2476 COORD_Y:=COORD_Y+30;
\r
2477 call Ville_Aff(ZOOM);
\r
2479 if (code=T_FLBAS) or (code=63) then call W.verti.DeplacerDown;
\r
2480 COORD_Y:=COORD_Y-30;
\r
2481 call Ville_Aff(ZOOM);
\r
2483 if (code=101) then if Bot_Quit then fin:=True; exit fi;
\r
2485 if (code=102) then call W.iconify;
\r
2486 call Ville_Aff(ZOOM);
\r
2488 if (code=52) then COORD_X:=0;
\r
2489 call W.Horiz.Reset_Bot;
\r
2490 call Ville_Aff(ZOOM);
\r
2492 if (code=62) then COORD_Y:=0;
\r
2493 call W.Verti.Reset_Bot;
\r
2494 call Ville_Aff(ZOOM);
\r
2496 if (code=6) or (code=T_F6)
\r
2497 then Zoom:=Zoom+1;
\r
2498 if zoom=5 then M(6).etat:=False;
\r
2499 call M(6).bot_disable;
\r
2501 if not M(7).etat then M(7).etat:=True;
\r
2502 call M(7).bot_enable;
\r
2505 Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20-2*C;
\r
2506 Haut_Aff:=W.Verti.y2-W.Verti.y1-20-2*C;
\r
2507 Xdep_Aff:=W.Horiz.x1+10+C;
\r
2508 Ydep_Aff:=W.Verti.y1+10+C;
\r
2509 call Ville_Aff(Zoom);
\r
2511 if (code=7) or (code=T_F7)
\r
2512 then Zoom:=Zoom-1;
\r
2513 if zoom=1 then M(7).etat:=False;
\r
2514 call M(7).bot_disable;
\r
2516 if not M(6).etat then M(6).etat:=True;
\r
2517 call M(6).bot_Enable;
\r
2520 Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20-2*C;
\r
2521 Haut_Aff:=W.Verti.y2-W.Verti.y1-20-2*C;
\r
2522 Xdep_Aff:=W.Horiz.x1+10+C;
\r
2523 Ydep_Aff:=W.Verti.y1+10+C;
\r
2524 call Ville_Aff(Zoom);
\r
2546 Var sim_aff : affichage;
\r
2548 sim_aff:=new affichage;
\r
2549 call schedule(sim_aff,time);
\r
2553 (***************************************************************************)
\r
2554 (* P R O G R A M M E P R I N C I P A L *)
\r
2555 (***************************************************************************)
\r
2556 Const Larg_bot=18,
\r
2563 ZOOM : integer, (*coeficient de zoom *)
\r
2564 C : integer, (* largeur des voies *)
\r
2565 boolAf : boolean; (* vrai si il faut afficher la ville *)
\r
2569 call gron(1); (* mode 640x480x256 avec driver stealth.grn*)
\r
2573 clics:=new cliquer; (* ensemble des zones de clic possible *)
\r
2575 W:=new Maine(100,1,1,SIZEX,SIZEY,3,True,True,False);
\r
2576 W.hauteur:=Haut_bot;
\r
2577 W.cborder:=BleuClair;
\r
2578 W.cbande:=GrisClair;
\r
2579 W.cnom:=BleuClair;
\r
2580 W.nom:="Simulation de r
\82seau routier";
\r
2583 array M dim (1:8);
\r
2585 y1:=W.y1+W.lborder+1+W.hauteur+2;
\r
2587 M(1):=new Menu(1,T_F1,W.x1+8,y1,W.x1+50,y2);
\r
2590 call W.Bout.Insert(M(1));
\r
2592 M(2):=new Menu(2,-1,W.x1+55,y1,W.x1+89,y2);
\r
2595 call W.Bout.Insert(M(2));
\r
2597 M(3):=new Menu(3,-1,W.x1+94,y1,W.x1+136,y2);
\r
2600 call W.Bout.Insert(M(3));
\r
2602 M(4):=new Menu(4,-1,W.x1+141,y1,W.x1+215,y2);
\r
2603 M(4).nom:="Continue";
\r
2605 call W.Bout.Insert(M(4));
\r
2607 M(5):=new Menu(5,T_F5,W.x1+220,y1,W.x1+262,y2);
\r
2610 call W.Bout.Insert(M(5));
\r
2612 M(6):=new Menu(6,T_F6,W.x2-94,y1,W.x2-77,y2);
\r
2615 call W.Bout.Insert(M(6));
\r
2617 M(7):=new Menu(7,T_F7,W.x2-72,y1,W.x2-55,y2);
\r
2620 call W.Bout.Insert(M(7));
\r
2622 M(8):=new Menu(8,T_F8,W.x2-30,y1,W.x2-13,y2);
\r
2625 call W.Bout.Insert(M(8));
\r
2627 x1:=W.x1+W.lborder+1;
\r
2628 y1:=W.y2-W.lborder-Haut_bot-1;
\r
2629 x2:=W.x2-W.lborder-Larg_bot-1;
\r
2630 y2:=W.y2-W.lborder-1;
\r
2631 W.Horiz:=new AccelerateH(50,-1,x1,y1,x2,y2,W);
\r
2633 x1:=W.x2-W.lborder-Larg_bot-1;
\r
2634 y1:=W.y1+W.lborder+2*(Haut_bot+2);
\r
2635 x2:=W.x2-W.lborder-1;
\r
2636 y2:=W.y2-W.lborder-Haut_bot;
\r
2637 W.Verti:=new AccelerateV(60,-1,x1,y1,x2,y2,W);
\r
2639 Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20;
\r
2640 Haut_Aff:=W.Verti.y2-W.Verti.y1-20;
\r
2641 Xdep_Aff:=W.Horiz.x1+10;
\r
2642 Ydep_Aff:=W.Verti.y1+10;
\r
2653 prg:=new prog; (* on met la simulation en route *)
\r
2654 (* NB: elle commence par l'affichage et sa gestion *)
\r