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 (* ligne de commande de lancement : 'svgaint simula' *)
\r
10 (***************************************************************************)
\r
13 Pref iiuwgraph block
\r
19 Const Noir = 0, Bleu = 1, Vert = 2, Cyan = 3,
\r
20 Rouge = 4, Magenta = 5, Marron = 6, GrisClair = 7,
\r
21 GrisFonce = 8, BleuClair = 9, VertClair =10, CyanClair =11,
\r
22 RougeClair =12, MagentaClair=13, Jaune =14, Blanc =15;
\r
24 Const T_F1 =315, T_F2 =316, T_F3 =317, T_F4 =318,
\r
25 T_F5 =319, T_F6 =320, T_F7 =321, T_F8 =322,
\r
26 T_F9 =323, T_F10 =324, T_SHFTF1 =340, T_SHFTF2 =341,
\r
27 T_SHFTF3 =342, T_SHFTF4 =343, T_SHFTF5 =344, T_SHFTF6 =345,
\r
28 T_SHFTF7 =346, T_SHFTF8 =347, T_SHFTF9 =348, T_SHFTF10=349,
\r
29 T_CTRLF1 =350, T_CTRLF2 =351, T_CTRLF3 =352, T_CTRLF4 =353,
\r
30 T_CTRLF5 =354, T_CTRLF6 =355, T_CTRLF7 =356, T_CTRLF8 =357,
\r
31 T_CTRLF9 =358, T_CTRLF10=359, T_ALTF1 =360, T_ALTF2 =361,
\r
32 T_ALTF3 =362, T_ALTF4 =363, T_ALTF5 =364, T_ALTF6 =365,
\r
33 T_ALTF7 =366, T_ALTF8 =367, T_ALTF9 =368, T_ALTF10 =369,
\r
34 Tou_Ent =013, T_ESC =027, T_N =078, T_Y =089,
\r
35 T_FLGCH =331, T_FLDTE =333, T_FLHAU =328, T_FLBAS =336,
\r
36 T_ALT1 =376, T_ALT2 =377, T_PGUP =329, T_PGDOWN =337,
\r
37 T_Back =008, T_ESPACE =032, T_CTRLENT=010;
\r
39 Const Larg_bot=18, (* largeur des boutons *)
\r
40 Haut_bot=18; (* hauteur des boutons *)
\r
42 Var SIZEX : integer,
\r
46 (* les variables du syst
\8ame de fenetrage *)
\r
49 Larg_Vil : integer, (* largeur de la ville *)
\r
50 Haut_Vil : integer, (* Hauteur de la ville *)
\r
51 Larg_Aff : integer, (* largeur de l'interieur de la fenetre maine *)
\r
52 Haut_Aff : integer, (* hauteur de l'interieur de la fenetre maine *)
\r
53 Xdep_Aff : integer, (* Point de depart de l'affichage en X ds maine *)
\r
54 Ydep_Aff : integer, (* point de depart de l'affichage en Y ds maine *)
\r
55 COEF_X : real, (* coeficient de zoom en x *)
\r
56 COEF_Y : real, (* coeficient de zoom en y *)
\r
57 COORD_X : integer, (* coordonn
\82e en X de Xdep_Aff en relatif *)
\r
58 COORD_Y : integer, (* coordonn
\82e en Y de Ydep_Aff en relatif *)
\r
60 SLKEYS : arrayof listkey,
\r
61 SLCLICS : arrayof cliquer,
\r
65 SIMULA : simulateur,
\r
69 (* les variables de la simulation *)
\r
71 Var RaciSomm : Sommets,
\r
73 Activ : arrayof Pointeur, (* liste des vehicules en activite *)
\r
74 NbCarActiv : integer,
\r
76 NBSOMMETS : integer,
\r
79 (***************************************************************************)
\r
80 (* Permet de cr
\82er un pointeur en loglan *)
\r
81 (***************************************************************************)
\r
82 Unit Pointeur : class;
\r
86 (***************************************************************************)
\r
87 (* definition des classes et procedures de simprocess *)
\r
88 (***************************************************************************)
\r
91 UNIT PRIORITYQUEUE: CLASS;
\r
93 (* HEAP AS BINARY LINKED TREE WITH FATHER LINK*)
\r
96 UNIT QUEUEHEAD: CLASS;
\r
97 (* HEAP ACCESING MODULE *)
\r
100 UNIT MIN: FUNCTION: ELEM;
\r
102 IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;
\r
105 UNIT INSERT: PROCEDURE(R:ELEM);
\r
106 (* INSERTION INTO HEAP *)
\r
112 ROOT.LEFT,ROOT.RIGHT,LAST:=ROOT
\r
128 LAST.LEFT.RIGHT:=X;
\r
133 CALL CORRECT(R,FALSE)
\r
136 UNIT DELETE: PROCEDURE(R: ELEM);
\r
153 LAST.NS:= LAST.NS-1;
\r
156 IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)
\r
157 ELSE CALL CORRECT(X.EL,TRUE) FI;
\r
160 UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN);
\r
161 (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *)
\r
162 VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN;
\r
167 IF Z.NS =0 THEN FIN:=TRUE ELSE
\r
168 IF Z.NS=1 THEN X:=Z.LEFT ELSE
\r
169 IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT
\r
171 IF Z.LESS(X) THEN FIN:=TRUE ELSE
\r
182 IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;
\r
191 IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);
\r
200 UNIT NODE: CLASS (EL:ELEM);
\r
201 (* ELEMENT OF THE HEAP *)
\r
202 VAR LEFT,RIGHT,UP: NODE, NS:INTEGER;
\r
203 UNIT LESS: FUNCTION(X:NODE): BOOLEAN;
\r
205 IF X= NONE THEN RESULT:=FALSE
\r
206 ELSE RESULT:=EL.LESS(X.EL) FI;
\r
211 UNIT ELEM: CLASS(PRIOR:REAL);
\r
212 (* PREFIX OF INFORMATION TO BE STORED IN NODE *)
\r
214 UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;
\r
216 IF X=NONE THEN RESULT:= FALSE ELSE
\r
217 RESULT:= PRIOR< X.PRIOR FI;
\r
220 LAB:= NEW NODE(THIS ELEM);
\r
228 UNIT SIMULATION: PRIORITYQUEUE CLASS;
\r
229 (* THE LANGUAGE FOR SIMULATION PURPOSES *)
\r
231 VAR CURR: SIMPROCESS, (*ACTIVE PROCESS *)
\r
232 PQ:QUEUEHEAD, (* THE TIME AXIS *)
\r
233 MAINPR: MAINPROGRAM;
\r
236 UNIT SIMPROCESS: pointeur COROUTINE;
\r
237 (* USER PROCESS PREFIX *)
\r
238 VAR EVENT, (* ACTIVATION MOMENT NOTICE *)
\r
239 EVENTAUX: EVENTNOTICE,
\r
240 (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)
\r
241 (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS *)
\r
244 UNIT IDLE: FUNCTION: BOOLEAN;
\r
246 RESULT:= EVENT= NONE;
\r
249 UNIT TERMINATED: FUNCTION :BOOLEAN;
\r
254 UNIT EVTIME: FUNCTION: REAL;
\r
255 (* TIME OF ACTIVATION *)
\r
257 IF IDLE THEN CALL ERROR1;
\r
259 RESULT:= EVENT.EVENTTIME;
\r
262 UNIT ERROR1:PROCEDURE;
\r
265 WRITELN(" AN ATTEMPT TO ACCESS AN IDLE PROCESS TIME");
\r
268 UNIT ERROR2:PROCEDURE;
\r
271 WRITELN(" AN ATTEMPT TO ACCESS A TERMINATED PROCESS TIME");
\r
283 UNIT EVENTNOTICE: ELEM CLASS;
\r
284 (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *)
\r
285 VAR EVENTTIME: REAL, PROC: SIMPROCESS;
\r
287 UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;
\r
288 (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)
\r
290 IF X=NONE THEN RESULT:= FALSE ELSE
\r
291 RESULT:= EVENTTIME< X.EVENTTIME OR
\r
292 (EVENTTIME=X.EVENTTIME AND PRIOR< X.PRIOR); FI;
\r
298 UNIT MAINPROGRAM: SIMPROCESS CLASS;
\r
299 (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)
\r
301 DO ATTACH(MAIN) OD;
\r
304 UNIT TIME:FUNCTION:REAL;
\r
305 (* CURRENT VALUE OF SIMULATION TIME *)
\r
307 RESULT:=CURRENT.EVTIME
\r
310 UNIT CURRENT: FUNCTION: SIMPROCESS;
\r
311 (* THE FIRST PROCESS ON THE TIME AXIS *)
\r
316 UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);
\r
317 (* ACTIVATION OF PROCESS P AT TIME T AND DEFINITION OF "PRIOR"- PRIORITY *)
\r
318 (* WITHIN TIME MOMENT T *)
\r
320 IF T<TIME THEN T:= TIME FI;
\r
321 IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE
\r
322 IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)
\r
323 P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);
\r
326 IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN
\r
327 P.EVENT:= P.EVENTAUX;
\r
328 P.EVENT.PRIOR:=RANDOM;
\r
330 (* NEW SCHEDULING *)
\r
331 P.EVENT.PRIOR:=RANDOM;
\r
332 CALL PQ.DELETE(P.EVENT)
\r
334 P.EVENT.EVENTTIME:= T;
\r
335 CALL PQ.INSERT(P.EVENT) FI;
\r
338 UNIT HOLD:PROCEDURE(T:REAL);
\r
339 (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)
\r
340 (* REDEFINE PRIOR *)
\r
342 CALL PQ.DELETE(CURRENT.EVENT);
\r
343 CURRENT.EVENT.PRIOR:=RANDOM;
\r
344 IF T<0 THEN T:=0; FI;
\r
345 CURRENT.EVENT.EVENTTIME:=TIME+T;
\r
346 CALL PQ.INSERT(CURRENT.EVENT);
\r
347 CALL CHOICEPROCESS;
\r
350 UNIT PASSIVATE: PROCEDURE;
\r
351 (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)
\r
353 CALL PQ.DELETE(CURRENT.EVENT);
\r
354 CURRENT.EVENT:=NONE;
\r
358 UNIT RUN: PROCEDURE(P:SIMPROCESS);
\r
359 (* ACTIVATE P IMMEDIATELY AND DELAY THE FORMER FIRST PROCESS BY REDEFINING*)
\r
362 CURRENT.EVENT.PRIOR:=RANDOM;
\r
365 P.EVENT.EVENTTIME:=TIME;
\r
366 CALL PQ.CORRECT(P.EVENT,FALSE)
\r
368 IF P.EVENTAUX=NONE THEN
\r
369 P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);
\r
370 P.EVENT.EVENTTIME:=TIME;
\r
372 CALL PQ.INSERT(P.EVENT)
\r
374 P.EVENT:=P.EVENTAUX;
\r
376 P.EVENT.EVENTTIME:=TIME;
\r
378 CALL PQ.INSERT(P.EVENT);
\r
380 CALL CHOICEPROCESS;
\r
383 UNIT CANCEL:PROCEDURE(P: SIMPROCESS);
\r
384 (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)
\r
386 IF P= CURRENT THEN CALL PASSIVATE ELSE
\r
387 CALL PQ.DELETE(P.EVENT);
\r
391 UNIT CHOICEPROCESS:PROCEDURE;
\r
392 (* CHOOSE THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)
\r
396 CURR:= PQ.MIN QUA EVENTNOTICE.PROC;
\r
397 IF CURR=NONE THEN WRITE(" ERROR IN THE HEAP"); WRITELN;
\r
399 ELSE ATTACH(CURR); FI;
\r
403 PQ:=NEW QUEUEHEAD; (* SIMULATION TIME AXIS*)
\r
404 CURR,MAINPR:=NEW MAINPROGRAM;
\r
405 MAINPR.EVENT,MAINPR.EVENTAUX:=NEW EVENTNOTICE(0);
\r
406 MAINPR.EVENT.EVENTTIME:=0;
\r
407 MAINPR.EVENT.PROC:=MAINPR;
\r
408 CALL PQ.INSERT(MAINPR.EVENT);
\r
409 (* THE FIRST PROCESS TO BE ACTIVATED IS MAIN PROGRAM *)
\r
416 UNIT LISTS:SIMULATION CLASS;
\r
417 (* WE WISH TO USE LISTS FOR QUEUEING PROCESSES DURING SIMULATION*)
\r
419 UNIT LINKAGE:CLASS;
\r
420 (*WE WILL USE TWO WAY LISTS *)
\r
421 VAR SUC1,PRED1:LINKAGE;
\r
423 UNIT HEAD:LINKAGE CLASS;
\r
424 (* EACH LIST WILL HAVE ONE ELEMENT ESTABLISHED *)
\r
425 UNIT FIRST:FUNCTION:LINK;
\r
427 IF SUC1 IN LINK THEN RESULT:=SUC1
\r
428 ELSE RESULT:=NONE FI;
\r
430 UNIT EMPTY:FUNCTION:BOOLEAN;
\r
432 RESULT:=SUC1=THIS LINKAGE;
\r
435 SUC1,PRED1:=THIS LINKAGE;
\r
438 UNIT LINK:LINKAGE CLASS;
\r
439 (* ORDINARY LIST ELEMENT PREFIX *)
\r
440 UNIT OUT:PROCEDURE;
\r
442 IF SUC1=/=NONE THEN
\r
445 SUC1,PRED1:=NONE FI;
\r
447 UNIT INTO:PROCEDURE(S:HEAD);
\r
452 IF S.SUC1=/=NONE THEN
\r
455 PRED1.SUC1:=THIS LINKAGE;
\r
456 S.PRED1:=THIS LINKAGE;
\r
461 UNIT ELEM:LINK CLASS(SPROCESS:SIMPROCESS);
\r
462 (* USER DEFINED PROCESS WILL BE JOINED INTO LISTS *)
\r
469 (***************************************************************************)
\r
470 (* definition des procedures de lecture des fichiers de donn
\82es et mise en *)
\r
471 (* m
\82moire des structures de la ville. *)
\r
472 (***************************************************************************)
\r
474 (***************************************************************************)
\r
475 (* Structure d une place de parking *)
\r
476 (***************************************************************************)
\r
478 Unit Place : class (N : integer );
\r
479 var P1 : arrayof boolean;
\r
481 array P1 dim (1:N);
\r
484 (***************************************************************************)
\r
485 (* Structure de la liste des arc qui peuvent etre atteind *)
\r
486 (***************************************************************************)
\r
488 Unit Liste : class;
\r
489 var pointeur: Arcs,
\r
493 (***************************************************************************)
\r
494 (* Structure des arcs *)
\r
495 (***************************************************************************)
\r
497 Var Numero : integer, (* Identification de l'arc *)
\r
498 Initial : Sommets, (* Sommet initial *)
\r
499 Final : Sommets, (* Sommet final *)
\r
500 Sens : integer, (* Sens de circulation *)
\r
501 Distance : integer, (* Distance de initial a final*)
\r
502 NbvoieIF : integer, (* Nombre de voie dans le sens 1 *)
\r
503 NbvoieFI : integer, (* Nombre de voie dans le sens -1 *)
\r
504 Suivants : Arcs, (* pointeur sur l'arc suivant dans la liste *)
\r
505 (* pointeur sera de type car lors des affectations *)
\r
506 occpsens : arrayof pointeur, (*si <>none alors il y a une voiture cette place*)
\r
507 occpinve : arrayof pointeur; (*en sens inverse de initial final *)
\r
510 (***************************************************************************)
\r
511 (* Structure des sommets *)
\r
512 (***************************************************************************)
\r
514 Unit Sommets : class;
\r
515 var Nom : char, (* Nom du sommet *)
\r
516 typecar : integer, (* Type carrefour 0:feu , 1:priorite , 2:stop *)
\r
517 afftype : integer, (* type carrefour 1..9 pour affichage *)
\r
518 Ligne : integer, (* Correspond a la position en Y sur ecran *)
\r
519 Colonne : integer, (* Correspond a la position en X sur ecran *)
\r
520 etat : integer, (* Etat du carrefour *)
\r
521 ptrarc : Liste, (* Pointeur sur la liste pointant sur les arcs *)
\r
522 suivant : Sommets; (* Pointeur sur les suivants *)
\r
525 (***************************************************************************)
\r
526 (* Procedure creant la liste des Sommets *)
\r
527 (* Ici il y a juste creation d un liste simple de sommet en mode pile *)
\r
528 (***************************************************************************)
\r
530 Unit CreeSomm : procedure( f: file);
\r
531 var Noeud : Sommets,
\r
541 if ( tampon <> '.') then
\r
542 Noeud := new Sommets;
\r
543 NBSOMMETS:=NBSOMMETS+1; (* on comptabilise le nombre de sommets*)
\r
544 Noeud.Nom := tampon;
\r
545 read(f,Noeud.typecar);
\r
546 read(f,Noeud.afftype);
\r
547 read(f,Noeud.colonne);
\r
548 (* on met en place les variables permettant de d
\82finir les coef*)
\r
549 (* de l'affichage en vectoriel *)
\r
550 if(Noeud.colonne>Larg_Vil) then Larg_Vil:=Noeud.colonne; fi;
\r
551 readln(f,Noeud.ligne);
\r
552 if(Noeud.ligne>Haut_Vil) then Haut_Vil:=Noeud.ligne; fi;
\r
553 Noeud.etat := 0; (* servira pour les
\82volutions futures *)
\r
554 Noeud.ptrarc := none;
\r
555 Noeud.Suivant := RaciSomm;
\r
557 else arret := true;
\r
563 (***************************************************************************)
\r
564 (* Procedure affichant chaque sommet ainsi que les arcs que l'on peut *)
\r
565 (* prendre depuis ce sommet en considerant les sens de circulation etc... *)
\r
566 (***************************************************************************)
\r
567 Unit ParcSomm : procedure;
\r
568 var Noeud : Sommets;
\r
569 var parcours : Liste;
\r
572 while (Noeud <> none)
\r
575 writeln(Noeud.Nom);
\r
576 writeln("X : ",Noeud.Colonne);
\r
577 writeln("Y : ",Noeud.ligne);
\r
578 parcours := Noeud.ptrarc;
\r
579 while (parcours <> none )
\r
581 writeln("Arc: ",parcours.pointeur.Numero);
\r
582 parcours := parcours.suivante;
\r
584 Noeud := Noeud.suivant;
\r
588 (***************************************************************************)
\r
589 (* Procedure affichant chaque arc *)
\r
590 (***************************************************************************)
\r
591 Unit ParcArc : procedure;
\r
593 var parcours : Liste;
\r
596 while (Noeud <> none)
\r
599 write(Noeud.Numero);
\r
600 write(" Sommet initial: ");
\r
601 write(Noeud.initial.nom);
\r
602 write(" Sommet final: ");
\r
603 write(Noeud.final.nom);
\r
604 write(" Distance: ");
\r
605 writeln(Noeud.Distance);
\r
606 Noeud := Noeud.suivants;
\r
611 (***************************************************************************)
\r
612 (* Procedure creant la liste des Arc *)
\r
613 (* Ici on cree la liste des Arc sur la base d'une pile, puis il y a *)
\r
614 (* rattachement des pointeurs final et initial avec la liste des sommets *)
\r
615 (* et ce grace a la procedure rattache. *)
\r
616 (***************************************************************************)
\r
618 Unit CreeArcs : procedure( f: file);
\r
626 while ( not(eof(f)))
\r
629 read(f,Noeud.Numero);
\r
635 read(f,Noeud.Sens);
\r
636 read(f,Noeud.distance);
\r
637 (* on va supposer qu'il y a toujours 2 voies, une dans chaque sens *)
\r
638 array Noeud.occpsens dim (1:Noeud.distance); (* on met la voie en place*)
\r
639 array Noeud.occpinve dim (1:Noeud.distance);
\r
640 read(f,Noeud.NbvoieIF);
\r
641 readln(f,Noeud.NbvoieFI);
\r
642 Noeud.Initial := none;
\r
643 Noeud.Final := none;
\r
644 Noeud.Suivants:= RaciArcs;
\r
646 Call rattache(Noeud,aux1,aux2);
\r
650 (***************************************************************************)
\r
651 (* Rattachement du pointeur arc avec le sommet *)
\r
652 (* Cette procedure rattache les pointeurs final et initial des arcs avec *)
\r
653 (* un sommet de la liste des sommets. *)
\r
654 (* Puis il y a la procedure creant la liste des arcs que l'on peut *)
\r
655 (* emprunter depuis ce sommet. Cette procedure est appele ici. *)
\r
656 (* Pour l appelle de cette procedure RattaListe nous verifions le sens de *)
\r
657 (* circulation dans les arcs, en effet des arcs ne peuvent pas etre pris a *)
\r
658 (* partir de certain sommets, donc il ne doivent pas figurer dans cette *)
\r
659 (* liste( Sens interdits ). *)
\r
660 (***************************************************************************)
\r
661 Unit Rattache : procedure ( inout Noeud : Arcs ; aux1,aux2:char);
\r
662 var Parcours : Sommets;
\r
665 Parcours := RaciSomm;
\r
666 while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))
\r
668 Parcours := Parcours.suivant;
\r
670 if Parcours.Nom = aux1
\r
672 Noeud.Initial := Parcours;
\r
673 if Noeud.Sens <> -1
\r
675 Call rattaListe(Parcours,Noeud);
\r
677 else if Parcours.Nom = aux2
\r
679 Noeud.Final := Parcours;
\r
682 Call rattaListe(Parcours,Noeud);
\r
685 write("ERREUR de rattachement initial");
\r
689 Parcours := Parcours.suivant;
\r
690 while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))
\r
692 Parcours := Parcours.suivant;
\r
694 if Parcours.Nom = aux1
\r
696 Noeud.Initial := Parcours;
\r
697 if Noeud.Sens <> -1
\r
699 Call rattaListe(Parcours,Noeud);
\r
701 else if Parcours.Nom = aux2
\r
703 Noeud.final := parcours;
\r
706 Call rattaListe(Parcours,Noeud);
\r
709 write("ERREUR de rattachement du final");
\r
714 (***************************************************************************)
\r
715 (* Rattachement des sommets a la liste des arc qui peuvent etres atteinds *)
\r
716 (***************************************************************************)
\r
717 Unit RattaListe : procedure (inout NoeudSom : sommets; NoeudArc : Arcs);
\r
721 Noeud := new Liste;
\r
722 Noeud.suivante := NoeudSom.ptrarc;
\r
723 Noeud.pointeur := NoeudArc;
\r
724 NoeudSom.ptrarc := Noeud;
\r
728 (***************************************************************************)
\r
729 (* Procedure de lecture de la ville appell
\82e par bo_load *)
\r
730 (***************************************************************************)
\r
732 Unit Lit_Ville : procedure( fenet : Windows; a : arrayof char);
\r
733 var fichier : file,
\r
734 flagbool : boolean;
\r
739 open (fichier,text,a);
\r
740 call color(VertClair);
\r
741 flagbool:=fenet.outgtext(".",1);
\r
742 call reset (fichier);
\r
743 call color(VertClair);
\r
744 flagbool:=fenet.outgtext("..",2);
\r
745 Call CreeSomm(fichier);
\r
746 call color(VertClair);
\r
747 flagbool:=fenet.outgtext("..",2);
\r
748 Call CreeArcs(fichier);
\r
749 call color(VertClair);
\r
750 flagbool:=fenet.outgtext("..",2);
\r
753 (***************************************************************************)
\r
754 (* definition des procedures d'utilitaires graphiques *)
\r
755 (***************************************************************************)
\r
757 (***************************************************************************)
\r
758 (* trace une ligne entre 2 points, change la position courante *)
\r
759 (***************************************************************************)
\r
760 Unit Line : procedure (x1,y1,x2,y2,c : integer);
\r
767 (***************************************************************************)
\r
768 (* tracer d'une ligne de pointill
\82s, ne fonctionne qu'en horiz ou en verti *)
\r
769 (***************************************************************************)
\r
770 Unit Linep : procedure (x1,y1,x2,y2,c,s :integer);
\r
772 Begin (* ne fonctionne que pour des horizontales ou des verticales *)
\r
774 then for i:=y1 step s*2 to y2
\r
776 call line(x1,i,x1,i+s,c);
\r
779 then for i:=x1 step s*2 to x2
\r
781 call line(i,y1,i+s,y1,c);
\r
787 (***************************************************************************)
\r
788 Unit Rectangle : procedure (x1,y1,x2,y2,c : integer);
\r
798 (***************************************************************************)
\r
799 (* tracer d'un rectangle plein *)
\r
800 (***************************************************************************)
\r
801 Unit Rectanglef : procedure (x1,y1,x2,y2,c : integer);
\r
804 for i:=imin(y1,y2) to imax(y1,y2)
\r
806 call Line(x1,i,x2,i,c);
\r
810 (****************************************************************************)
\r
811 (* Lecture d'une touche (bloquant) en affichant un curseur clignotant *)
\r
812 (***************************************************************************)
\r
813 Unit Readcara : function (x,y,col_f,col_e : integer) : integer;
\r
824 call outstring("_");
\r
825 for i:=1 to 300 do od;
\r
828 call outstring("_");
\r
829 for i:=1 to 100 do od;
\r
834 call outstring("_");
\r
840 (****************************************************************************)
\r
841 (* lecture d'un entier en mode graphique, esc revient au debut de saisie *)
\r
842 (* l'entier doit se trouver dans une plage d
\82finie par rangmin et rangmax *)
\r
843 (****************************************************************************)
\r
844 Unit gscanf_num : function (rangmin,rangmax : integer) : integer;
\r
845 Var valeur : integer,
\r
855 flag:=readcara(inxpos,inypos,Noir,BleuClair);
\r
856 if (flag>=48 and flag<=57)
\r
857 then valeur:=valeur*10+flag-48;
\r
858 call move(inxpos,inypos);
\r
861 if (flag=13) then exit; fi;
\r
862 if (flag=27) (* on a demand
\82 annulation *)
\r
864 call rectanglef(sauvx-1,sauvy-1,inxpos,sauvy+13,Noir);
\r
865 call color(BleuClair);
\r
866 call move(sauvx,sauvy);
\r
869 if (valeur>=rangmin and valeur<=rangmax)
\r
871 else call rectanglef(sauvx-1,sauvy-1,inxpos,sauvy+13,Noir);
\r
872 call color(BleuClair);
\r
873 call move(sauvx,sauvy);
\r
879 (****************************************************************************)
\r
880 (* lecture d'une chaine en mode graphique, esc revient au debut de saisie *)
\r
881 (****************************************************************************)
\r
882 Unit gscanf_char : function (x,y,larg : integer;inout nbmax : integer) : arrayof char;
\r
883 Var depx,posx : integer,
\r
885 col_e,col_f : integer,
\r
886 resultat : arrayof char;
\r
888 Unit affiche : procedure;
\r
891 call Rectanglef(x-1,y-1,x+larg*8,y+14,col_f);
\r
892 for i:=depx to posx
\r
894 call move(x+(i-depx)*8,y);
\r
895 call hascii(ord(resultat(i)));
\r
901 array resultat dim (0:nbmax);
\r
902 resultat(0):=chr(0);
\r
911 then rep:=readcara(x+posx*8,y,col_f,col_e);
\r
912 else rep:=readcara(x+(larg-1)*8,y,col_f,col_e);
\r
914 if ((rep>=32 and rep<=122) or rep=T_Back or rep=Tou_Ent)
\r
918 if (rep>=32 and rep<=122)
\r
919 then resultat(posx):=chr(rep);
\r
928 else if rep=Tou_ent
\r
931 if posx<0 then posx:=0; fi;
\r
932 resultat(posx):=chr(0);
\r
934 if depx<0 then depx:=0; fi;
\r
945 (****************************************************************************)
\r
946 (* affiche un entier en mode graphique, maximum 10 chiffres *)
\r
947 (****************************************************************************)
\r
948 unit writint : procedure( valeur : integer);
\r
949 var flag,i : integer;
\r
950 var tbl : arrayof integer;
\r
952 array tbl dim (1:10);
\r
953 flag:=1; (* on 'empile' en ordre reverse *)
\r
956 tbl(flag):=valeur mod 10;
\r
957 valeur:=valeur div 10;
\r
960 for i:=flag-1 downto 1 (* on affiche dans le bon ordre *)
\r
962 call hascii(48+tbl(i))
\r
968 (***************************************************************************)
\r
969 (* definition des classes d'
\82l
\82ments des listes *)
\r
970 (***************************************************************************)
\r
972 Unit Elmt : class(id : integer);
\r
975 Unit elm : Elmt class(x1,y1,x2,y2 :integer);
\r
978 (***************************************************************************)
\r
979 (* definition de la classe Bottons *)
\r
980 (***************************************************************************)
\r
982 Unit Bottons : Elmt class(touche,x1,y1,x2,y2 : integer);
\r
983 (* x2-x1 et y2-y1 doit au mini etre de 8*)
\r
984 (* x1,y1 : integer coordonn
\82es du point haut gauche *)
\r
985 (* x2,y2 : integer coordonn
\82es du point bas droit *)
\r
986 Var etat : boolean; (* true si bouton enable *)
\r
988 Unit affiche : procedure;
\r
990 call Line(x1,y1,x2,y1,Blanc); (* Lignes en blanc *)
\r
991 call Line(x1,y1+1,x2-1,y1+1,Blanc);
\r
992 call Line(x1,y1,x1,y2,Blanc);
\r
993 call Line(x1+1,y1+2,x1+1,y2-1,Blanc);
\r
994 call Line(x1+1,y2,x2,y2,GrisFonce); (* Lignes en gris fonce *)
\r
995 call Line(x1+2,y2-1,x2,y2-1,GrisFonce);
\r
996 call Line(x2,y2,x2,y1+1,GrisFonce);
\r
997 call Line(x2-1,y2-1,x2-1,y1+2,GrisFonce);
\r
998 call Rectanglef(x1+2,y1+2,x2-2,y2-2,GrisClair); (* centre en gris *)
\r
1002 Unit virtual AfficheSuite : procedure;
\r
1005 Unit virtual bot_enable : procedure;
\r
1008 Unit virtual bot_disable : procedure;
\r
1013 (***************************************************************************)
\r
1014 (* definition de la classe Menu derivant de Bottons *)
\r
1015 (***************************************************************************)
\r
1017 Unit Menu : Bottons class;
\r
1018 Var cnom : integer, (* couleur du nom du bouton *)
\r
1019 nom : string; (* nom du bouton *)
\r
1021 Unit affiche_nom : procedure;
\r
1023 call move(x1+5,y1+(y2-y1)/4-1);
\r
1025 call outstring(nom);
\r
1028 Unit virtual bot_enable : procedure;
\r
1032 e:=new elm(id,x1,y1,x2,y2);
\r
1033 call clics.Insert(e);
\r
1035 then call Keys.Insert(new elmt(touche));
\r
1040 Unit virtual bot_disable : procedure;
\r
1044 e:=new elm(id,x1,y1,x2,y2);
\r
1045 call clics.Delete(e);
\r
1047 then call Keys.delete(new elmt(touche));
\r
1052 Unit virtual AfficheSuite : procedure;
\r
1055 then call bot_enable;
\r
1056 else call bot_disable;
\r
1062 (***************************************************************************)
\r
1063 (* definition de la classe Racc derivant de Bottons *)
\r
1064 (* la procedure sprite permet d'afficher le sprite correspondant au bouton *)
\r
1065 (***************************************************************************)
\r
1066 Unit Racc : Bottons class (procedure sprite(x1,y1,x2,y2,col :integer));
\r
1068 Unit virtual bot_enable : procedure;
\r
1071 e:=new elm(id,x1,y1,x2,y2);
\r
1072 call clics.Insert(e);
\r
1073 if (touche<>-1) (* si une touche a
\82t
\82 d
\82finie pour ce bouton *)
\r
1074 then call Keys.Insert(new elmt(touche));
\r
1078 Unit virtual bot_disable : procedure;
\r
1081 e:=new elm(id,x1,y1,x2,y2);
\r
1082 call clics.Delete(e);
\r
1083 if (touche<>-1) (* si une touche a
\82t
\82 d
\82finie pour ce bouton *)
\r
1084 then call Keys.delete(new elmt(touche));
\r
1088 Unit virtual AfficheSuite : procedure;
\r
1091 then call bot_enable;
\r
1092 call sprite(x1,y1,x2,y2,Noir);
\r
1093 else call bot_disable;
\r
1094 call sprite(x1,y1,x2,y2,GrisFonce);
\r
1100 (***************************************************************************)
\r
1101 (* definition de la classe Windows *)
\r
1102 (***************************************************************************)
\r
1104 Unit Windows : class(numero,x1,y1,x2,y2,lborder : integer;
\r
1105 r1,r2,r3 : boolean);
\r
1106 hidden x,y,xp,yp;
\r
1107 (* x2-x1 et y2-y1 doit au mini etre 33 *)
\r
1108 Var cborder : integer, (* couleur du pourtour *)
\r
1109 cnom : integer, (* couleur du nom de la fenetre *)
\r
1110 nom : string, (* nom de la fenetre, sera affich
\82 en haut *)
\r
1111 Bout : ListBot, (* liste des boutons rattaches *)
\r
1112 Hauteur : integer, (* hauteur de la bande *)
\r
1113 Largeur : integer, (* largeur des raccourcis *)
\r
1114 cbande : integer, (* couleur de la bande *)
\r
1115 WhereXd : integer, (* position en x de depart dans la fenetre *)
\r
1116 WhereX : integer, (* position courante en X dans la fenetre *)
\r
1117 WhereYd : integer, (* position en y de depart dans la fenetre *)
\r
1118 WhereY : integer; (* position courante en Y dans la fenetre *)
\r
1119 var B : arrayof Racc, (* variables locales *)
\r
1122 map : arrayof integer, (* pour le getmap du dessous *)
\r
1123 savmap : arrayof integer; (* pour le getmap du dessus *)
\r
1125 Unit affiche : procedure;
\r
1129 map:=getmap(x2,y2);
\r
1130 call rectanglef(x1,y1,x2,y2,Noir);
\r
1131 for i:=0 to lborder
\r
1133 call rectangle(x1+i,y1+i,x2-i,y2-i,cborder);
\r
1135 call Line(x1+16,y1,x1+16,y1+lborder,Noir); (* Lignes noires *)
\r
1136 call Line(x2-16,y1,x2-16,y1+lborder,Noir);
\r
1137 call Line(x1+16,y2,x1+16,y2-lborder,Noir);
\r
1138 call Line(x2-16,y2,x2-16,y2-lborder,Noir);
\r
1139 call Line(x1,y1+16,x1+lborder,y1+16,Noir);
\r
1140 call Line(x1,y2-16,x1+lborder,y2-16,Noir);
\r
1141 call Line(x2,y1+16,x2-lborder,y1+16,Noir);
\r
1142 call Line(x2,y2-16,x2-lborder,y2-16,Noir);
\r
1143 call Rectanglef(x1+lborder+1,y1+lborder+1,x2-lborder-1,
\r
1144 y1+lborder+hauteur+1,cbande);
\r
1145 call move(x1+(x2-x1)/3,y1+lborder+hauteur/4);
\r
1147 call outstring(nom);
\r
1150 savmap:=getmap(x2,y2);
\r
1153 Unit virtual AffSuite : procedure;
\r
1156 Unit restore : procedure;
\r
1163 Unit virtual clear : procedure;
\r
1166 (* gestionnaire d'
\82v
\82nement de la fenetre *)
\r
1167 Unit gestionnaire : function : integer;
\r
1168 Var l,r,c : boolean,
\r
1174 call getpress(0,x,y,nbbot,l,r,c);
\r
1175 if (l) and (clics<>none)
\r
1176 then result:=clics.Appartient(x,y); exit;
\r
1179 if (rep>=97 and rep<=122) (* passe les lettres en majuscule *)
\r
1182 if keys.Appartient(rep)
\r
1183 then result:=rep; exit;
\r
1185 (* ligne rajoutee pour que cela ne soit pas bloquant pdt la simulation *)
\r
1186 if not SimStop then exit fi;
\r
1190 (* permet de se deplacer dans la fenetre *)
\r
1191 Unit moveto : function (x,y :integer) : boolean;
\r
1193 if (x>0 and x<(x2-x1)) and (y>0 and y<y2-y1)
\r
1194 then WhereX:=WhereXd+x;
\r
1195 WhereY:=WhereYd+y;
\r
1196 call move(WhereX,WhereY);
\r
1198 else result:=False;
\r
1202 (* affichage d'une chaine de longueur connue 'long' *)
\r
1203 Unit outgtext : function (chaine : string; long : integer) : boolean;
\r
1205 if (long*8+WhereX)<(x2-lborder-5)
\r
1206 then call move(WhereX,WhereY);
\r
1207 call outstring(chaine);
\r
1208 WhereX:=WhereX+long*8;
\r
1209 if WhereX>= x2-lborder-16
\r
1210 then WhereX:=WhereXd;
\r
1211 WhereY:=WhereY+16;
\r
1214 else result:=False;
\r
1218 (* affichage d'un caract
\8are *)
\r
1219 Unit outchar : function (tmp : char) : boolean;
\r
1221 if (10+WhereX)<(x2-lborder-5-largeur)
\r
1222 then call move(WhereX,WhereY);
\r
1223 call hascii(ord(tmp));
\r
1224 WhereX:=WhereX+10;
\r
1225 if WhereX>= x2-lborder-16-largeur
\r
1226 then WhereX:=WhereXd;
\r
1227 WhereY:=WhereY+16;
\r
1230 else result:=False;
\r
1236 Bout:=new ListBot; (* liste des boutons rattach
\82s *)
\r
1238 array B dim (0:2);
\r
1240 x:=x2-Larg_bot-lborder-1;
\r
1244 B(2):=new Racc(numero+3,-1,x,y,xp,yp,spr_upper);
\r
1246 call Bout.Insert(B(2));
\r
1250 B(1):=new Racc(numero+2,-1,x,y,xp,yp,spr_lower);
\r
1252 call Bout.Insert(B(1));
\r
1256 B(0):=new Racc(numero+1,-1,x,y,xp,yp,spr_close);
\r
1258 call Bout.Insert(B(0));
\r
1262 (***************************************************************************)
\r
1263 (* definition de main d
\82rivant de la classe Windows *)
\r
1264 (***************************************************************************)
\r
1266 Unit Maine : Windows class;
\r
1267 var icname : string, (* nom une fois iconise *)
\r
1268 Lwind : ListW, (* liste des fenetres filles *)
\r
1269 Horiz : AccelerateH, (* accelerateur horizontal *)
\r
1270 Verti : AccelerateV1; (* accelerateur vertical *)
\r
1272 Unit virtual AffSuite : procedure;
\r
1274 call Rectanglef(x1+lborder+1,y1+lborder+hauteur+3,
\r
1275 x2-lborder-1,y1+lborder+2*(hauteur+2),cbande);
\r
1277 then call Horiz.affiche;
\r
1280 then call Verti.affiche;
\r
1282 Bout.Courant:=Bout.head;
\r
1283 while(Bout.Courant<>none)
\r
1285 call Bout.Courant.data qua Bottons.affiche;
\r
1286 Bout.Courant:=Bout.Courant.next;
\r
1288 call Keys.Insert(new elmt(T_ALTF4)); (* alt/f4 pour quitter *)
\r
1289 call Keys.Insert(new elmt(T_SHFTF4)); (* shift/f4 pour about *)
\r
1290 call Keys.Insert(new elmt(T_CTRLF4)); (* ctrl/f4 pour iconify *)
\r
1293 Unit virtual clear : procedure;
\r
1294 Var xf,yf : integer;
\r
1296 if Verti<>none then xf:=Verti.x1-1;
\r
1297 else xf:=x2-lborder-1;
\r
1299 if Horiz<>none then yf:=Horiz.y1-1;
\r
1300 else yf:=y2-lborder-1;
\r
1302 call Rectanglef(x1+lborder+1,y1+lborder+2*(hauteur+2)+1,xf,yf,Noir);
\r
1307 Unit iconify : procedure;
\r
1314 mmap : arrayof integer;
\r
1318 mmap:=getmap(x2,y2);
\r
1320 call putmap(this maine qua windows.map);
\r
1323 call rectangle(1,SIZEY-40,40,SIZEY,BleuClair);
\r
1324 call rectangle(2,SIZEY-39,39,SIZEY-1,BleuClair);
\r
1325 call move(5,SIZEY-20);
\r
1326 call outstring(icname);
\r
1329 call getpress(0,x,y,nboot,l,r,c);
\r
1331 then if(x>=1 and x<=40 and y<=SIZEY and y>=SIZEY-40)
\r
1336 if (rep=13) (* validation *)
\r
1344 call putmap(mmap);
\r
1349 WhereXd:=x1+lborder+5;
\r
1350 WhereYd:=y1+lborder+2*(Haut_Bot+2)+5+8;
\r
1355 (***************************************************************************)
\r
1356 (* definition de la classe Son d
\82rivant des classes Windows et elmt *)
\r
1357 (***************************************************************************)
\r
1359 Unit Son : Windows coroutine;
\r
1361 Horiz : AccelerateH, (* accelerateur horizontal *)
\r
1362 Verti : AccelerateV1; (* accelerateur vertical *)
\r
1364 Unit virtual AffSuite : procedure;
\r
1367 then call Horiz.affiche;
\r
1370 then call Verti.affiche;
\r
1372 Bout.Courant:=Bout.Head;
\r
1373 while(Bout.Courant<>none)
\r
1375 call Bout.Courant.data qua Bottons.affiche;
\r
1376 Bout.Courant:=bout.Courant.next;
\r
1381 Unit virtual AffSuite1 : procedure;
\r
1384 Unit virtual clear : procedure;
\r
1385 Var xf,yf : integer;
\r
1387 if Verti<>none then xf:=Verti.x1-1;
\r
1388 else xf:=x2-lborder-1;
\r
1390 if Horiz<>none then yf:=Horiz.y1-1;
\r
1391 else yf:=y2-lborder-1;
\r
1393 call Rectanglef(x1+lborder+1,y1+lborder+(hauteur+1)+1,xf,yf,Noir);
\r
1400 pref Elmt(0) block
\r
1403 WhereXd:=x1+lborder+5;
\r
1404 WhereYd:=y1+lborder+(Haut_Bot+1)+5+8;
\r
1411 (***************************************************************************)
\r
1412 (* definition de la classe dialogue d
\82rivant de la classe Son *)
\r
1413 (***************************************************************************)
\r
1415 Unit Dialogue : Son coroutine;
\r
1416 Var ok, cancel : Menu,
\r
1417 nomfic : arrayof char,
\r
1418 lgnomfic : integer,
\r
1419 flagbool : boolean,
\r
1421 pwd : arrayof char,
\r
1422 rep,i,j : integer,
\r
1424 fichiers : liste_chaine,
\r
1425 nbfichiers : integer,
\r
1426 tampon : arrayof arrayof char,
\r
1427 creation : boolean; (* true si le fichier doit
\88tre cr
\82\82 *)
\r
1430 Unit virtual AffSuite1 : procedure;
\r
1433 call color(RougeClair);
\r
1434 flagbool:=moveto(5,1);
\r
1435 flagbool:=outgtext("Nom du fichier:",15);
\r
1436 flagbool:=moveto(175,1);
\r
1437 flagbool:=outgtext("Repertoires:",12);
\r
1438 flagbool:=moveto(175,18);
\r
1440 then for j:=0 to lgpwd
\r
1442 flagbool:=outchar(pwd(j));
\r
1444 else for j:=0 to 2
\r
1446 flagbool:=outchar(pwd(j));
\r
1448 flagbool:=outchar('.');
\r
1449 flagbool:=outchar('.');
\r
1450 flagbool:=outchar('.');
\r
1451 for j:=lgpwd-8 to lgpwd
\r
1453 flagbool:=outchar(pwd(j));
\r
1456 call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);
\r
1457 call clics.insert(new elm(512,x1+9,y1+52,x1+147,y1+66));
\r
1458 call rectangle(x1+18,y1+70,x1+147,y1+150,BleuClair);
\r
1459 call affiche_fic(0);
\r
1461 then verti:=new accelerateV1(520,-1,x1+148,y1+70,x1+164,y1+150,this windows);
\r
1462 call verti.affiche;
\r
1463 Bout.courant:=Bout.head;
\r
1464 while(Bout.Courant<>none)
\r
1466 call Bout.courant.data qua Bottons.affiche;
\r
1467 Bout.courant:=Bout.courant.next;
\r
1472 Unit affiche_fic : procedure (depuis : integer);
\r
1473 Var i,j : integer;
\r
1475 call rectanglef(x1+19,y1+71,x1+146,y1+149,Noir);
\r
1476 call color(BleuClair);
\r
1477 fichiers.depl:=fichiers.root;
\r
1478 for i:=1 to depuis
\r
1480 fichiers.depl:=fichiers.depl.ptr;
\r
1482 (* on est positionn
\82 sur le premier *)
\r
1483 for j:=0 to imin(4,nbfichiers-depuis-1)
\r
1485 flagbool:=moveto(15,39+j*15);
\r
1486 call clics.insert(new elm(j+1,x1+20,y1+72+j*15,x1+147,y1+72+(j+1)*15));
\r
1487 tampon(j):=copy(fichiers.depl.data);
\r
1490 if fichiers.depl.data(i)=chr(0) then exit fi;
\r
1491 flagbool:=outchar(fichiers.depl.data(i));
\r
1493 fichiers.depl:=fichiers.depl.ptr;
\r
1497 Unit Lecture : function : boolean;
\r
1498 Var rep : integer,
\r
1501 Unit Aff_nom : procedure;
\r
1504 call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);
\r
1505 nomfic:=copy(tampon(rep-1));
\r
1506 for i:=0 to upper(tampon(rep-1))
\r
1508 if tampon(rep-1,i)=chr(0) then exit fi;
\r
1509 flagbool:=moveto(3+i*8,18);
\r
1510 flagbool:=outchar(tampon(rep-1,i));
\r
1514 Unit Veux_creation : function : boolean;
\r
1515 Const Largeur=320,
\r
1517 Var x,y,code : integer,
\r
1518 Posx,Posy : integer,
\r
1524 flagbool : boolean;
\r
1527 x:=(x2-x1-largeur)/2;
\r
1528 y:=(y2-y1-hauteur)/2;
\r
1532 clics:=new cliquer;
\r
1534 keys:=new listkey;
\r
1535 fille:=new Son(20,Posx,Posy,Posx+Largeur,Posy+hauteur,2,
\r
1536 True,False,False);
\r
1538 fille.hauteur:=Haut_Bot;
\r
1539 fille.cborder:=RougeClair;
\r
1540 fille.cbande:=Rouge;
\r
1541 call color(RougeClair);
\r
1542 fille_Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);
\r
1543 fille_Yes.nom:="Yes";
\r
1544 fille_Yes.etat:=True;
\r
1545 call fille.Bout.Insert(fille_Yes);
\r
1546 fille_No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);
\r
1547 fille_No.nom:="No";
\r
1548 fille_No.etat:=True;
\r
1549 call fille.Bout.Insert(fille_No);
\r
1550 call keys.insert(new elmt(T_ESC));
\r
1552 call fille.affiche;
\r
1553 flagbool:=fille.outgtext(" File not found : Do you want to creat",30);
\r
1556 code:=fille.gestionnaire;
\r
1558 when T_ESC : result:=false; exit;
\r
1559 when T_N : result:=false; exit;
\r
1560 when T_Y : result:=true; exit;
\r
1561 when 1 : result:=true; exit; (* menu yes *)
\r
1562 when 2 : result:=false; exit; (* menu no *)
\r
1563 when 11 : result:=false; exit; (*racc exit *)
\r
1567 call fille.restore;
\r
1575 End Veux_creation;
\r
1579 rep:=gestionnaire;
\r
1580 if rep=512 or rep=T_ESPACE (* zone clics pr entr
\82e clavier nomfichier *)
\r
1581 then lgnomfic:=80;
\r
1582 nomfic:=gscanf_char(x1+10,y1+52,17,lgnomfic);
\r
1583 if nomfic(0)=chr(0)
\r
1584 then call hidecursor;
\r
1585 call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);
\r
1587 call ok.bot_disable;
\r
1588 else if not fichiers.appartient(nomfic)
\r
1589 then if Veux_creation
\r
1590 then result:=true;
\r
1593 else call hidecursor;
\r
1594 call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);
\r
1596 nomfic(0):=chr(0);
\r
1597 call ok.bot_disable;
\r
1599 else call ok.bot_enable;
\r
1602 else if rep>=1 and rep<=5
\r
1603 then call aff_nom;
\r
1604 call ok.bot_enable;
\r
1605 else if rep=510 or rep=Tou_Ent
\r
1606 then result:=true; exit;
\r
1607 else if rep=511 or rep=T_ESC
\r
1608 then result:=false; exit;
\r
1609 else if rep=521 or rep=T_FLHAU (* il y a plus de 5 fichiers : up *)
\r
1610 then depuis:=depuis-1;
\r
1611 if depuis<0 then depuis:=0; fi;
\r
1612 call affiche_fic(depuis);
\r
1613 else if rep=523 or rep=T_FLBAS(* down *)
\r
1614 then depuis:=depuis+1;
\r
1615 if depuis>(nbfichiers-4)
\r
1616 then depuis:=nbfichiers-4;
\r
1618 call affiche_fic(depuis);
\r
1628 Unit liste_chaine : class;
\r
1630 depl : node, (* pour les parcours *)
\r
1633 Unit node : class;
\r
1634 Var data : arrayof char,
\r
1638 Unit appartient : function (a : arrayof char) : boolean;
\r
1641 Unit egalite : function (a,b : arrayof char) :boolean;
\r
1642 Var i,j : integer;
\r
1644 Unit toupper : function (a : char) : char;
\r
1646 if (ord(a)>=97 and ord(a)<=122)
\r
1647 then result:=chr(ord(a)-32);
\r
1657 if toupper(a(i))<>toupper(b(i))
\r
1658 then result:=false;
\r
1662 if a(i)=chr(0) then exit; fi;
\r
1669 call move(10,400);
\r
1670 while (not(fl) and depl<>none)
\r
1672 fl:=egalite(a,depl.data);
\r
1678 Unit insert : procedure (a : arrayof char);
\r
1679 Var nouveau : node;
\r
1681 nouveau:=new node;
\r
1682 nouveau.data:=copy(a);
\r
1684 then root:=nouveau;
\r
1686 else cour.ptr:=nouveau;
\r
1695 (* on va maintenant lire le pwd et le mettre dans la variable pwd *)
\r
1696 rep:=exec(unpack("cd > simula.tmp"));
\r
1697 open(temp,text,unpack("simula.tmp"));
\r
1700 array pwd dim (0:256);
\r
1702 array nomfic dim (0:lgnomfic);
\r
1703 while (not(eof(temp)) and i<=256)
\r
1705 read(temp,pwd(i));
\r
1708 lgpwd:=i-2; (* -1 pour le i:=i+1 en trop + -1 pour le RC *)
\r
1709 call unlink(temp);
\r
1710 rep:=exec(unpack("dir *.dat /a /b > simula.tmp"));
\r
1711 open(temp,text,unpack("simula.tmp"));
\r
1713 fichiers:=new liste_chaine;
\r
1714 while not(eof(temp))
\r
1718 read(temp,nomfic(i));
\r
1719 if nomfic(i)=' ' then nomfic(i):=chr(0); fi;
\r
1720 if nomfic(i)=chr(10) or eof(temp)
\r
1721 then nomfic(i):=chr(0);
\r
1726 call fichiers.insert(nomfic);
\r
1727 nbfichiers:=nbfichiers+1;
\r
1729 call unlink(temp);
\r
1730 array tampon dim (0:5);
\r
1733 array tampon(i) dim (0:15);
\r
1735 ok:=new menu(510,Tou_Ent,x2-56,y1+30,x2-16,y1+30+Haut_Bot);
\r
1738 call Bout.insert(ok);
\r
1739 cancel:=new menu(511,T_ESC,x2-66,y1+60,x2-8,y1+60+Haut_Bot);
\r
1740 cancel.nom:="Cancel";
\r
1741 cancel.etat:=True;
\r
1742 call Bout.insert(cancel);
\r
1743 call Keys.insert(new elmt(T_ESPACE));
\r
1748 (***************************************************************************)
\r
1749 (* definition de Accelerate d
\82rivant des classes Windows et Bottons *)
\r
1750 (***************************************************************************)
\r
1752 Unit Accelerate : Bottons class(mother : Windows);
\r
1753 Var Bs : arrayof Racc,
\r
1757 C : integer; (* valeur du pas d'affichage *)
\r
1759 Unit virtual AfficheSuite : procedure; (* descend de bottons *)
\r
1762 Unit virtual bot_enable : procedure;
\r
1764 call mother.Bout.Insert(Bs(1));
\r
1765 call mother.Bout.Insert(Bs(3));
\r
1766 call bot_enable_suite;
\r
1770 Unit virtual bot_enable_suite : procedure;
\r
1771 End bot_enable_suite;
\r
1773 Unit virtual bot_disable : procedure;
\r
1775 call mother.Bout.Delete(Bs(1));
\r
1776 call mother.Bout.Delete(Bs(3));
\r
1777 call bot_disable_suite;
\r
1781 Unit virtual bot_disable_suite : procedure;
\r
1782 End bot_disable_suite;
\r
1784 Unit virtual Deplacer : procedure( i :integer);
\r
1787 Unit virtual Reset_Bot : procedure;
\r
1791 C:=5; (* valeur par defaut *)
\r
1796 (***************************************************************************)
\r
1797 (* definition de AccelerateH d
\82rivant de Accelerate *)
\r
1798 (***************************************************************************)
\r
1800 Unit AccelerateH : Accelerate class;
\r
1805 Unit virtual bot_enable_suite : procedure;
\r
1807 call mother.bout.insert(Bs(2));
\r
1808 End bot_enable_suite;
\r
1810 Unit virtual bot_disable_suite : procedure;
\r
1812 call mother.bout.delete(Bs(2));
\r
1813 End bot_disable_suite;
\r
1815 Unit virtual AfficheSuite : procedure; (* descend de bottons *)
\r
1817 call Rectanglef(x1+18,y1+3,x2-18,y2-3,Noir);
\r
1822 Unit DeplacerLeft : procedure;
\r
1825 call Bs(2).bot_disable;
\r
1826 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1830 Bs(1).etat:=False;
\r
1831 call Bs(1).bot_disable;
\r
1833 if not (Bs(3).etat)
\r
1834 then Bs(3).etat:=True;
\r
1835 call Bs(3).bot_enable;
\r
1837 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
1838 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
1839 call Bs(2).affiche;
\r
1842 Unit virtual Deplacer : procedure (x : integer);
\r
1844 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1846 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
1847 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
1848 call Bs(2).affiche;
\r
1851 Unit DeplacerRight : procedure;
\r
1854 call Bs(2).bot_disable;
\r
1855 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1859 Bs(3).etat:=False;
\r
1860 call Bs(3).bot_disable;
\r
1862 if not (Bs(1).etat)
\r
1863 then Bs(1).etat:=True;
\r
1864 call Bs(1).bot_enable;
\r
1866 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
1867 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
1868 call Bs(2).affiche;
\r
1869 End DeplacerRight;
\r
1871 Unit virtual Reset_Bot : procedure;
\r
1873 call Bs(2).bot_disable;
\r
1874 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1882 Bs(2).x2:=PosX+LX;
\r
1883 Bs(2).y2:=PosY+LY;
\r
1884 call Bs(2).affiche;
\r
1888 array Bs dim (1:3);
\r
1889 Bs(1):=new Racc(id+1,T_FLDTE,x1+2,y1+2,x1+15,y1+15,spr_right);
\r
1896 Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);
\r
1898 Bs(3):=new Racc(id+3,T_FLGCH,x2-15,y2-16,x2-2,y2-3,spr_left);
\r
1902 (***************************************************************************)
\r
1903 (* definition de AccelerateV1 d
\82rivant de Accelerate *)
\r
1904 (***************************************************************************)
\r
1906 Unit AccelerateV1 : Accelerate class;
\r
1911 Unit virtual AfficheSuite : procedure; (* descend de bottons *)
\r
1913 call Rectanglef(x1+3,y1+18,x2-3,y2-18,Noir);
\r
1918 Unit virtual bot_enable_suite : procedure;
\r
1919 End bot_enable_suite;
\r
1921 Unit virtual bot_disable_suite : procedure;
\r
1922 End bot_disable_suite;
\r
1924 Unit virtual DeplacerUp : procedure;
\r
1930 Bs(1).etat:=False;
\r
1931 call Bs(1).bot_disable;
\r
1933 if not (Bs(3).etat)
\r
1934 then Bs(3).etat:=True;
\r
1935 call Bs(3).bot_enable;
\r
1939 Unit virtual Deplacer : procedure (y : integer);
\r
1942 Unit virtual DeplacerDown : procedure;
\r
1948 Bs(3).etat:=False;
\r
1949 call Bs(3).bot_disable;
\r
1951 if not (Bs(1).etat)
\r
1952 then Bs(1).etat:=True;
\r
1953 call Bs(1).bot_enable;
\r
1957 Unit virtual Reset_Bot : procedure;
\r
1961 array Bs dim (1:3);
\r
1962 Bs(1):=new Racc(id+1,T_FLHAU,x1+2,y1+2,x1+15,y1+15,spr_upper);
\r
1970 Bs(3):=new Racc(id+3,T_FLBAS,x2-15,y2-16,x2-2,y2-3,spr_lower);
\r
1974 (***************************************************************************)
\r
1975 (* definition de AccelerateV2 d
\82rivant de AccelerateV1 *)
\r
1976 (***************************************************************************)
\r
1978 Unit AccelerateV2 : AccelerateV1 class;
\r
1980 Unit virtual bot_enable_suite : procedure;
\r
1982 call mother.bout.insert(Bs(2));
\r
1983 End bot_enable_suite;
\r
1985 Unit virtual bot_disable_suite : procedure;
\r
1987 call mother.bout.delete(Bs(2));
\r
1988 End bot_disable_suite;
\r
1990 Unit virtual DeplacerUp : procedure;
\r
1993 call Bs(2).bot_disable;
\r
1994 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
1998 Bs(1).etat:=False;
\r
1999 call Bs(1).bot_disable;
\r
2001 if not (Bs(3).etat)
\r
2002 then Bs(3).etat:=True;
\r
2003 call Bs(3).bot_enable;
\r
2005 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
2006 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
2007 call Bs(2).affiche;
\r
2010 Unit virtual Deplacer : procedure (y : integer);
\r
2012 if y>=MinY and y<=MaxY
\r
2013 then call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
2015 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
2016 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
2017 call Bs(2).affiche;
\r
2021 Unit virtual DeplacerDown : procedure;
\r
2024 call Bs(2).bot_disable;
\r
2025 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
2029 Bs(3).etat:=False;
\r
2030 call Bs(3).bot_disable;
\r
2032 if not (Bs(1).etat)
\r
2033 then Bs(1).etat:=True;
\r
2034 call Bs(1).bot_enable;
\r
2036 Bs(2).x1:=PosX; Bs(2).y1:=PosY;
\r
2037 Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;
\r
2038 call Bs(2).affiche;
\r
2041 Unit virtual Reset_Bot : procedure;
\r
2043 call Bs(2).bot_disable;
\r
2044 call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);
\r
2052 Bs(2).x2:=PosX+LX;
\r
2053 Bs(2).y2:=PosY+LY;
\r
2054 call Bs(2).affiche;
\r
2058 Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);
\r
2062 (***************************************************************************)
\r
2063 (* definition de la classe Ensemble (c'est une liste) *)
\r
2064 (***************************************************************************)
\r
2066 Unit Ensemble : class;
\r
2071 Unit Node : class(data : elmt);
\r
2075 Unit virtual egalite : function (x,y : elmt) :boolean;
\r
2078 Unit Empty : function : boolean;
\r
2081 then result:=True;
\r
2082 else result:=False;
\r
2086 Unit Member : function (n : elmt) : boolean;
\r
2093 While (Courant<>none)
\r
2095 if not egalite(Courant.data,n)
\r
2096 then saveCou:=Courant; Courant:=Courant.next;
\r
2097 else bl:=True; exit;
\r
2104 Unit Insert : procedure (n : elmt);
\r
2110 then Head:=new Node(n); Last:=Head;
\r
2111 else Last.next:=new Node(n);
\r
2117 Unit Delete : procedure (n : elmt);
\r
2123 then flag:=Courant.next;
\r
2125 then Last:=Courant; courant.next:=none; kill(flag);
\r
2126 else if Courant.next<>none
\r
2127 then Courant.next:=Courant.next.next; kill(flag);
\r
2135 (***************************************************************************)
\r
2136 (* definition de la classe cliquer derivant de la classe ensemble *)
\r
2137 (***************************************************************************)
\r
2139 Unit cliquer : Ensemble class;
\r
2141 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
2144 then result:=True;
\r
2145 else result:=False;
\r
2149 Unit Appartient : function(x,y : integer) : integer;
\r
2154 while (Courant<>none)
\r
2156 if(x<(Courant.data qua elm.x2) and x>(Courant.data qua elm.x1) and
\r
2157 y<(Courant.data qua elm.y2) and y>(Courant.data qua elm.y1))
\r
2158 then bl:=True; exit;
\r
2159 else Courant:=Courant.next;
\r
2163 then result:=Courant.data qua elm.id;
\r
2170 (***************************************************************************)
\r
2171 (* definition de la classe Listbot d
\82rivant de ensemble *)
\r
2172 (***************************************************************************)
\r
2174 Unit Listbot : Ensemble class;
\r
2176 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
2178 if (x.id) = (y.id)
\r
2179 then result:=True;
\r
2180 else result:=False;
\r
2186 (***************************************************************************)
\r
2187 (* definition de la classe ListKey d
\82rivant de ensemble *)
\r
2188 (***************************************************************************)
\r
2190 Unit ListKey : Ensemble class;
\r
2192 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
2194 if (x.id) = (y.id)
\r
2195 then result:=True;
\r
2196 else result:=False;
\r
2200 Unit Appartient : function(x : integer) : boolean;
\r
2205 while (Courant<>none)
\r
2207 if(Courant.data.id = x)
\r
2208 then bl:=True; exit;
\r
2209 else Courant:=Courant.next;
\r
2217 (***************************************************************************)
\r
2218 (* definition de la classe ListW d
\82rivant de ensemble *)
\r
2219 (***************************************************************************)
\r
2221 Unit ListW : Ensemble class;
\r
2223 Unit virtual egalite : function (x,y : elmt) : boolean;
\r
2225 (* if (x qua Son.numero) = (y qua Son.numero)
\r
2226 then result:=True;
\r
2227 else result:=False;
\r
2233 (***************************************************************************)
\r
2234 (* procedure d'affichage des sprites des boutons *)
\r
2235 (***************************************************************************)
\r
2237 (***************************************************************************)
\r
2238 Unit spr_upper : procedure(x1,y1,x2,y2,couleur : integer);
\r
2239 var i,x,y : integer;
\r
2245 call Line(x1+x-i/2,y1+y/2+i,x1+x+i/2,y1+y/2+i,couleur);
\r
2249 (***************************************************************************)
\r
2250 Unit spr_lower : procedure(x1,y1,x2,y2,couleur : integer);
\r
2251 var i,x,y : integer;
\r
2257 call Line(x1+x-i/2,y2-y/2-i,x1+x+i/2,y2-y/2-i,couleur);
\r
2261 (***************************************************************************)
\r
2262 Unit spr_left : procedure(x1,y1,x2,y2,couleur : integer);
\r
2263 var i,x,y : integer;
\r
2269 call Line(x2-x/2-i,y1+y-i/2,x2-x/2-i,y1+y+i/2,couleur);
\r
2273 (***************************************************************************)
\r
2274 Unit spr_right : procedure(x1,y1,x2,y2,couleur : integer);
\r
2275 var i,x,y : integer;
\r
2281 call Line(x1+x/2+i,y1+y-i/2,x1+x/2+i,y1+y+i/2,couleur);
\r
2285 (***************************************************************************)
\r
2286 Unit spr_close : procedure(x1,y1,x2,y2,couleur : integer);
\r
2290 call Rectanglef(x1+3,y1+y-1,x2-3,y1+y+1,couleur);
\r
2293 (***************************************************************************)
\r
2294 Unit spr_point : procedure(x1,y1,x2,y2,couleur : integer);;
\r
2295 var x,y : integer;
\r
2299 call Rectanglef(x1+x-1,y1+y-1,x1+x+1,y1+y+1,couleur);
\r
2303 (***************************************************************************)
\r
2304 (***************************************************************************)
\r
2305 (* PROGRAMME NUMERO 1 : SIMULATEUR *)
\r
2306 (***************************************************************************)
\r
2307 (***************************************************************************)
\r
2308 Unit simulateur : Logiciel coroutine;
\r
2310 var prg : prog, (* programme principal, g
\82r
\82 par des simprocess *)
\r
2314 ZOOM : integer, (* coeficient de zoom *)
\r
2315 C : integer, (* largeur des voies *)
\r
2317 boolAf : boolean; (* vrai si il faut afficher la ville *)
\r
2319 (***************************************************************************)
\r
2320 Unit Bot_Load : procedure;
\r
2321 Const Largeur1=400,
\r
2325 Var fenet1 : Dialogue,
\r
2329 flagbool : boolean,
\r
2337 clics:=new cliquer;
\r
2339 keys:=new listkey;
\r
2340 fenet1:=new dialogue(10,x-Largeur1/2,y-Hauteur1/2,x+Largeur1/2,y+Hauteur1/2,
\r
2341 2,False,False,False);
\r
2344 fenet1.hauteur:=Haut_Bot;
\r
2345 fenet1.cborder:=RougeClair;
\r
2346 fenet1.cbande:=Rouge;
\r
2347 call fenet1.affiche;
\r
2349 flagbool:=fenet1.lecture;
\r
2350 if flagbool and not fenet1.creation
\r
2351 then call hidecursor;
\r
2353 keys:=new listkey;
\r
2355 clics:=new cliquer;
\r
2356 fenet2:=new Son(20,x-Largeur2/2,y-Hauteur2/2,x+Largeur2/2,y+hauteur2/2,2,
\r
2357 False,False,False);
\r
2359 fenet2.hauteur:=Haut_Bot;
\r
2360 fenet2.cborder:=RougeClair;
\r
2361 fenet2.cbande:=Rouge;
\r
2362 call fenet2.affiche;
\r
2363 flagbool:=fenet2.moveto(10,10);
\r
2364 call color(BleuClair);
\r
2365 flagbool:=fenet2.outgtext("Chargement de",14);
\r
2368 if fenet1.nomfic(i)=chr(0) then exit fi;
\r
2369 flagbool:=fenet2.outchar(fenet1.nomfic(i));
\r
2371 flagbool:=fenet2.outgtext(" en cours",8);
\r
2372 flagbool:=fenet2.moveto(10,25);
\r
2373 call color(VertClair);
\r
2374 flagbool:=fenet2.outgtext(".",1);
\r
2375 if RaciSomm<>none then RaciSomm:=none; fi;
\r
2376 if RaciArcs<>none then RaciArcs:=none; fi;
\r
2377 call W.verti.reset_bot;
\r
2378 call W.horiz.reset_bot;
\r
2379 call Lit_Ville(fenet2,fenet1.nomfic);
\r
2380 flagbool:=fenet2.moveto(10,40);
\r
2381 call color(BleuClair);
\r
2382 flagbool:=fenet2.outgtext("Chargement termin
\82 : 'Enter'",28);
\r
2383 fenet2.B(0).etat:=True;
\r
2384 call fenet2.bout.insert(fenet2.B(0));
\r
2385 call fenet2.B(0).affiche;
\r
2386 call keys.insert(new elmt(Tou_Ent));
\r
2389 code:=fenet2.gestionnaire;
\r
2390 if (code=Tou_Ent or code=21) then exit; fi;
\r
2393 call fenet2.restore;
\r
2394 else if flagbool and fenet1.creation
\r
2395 then EDIT.nomfic:=fenet1.nomfic;
\r
2397 if edit_bool (* on a cr
\82\82 un fichier coherant *)
\r
2399 call Etat_Menu(True,True,False,False,False,True);
\r
2400 COEF_X:=Larg_Aff/Larg_Vil;
\r
2401 COEF_Y:=Haut_Aff/Haut_Vil;
\r
2406 call ville_aff(zoom);
\r
2409 else call hidecursor;
\r
2412 call fenet1.restore;
\r
2417 if flagbool and not fenet1.creation
\r
2418 then attach(fenet2);
\r
2420 call Etat_Menu(True,True,False,False,False,True);
\r
2421 COEF_X:=Larg_Aff/Larg_Vil;
\r
2422 COEF_Y:=Haut_Aff/Haut_Vil;
\r
2427 call ville_aff(zoom);
\r
2434 (***************************************************************************)
\r
2435 Unit Bot_Run : procedure;
\r
2436 Const Largeur=330,
\r
2440 Posx,Posy : integer,
\r
2442 flagbool : boolean,
\r
2449 Posx:=x-Largeur/2;
\r
2450 Posy:=y-Hauteur/2;
\r
2452 clics:=new cliquer;
\r
2454 keys:=new listkey;
\r
2455 fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
\r
2456 2,False,False,False);
\r
2458 fenet.hauteur:=Haut_Bot;
\r
2459 fenet.cborder:=RougeClair;
\r
2460 fenet.cbande:=Rouge;
\r
2462 clics:=new cliquer;
\r
2463 call fenet.affiche;
\r
2464 call color(BleuClair);
\r
2465 flagbool:=fenet.moveto(10,10);
\r
2466 flagbool:=fenet.outgtext("Entrez le nombre de voitures (1-50)",32);
\r
2467 flagbool:=fenet.moveto(145,30);
\r
2468 NbMaxCar:=gscanf_num(1,50);
\r
2469 array Activ dim (0:NbMaxCar); (* on genere le tableau des car actives *)
\r
2470 call fenet.restore;
\r
2477 call Etat_Menu(False,False,True,False,False,False);
\r
2481 (***************************************************************************)
\r
2482 Unit Bot_Stop : procedure;
\r
2483 Const Largeur=280,
\r
2487 Posx,Posy : integer,
\r
2489 flagbool : boolean,
\r
2496 Posx:=x-Largeur/2;
\r
2497 Posy:=y-Hauteur/2;
\r
2499 clics:=new cliquer;
\r
2501 keys:=new listkey;
\r
2502 fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
\r
2503 2,False,False,False);
\r
2505 fenet.hauteur:=Haut_Bot;
\r
2506 fenet.cborder:=RougeClair;
\r
2507 fenet.cbande:=Rouge;
\r
2509 clics:=new cliquer;
\r
2510 call fenet.affiche;
\r
2511 call color(BleuClair);
\r
2512 flagbool:=fenet.moveto(60,10);
\r
2513 flagbool:=fenet.outgtext("Simulation stopp
\82e",18);
\r
2514 flagbool:=fenet.moveto(40,30);
\r
2515 flagbool:=fenet.outgtext("Appuyez sur une touche",22);
\r
2519 if code<>0 then exit; fi;
\r
2522 call fenet.restore;
\r
2529 call Etat_Menu(True,False,False,True,True,True);
\r
2533 (***************************************************************************)
\r
2534 Unit Bot_continue : procedure;
\r
2535 Const Largeur=290,
\r
2539 Posx,Posy : integer,
\r
2541 flagbool : boolean,
\r
2548 Posx:=x-Largeur/2;
\r
2549 Posy:=y-Hauteur/2;
\r
2551 clics:=new cliquer;
\r
2553 keys:=new listkey;
\r
2554 fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
\r
2555 2,False,False,False);
\r
2557 fenet.hauteur:=Haut_Bot;
\r
2558 fenet.cborder:=RougeClair;
\r
2559 fenet.cbande:=Rouge;
\r
2560 call fenet.affiche;
\r
2561 call color(BleuClair);
\r
2562 flagbool:=fenet.moveto(20,10);
\r
2563 flagbool:=fenet.outgtext("La simulation va reprendre...",29);
\r
2564 flagbool:=fenet.moveto(50,30);
\r
2565 flagbool:=fenet.outgtext("Appuyez sur une touche",22);
\r
2570 if code<>0 then exit fi;
\r
2573 call fenet.restore;
\r
2580 call Etat_Menu(False,False,True,False,False,False);
\r
2584 (***************************************************************************)
\r
2585 Unit Bot_Quit : function : boolean;
\r
2586 Const Largeur=300,
\r
2590 Posx,Posy : integer,
\r
2600 Posx:=x-Largeur/2;
\r
2601 Posy:=y-Hauteur/2;
\r
2603 clics:=new cliquer;
\r
2605 keys:=new listkey;
\r
2606 fenet:=new Son(10,Posx,Posy,Posx+Largeur,Posy+hauteur,2,True,False,False);
\r
2608 fenet.hauteur:=Haut_Bot;
\r
2609 fenet.cborder:=RougeClair;
\r
2610 fenet.nom:="Q U I T";
\r
2611 fenet.cnom:=RougeClair;
\r
2612 fenet.cbande:=Rouge;
\r
2613 Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);
\r
2616 call fenet.Bout.Insert(Yes);
\r
2617 No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);
\r
2620 call fenet.Bout.Insert(No);
\r
2621 call fenet.affiche;
\r
2622 call move(Posx+10,Posy+35);
\r
2623 call color(BleuClair);
\r
2624 call outstring("Do you want to quit the simulation");
\r
2625 call Keys.Insert(new elmt(T_ESC));
\r
2628 code:=fenet.gestionnaire;
\r
2630 when T_ESC : fin:=False; exit; (* touche racc exit *)
\r
2631 when T_Y : fin:=True; exit; (* touche Y *)
\r
2632 when T_N : fin:=False; exit; (* touche N *)
\r
2633 when 1 : fin:=True; exit; (* bouton yes *)
\r
2634 when 2 : fin:=False; exit; (* bouton no *)
\r
2635 when 11 : fin:=False; exit; (* racc exit *)
\r
2640 then result:=False;
\r
2641 else result:=True;
\r
2643 call fenet.restore;
\r
2653 (***************************************************************************)
\r
2654 Unit Bot_Help : procedure;
\r
2655 Const Largeur=410,
\r
2658 x,y,i,j : integer,
\r
2660 COORD_Y : integer,
\r
2663 boolaff : boolean,
\r
2664 help : arrayof arrayof char,
\r
2665 nb_lign_hlp : integer,
\r
2670 Unit affiche_hlp : procedure;
\r
2673 call color(BleuClair);
\r
2674 for i:=COORD_Y to imin(COORD_Y+18,nb_lign_hlp)
\r
2678 if (ord(help(i,j))>=28 and ord(help(i,j))<=255)
\r
2679 then boolaff:=fen.outchar(help(i,j));
\r
2689 clics:=new cliquer;
\r
2691 keys:=new listkey;
\r
2692 fen:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,2,
\r
2693 True,False,False);
\r
2695 fen.cnom:=RougeClair;
\r
2696 fen.nom:="H E L P";
\r
2697 fen.hauteur:=Haut_Bot;
\r
2698 fen.largeur:=Larg_Bot;
\r
2699 fen.cborder:=RougeClair;
\r
2700 fen.cbande:=Rouge;
\r
2701 x:=fen.x2-fen.lborder-1-fen.hauteur;
\r
2702 y:=fen.y1+fen.hauteur+fen.lborder+1;
\r
2703 fen.Verti:=new AccelerateV2(20,-1,x,y,x+fen.largeur,fen.y2-fen.lborder-1,fen);
\r
2705 call fen.Verti.deplacer(fen.Verti.MinY);
\r
2706 call Keys.Insert(new elmt(T_ESC)); (* pour sortir de la fenetre *)
\r
2707 call Keys.Insert(new elmt(T_PGUP)); (* page up *)
\r
2708 call Keys.Insert(new elmt(T_PGDOWN)); (* page dow *)
\r
2710 open(fp,text,unpack("simula.hlp"));
\r
2712 readln(fp,nb_lign_hlp);
\r
2713 array help dim (1:nb_lign_hlp);
\r
2714 for i:=1 to nb_lign_hlp
\r
2716 array help(i) dim (1:38);
\r
2718 call color(BleuClair);
\r
2723 read(fp,help(i,j));
\r
2725 if j=39 then j:=1;
\r
2730 call setposition(fen.x1,fen.y1);
\r
2733 code:=fen.gestionnaire;
\r
2735 if (code=T_ESC) or (code=11) then exit;
\r
2737 if (code=21) or (code=T_FLHAU) then COORD_Y:=COORD_Y-5;
\r
2738 if COORD_Y<=0 then COORD_Y:=1; fi;
\r
2739 call fen.Verti.DeplacerUp;
\r
2742 if (code=22) then COORD_Y:=1;
\r
2743 call fen.Verti.Reset_Bot;
\r
2746 if (code=23) or (code=T_FLBAS) then COORD_Y:=COORD_Y+5;
\r
2747 if COORD_Y>(nb_lign_hlp-5)
\r
2748 then COORD_Y:=nb_lign_hlp-5;
\r
2750 call fen.Verti.DeplacerDown;
\r
2753 if (code=T_PGUP) then COORD_Y:=COORD_Y-19;
\r
2756 call fen.Verti.Deplacer(fen.Verti.MinY);
\r
2757 else call fen.Verti.DeplacerDown;
\r
2761 if (code=T_PGDOWN) then COORD_Y:=COORD_Y+19;
\r
2762 if COORD_Y>(nb_lign_hlp-5)
\r
2763 then COORD_Y:=nb_lign_hlp-5;
\r
2764 call fen.Verti.Deplacer(fen.Verti.MaxY);
\r
2765 else call fen.Verti.DeplacerDown;
\r
2776 call fen.restore; (* restore le getmap et free de la ram *)
\r
2781 attach(fen); (* correspond a la 1ere etape kill *)
\r
2785 (***************************************************************************)
\r
2786 Unit About : procedure;
\r
2787 Const Largeur=400,
\r
2791 Posx,Posy : integer,
\r
2793 flagbool : boolean,
\r
2800 Posx:=x-Largeur/2;
\r
2801 Posy:=y-Hauteur/2;
\r
2803 clics:=new cliquer;
\r
2805 keys:=new listkey;
\r
2806 fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,2,
\r
2807 True,False,False);
\r
2809 fenet.hauteur:=Haut_Bot;
\r
2810 fenet.cborder:=RougeClair;
\r
2811 fenet.cbande:=Rouge;
\r
2812 call fenet.affiche;
\r
2813 call color(BleuClair);
\r
2814 flagbool:=fenet.moveto(18,10);
\r
2815 flagbool:=fenet.outgtext("Logiciel r
\82alis
\82 dans le cadre d'un projet",43);
\r
2816 flagbool:=fenet.moveto(18,40);
\r
2817 flagbool:=fenet.outgtext("de Licence Informatique - Univertit
\82 de PAU",43);
\r
2818 flagbool:=fenet.moveto(10,70);
\r
2819 flagbool:=fenet.outgtext("BARETS Olivier/PATAUD Fr
\82d
\82ric/PEYRAT Fran
\87ois",43);
\r
2820 flagbool:=fenet.moveto(10,100);
\r
2821 flagbool:=fenet.outgtext("LI1 1993/1994",43);
\r
2822 flagbool:=fenet.moveto(10,130);
\r
2823 flagbool:=fenet.outgtext("M
\82moire disponible : ",25);
\r
2824 call writint(memavail*4); (* sizeof (word) = 32 *)
\r
2825 flagbool:=fenet.moveto(230,130);
\r
2826 flagbool:=fenet.outgtext("Ko",2);
\r
2827 call Keys.Insert(new elmt(Tou_Ent));
\r
2828 call Keys.Insert(new elmt(T_ESC));
\r
2831 code:=fenet.gestionnaire;
\r
2832 if (code=11 or code=Tou_Ent or code=T_ESC) then exit; fi;
\r
2835 call fenet.restore;
\r
2846 (***************************************************************************)
\r
2847 Unit Etat_Menu : procedure (ml,mr,msto,mc,msta,mq : boolean);
\r
2849 if (ml and not M(1).etat) (* load devient enable *)
\r
2850 then M(1).etat:=True;
\r
2851 M(1).Touche:=T_F1;
\r
2852 call M(1).bot_enable;
\r
2854 if (not ml and M(1).etat) (* load devient disable *)
\r
2855 then M(1).etat:=False;
\r
2857 call M(1).bot_disable;
\r
2859 if (mr and not M(2).etat) (* run devient enable *)
\r
2860 then M(2).etat:=True;
\r
2861 M(2).Touche:=T_F2;
\r
2862 call M(2).bot_enable;
\r
2864 if (not mr and M(2).etat) (* run devient disable *)
\r
2865 then M(2).etat:=False;
\r
2867 call M(2).bot_disable;
\r
2869 if (msto and not M(3).etat) (* stop devient enable *)
\r
2870 then M(3).etat:=True;
\r
2871 M(3).Touche:=T_F3;
\r
2872 call M(3).bot_enable;
\r
2874 if (not msto and M(3).etat) (* stop devient disable *)
\r
2875 then M(3).etat:=False;
\r
2877 call M(3).bot_disable;
\r
2879 if (mc and not M(4).etat) (* continue devient enable *)
\r
2880 then M(4).etat:=True;
\r
2881 M(4).Touche:=T_F4;
\r
2882 call M(4).bot_enable;
\r
2884 if (not mc and M(4).etat) (* continue devient disable *)
\r
2885 then M(4).etat:=False;
\r
2887 call M(4).bot_disable;
\r
2889 if (msta and not M(5).etat) (* stats devient enable *)
\r
2890 then M(5).etat:=True;
\r
2891 M(5).Touche:=T_F5;
\r
2892 call M(5).bot_enable;
\r
2894 if (not msta and M(5).etat) (* stats devient disable *)
\r
2895 then M(5).etat:=False;
\r
2897 call M(5).bot_disable;
\r
2899 if (mq and not M(6).etat) (* quit devient enable *)
\r
2900 then M(6).etat:=True;
\r
2901 M(6).Touche:=T_F6;
\r
2902 call M(6).bot_enable;
\r
2904 if (not mq and M(6).etat) (* quit devient disable *)
\r
2905 then M(6).etat:=False;
\r
2907 call M(6).bot_disable;
\r
2911 (***************************************************************************)
\r
2912 (* procedure d'affichage de la ville - on deborde de l'ecran *)
\r
2913 (* tracer d'une ligne verticale qui peut depasser le cadre *)
\r
2914 (***************************************************************************)
\r
2916 Unit Trace_Vil1 : procedure (x1,y1,x2,y2 : real ; zoom : integer);
\r
2924 min_x:=imin(x1,x2);
\r
2925 max_x:=imax(x1,x2);
\r
2926 min_y:=imin(y1,y2);
\r
2927 max_y:=imax(y1,y2);
\r
2928 if (min_y>=Ydep_Aff and max_y<=(Ydep_Aff+Haut_Aff))
\r
2929 then (* on est en plein dans le cadre, on peut tracer normalement *)
\r
2930 call line(x1-C,imin(y1,y2)+C,x2-C,imax(y1,y2)-C,GrisClair);
\r
2931 call linep(x1,imin(y1,y2)+C,x2,imax(y1,y2)-C,Blanc,C);
\r
2932 call line(x1+C,imin(y1,y2)+C,x2+C,imax(y1,y2)-C,GrisClair);
\r
2933 else if (min_y<Ydep_Aff) (* c'est le minimum qui pose pb *)
\r
2934 then call line(x1-C,Ydep_Aff+C,x2-C,imax(y1,y2)-C,GrisClair);
\r
2935 call linep(x1,Ydep_Aff+C,x2,imax(y1,y2)-C,Blanc,C);
\r
2936 call line(x1+C,Ydep_Aff+C,x2+C,imax(y1,y2)-C,GrisClair);
\r
2937 else call line(x1-C,imin(y1,y2)+C,x2-C,Ydep_Aff+Haut_Aff-C,GrisClair);
\r
2938 call linep(x1,imin(y1,y2)+C,x2,Ydep_Aff+Haut_Aff-C,Blanc,C);
\r
2939 call line(x1+C,imin(y1,y2)+C,x2+C,Ydep_Aff+Haut_Aff-C,GrisClair);
\r
2945 (***************************************************************************)
\r
2946 (* procedure d'affichage de la ville - on deborde de l'ecran *)
\r
2947 (* tracer d'une ligne horizontale qui peut depasser le cadre *)
\r
2948 (***************************************************************************)
\r
2950 Unit Trace_Vil2 : procedure (x1,y1,x2,y2 : real ; zoom : integer);
\r
2958 min_x:=imin(x1,x2);
\r
2959 max_x:=imax(x1,x2);
\r
2960 min_y:=imin(y1,y2);
\r
2961 max_y:=imax(y1,y2);
\r
2962 if (min_x>=Xdep_Aff and max_x<=(Xdep_Aff+Larg_Aff))
\r
2963 then (* on est en plein dans le cadre, on peut tracer normalement *)
\r
2964 call line(imin(x1,x2)+C,y1-C,imax(x2,x1)-C,y2-C,GrisClair);
\r
2965 call linep(imin(x1,x2)+C,y1,imax(x2,x1)-C,y2,Blanc,C);
\r
2966 call line(imin(x1,x2)+C,y1+C,imax(x1,x2)-C,y2+C,GrisClair);
\r
2967 else if (min_x<Xdep_Aff) (* c'est le minimum qui pose pb *)
\r
2968 then call line(Xdep_Aff+C,y1-C,imax(x1,x2)-C,y2-C,GrisClair);
\r
2969 call linep(Xdep_Aff+C,y1,imax(x1,x2)-C,y2,Blanc,C);
\r
2970 call line(Xdep_Aff+C,y1+C,imax(x1,x2)-C,y2+C,GrisClair);
\r
2971 else call line(imin(x1,x2)+C,y1-C,Xdep_Aff+Larg_Aff-C,y2-C,GrisClair);
\r
2972 call linep(imin(x1,x2)+C,y1,Xdep_Aff+Larg_Aff-C,y2,Blanc,C);
\r
2973 call line(imin(x1,x2)+C,y1+C,Xdep_Aff+Larg_Aff-C,y2+C,GrisClair);
\r
2978 (***************************************************************************)
\r
2979 (* procedure d'affichage de la ville *)
\r
2980 (***************************************************************************)
\r
2981 Unit Ville_Aff : procedure(zoom : integer);
\r
2999 x1:=Xdep_Aff+COORD_X+(r.initial.colonne*COEF_X*zoom);
\r
3000 y1:=Ydep_Aff+COORD_Y+(r.initial.Ligne*COEF_Y*zoom);
\r
3001 x2:=Xdep_Aff+COORD_X+(r.final.colonne*COEF_X*zoom);
\r
3002 y2:=Ydep_Aff+COORD_Y+(r.final.Ligne*COEF_Y*zoom);
\r
3003 min_x:=imin(x1,x2);
\r
3004 max_x:=imax(x1,x2);
\r
3005 min_y:=imin(y1,y2);
\r
3006 max_y:=imax(y1,y2);
\r
3007 if(x1=x2) (* c'est une ligne verticale *)
\r
3009 if (x1<Xdep_Aff or x2>(Xdep_Aff+Larg_Aff)) (* on est hors de l'ecran*)
\r
3010 then (* on ne fait rien *)
\r
3011 else (* on va peut etre afficher qqch *)
\r
3012 if (max_y<Ydep_Aff or min_y>(Ydep_Aff+Haut_Aff))
\r
3013 then (* on ne doit rien afficher *)
\r
3014 else (* on va afficher qqch *)
\r
3015 call trace_vil1(x1,y1,x2,y2,zoom);
\r
3019 if(y1=y2) (* c'est une ligne horizontale *)
\r
3021 if (y1<Ydep_Aff or y2>(Ydep_Aff+Haut_Aff)) (* on est hors de l'ecran*)
\r
3022 then (*on ne fait rien *)
\r
3023 else (*on va peut etre afficher qqch *)
\r
3024 if (max_x<Xdep_Aff or min_x>(Xdep_Aff+Larg_Aff))
\r
3025 then (* on ne doit rien afficher *)
\r
3026 else (* on va afficher qqch *)
\r
3027 call trace_vil2(x1,y1,x2,y2,zoom);
\r
3037 x1:=Xdep_Aff+COORD_X+(s.colonne*COEF_X*zoom);
\r
3038 y1:=Ydep_Aff+COORD_Y+(s.Ligne*COEF_Y*zoom);
\r
3039 if (x1>=Xdep_Aff and x1<=(Xdep_Aff+Larg_Aff)
\r
3040 and y1>=Ydep_Aff and y1<=(Ydep_Aff+Haut_Aff))
\r
3041 then case s.afftype
\r
3042 when 1 : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
\r
3043 call line(x1+C,y1-C,x1+C,y1+C,GrisClair);
\r
3044 when 2 : call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
\r
3045 call line(x1+C,y1+C,x1+C,y1-C,GrisClair);
\r
3046 when 3 : call line(x1-C,y1+C,x1-C,y1-C,GrisClair);
\r
3047 call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
\r
3048 when 4 : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);
\r
3049 call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
\r
3050 when 5 : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
\r
3051 when 6 : call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
\r
3052 when 7 : call line(x1+C,y1-C,x1+C,y1+C,GrisClair);
\r
3053 when 8 : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);
\r
3055 when 10 : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);
\r
3056 call line(x1-C,y1+C,x1+C,y1+C,GrisClair);
\r
3057 when 11 : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);
\r
3058 call line(x1+C,y1-C,x1+C,y1+C,GrisClair);
\r
3066 (***************************************************************************)
\r
3068 (***************************************************************************)
\r
3069 Unit prog : Lists class;
\r
3071 (***************************************************************************)
\r
3072 Unit Bot_Stats : procedure;
\r
3073 Const Largeur=450,
\r
3077 Posx,Posy : integer,
\r
3079 flagbool : boolean,
\r
3087 Posx:=x-Largeur/2;
\r
3088 Posy:=y-Hauteur/2;
\r
3090 clics:=new cliquer;
\r
3092 keys:=new listkey;
\r
3093 fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,
\r
3094 2,False,False,False);
\r
3096 fenet.hauteur:=Haut_Bot;
\r
3097 fenet.cborder:=RougeClair;
\r
3098 fenet.cbande:=Rouge;
\r
3099 call fenet.affiche;
\r
3100 call color(BleuClair);
\r
3101 flagbool:=fenet.moveto(60,5);
\r
3102 flagbool:=fenet.outgtext("Appuyez sur une touche pour continuer",38);
\r
3103 call color(RougeClair);
\r
3105 then for c:=0 to imax((NbCarActiv div 18)-1,0)
\r
3107 for i:=c*18 to imin(NbCarActiv-1-c*18,18*(c+1)) (*maxi 18 car
\85 la fois *)
\r
3109 flagbool:=fenet.moveto(10,25+(i-c*18)*15);
\r
3110 call color(RougeClair);
\r
3111 call writint(i+1+c);
\r
3112 flagbool:=fenet.moveto(40,25+(i-c*18)*15);
\r
3113 call color(VertClair);
\r
3114 flagbool:=fenet.outgtext("En partance de ",15);
\r
3115 flagbool:=fenet.outchar(Activ(i) qua car.dep.nom);
\r
3116 call color(BleuClair);
\r
3117 flagbool:=fenet.moveto(170,25+(i-c*18)*15);
\r
3118 if Activ(i) qua car.km<>0
\r
3119 then flagbool:=fenet.outgtext(" position ",10);
\r
3120 call writint(Activ(i) qua car.km);
\r
3121 else flagbool:=fenet.outgtext(" position 0",11);
\r
3123 call color(VertClair);
\r
3124 flagbool:=fenet.moveto(266,25+(i-c*18)*15);
\r
3125 flagbool:=fenet.outgtext(" vers ",6);
\r
3126 if (Activ(i) qua car.arccour.initial.nom)=(Activ(i) qua car.dep.nom)
\r
3127 then flagbool:=fenet.outchar(Activ(i) qua car.arccour.final.nom);
\r
3128 else flagbool:=fenet.outchar(Activ(i) qua car.arccour.initial.nom);
\r
3134 if code<>0 then exit fi;
\r
3137 call color(BleuClair);
\r
3138 flagbool:=fenet.moveto(60,5);
\r
3139 flagbool:=fenet.outgtext("Appuyez sur une touche pour continuer",38);
\r
3141 else flagbool:=fenet.moveto(10,25);
\r
3142 flagbool:=fenet.outgtext("NbCarActiv = 0",14);
\r
3146 if code<>0 then exit fi;
\r
3149 call fenet.restore;
\r
3159 (***************************************************************************)
\r
3160 (* simprocess de generation des voitures *)
\r
3161 (***************************************************************************)
\r
3162 Unit Generate : Simprocess class;
\r
3165 if NbCarActiv<NbMaxCar
\r
3166 then Activ(NbCarActiv):=new car;
\r
3167 call schedule(Activ(NbCarActiv),time);
\r
3168 NbCarActiv:=NbCarActiv+1;
\r
3170 else call hold(70);
\r
3175 (***************************************************************************)
\r
3176 (* simprocess des voitures *)
\r
3177 (* on se limite au cas o
\97 toutes les voies sont
\85 double sens *)
\r
3178 (***************************************************************************)
\r
3179 Unit Car : Simprocess class;
\r
3181 (* procedure d'affichage de la voiture dans la ville *)
\r
3182 Unit affiche_car : procedure;
\r
3183 Var flagbool : boolean;
\r
3185 Unit dessine_car : procedure (x1,y1,x2,y2 : integer);
\r
3188 x1:=COORD_X+x1*COEF_X*Zoom;
\r
3189 y1:=COORD_Y+y1*COEF_Y*Zoom;
\r
3190 x2:=COORD_X+x2*COEF_X*Zoom;
\r
3191 y2:=COORD_Y+y2*COEF_Y*Zoom;
\r
3192 if (x1>=0 and y1>=0 and x2<=Larg_Aff and y2<=Haut_Aff)
\r
3193 then call rectanglef(Xdep_Aff+x1,Ydep_Aff+y1,Xdep_Aff+x2,Ydep_Aff+y2,col);
\r
3198 if arccour.Initial.colonne=arccour.final.colonne
\r
3199 then (* on est vertical *)
\r
3201 then (* on va de initial
\85 final *)
\r
3202 if arccour.initial.ligne<arccour.final.ligne
\r
3203 then (* l'initial est plus 'haut' que le final *)
\r
3204 call dessine_car(arccour.initial.colonne+1,
\r
3205 arccour.initial.ligne+(km-1),
\r
3206 arccour.initial.colonne+(1+Zoom),
\r
3207 arccour.initial.ligne+(km));
\r
3208 else (* l'initial est plus 'bas' que le final *)
\r
3209 call dessine_car(arccour.initial.colonne+1,
\r
3210 arccour.initial.ligne-(km-1),
\r
3211 arccour.initial.colonne+(1+Zoom),
\r
3212 arccour.initial.ligne-(km));
\r
3214 else (* on va de final
\85 initial *)
\r
3215 if arccour.initial.ligne<arccour.final.ligne
\r
3216 then (* l'initial est plus 'haut' que le final *)
\r
3217 call dessine_car(arccour.final.colonne-1,
\r
3218 arccour.final.ligne-(km-1),
\r
3219 arccour.final.colonne-(1+Zoom),
\r
3220 arccour.final.ligne-(km));
\r
3221 else (* l'initial est plus 'bas' que le final *)
\r
3222 call dessine_car(arccour.final.colonne-1,
\r
3223 arccour.final.ligne+(km-1),
\r
3224 arccour.final.colonne-(1+Zoom),
\r
3225 arccour.final.ligne+(km));
\r
3228 else (* on est horizontal *)
\r
3230 then (* on va de initial
\85 final *)
\r
3231 if arccour.initial.colonne<arccour.final.colonne
\r
3232 then (* l'initial est plus 'gche' que le final *)
\r
3233 call dessine_car(arccour.initial.colonne+(km-1),
\r
3234 arccour.initial.ligne+1,
\r
3235 arccour.initial.colonne+(km),
\r
3236 arccour.initial.ligne+(1+Zoom));
\r
3237 else (* l'initial est plus 'dte' que le final *)
\r
3238 call dessine_car(arccour.initial.colonne-(km-1),
\r
3239 arccour.initial.ligne+1,
\r
3240 arccour.initial.colonne-(km),
\r
3241 arccour.initial.ligne+(1+Zoom));
\r
3243 else (* on va de final
\85 initial *)
\r
3244 if arccour.initial.colonne<arccour.final.colonne
\r
3245 then (* l'initial est plus 'gche' que le final *)
\r
3246 call dessine_car(arccour.final.colonne-(km-1),
\r
3247 arccour.final.ligne-1,
\r
3248 arccour.final.colonne-(km),
\r
3249 arccour.final.ligne-(1+Zoom));
\r
3250 else (* l'initial est plus 'dte' que le final *)
\r
3251 call dessine_car(arccour.final.colonne+(km-1),
\r
3252 arccour.final.ligne-1,
\r
3253 arccour.final.colonne+(km),
\r
3254 arccour.final.ligne-(1+Zoom));
\r
3260 (* fonction se deplacant dans l'arc courant *)
\r
3261 Unit avance : function : boolean;
\r
3264 then arccour.occpsens(km):=none;
\r
3266 if km<arccour.distance
\r
3267 then if arccour.occpsens(km)=none (* si il n'y a personne devant*)
\r
3268 then arccour.occpsens(km):=this car;
\r
3271 result:=True; (* on n'a pas encore fini *)
\r
3272 else result:=False; (* on est arrive au sommet final *)
\r
3274 else arccour.occpinve(km):=none;
\r
3276 if km<=arccour.distance
\r
3277 then if arccour.occpinve(km)=none (* s'il n'y a personne devant *)
\r
3278 then arccour.occpinve(km):=this car; (* on avance *)
\r
3279 else km:=km-1; (* sinon on reste en place *)
\r
3281 result:=True; (* on n'a pas encore fini *)
\r
3282 else result:=False; (* on est arrive au sommet final *)
\r
3285 call affiche_car;
\r
3288 (* fonction choisissant le sommet de depart *)
\r
3289 Unit choix_sommet : function : sommets;
\r
3290 var som : sommets,
\r
3295 ch:=RANDOM*NBSOMMETS+1; (* on choisit le numero du sommet *)
\r
3303 (* fonction choisissant l'arc suivant que l'on va prendre *)
\r
3304 Unit choix_arc : function : arcs;
\r
3307 numarcdep : integer,
\r
3309 sl : liste; (* sauvegarde du precedent *)
\r
3312 if (dep.afftype<=8 and dep.afftype>=5)
\r
3313 then nbarcs:=nbarcs+1;
\r
3314 else if dep.afftype=9
\r
3315 then nbarcs:=nbarcs+2;
\r
3318 numarcdep:=RANDOM*nbarcs+1;
\r
3321 for i:=1 to numarcdep-1 (* on recherche cet arc dans la liste *)
\r
3324 lst:=lst.suivante;
\r
3326 km:=1; (* kilometrage dans l'arc *)
\r
3327 if lst.pointeur=arccour (* on a repris le meme arc *)
\r
3329 then result:=sl.pointeur; (* on prend le precedent *)
\r
3330 else result:=lst.suivante.pointeur; (* sinon le suivant *)
\r
3332 else result:=lst.pointeur; (* on poss
\8ade l'arc *)
\r
3334 if result.initial=dep
\r
3340 Var dep : sommets, (* sommet de depart du voyage *)
\r
3341 arccour : arcs, (* arc de depart du voyage *)
\r
3343 sens : integer, (* 1 si ini-fin , -1 si fin-ini *)
\r
3344 km : integer, (* distance ds l'arc courant depuis sommet initial*)
\r
3345 pourcent : integer,
\r
3346 col : integer; (* couleur de la voiture *)
\r
3348 dep:=choix_sommet;
\r
3349 arccour:=dep.ptrarc.pointeur;
\r
3350 if dep=arccour.initial
\r
3354 col:=RANDOM*15+1; (* tout sauf noir *)
\r
3357 boo:=avance; (* on avance d'un pas *)
\r
3358 if not boo (* on est
\85 la fin de l'arc, il faut savoir si on va en *)
\r
3359 (* prendre un autre *)
\r
3360 then pourcent:=RANDOM*100;
\r
3362 then if dep=arccour.initial
\r
3363 then dep:=arccour.final;
\r
3364 else dep:=arccour.initial;
\r
3366 arccour:=choix_arc; (* on a 80% de chance de continuer *)
\r
3367 boo:=True; (* on doit donc continuer *)
\r
3368 else boo:=False; (* on s'arrete *)
\r
3371 if boo (* si boo alors on n'est pas encore au point d'arrivee *)
\r
3372 then call hold(90);
\r
3376 NbCarActiv:=NbCarActiv-1;
\r
3381 (***************************************************************************)
\r
3382 (* simprocess de gestion de l'affichage *)
\r
3383 (***************************************************************************)
\r
3384 Unit affichage : simprocess class;
\r
3387 code:=W.Gestionnaire;
\r
3389 if (code=T_F1) or (code=1) then call Bot_Load;
\r
3391 if (code=T_F6) or (code=6) then if Bot_Quit then fin:=True; exit; fi;
\r
3393 if (code=T_F9) or (code=9) then call Bot_help;
\r
3395 if (code=T_ALTF4) then if Bot_Quit then fin:=True; exit; fi;
\r
3397 if (code=T_F2) or (code=2) then call Bot_Run;
\r
3399 if (code=T_F3) or (code=3) then call Bot_Stop;
\r
3401 if (code=T_f4) or (code=4) then call Bot_Continue;
\r
3403 if (code=T_FLGCH) or (code=51) then call W.Horiz.DeplacerLeft;
\r
3404 COORD_X:=COORD_X+30;
\r
3405 call Ville_Aff(ZOOM);
\r
3407 if (code=T_FLDTE) or (code=53) then call W.Horiz.DeplacerRight;
\r
3408 COORD_X:=COORD_X-30;
\r
3409 call Ville_Aff(ZOOM);
\r
3411 if (code=T_FLHAU) or (code=61) then call W.Verti.DeplacerUp;
\r
3412 COORD_Y:=COORD_Y+30;
\r
3413 call Ville_Aff(ZOOM);
\r
3415 if (code=T_FLBAS) or (code=63) then call W.verti.DeplacerDown;
\r
3416 COORD_Y:=COORD_Y-30;
\r
3417 call Ville_Aff(ZOOM);
\r
3419 if (code=101) then if Bot_Quit then fin:=True; exit fi;
\r
3421 if (code=102) then call W.iconify;
\r
3423 if (code=52) then COORD_X:=0;
\r
3424 call W.Horiz.Reset_Bot;
\r
3425 call Ville_Aff(ZOOM);
\r
3427 if (code=62) then COORD_Y:=0;
\r
3428 call W.Verti.Reset_Bot;
\r
3429 call Ville_Aff(ZOOM);
\r
3431 if (code=7) or (code=T_F7)
\r
3432 then Zoom:=Zoom+1;
\r
3433 if zoom=5 then M(7).etat:=False;
\r
3434 call M(7).bot_disable;
\r
3436 if not M(8).etat then M(8).etat:=True;
\r
3437 call M(8).bot_enable;
\r
3440 Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20-2*C;
\r
3441 Haut_Aff:=W.Verti.y2-W.Verti.y1-20-2*C;
\r
3442 Xdep_Aff:=W.Horiz.x1+10+C;
\r
3443 Ydep_Aff:=W.Verti.y1+10+C;
\r
3444 call Ville_Aff(Zoom);
\r
3446 if (code=8) or (code=T_F8)
\r
3447 then Zoom:=Zoom-1;
\r
3448 if zoom=1 then M(8).etat:=False;
\r
3449 call M(8).bot_disable;
\r
3451 if not M(7).etat then M(7).etat:=True;
\r
3452 call M(7).bot_Enable;
\r
3455 Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20-2*C;
\r
3456 Haut_Aff:=W.Verti.y2-W.Verti.y1-20-2*C;
\r
3457 Xdep_Aff:=W.Horiz.x1+10+C;
\r
3458 Ydep_Aff:=W.Verti.y1+10+C;
\r
3459 call Ville_Aff(Zoom);
\r
3461 if (code=5) or (code=T_F5) then call Bot_Stats;
\r
3463 if (code=T_SHFTF4) then call About;
\r
3465 if (code=T_CTRLF4) then call W.iconify;
\r
3467 if code=T_CTRLENT then call rattacher(SIMULA,EDIT);
\r
3490 (* si on n'est pas en pause dans la simulation, on doit faire un hold *)
\r
3491 (* pour pouvoir passer la 'main' au generateur et aux voitures *)
\r
3492 if not SimStop then call hold(120); fi;
\r
3496 Var sim_aff : affichage;
\r
3498 sim_aff:=new affichage;
\r
3499 call schedule(new generate,time); (* mise dans la file du generateur de car *)
\r
3501 call schedule(sim_aff,time); (* mise dans la file du syst
\8ame d'affichage *)
\r
3504 if fin then exit; fi;
\r
3512 W:=new Maine(100,1,1,SIZEX,SIZEY,3,True,True,False);
\r
3513 W.hauteur:=Haut_bot;
\r
3514 W.cborder:=BleuClair;
\r
3515 W.cbande:=GrisClair;
\r
3516 W.cnom:=BleuClair;
\r
3517 W.nom:="Simulation de r
\82seau routier";
\r
3520 array M dim (1:9);
\r
3522 y1:=W.y1+W.lborder+1+W.hauteur+2;
\r
3524 M(1):=new Menu(1,T_F1,W.x1+8,y1,W.x1+50,y2);
\r
3527 call W.Bout.Insert(M(1));
\r
3529 M(2):=new Menu(2,-1,W.x1+55,y1,W.x1+89,y2);
\r
3532 call W.Bout.Insert(M(2));
\r
3534 M(3):=new Menu(3,-1,W.x1+94,y1,W.x1+136,y2);
\r
3537 call W.Bout.Insert(M(3));
\r
3539 M(4):=new Menu(4,-1,W.x1+141,y1,W.x1+215,y2);
\r
3540 M(4).nom:="Continue";
\r
3542 call W.Bout.Insert(M(4));
\r
3544 M(5):=new Menu(5,-1,W.x1+220,y1,W.x1+270,y2);
\r
3545 M(5).nom:="Stats";
\r
3547 call W.Bout.Insert(M(5));
\r
3549 M(6):=new Menu(6,T_F6,W.x1+275,y1,W.x1+317,y2);
\r
3552 call W.Bout.Insert(M(6));
\r
3554 M(7):=new Menu(7,T_F7,W.x2-94,y1,W.x2-77,y2);
\r
3557 call W.Bout.Insert(M(7));
\r
3559 M(8):=new Menu(8,T_F8,W.x2-72,y1,W.x2-55,y2);
\r
3562 call W.Bout.Insert(M(8));
\r
3564 M(9):=new Menu(9,T_F9,W.x2-30,y1,W.x2-13,y2);
\r
3567 call W.Bout.Insert(M(9));
\r
3569 x1:=W.x1+W.lborder+1;
\r
3570 y1:=W.y2-W.lborder-Haut_bot-1;
\r
3571 x2:=W.x2-W.lborder-Larg_bot-1;
\r
3572 y2:=W.y2-W.lborder-1;
\r
3573 W.Horiz:=new AccelerateH(50,-1,x1,y1,x2,y2,W);
\r
3575 x1:=W.x2-W.lborder-Larg_bot-1;
\r
3576 y1:=W.y1+W.lborder+2*(Haut_bot+2);
\r
3577 x2:=W.x2-W.lborder-1;
\r
3578 y2:=W.y2-W.lborder-Haut_bot;
\r
3579 W.Verti:=new AccelerateV2(60,-1,x1,y1,x2,y2,W);
\r
3581 Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20;
\r
3582 Haut_Aff:=W.Verti.y2-W.Verti.y1-20;
\r
3583 Xdep_Aff:=W.Horiz.x1+10;
\r
3584 Ydep_Aff:=W.Verti.y1+10;
\r
3594 call keys.insert(new elmt(T_CTRLENT)); (* pour le chgt de programme *)
\r
3597 notfirst:=true; (* on a deja fait un affichage de la fenetre *)
\r
3599 call About; (* about en presentation *)
\r
3603 prg:=new prog; (* on met la simulation en route *)
\r
3604 (* NB: elle commence par l'affichage et sa gestion *)
\r
3611 (***************************************************************************)
\r
3612 (***************************************************************************)
\r
3613 (* PROGRAMME NUMERO 2 : EDITEUR DE VILLES *)
\r
3614 (***************************************************************************)
\r
3615 (***************************************************************************)
\r
3616 Unit editor : Logiciel coroutine (nomfic : arrayof char;output resultat : boolean);
\r
3617 Var largeur : integer,
\r
3618 hauteur : integer,
\r
3622 (***************************************************************************)
\r
3623 Unit Bot_Quit : function : boolean;
\r
3624 Const Largeur=300,
\r
3628 Posx,Posy : integer,
\r
3638 Posx:=x-Largeur/2;
\r
3639 Posy:=y-Hauteur/2;
\r
3641 clics:=new cliquer;
\r
3643 keys:=new listkey;
\r
3644 fenet:=new Son(10,Posx,Posy,Posx+Largeur,Posy+hauteur,2,True,False,False);
\r
3646 fenet.hauteur:=Haut_Bot;
\r
3647 fenet.cborder:=RougeClair;
\r
3648 fenet.nom:="Q U I T";
\r
3649 fenet.cnom:=RougeClair;
\r
3650 fenet.cbande:=Rouge;
\r
3651 Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);
\r
3654 call fenet.Bout.Insert(Yes);
\r
3655 No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);
\r
3658 call fenet.Bout.Insert(No);
\r
3659 call fenet.affiche;
\r
3660 call move(Posx+10,Posy+35);
\r
3661 call color(BleuClair);
\r
3662 call outstring("Do you want to quit the editor");
\r
3663 call Keys.Insert(new elmt(T_ESC));
\r
3666 code:=fenet.gestionnaire;
\r
3668 when T_ESC : fin:=False; exit; (* touche racc exit *)
\r
3669 when T_Y : fin:=True; exit; (* touche Y *)
\r
3670 when T_N : fin:=False; exit; (* touche N *)
\r
3671 when 1 : fin:=True; exit; (* bouton yes *)
\r
3672 when 2 : fin:=False; exit; (* bouton no *)
\r
3673 when 11 : fin:=False; exit; (* racc exit *)
\r
3678 then result:=False;
\r
3679 else result:=True;
\r
3681 call fenet.restore;
\r
3697 W:=new Maine(100,1,1,largeur,hauteur,3,True,True,False);
\r
3698 W.hauteur:=Haut_bot;
\r
3699 W.cborder:=BleuClair;
\r
3700 W.cbande:=GrisClair;
\r
3701 W.cnom:=BleuClair;
\r
3702 W.nom:="Editeur de r
\82seau routier";
\r
3705 array M dim (1:6);
\r
3707 y1:=W.y1+W.lborder+1+W.hauteur+2;
\r
3709 M(1):=new Menu(1,T_F1,W.x1+8,y1,W.x1+50,y2);
\r
3712 call W.Bout.Insert(M(1));
\r
3714 M(2):=new Menu(2,T_F2,W.x1+55,y1,W.x1+99,y2);
\r
3717 call W.Bout.Insert(M(2));
\r
3719 M(3):=new Menu(3,T_F3,W.x1+104,y1,W.x1+146,y2);
\r
3722 call W.Bout.Insert(M(3));
\r
3724 M(4):=new Menu(4,T_F4,W.x2-94,y1,W.x2-77,y2);
\r
3727 call W.Bout.Insert(M(4));
\r
3729 M(5):=new Menu(5,-1,W.x2-72,y1,W.x2-55,y2);
\r
3732 call W.Bout.Insert(M(5));
\r
3734 M(6):=new Menu(6,T_F6,W.x2-30,y1,W.x2-13,y2);
\r
3737 call W.Bout.Insert(M(6));
\r
3739 return; (* fin de l'initialisation de la coroutine *)
\r
3741 call keys.insert(new elmt(T_CTRLENT)); (* pour le chgt de programme *)
\r
3744 notfirst:=true; (* on a deja fait un affichage de la fenetre *)
\r
3747 code:=W.gestionnaire;
\r
3748 if code=T_F3 or code=3 then if bot_quit then exit; fi;
\r
3750 if code=T_F1 or code=1 then
\r
3752 if code=T_F2 or code=2 then
\r
3754 if code=T_CTRLF4 then call W.iconify;
\r
3756 if code=T_F4 or code=4 then
\r
3758 if code=T_F5 or code=5 then
\r
3760 if code=T_F6 or code=6 then
\r
3762 if code=T_CTRLENT then call rattacher(EDIT,DOS);
\r
3779 (***************************************************************************)
\r
3780 (***************************************************************************)
\r
3781 (* PROGRAMME NUMERO 3 : FENETRE MS-DOS *)
\r
3782 (***************************************************************************)
\r
3783 (***************************************************************************)
\r
3784 Unit MS_DOS : Logiciel coroutine;
\r
3785 Var largeur : integer,
\r
3786 hauteur : integer,
\r
3790 (***************************************************************************)
\r
3791 Unit Bot_Quit : function : boolean;
\r
3792 Const Largeur=300,
\r
3796 Posx,Posy : integer,
\r
3806 Posx:=x-Largeur/2;
\r
3807 Posy:=y-Hauteur/2;
\r
3809 clics:=new cliquer;
\r
3811 keys:=new listkey;
\r
3812 fenet:=new Son(10,Posx,Posy,Posx+Largeur,Posy+hauteur,2,True,False,False);
\r
3814 fenet.hauteur:=Haut_Bot;
\r
3815 fenet.cborder:=RougeClair;
\r
3816 fenet.nom:="Q U I T";
\r
3817 fenet.cnom:=RougeClair;
\r
3818 fenet.cbande:=Rouge;
\r
3819 Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);
\r
3822 call fenet.Bout.Insert(Yes);
\r
3823 No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);
\r
3826 call fenet.Bout.Insert(No);
\r
3827 call fenet.affiche;
\r
3828 call move(Posx+10,Posy+35);
\r
3829 call color(BleuClair);
\r
3830 call outstring("Do you want to quit the DOS session");
\r
3831 call Keys.Insert(new elmt(T_ESC));
\r
3834 code:=fenet.gestionnaire;
\r
3836 when T_ESC : fin:=False; exit; (* touche racc exit *)
\r
3837 when T_Y : fin:=True; exit; (* touche Y *)
\r
3838 when T_N : fin:=False; exit; (* touche N *)
\r
3839 when 1 : fin:=True; exit; (* bouton yes *)
\r
3840 when 2 : fin:=False; exit; (* bouton no *)
\r
3841 when 11 : fin:=False; exit; (* racc exit *)
\r
3846 then result:=False;
\r
3847 else result:=True;
\r
3849 call fenet.restore;
\r
3865 W:=new Maine(100,1,1,largeur,hauteur,3,True,True,False);
\r
3866 W.hauteur:=Haut_bot;
\r
3867 W.cborder:=BleuClair;
\r
3868 W.cbande:=GrisClair;
\r
3869 W.cnom:=BleuClair;
\r
3870 W.nom:="Fenetre MS-DOS";
\r
3871 W.icname:="MS-DOS";
\r
3873 array M dim (1:2);
\r
3875 y1:=W.y1+W.lborder+1+W.hauteur+2;
\r
3877 M(1):=new Menu(1,T_F1,W.x1+8,y1,W.x1+50,y2);
\r
3880 call W.Bout.Insert(M(1));
\r
3882 M(2):=new Menu(2,T_F2,W.x2-30,y1,W.x2-13,y2);
\r
3885 call W.Bout.Insert(M(2));
\r
3887 return; (* fin de l'initialisation de la coroutine *)
\r
3889 call keys.insert(new elmt(T_CTRLENT)); (* pour le chgt de programme *)
\r
3892 notfirst:=true; (* on a deja fait un affichage de la fenetre *)
\r
3895 code:=W.gestionnaire;
\r
3896 if code=T_F1 or code=1 then if bot_quit then exit; fi;
\r
3898 if code=T_CTRLF4 then call W.iconify;
\r
3900 if code=T_CTRLENT then call rattacher(DOS,SIMULA);
\r
3913 (***************************************************************************)
\r
3914 (***************************************************************************)
\r
3915 (* P R O G R A M M E P R IN C I P A L *)
\r
3916 (***************************************************************************)
\r
3917 (***************************************************************************)
\r
3919 Unit Logiciel : coroutine(id : integer);
\r
3921 notfirst : boolean; (* false si c'est la premi
\8are fois *)
\r
3926 Unit rattacher : procedure (co_prov,co_dest : Logiciel);
\r
3929 then SLKEYS(co_prov.id):=Keys; (* on sauve les liste de l'ancien actif *)
\r
3930 SLCLICS(co_prov.id):=clics;
\r
3931 call move(co_prov.W.x1,co_prov.W.y1);
\r
3932 co_prov.W.savmap:=getmap(co_prov.W.x2,co_prov.W.y2);
\r
3934 Keys:=SLKEYS(co_dest.id); (* on met les listes du prog actif en place *)
\r
3935 clics:=SLCLICS(co_dest.id);
\r
3936 if co_dest.notfirst
\r
3937 then call move(co_dest.W.x1,co_dest.W.y1);
\r
3938 call putmap(co_dest.W.savmap);
\r
3941 attach(co_dest); (* on met actif le programme *)
\r
3947 call gron(1); (* mode 640x480x256 avec driver stealth.grn*)
\r
3951 array SLKEYS dim (1:3);
\r
3952 array SLCLICS dim (1:3);
\r
3954 clics:=new cliquer; (* ensemble des zones de clic possible *)
\r
3955 Keys:=new ListKey; (* liste des touches rattach
\82es *)
\r
3956 SIMULA:=new simulateur(1);
\r
3958 SLCLICS(1):=clics;
\r
3960 clics:=new cliquer; (* ensemble des zones de clic possible *)
\r
3961 Keys:=new ListKey; (* liste des touches rattach
\82es *)
\r
3962 EDIT:=new editor(2,none,edit_bool);
\r
3964 SLCLICS(2):=clics;
\r
3966 clics:=new cliquer; (* ensemble des zones de clic possible *)
\r
3967 Keys:=new ListKey; (* liste des touches rattach
\82es *)
\r
3968 DOS:=new MS_DOS(3);
\r
3970 SLCLICS(3):=clics;
\r
3972 Keys:=SLKEYS(1); (* on met les listes du prog actif en place *)
\r
3973 clics:=SLCLICS(1);
\r