examples/pataud/simula.log

   1 Program simulation;\r
   2 \r
   3 (***************************************************************************)\r
   4 (* Programme de syst\8ame de fenetrage avec boutons et gestion de la souris  *)\r
   5 (* ainsi que de simulation d'un r\82seau routier en ville.                   *)\r
   6 (* BARETS Olivier & PATAUD Fr\82d\82ric & PEYRAT Fran\87ois            1993/1994 *)\r
   7 (*  plateforme : PC-DOS_386 avec clavier 102 touches / mode VGA / souris   *)\r
   8 (*               PC 486DX33 16Mo Ram                                       *)\r
   9 (***************************************************************************)\r
  10 \r
  11 Begin\r
  12 Pref iiuwgraph block\r
  13   \r
  14   Begin\r
  15   Pref mouse block\r
  16 \r
  17  Const Noir       = 0, Bleu        = 1, Vert        = 2, Cyan        = 3,\r
  18        Rouge      = 4, Magenta     = 5, Marron      = 6, GrisClair   = 7,\r
  19        GrisFonce  = 8, BleuClair   = 9, VertClair   =10, CyanClair   =11,\r
  20        RougeClair =12, MagentaClair=13, Jaune       =14, Blanc       =15;\r
  21  \r
  22  Const T_F1     =315, T_F2     =316, T_F3     =317, T_F4     =318,\r
  23        T_F5     =319, T_F6     =320, T_F7     =321, T_F8     =322,\r
  24        T_F9     =323, T_F10    =324, T_SHFTF1 =340, T_SHFTF2 =341,\r
  25        T_SHFTF3 =342, T_SHFTF4 =343, T_SHFTF5 =344, T_SHFTF6 =345,\r
  26        T_SHFTF7 =346, T_SHFTF8 =347, T_SHFTF9 =348, T_SHFTF10=349,\r
  27        T_CTRLF1 =350, T_CTRLF2 =351, T_CTRLF3 =352, T_CTRLF4 =353, \r
  28        T_CTRLF5 =354, T_CTRLF6 =355, T_CTRLF7 =356, T_CTRLF8 =357, \r
  29        T_CTRLF9 =358, T_CTRLF10=359, T_ALTF1  =360, T_ALTF2  =361, \r
  30        T_ALTF3  =362, T_ALTF4  =363, T_ALTF5  =364, T_ALTF6  =365, \r
  31        T_ALTF7  =366, T_ALTF8  =367, T_ALTF9  =368, T_ALTF10 =369,\r
  32        Tou_Ent  =013, T_ESC    =027, T_N      =078, T_Y      =089,\r
  33        T_FLGCH  =331, T_FLDTE  =333, T_FLHAU  =328, T_FLBAS  =336,\r
  34        T_ALT1   =376, T_ALT2   =377, T_PGUP   =329, T_PGDOWN =337;\r
  35 \r
  36  Var   SIZEX : integer,\r
  37        SIZEY : integer;\r
  38 \r
  39 \r
  40 (* les variables du syst\8ame de fenetrage   *)\r
  41 \r
  42  Var code     : integer,\r
  43      Larg_Vil : integer,  (* largeur de la ville                          *)\r
  44      Haut_Vil : integer,  (* Hauteur de la ville                          *)\r
  45      Larg_Aff : integer,  (* largeur de l'interieur de la fenetre maine   *)\r
  46      Haut_Aff : integer,  (* hauteur de l'interieur de la fenetre maine   *)\r
  47      Xdep_Aff : integer,  (* Point de depart de l'affichage en X ds maine *)\r
  48      Ydep_Aff : integer,  (* point de depart de l'affichage en Y ds maine *)\r
  49      COEF_X   : real,     (* coeficient de zoom en x                      *)\r
  50      COEF_Y   : real,     (* coeficient de zoom en y                      *)\r
  51      COORD_X  : integer,  (* coordonn\82e en X de Xdep_Aff en relatif       *)\r
  52      COORD_Y  : integer,  (* coordonn\82e en Y de Ydep_Aff en relatif       *)\r
  53      W        : Maine,\r
  54      Keys     : ListKey,\r
  55      M        : arrayof Menu,\r
  56      clics    : cliquer;\r
  57 \r
  58 \r
  59 (* les variables de la simulation *)\r
  60 \r
  61  Var RaciSomm   : Sommets,\r
  62      RaciArcs   : Arcs,\r
  63      NbCarActiv : integer,\r
  64      NBSOMMETS  : integer;\r
  65 \r
  66    Unit pointeur : class;\r
  67    End pointeur;\r
  68 \r
  69 \r
  70 \r
  71 (***************************************************************************)\r
  72 (*          definition des classes et procedures de simprocess             *)\r
  73 (***************************************************************************)\r
  74 \r
  75 \r
  76 UNIT PRIORITYQUEUE: CLASS;\r
  77 \r
  78   (* HEAP AS BINARY LINKED TREE WITH FATHER LINK*)\r
  79 \r
  80 \r
  81      UNIT QUEUEHEAD: CLASS;\r
  82         (* HEAP ACCESING MODULE *)\r
  83              VAR LAST,ROOT:NODE;\r
  84  \r
  85              UNIT MIN: FUNCTION: ELEM;\r
  86                   BEGIN\r
  87                 IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;\r
  88                  END MIN;\r
  89  \r
  90              UNIT INSERT: PROCEDURE(R:ELEM);\r
  91                (* INSERTION INTO HEAP *)\r
  92                    VAR X,Z:NODE;\r
  93                  BEGIN\r
  94                        X:= R.LAB;\r
  95                        IF LAST=NONE THEN\r
  96                          ROOT:=X;\r
  97                          ROOT.LEFT,ROOT.RIGHT,LAST:=ROOT\r
  98                        ELSE\r
  99                          IF LAST.NS=0 THEN\r
 100                            LAST.NS:=1;\r
 101                            Z:=LAST.LEFT;\r
 102                            LAST.LEFT:=X;\r
 103                            X.UP:=LAST;\r
 104                            X.LEFT:=Z;\r
 105                            Z.RIGHT:=X;\r
 106                          ELSE\r
 107                            LAST.NS:=2;\r
 108                            Z:=LAST.RIGHT;\r
 109                            LAST.RIGHT:=X;\r
 110                            X.RIGHT:=Z;\r
 111                            X.UP:=LAST;\r
 112                            Z.LEFT:=X;\r
 113                            LAST.LEFT.RIGHT:=X;\r
 114                            X.LEFT:=LAST.LEFT;\r
 115                            LAST:=Z;\r
 116                          FI\r
 117                        FI;\r
 118                        CALL CORRECT(R,FALSE)\r
 119                        END INSERT;\r
 120 \r
 121 UNIT DELETE: PROCEDURE(R: ELEM);\r
 122      VAR X,Y,Z:NODE;\r
 123      BEGIN\r
 124      X:=R.LAB;\r
 125      Z:=LAST.LEFT;\r
 126      IF LAST.NS =0 THEN\r
 127            Y:= Z.UP;\r
 128            Y.RIGHT:= LAST;\r
 129            LAST.LEFT:=Y;\r
 130            LAST:=Y;\r
 131                    ELSE\r
 132            Y:= Z.LEFT;\r
 133            Y.RIGHT:= LAST;\r
 134             LAST.LEFT:= Y;\r
 135                     FI;\r
 136        Z.EL.LAB:=X;\r
 137        X.EL:= Z.EL;\r
 138        LAST.NS:= LAST.NS-1;\r
 139        R.LAB:=Z;\r
 140        Z.EL:=R;\r
 141        IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)\r
 142                        ELSE CALL CORRECT(X.EL,TRUE) FI;\r
 143      END DELETE;\r
 144 \r
 145 UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN);\r
 146    (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *)\r
 147      VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN;\r
 148      BEGIN\r
 149      Z:=R.LAB;\r
 150      IF DOWN THEN\r
 151           WHILE NOT FIN DO\r
 152                  IF Z.NS =0 THEN FIN:=TRUE ELSE\r
 153                       IF Z.NS=1 THEN X:=Z.LEFT ELSE\r
 154                       IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT\r
 155                        FI; FI;\r
 156                       IF Z.LESS(X) THEN FIN:=TRUE ELSE\r
 157                             T:=X.EL;\r
 158                             X.EL:=Z.EL;\r
 159                             Z.EL:=T;\r
 160                             Z.EL.LAB:=Z;\r
 161                            X.EL.LAB:=X\r
 162                       FI; FI;\r
 163                  Z:=X;\r
 164                        OD\r
 165               ELSE\r
 166     X:=Z.UP;\r
 167     IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;\r
 168     WHILE NOT LOG DO\r
 169           T:=Z.EL;\r
 170           Z.EL:=X.EL;\r
 171            X.EL:=T;\r
 172           X.EL.LAB:=X;\r
 173           Z.EL.LAB:=Z;\r
 174           Z:=X;\r
 175           X:=Z.UP;\r
 176            IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);\r
 177             FI;\r
 178                 OD\r
 179      FI;\r
 180  END CORRECT;\r
 181 \r
 182 END QUEUEHEAD;\r
 183 \r
 184 \r
 185      UNIT NODE: CLASS (EL:ELEM);\r
 186        (* ELEMENT OF THE HEAP *)\r
 187            VAR LEFT,RIGHT,UP: NODE, NS:INTEGER;\r
 188            UNIT LESS: FUNCTION(X:NODE): BOOLEAN;\r
 189                BEGIN\r
 190                IF X= NONE THEN RESULT:=FALSE\r
 191                          ELSE RESULT:=EL.LESS(X.EL) FI;\r
 192                END LESS;\r
 193           END NODE;\r
 194 \r
 195 \r
 196      UNIT ELEM: CLASS(PRIOR:REAL);\r
 197        (* PREFIX OF INFORMATION TO BE STORED IN NODE *)\r
 198         VAR LAB: NODE;\r
 199         UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;\r
 200                  BEGIN\r
 201                  IF X=NONE THEN RESULT:= FALSE ELSE\r
 202                                 RESULT:= PRIOR< X.PRIOR FI;\r
 203                  END LESS;\r
 204          BEGIN\r
 205          LAB:= NEW NODE(THIS ELEM);\r
 206          END ELEM;\r
 207 \r
 208 \r
 209 END PRIORITYQUEUE;\r
 210 \r
 211 \r
 212  \r
 213 UNIT SIMULATION: PRIORITYQUEUE CLASS;\r
 214 (* THE LANGUAGE FOR SIMULATION PURPOSES *)\r
 215  \r
 216   VAR CURR: SIMPROCESS,  (*ACTIVE PROCESS *)\r
 217       PQ:QUEUEHEAD,  (* THE TIME AXIS *)\r
 218        MAINPR: MAINPROGRAM;\r
 219  \r
 220  \r
 221       UNIT SIMPROCESS: pointeur COROUTINE;\r
 222         (* USER PROCESS PREFIX *)\r
 223              VAR EVENT,  (* ACTIVATION MOMENT NOTICE *)\r
 224                  EVENTAUX: EVENTNOTICE,\r
 225                  (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)\r
 226                  (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS             *)\r
 227                  FINISH: BOOLEAN;\r
 228  \r
 229              UNIT IDLE: FUNCTION: BOOLEAN;\r
 230                    BEGIN\r
 231                    RESULT:= EVENT= NONE;\r
 232                    END IDLE;\r
 233  \r
 234              UNIT TERMINATED: FUNCTION :BOOLEAN;\r
 235                    BEGIN\r
 236                   RESULT:= FINISH;\r
 237                    END TERMINATED;\r
 238  \r
 239              UNIT EVTIME: FUNCTION: REAL;\r
 240              (* TIME OF ACTIVATION *)\r
 241                   BEGIN\r
 242                   IF IDLE THEN CALL ERROR1;\r
 243                                            FI;\r
 244                   RESULT:= EVENT.EVENTTIME;\r
 245                   END EVTIME;\r
 246  \r
 247     UNIT ERROR1:PROCEDURE;\r
 248                 BEGIN\r
 249                 ATTACH(MAIN);\r
 250                 WRITELN(" AN ATTEMPT TO ACCESS AN IDLE PROCESS TIME");\r
 251                 END ERROR1;\r
 252  \r
 253      UNIT ERROR2:PROCEDURE;\r
 254                  BEGIN\r
 255                  ATTACH(MAIN);\r
 256                  WRITELN(" AN ATTEMPT TO ACCESS A TERMINATED PROCESS TIME");\r
 257                  END ERROR2;\r
 258              BEGIN\r
 259  \r
 260              RETURN;\r
 261              INNER;\r
 262              FINISH:=TRUE;\r
 263               CALL PASSIVATE;\r
 264              CALL ERROR2;\r
 265           END SIMPROCESS;\r
 266  \r
 267  \r
 268 UNIT EVENTNOTICE: ELEM CLASS;\r
 269   (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *)\r
 270       VAR EVENTTIME: REAL, PROC: SIMPROCESS;\r
 271  \r
 272       UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;\r
 273        (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)\r
 274                   BEGIN\r
 275                   IF X=NONE THEN RESULT:= FALSE ELSE\r
 276                   RESULT:= EVENTTIME< X.EVENTTIME OR\r
 277                   (EVENTTIME=X.EVENTTIME AND PRIOR< X.PRIOR); FI;\r
 278  \r
 279                END LESS;\r
 280     END EVENTNOTICE;\r
 281  \r
 282  \r
 283 UNIT MAINPROGRAM: SIMPROCESS CLASS;\r
 284  (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)\r
 285       BEGIN\r
 286       DO ATTACH(MAIN) OD;\r
 287       END MAINPROGRAM;\r
 288  \r
 289 UNIT TIME:FUNCTION:REAL;\r
 290  (* CURRENT VALUE OF SIMULATION TIME *)\r
 291      BEGIN\r
 292      RESULT:=CURRENT.EVTIME\r
 293      END TIME;\r
 294  \r
 295 UNIT CURRENT: FUNCTION: SIMPROCESS;\r
 296    (* THE FIRST PROCESS ON THE TIME AXIS *)\r
 297      BEGIN\r
 298      RESULT:=CURR;\r
 299      END CURRENT;\r
 300 \r
 301 UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);\r
 302  (* ACTIVATION OF PROCESS P AT TIME T AND DEFINITION OF "PRIOR"- PRIORITY *)\r
 303  (* WITHIN TIME MOMENT T                                                  *)\r
 304       BEGIN\r
 305       IF T<TIME THEN T:= TIME FI;\r
 306       IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE\r
 307       IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)\r
 308                 P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);\r
 309                 P.EVENT.PROC:= P;\r
 310                                       ELSE\r
 311        IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN\r
 312                P.EVENT:= P.EVENTAUX;\r
 313                P.EVENT.PRIOR:=RANDOM;\r
 314                                           ELSE\r
 315    (* NEW SCHEDULING *)\r
 316                P.EVENT.PRIOR:=RANDOM;\r
 317                CALL PQ.DELETE(P.EVENT)\r
 318                                 FI; FI;\r
 319       P.EVENT.EVENTTIME:= T;\r
 320       CALL PQ.INSERT(P.EVENT) FI;\r
 321 END SCHEDULE;\r
 322  \r
 323 UNIT HOLD:PROCEDURE(T:REAL);\r
 324  (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)\r
 325  (* REDEFINE PRIOR                                  *)\r
 326      BEGIN\r
 327      CALL PQ.DELETE(CURRENT.EVENT);\r
 328      CURRENT.EVENT.PRIOR:=RANDOM;\r
 329      IF T<0 THEN T:=0; FI;\r
 330       CURRENT.EVENT.EVENTTIME:=TIME+T;\r
 331      CALL PQ.INSERT(CURRENT.EVENT);\r
 332      CALL CHOICEPROCESS;\r
 333      END HOLD;\r
 334  \r
 335 UNIT PASSIVATE: PROCEDURE;\r
 336   (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)\r
 337      BEGIN\r
 338       CALL PQ.DELETE(CURRENT.EVENT);\r
 339       CURRENT.EVENT:=NONE;\r
 340       CALL CHOICEPROCESS\r
 341      END PASSIVATE;\r
 342  \r
 343 UNIT RUN: PROCEDURE(P:SIMPROCESS);\r
 344  (* ACTIVATE P IMMEDIATELY AND DELAY THE FORMER FIRST PROCESS BY REDEFINING*)\r
 345  (* PRIOR                                                              *)\r
 346      BEGIN\r
 347      CURRENT.EVENT.PRIOR:=RANDOM;\r
 348      IF NOT P.IDLE THEN\r
 349             P.EVENT.PRIOR:=0;\r
 350             P.EVENT.EVENTTIME:=TIME;\r
 351             CALL PQ.CORRECT(P.EVENT,FALSE)\r
 352                     ELSE\r
 353       IF P.EVENTAUX=NONE THEN\r
 354             P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);\r
 355             P.EVENT.EVENTTIME:=TIME;\r
 356             P.EVENT.PROC:=P;\r
 357             CALL PQ.INSERT(P.EVENT)\r
 358                         ELSE\r
 359              P.EVENT:=P.EVENTAUX;\r
 360              P.EVENT.PRIOR:=0;\r
 361              P.EVENT.EVENTTIME:=TIME;\r
 362              P.EVENT.PROC:=P;\r
 363              CALL PQ.INSERT(P.EVENT);\r
 364                           FI;FI;\r
 365       CALL CHOICEPROCESS;\r
 366 END RUN;\r
 367  \r
 368 UNIT CANCEL:PROCEDURE(P: SIMPROCESS);\r
 369  (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)\r
 370    BEGIN\r
 371    IF P= CURRENT THEN CALL PASSIVATE ELSE\r
 372     CALL PQ.DELETE(P.EVENT);\r
 373     P.EVENT:=NONE;  FI;\r
 374  END CANCEL;\r
 375  \r
 376 UNIT CHOICEPROCESS:PROCEDURE;\r
 377  (* CHOOSE THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)\r
 378    VAR P:SIMPROCESS;\r
 379    BEGIN\r
 380    P:=CURR;\r
 381    CURR:= PQ.MIN QUA EVENTNOTICE.PROC;\r
 382     IF CURR=NONE THEN WRITE(" ERROR IN THE HEAP"); WRITELN;\r
 383                       ATTACH(MAIN);\r
 384                  ELSE ATTACH(CURR); FI;\r
 385 END CHOICEPROCESS;\r
 386  \r
 387 BEGIN\r
 388   PQ:=NEW QUEUEHEAD;  (* SIMULATION TIME AXIS*)\r
 389   CURR,MAINPR:=NEW MAINPROGRAM;\r
 390   MAINPR.EVENT,MAINPR.EVENTAUX:=NEW EVENTNOTICE(0);\r
 391   MAINPR.EVENT.EVENTTIME:=0;\r
 392   MAINPR.EVENT.PROC:=MAINPR;\r
 393   CALL PQ.INSERT(MAINPR.EVENT);\r
 394   (* THE FIRST PROCESS TO BE ACTIVATED IS MAIN PROGRAM *)\r
 395   INNER;\r
 396   PQ:=NONE; \r
 397 END SIMULATION;\r
 398  \r
 399  \r
 400  \r
 401 UNIT LISTS:SIMULATION CLASS;\r
 402  (* WE WISH TO USE LISTS FOR QUEUEING PROCESSES DURING SIMULATION*)\r
 403  \r
 404            UNIT LINKAGE:CLASS;\r
 405             (*WE WILL USE TWO WAY LISTS *)\r
 406                 VAR SUC1,PRED1:LINKAGE;\r
 407                           END LINKAGE;\r
 408             UNIT HEAD:LINKAGE CLASS;\r
 409             (* EACH LIST WILL HAVE ONE ELEMENT ESTABLISHED *)\r
 410                       UNIT FIRST:FUNCTION:LINK;\r
 411                                  BEGIN\r
 412                              IF SUC1 IN LINK THEN RESULT:=SUC1\r
 413                                              ELSE RESULT:=NONE FI;\r
 414                                  END;\r
 415                       UNIT EMPTY:FUNCTION:BOOLEAN;\r
 416                                  BEGIN\r
 417                                  RESULT:=SUC1=THIS LINKAGE;\r
 418                                  END EMPTY;\r
 419                    BEGIN\r
 420                    SUC1,PRED1:=THIS LINKAGE;\r
 421                      END HEAD;\r
 422  \r
 423           UNIT LINK:LINKAGE CLASS;\r
 424            (* ORDINARY LIST ELEMENT PREFIX *)\r
 425                      UNIT OUT:PROCEDURE;\r
 426                               BEGIN\r
 427                               IF SUC1=/=NONE THEN\r
 428                                     SUC1.PRED1:=PRED1;\r
 429                                     PRED1.SUC1:=SUC1;\r
 430                                     SUC1,PRED1:=NONE FI;\r
 431                                END OUT;\r
 432                      UNIT INTO:PROCEDURE(S:HEAD);\r
 433                                BEGIN\r
 434  \r
 435                                CALL OUT;\r
 436                                IF S=/= NONE THEN\r
 437                                     IF S.SUC1=/=NONE THEN\r
 438                                             SUC1:=S;\r
 439                                             PRED1:=S.PRED1;\r
 440                                             PRED1.SUC1:=THIS LINKAGE;\r
 441                                             S.PRED1:=THIS LINKAGE;\r
 442                                                  FI FI;\r
 443                                   END INTO;\r
 444                   END LINK;\r
 445 \r
 446      UNIT ELEM:LINK CLASS(SPROCESS:SIMPROCESS);\r
 447      (* USER DEFINED  PROCESS WILL BE JOINED INTO LISTS  *)\r
 448                     END ELEM;\r
 449 \r
 450     END LISTS;\r
 451 \r
 452 (***************************************************************************)\r
 453 (* definition des procedures de lecture des fichiers de donn\82es et mise en *)\r
 454 (* m\82moire des structures de la ville.                                     *)\r
 455 (***************************************************************************)\r
 456 \r
 457 (***************************************************************************)\r
 458 (*                 Structure d une place de parking                        *)\r
 459 (***************************************************************************)\r
 460 \r
 461 Unit Place : class (N : integer );\r
 462 var P1 : arrayof boolean;\r
 463 Begin\r
 464    array P1 dim (1:N);\r
 465 End Place;\r
 466 \r
 467 (***************************************************************************)\r
 468 (*        Structure de la liste des arc qui peuvent etre atteind           *)\r
 469 (***************************************************************************)\r
 470 \r
 471 Unit Liste : class;\r
 472 var pointeur: Arcs,\r
 473     suivante: Liste;\r
 474 end Liste;\r
 475 \r
 476 (***************************************************************************)\r
 477 (*                         Structure des arcs                              *)\r
 478 (***************************************************************************)\r
 479 Unit Arcs : class;\r
 480 Var Numero   : integer,  (* Identification de l'arc *)\r
 481     Initial  : Sommets,  (* Sommet initial *)\r
 482     Final    : Sommets,  (* Sommet final *)\r
 483     Sens     : integer,     (* Sens de circulation *)\r
 484     Distance : integer,  (* Distance de initial a final*)\r
 485     NbvoieIF : integer,  (* Nombre de voie dans le sens 1 *)\r
 486     NbvoieFI : integer,  (* Nombre de voie dans le sens -1 *)\r
 487     Suivants : Arcs,\r
 488      (* pointeur sera de type car lors des affectations *)\r
 489     occpsens : arrayof pointeur, (*si <>none alors il y a une voiture cette place*)\r
 490     occpinve : arrayof pointeur; (*en sens inverse de initial final *)\r
 491 End Arcs;\r
 492 \r
 493 (***************************************************************************)\r
 494 (*                          Structure des sommets                          *)\r
 495 (***************************************************************************)\r
 496 \r
 497 Unit Sommets : class;\r
 498 var Nom      : char,     (* Nom du sommet *) \r
 499     typecar  : integer,  (* Type carrefour 0:feu , 1:priorite , 2:stop *)\r
 500     afftype  : integer,  (* type carrefour 1..9 pour affichage *)\r
 501     Ligne    : integer,  (* Correspond a la position en Y sur ecran *)\r
 502     Colonne  : integer,  (* Correspond a la position en X sur ecran *)\r
 503     etat     : integer,  (* Etat du carrefour *)\r
 504     ptrarc   : Liste,    (* Pointeur sur la liste pointant sur les arcs *)\r
 505     suivant  : Sommets;  (* Pointeur sur les suivants *)\r
 506 End Sommets;\r
 507 \r
 508 (***************************************************************************)\r
 509 (*              Procedure creant la liste des Sommets                      *)\r
 510 (*    Ici il y a juste creation d un liste simple de sommet en mode pile   *)\r
 511 (***************************************************************************)\r
 512 \r
 513 Unit CreeSomm : procedure( f: file);\r
 514 var Noeud : Sommets,\r
 515     tampon: char,\r
 516     arret : boolean;\r
 517 \r
 518 Begin\r
 519    readln(f);\r
 520    arret := false;\r
 521    while  not arret \r
 522    do\r
 523       read(f,tampon);\r
 524       if ( tampon <> '.') then\r
 525              Noeud := new Sommets;\r
 526              NBSOMMETS:=NBSOMMETS+1; (* on comptabilise le nombre de sommets*)\r
 527              Noeud.Nom := tampon;\r
 528              read(f,Noeud.typecar);\r
 529              read(f,Noeud.afftype);\r
 530              read(f,Noeud.colonne);\r
 531              if(Noeud.colonne>Larg_Vil) then Larg_Vil:=Noeud.colonne; fi;\r
 532              readln(f,Noeud.ligne);\r
 533              if(Noeud.ligne>Haut_Vil) then Haut_Vil:=Noeud.ligne; fi;\r
 534              Noeud.etat := 0;\r
 535              Noeud.ptrarc := none;\r
 536              Noeud.Suivant := RaciSomm;\r
 537              RaciSomm := Noeud;\r
 538          else arret := true;\r
 539       fi\r
 540    od;\r
 541 End CreeSomm;\r
 542 \r
 543 \r
 544 (***************************************************************************)\r
 545 (* Procedure affichant chaque sommet ainsi que les arcs que l'on peut      *)\r
 546 (* prendre depuis ce sommet en considerant les sens de circulation etc...  *)\r
 547 (***************************************************************************)\r
 548 Unit ParcSomm : procedure;\r
 549 var Noeud : Sommets;\r
 550 var parcours : Liste;\r
 551 Begin\r
 552    Noeud := RaciSomm;\r
 553    while (Noeud <> none)\r
 554    do\r
 555      write("Nom: ");\r
 556      writeln(Noeud.Nom);\r
 557      writeln("X : ",Noeud.Colonne);\r
 558      writeln("Y : ",Noeud.ligne);\r
 559      parcours := Noeud.ptrarc;\r
 560      while (parcours <> none )\r
 561      do\r
 562        writeln("Arc: ",parcours.pointeur.Numero);\r
 563        parcours := parcours.suivante;\r
 564      od;\r
 565      Noeud := Noeud.suivant;\r
 566    od;\r
 567 End ParcSomm;\r
 568 \r
 569 \r
 570 (***************************************************************************)\r
 571 (*              Procedure creant la liste des Arc                          *)\r
 572 (* Ici on cree la liste des Arc sur la base d'une pile, puis il y a        *)\r
 573 (* rattachement des pointeurs final et initial avec la liste des sommets   *)\r
 574 (* et ce grace a la procedure rattache.                                    *)           \r
 575 (***************************************************************************)\r
 576 \r
 577 Unit CreeArcs : procedure( f: file);\r
 578 var Noeud : Arcs;\r
 579 var aux1 : char,\r
 580     aux2 : char,\r
 581     aux3 : char,\r
 582     i    : integer;\r
 583 Begin\r
 584    readln(f);\r
 585    readln(f);\r
 586    while ( not(eof(f)))\r
 587    do\r
 588  \r
 589  i:=i+1;    \r
 590  call color(Blanc);\r
 591  call move(10,400);\r
 592  call outstring("coucou");\r
 593  call hascii(48+i);\r
 594 \r
 595       Noeud := new Arcs;\r
 596       read(f,Noeud.Numero);\r
 597       read(f,aux3);\r
 598       read(f,aux1);\r
 599       read(f,aux3);\r
 600       read(f,aux2);\r
 601       read(f,aux3);\r
 602       read(f,Noeud.Sens);\r
 603       read(f,Noeud.distance);\r
 604       array Noeud.occpsens dim (1:Noeud.distance); (* on met la voie en place*)\r
 605       array Noeud.occpinve dim (1:Noeud.distance);\r
 606       read(f,Noeud.NbvoieIF);\r
 607       readln(f,Noeud.NbvoieFI);\r
 608       Noeud.Initial := none;\r
 609       Noeud.Final := none;\r
 610       Noeud.Suivants:= RaciArcs;\r
 611       RaciArcs := Noeud;\r
 612       Call rattache(Noeud,aux1,aux2);\r
 613    od;\r
 614 End CreeArcs;\r
 615 \r
 616 (***************************************************************************)\r
 617 (*             Rattachement du pointeur arc avec le sommet                 *)\r
 618 (* Cette procedure rattache les pointeurs final et initial des arcs avec   *)\r
 619 (* un sommet de la liste des sommets.                                      *)\r
 620 (* Puis il y a la procedure creant la liste des arcs que l'on peut         *)\r
 621 (* emprunter depuis ce sommet. Cette procedure est appele ici.             *) \r
 622 (* Pour l appelle de cette procedure RattaListe nous verifions le sens de  *)\r
 623 (* circulation dans les arcs, en effet des arcs ne peuvent pas etre pris a *)\r
 624 (* partir de certain sommets, donc il ne doivent pas figurer dans cette    *)\r
 625 (* liste( Sens interdits ).                                                *)\r
 626 (***************************************************************************)\r
 627 Unit Rattache : procedure ( inout  Noeud : Arcs ; aux1,aux2:char);\r
 628 var Parcours : Sommets;\r
 629 \r
 630 begin\r
 631    Parcours := RaciSomm;\r
 632    while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))\r
 633    do\r
 634       Parcours := Parcours.suivant;\r
 635    od;\r
 636    if Parcours.Nom = aux1\r
 637       then\r
 638         Noeud.Initial := Parcours;\r
 639         if Noeud.Sens <> -1\r
 640         then\r
 641             Call rattaListe(Parcours,Noeud);\r
 642         fi;\r
 643       else if Parcours.Nom = aux2  \r
 644                 then\r
 645                    Noeud.Final := Parcours;         \r
 646                    if Noeud.Sens <> 1\r
 647                    then\r
 648                        Call rattaListe(Parcours,Noeud);\r
 649                    fi\r
 650                 else\r
 651                     write("ERREUR de rattachement initial");\r
 652                     exit;\r
 653            fi;\r
 654    fi;\r
 655    Parcours := Parcours.suivant;\r
 656    while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))\r
 657    do\r
 658       Parcours := Parcours.suivant;\r
 659    od;\r
 660    if Parcours.Nom = aux1\r
 661       then\r
 662          Noeud.Initial := Parcours;         \r
 663          if Noeud.Sens <> -1\r
 664          then\r
 665               Call rattaListe(Parcours,Noeud);\r
 666          fi;\r
 667       else if Parcours.Nom = aux2  \r
 668                 then\r
 669                     Noeud.final := parcours;\r
 670                     if Noeud.Sens <> 1\r
 671                     then\r
 672                          Call rattaListe(Parcours,Noeud);\r
 673                     fi;\r
 674                 else\r
 675                    write("ERREUR de rattachement du final");\r
 676            fi;\r
 677    fi;\r
 678 end rattache;\r
 679 \r
 680 (***************************************************************************)\r
 681 (*  Rattachement des sommets a la liste des arc qui peuvent etres atteinds *)\r
 682 (***************************************************************************)\r
 683 Unit RattaListe : procedure (inout NoeudSom : sommets; NoeudArc : Arcs);\r
 684 var Noeud : Liste;\r
 685 \r
 686 begin\r
 687   Noeud := new Liste;\r
 688   Noeud.suivante := NoeudSom.ptrarc;\r
 689   Noeud.pointeur := NoeudArc;\r
 690   NoeudSom.ptrarc := Noeud;\r
 691 End RattaListe;\r
 692 \r
 693 \r
 694 (***************************************************************************)\r
 695 (*           Procedure de lecture de la ville appell\82e par bo_load         *)\r
 696 (***************************************************************************)\r
 697 \r
 698 Unit Lit_Ville : procedure( fenet : Windows);\r
 699 var fichier  : file,\r
 700     flagbool : boolean;\r
 701 begin\r
 702    Larg_Vil:=0;\r
 703    Haut_Vil:=0;\r
 704    NBSOMMETS:=0;\r
 705    open (fichier,text,unpack("Ville.dat"));\r
 706    call color(VertClair);\r
 707    flagbool:=fenet.outgtext(".",1);\r
 708    call reset (fichier);\r
 709    call color(VertClair);\r
 710    flagbool:=fenet.outgtext("..",2);\r
 711    Call CreeSomm(fichier);\r
 712    call color(VertClair);\r
 713    flagbool:=fenet.outgtext("..",2);\r
 714    Call CreeArcs(fichier);\r
 715    call color(VertClair);\r
 716    flagbool:=fenet.outgtext("..",2);\r
 717 end Lit_Ville;\r
 718 \r
 719 (***************************************************************************)\r
 720 (*          definition des procedures d'utilitaires graphiques             *)\r
 721 (***************************************************************************)\r
 722 \r
 723 (***************************************************************************)\r
 724    Unit Line : procedure (x1,y1,x2,y2,c : integer);\r
 725    Begin\r
 726       call color(c);\r
 727       call move(x1,y1);\r
 728       call draw(x2,y2);\r
 729    End Line;\r
 730 \r
 731 (***************************************************************************)\r
 732    Unit Linep : procedure (x1,y1,x2,y2,c,s :integer);\r
 733    Var i :integer;\r
 734    Begin (* ne fonctionne que pour des horizontales ou des verticales *)\r
 735     if (x1=x2)\r
 736     then for i:=y1 step s*2 to y2 \r
 737          do\r
 738           call line(x1,i,x1,i+s,c);\r
 739          od;\r
 740     else if (y1=y2)\r
 741          then for i:=x1 step s*2 to x2 \r
 742               do\r
 743                call line(i,y1,i+s,y1,c);\r
 744               od;\r
 745          fi;\r
 746     fi;\r
 747    End linep;\r
 748 \r
 749 (***************************************************************************)\r
 750    Unit Rectangle : procedure (x1,y1,x2,y2,c : integer);\r
 751    Begin\r
 752     call color(c);\r
 753     call move(x1,y1);\r
 754     call draw(x2,y1);\r
 755     call draw(x2,y2);\r
 756     call draw(x1,y2);\r
 757     call draw(x1,y1);\r
 758    End Rectangle;\r
 759 \r
 760 (***************************************************************************)\r
 761    Unit Rectanglef : procedure (x1,y1,x2,y2,c : integer);\r
 762    var i : integer;\r
 763    Begin\r
 764     for i:=y1 to y2\r
 765     do\r
 766       call Line(x1,i,x2,i,c);\r
 767     od\r
 768    End Rectanglef;\r
 769 \r
 770 (****************************************************************************)\r
 771    Unit Readcara : function (x,y,col_f,col_e : integer) : integer;\r
 772    Var i    : integer,\r
 773       sx,sy : integer;\r
 774    Begin\r
 775     sx:=x;\r
 776     sy:=y;\r
 777     i:=inkey;\r
 778     while i=0\r
 779      do\r
 780       call color(col_f);\r
 781       call move(x,y);\r
 782       call outstring("_");\r
 783       for i:=1 to 300 do od;\r
 784       call color(col_e);\r
 785       call move(x,y);\r
 786       call outstring("_");\r
 787       for i:=1 to 100 do od;\r
 788       i:=inkey;\r
 789      od;\r
 790      call color(col_f);\r
 791      call move(x,y);\r
 792      call outstring("_");\r
 793      call move(sx,sy);\r
 794      call color(col_e);\r
 795      result:=i;\r
 796    End Readcara;\r
 797 \r
 798 (****************************************************************************)\r
 799 (*   lecture d'un entier en mode graphique, esc revient au debut de saisie  *)\r
 800 (****************************************************************************)\r
 801    Unit gscanf : function (rangmin,rangmax : integer) : integer;\r
 802    Var valeur : integer,\r
 803        sauvx  : integer,\r
 804        sauvy  : integer,\r
 805        flag   : integer;\r
 806    Begin\r
 807      sauvx:=inxpos;\r
 808      sauvy:=inypos;\r
 809      do\r
 810        valeur:=0;\r
 811        do\r
 812         flag:=readcara(inxpos,inypos,Noir,BleuClair);\r
 813         if (flag>=48 and flag<=57)\r
 814         then valeur:=valeur*10+flag-48;\r
 815              call move(inxpos,inypos);\r
 816              call hascii(flag);\r
 817         fi;\r
 818         if (flag=13) then exit; fi;\r
 819         if (flag=27)                          (* on a demand\82 annulation *)\r
 820         then valeur:=0;\r
 821              call rectanglef(sauvx-1,sauvy-1,inxpos,sauvy+13,Noir);\r
 822              call color(BleuClair);\r
 823              call move(sauvx,sauvy);\r
 824         fi;\r
 825        od;\r
 826       if (valeur>=rangmin and valeur<=rangmax)\r
 827       then exit;\r
 828       else call rectanglef(sauvx-1,sauvy-1,inxpos,sauvy+13,Noir);\r
 829            call color(BleuClair);\r
 830            call move(sauvx,sauvy);\r
 831       fi;\r
 832      od;\r
 833      result:=valeur;\r
 834    End gscanf;\r
 835 \r
 836 \r
 837 (***************************************************************************)\r
 838 (*                definition des classes d'\82l\82ments des listes             *)\r
 839 (***************************************************************************)\r
 840         \r
 841    Unit Elmt : class(id : integer);\r
 842    End Elmt;\r
 843         \r
 844    Unit elm : Elmt class(x1,y1,x2,y2 :integer);\r
 845    End elm;\r
 846 \r
 847 (***************************************************************************)\r
 848 (*                   definition de la classe Bottons                       *)\r
 849 (***************************************************************************)\r
 850    \r
 851    Unit Bottons : Elmt class(touche,x1,y1,x2,y2 : integer);  \r
 852                                (* x2-x1 et y2-y1 doit au mini etre de 8*)\r
 853       (*  x1,y1   : integer  coordonn\82es du point haut gauche          *)\r
 854       (*  x2,y2   : integer  coordonn\82es du point bas droit            *)\r
 855    Var etat    : boolean; (* true si bouton enable                     *)\r
 856    \r
 857         Unit affiche : procedure;\r
 858         Begin\r
 859           call Line(x1,y1,x2,y1,Blanc);                 (* Lignes en blanc *) \r
 860           call Line(x1,y1+1,x2-1,y1+1,Blanc);\r
 861           call Line(x1,y1,x1,y2,Blanc);\r
 862           call Line(x1+1,y1+2,x1+1,y2-1,Blanc);\r
 863           call Line(x1+1,y2,x2,y2,GrisFonce);      (* Lignes en gris fonce *)\r
 864           call Line(x1+2,y2-1,x2,y2-1,GrisFonce);\r
 865           call Line(x2,y2,x2,y1+1,GrisFonce);\r
 866           call Line(x2-1,y2-1,x2-1,y1+2,GrisFonce);\r
 867           call Rectanglef(x1+2,y1+2,x2-2,y2-2,GrisClair); (* centre en gris *)\r
 868           call AfficheSuite;\r
 869         End affiche;\r
 870 \r
 871         Unit virtual AfficheSuite : procedure;\r
 872         End;\r
 873 \r
 874         Unit virtual bot_enable : procedure;\r
 875         End;\r
 876 \r
 877         Unit virtual bot_disable : procedure;\r
 878         End;\r
 879    \r
 880    End Bottons;\r
 881 \r
 882 (***************************************************************************)\r
 883 (*            definition de la classe Menu derivant de Bottons             *)\r
 884 (***************************************************************************)\r
 885    \r
 886    Unit Menu : Bottons class;\r
 887    Var cnom    : integer, (* couleur du nom du bouton                  *) \r
 888        nom     : string;  (* nom du bouton                             *)\r
 889         \r
 890         Unit affiche_nom : procedure;\r
 891         Begin \r
 892           call move(x1+5,y1+(y2-y1)/4);\r
 893           call color(cnom);\r
 894           call outstring(nom);\r
 895         End affiche_nom;\r
 896 \r
 897         Unit virtual bot_enable : procedure;\r
 898         var e : elm;\r
 899         Begin\r
 900          cnom:=RougeClair;\r
 901          e:=new elm(id,x1,y1,x2,y2);\r
 902          call clics.Insert(e);\r
 903          if (touche<>-1)\r
 904          then call Keys.Insert(new elmt(touche));\r
 905          fi;\r
 906          call affiche_nom;\r
 907         End bot_enable;\r
 908 \r
 909         Unit virtual bot_disable : procedure;\r
 910         var e : elm;\r
 911         Begin\r
 912          cnom:=Rouge;\r
 913          e:=new elm(id,x1,y1,x2,y2);\r
 914          call clics.Delete(e);\r
 915          if (touche<>-1)\r
 916          then call Keys.delete(new elmt(touche));\r
 917          fi;\r
 918          call affiche_nom;\r
 919         End bot_disable;\r
 920 \r
 921         Unit virtual AfficheSuite : procedure;\r
 922         Begin\r
 923           if (etat) \r
 924           then call bot_enable;\r
 925           else call bot_disable;\r
 926           fi;\r
 927         End AfficheSuite;\r
 928 \r
 929    End Menu;\r
 930 \r
 931 (***************************************************************************)\r
 932 (*            definition de la classe Racc derivant de Bottons             *)\r
 933 (***************************************************************************)\r
 934    \r
 935    Unit Racc : Bottons class (procedure sprite(x1,y1,x2,y2,col :integer));\r
 936 \r
 937         Unit virtual bot_enable : procedure;\r
 938         var e : elm;\r
 939         Begin \r
 940          e:=new elm(id,x1,y1,x2,y2);\r
 941          call clics.Insert(e);\r
 942          if (touche<>-1)\r
 943          then call Keys.Insert(new elmt(touche));\r
 944          fi;\r
 945         End bot_enable;\r
 946 \r
 947         Unit virtual bot_disable : procedure;\r
 948         var e : elm;\r
 949         Begin \r
 950          e:=new elm(id,x1,y1,x2,y2);\r
 951          call clics.Delete(e);\r
 952          if (touche<>-1)\r
 953          then call Keys.delete(new elmt(touche));\r
 954          fi;\r
 955         End bot_disable;\r
 956 \r
 957         Unit virtual AfficheSuite : procedure;\r
 958         Begin\r
 959          if etat\r
 960          then call bot_enable;\r
 961               call sprite(x1,y1,x2,y2,Noir);\r
 962          else call bot_disable;\r
 963               call sprite(x1,y1,x2,y2,GrisFonce);\r
 964          fi;\r
 965         End AfficheSuite;\r
 966 \r
 967    End Racc;\r
 968 \r
 969 (***************************************************************************)\r
 970 (*                       definition de la classe Windows                   *)\r
 971 (***************************************************************************)\r
 972    \r
 973    Unit Windows : class(numero,x1,y1,x2,y2,lborder : integer; \r
 974                         r1,r2,r3 : boolean);   \r
 975    hidden x,y,xp,yp;   \r
 976                            (* x2-x1 et y2-y1 doit au mini etre 33      *)\r
 977    Var cborder : integer,  (* couleur du pourtour                      *)\r
 978        cnom    : integer,  (* couleur du nom de la fenetre             *)\r
 979        nom     : string,\r
 980        Bout    : ListBot,  (* liste des boutons rattaches              *)\r
 981        Hauteur : integer,  (* hauteur de la bande                      *)\r
 982        Largeur : integer,  (* largeur des raccourcis                   *)\r
 983        cbande  : integer,  (* couleur de la bande                      *)\r
 984        WhereXd : integer,  (* position en x de depart dans la fenetre  *)\r
 985        WhereX  : integer,  (* position courante en X dans la fenetre   *)\r
 986        WhereYd : integer,  (* position en y de depart dans la fenetre  *)\r
 987        WhereY  : integer;  (* position courante en Y dans la fenetre   *)\r
 988    var B       : arrayof Racc, (* variables locales *)\r
 989        x,y     : integer,\r
 990        xp,yp   : integer;\r
 991         \r
 992        Unit affiche : procedure;\r
 993        var i : integer; \r
 994         Begin\r
 995          call rectanglef(x1,y1,x2,y2,Noir);\r
 996          for i:=0 to lborder\r
 997          do\r
 998           call rectangle(x1+i,y1+i,x2-i,y2-i,cborder);\r
 999          od;\r
1000          call Line(x1+16,y1,x1+16,y1+lborder,Noir);  (* Lignes noires *)\r
1001          call Line(x2-16,y1,x2-16,y1+lborder,Noir);\r
1002          call Line(x1+16,y2,x1+16,y2-lborder,Noir);\r
1003          call Line(x2-16,y2,x2-16,y2-lborder,Noir);\r
1004          call Line(x1,y1+16,x1+lborder,y1+16,Noir);\r
1005          call Line(x1,y2-16,x1+lborder,y2-16,Noir);\r
1006          call Line(x2,y1+16,x2-lborder,y1+16,Noir);\r
1007          call Line(x2,y2-16,x2-lborder,y2-16,Noir);\r
1008          call Rectanglef(x1+lborder+1,y1+lborder+1,x2-lborder-1,\r
1009                          y1+lborder+hauteur+1,cbande);\r
1010          call move(x1+(x2-x1)/3,y1+lborder+hauteur/4);\r
1011          call color(cnom);\r
1012          call outstring(nom);\r
1013          call AffSuite;\r
1014         End affiche;\r
1015    \r
1016         Unit virtual AffSuite : procedure;\r
1017         End AffSuite;\r
1018         \r
1019         Unit virtual clear : procedure;\r
1020         End clear;\r
1021         \r
1022         Unit gestionnaire : function : integer;\r
1023         Var  l,r,c : boolean,\r
1024              x,y   : integer,\r
1025              rep   : integer,\r
1026              nbbot : integer;\r
1027         Begin\r
1028          do\r
1029           call getpress(0,x,y,nbbot,l,r,c);\r
1030           if (l) and (clics<>none)\r
1031           then result:=clics.Appartient(x,y); exit;\r
1032           fi;\r
1033           rep:=inkey;\r
1034           if (rep>=97 and rep<=122) (* passe les lettres en majuscule *)\r
1035           then rep:=rep-32;\r
1036           fi;\r
1037           if keys.Appartient(rep)\r
1038           then result:=rep; exit;\r
1039           fi;\r
1040          od;\r
1041         End gestionnaire;\r
1042 \r
1043         Unit moveto : function (x,y :integer) : boolean;\r
1044         Begin\r
1045           if (x>0 and x<(x2-x1)) and (y>0 and y<y2-y1)\r
1046           then WhereX:=WhereXd+x;\r
1047                WhereY:=WhereYd+y;\r
1048                call move(WhereX,WhereY);\r
1049                result:=True;\r
1050           else result:=False;\r
1051           fi;\r
1052         End moveto;\r
1053 \r
1054         Unit outgtext : function (chaine : string; long : integer) : boolean;\r
1055         Begin\r
1056          if (long*8+WhereX)<(x2-lborder-5)\r
1057          then call move(WhereX,WhereY);\r
1058               call outstring(chaine);\r
1059               WhereX:=WhereX+long*8;\r
1060               if WhereX>= x2-lborder-16\r
1061               then WhereX:=WhereXd;\r
1062                    WhereY:=WhereY+16;\r
1063               fi;\r
1064               result:=True;\r
1065          else result:=False;\r
1066          fi;\r
1067         End outgtext;\r
1068 \r
1069         Unit outchar : function (tmp : char) : boolean;\r
1070         Begin\r
1071          if (10+WhereX)<(x2-lborder-5-largeur)\r
1072          then call move(WhereX,WhereY);\r
1073               call hascii(ord(tmp));\r
1074               WhereX:=WhereX+10;\r
1075               if WhereX>= x2-lborder-16-largeur\r
1076               then WhereX:=WhereXd;\r
1077                    WhereY:=WhereY+16;\r
1078               fi;\r
1079               result:=True;\r
1080          else result:=False;\r
1081          fi;\r
1082         End outchar;\r
1083 \r
1084    Begin\r
1085     \r
1086     Bout:=new ListBot;\r
1087     Keys:=new ListKey;\r
1088    \r
1089     array B dim (0:2);\r
1090 \r
1091     x:=x2-Larg_bot-lborder-1;\r
1092     y:=y1+lborder+1;\r
1093     xp:=x2-lborder-1;\r
1094     yp:=y+Haut_bot;\r
1095     B(2):=new Racc(numero+3,-1,x,y,xp,yp,spr_upper);\r
1096     B(2).etat:=r3;\r
1097     call Bout.Insert(B(2));\r
1098    \r
1099     xp:=x-1;\r
1100     x:=xp-Larg_bot;\r
1101     B(1):=new Racc(numero+2,-1,x,y,xp,yp,spr_lower);\r
1102     B(1).etat:=r2;\r
1103     call Bout.Insert(B(1));\r
1104    \r
1105     x:=x1+lborder+1;\r
1106     xp:=x+Larg_bot;\r
1107     B(0):=new Racc(numero+1,-1,x,y,xp,yp,spr_close);\r
1108     B(0).etat:=r1;\r
1109     call Bout.Insert(B(0));\r
1110 \r
1111    End Windows;\r
1112 \r
1113 (***************************************************************************)\r
1114 (*            definition de main d\82rivant de la classe Windows             *)\r
1115 (***************************************************************************)\r
1116    \r
1117    Unit Maine : Windows class;\r
1118    var icname  : string,   (* nom une fois iconise                     *)\r
1119        Lwind   : ListW,    (* liste des fenetres filles                *)\r
1120        Horiz   : AccelerateH, (* accelerateur horizontal               *)\r
1121        Verti   : AccelerateV; (* accelerateur vertical                 *)\r
1122 \r
1123        Unit virtual AffSuite : procedure;\r
1124         Begin\r
1125          call Rectanglef(x1+lborder+1,y1+lborder+hauteur+3,\r
1126                          x2-lborder-1,y1+lborder+2*(hauteur+2),cbande);\r
1127          if (Horiz<>none)\r
1128          then call Horiz.affiche;\r
1129          fi;\r
1130          if (Verti<>none)\r
1131          then call Verti.affiche;\r
1132          fi;\r
1133          Bout.Courant:=Bout.head;\r
1134          while(Bout.Courant<>none)\r
1135           do\r
1136            call Bout.Courant.data qua Bottons.affiche;\r
1137            Bout.Courant:=Bout.Courant.next;\r
1138           od;\r
1139          call Keys.Insert(new elmt(T_ALTF4)); (* alt/f4 pour quitter *)\r
1140         End AffSuite;\r
1141 \r
1142         Unit virtual clear : procedure;\r
1143         Var xf,yf : integer;\r
1144         Begin\r
1145          if Verti<>none then xf:=Verti.x1-1;\r
1146          else xf:=x2-lborder-1;\r
1147          fi;\r
1148          if Horiz<>none then yf:=Horiz.y1-1;\r
1149          else yf:=y2-lborder-1;\r
1150          fi;\r
1151          call Rectanglef(x1+lborder+1,y1+lborder+2*(hauteur+2)+1,xf,yf,Noir);\r
1152          WhereX:=WhereXd;\r
1153          WhereY:=WhereYd;\r
1154         end;\r
1155 \r
1156         Unit iconify : procedure;\r
1157         var i     : integer,\r
1158             l,r,c : boolean,\r
1159             x,y   : integer,\r
1160             nboot : integer,\r
1161             rep   : integer;\r
1162 \r
1163         Begin\r
1164           call cls;\r
1165           kill(clics);\r
1166           call rectangle(1,SIZEY-40,40,SIZEY,BleuClair);\r
1167           call rectangle(2,SIZEY-39,39,SIZEY-1,BleuClair);\r
1168           call move(5,SIZEY-20);\r
1169           call outstring(icname);\r
1170           call showcursor;\r
1171           do\r
1172             call getpress(0,x,y,nboot,l,r,c);\r
1173             if l \r
1174             then if(x>=1 and x<=40 and y<=SIZEY and y>=SIZEY-40)\r
1175                  then exit;\r
1176                  fi;\r
1177             fi;\r
1178             rep:=inkey;\r
1179             if (rep=13)   (* validation *)\r
1180             then exit;\r
1181             fi;\r
1182           od;\r
1183           call hidecursor;\r
1184           call cls;\r
1185           clics:=new cliquer;\r
1186           call W.affiche;\r
1187         End iconify;\r
1188 \r
1189    Begin\r
1190     WhereXd:=x1+lborder+5;\r
1191     WhereYd:=y1+lborder+2*(Haut_Bot+2)+5+8;\r
1192     WhereX:=WhereXd;\r
1193     WhereY:=WhereYd;\r
1194    End Maine;\r
1195 \r
1196 (***************************************************************************)\r
1197 (*    definition de la classe Son d\82rivant des classes Windows et elmt     *)\r
1198 (***************************************************************************)\r
1199    \r
1200    Unit Son : Windows coroutine;\r
1201    Var aa      : Elmt,\r
1202        Horiz   : AccelerateH, (* accelerateur horizontal               *)\r
1203        Verti   : AccelerateV; (* accelerateur vertical                 *)\r
1204    \r
1205         Unit virtual AffSuite : procedure;\r
1206         Begin\r
1207          if Horiz<>none\r
1208          then call Horiz.affiche;\r
1209          fi;\r
1210          if Verti<>none\r
1211          then call Verti.affiche;\r
1212          fi;\r
1213          Bout.Courant:=Bout.Head;\r
1214          while(Bout.Courant<>none)\r
1215          do\r
1216           call Bout.Courant.data qua Bottons.affiche;\r
1217           Bout.Courant:=bout.Courant.next;\r
1218          od;\r
1219         End AffSuite;\r
1220 \r
1221         Unit virtual clear : procedure;\r
1222         Var xf,yf : integer;\r
1223         Begin\r
1224          if Verti<>none then xf:=Verti.x1-1;\r
1225          else xf:=x2-lborder-1;\r
1226          fi;\r
1227          if Horiz<>none then yf:=Horiz.y1-1;\r
1228          else yf:=y2-lborder-1;\r
1229          fi;\r
1230          call Rectanglef(x1+lborder+1,y1+lborder+(hauteur+1)+1,xf,yf,Noir);\r
1231          WhereX:=WhereXd;\r
1232          WhereY:=WhereYd;\r
1233         end;\r
1234        \r
1235    Begin\r
1236      return;\r
1237      pref Elmt(0) block\r
1238      begin\r
1239        aa:=this Elmt;\r
1240        WhereXd:=x1+lborder+5;\r
1241        WhereYd:=y1+lborder+(Haut_Bot+1)+5+8;\r
1242        WhereX:=WhereXd;\r
1243        WhereY:=WhereYd;\r
1244        detach;\r
1245      end\r
1246    End Son;\r
1247 \r
1248 \r
1249 (***************************************************************************)\r
1250 (*    definition de Accelerate d\82rivant des classes Windows et Bottons     *)\r
1251 (***************************************************************************)\r
1252    \r
1253    Unit Accelerate : Bottons class(mother : Windows);\r
1254    Var Bs   : arrayof Racc,\r
1255        PosX : integer,\r
1256        PosY : integer,\r
1257        LX,LY: integer,\r
1258        C    : integer;  (* valeur du pas d'affichage *)\r
1259        \r
1260         Unit virtual AfficheSuite : procedure;  (* descend de bottons *)\r
1261         End AfficheSuite;\r
1262        \r
1263         Unit virtual bot_enable : procedure;\r
1264         Begin\r
1265          call mother.Bout.Insert(Bs(1));\r
1266          call mother.Bout.Insert(Bs(2));\r
1267          Call mother.Bout.Insert(Bs(3));\r
1268          etat:=True;\r
1269         End bot_enable;\r
1270 \r
1271         Unit virtual bot_disable : procedure;\r
1272         Begin\r
1273          call mother.Bout.Delete(Bs(1));\r
1274          call mother.Bout.Delete(Bs(2));\r
1275          call mother.Bout.Delete(Bs(3));\r
1276          etat:=False;\r
1277         End bot_disable;\r
1278 \r
1279 \r
1280         Unit virtual Deplacer : procedure( i :integer);\r
1281         End Deplacer;\r
1282   \r
1283         Unit virtual Reset_Bot : procedure;\r
1284         End Reset_Bot;\r
1285 \r
1286    Begin  \r
1287     C:=5; (* valeur par defaut *)\r
1288     inner;\r
1289     call bot_enable;\r
1290    End Accelerate;\r
1291 \r
1292 (***************************************************************************)\r
1293 (*             definition de AccelerateH d\82rivant de Accelerate            *)\r
1294 (***************************************************************************)\r
1295 \r
1296    Unit AccelerateH : Accelerate class;\r
1297    Var x    : integer,     \r
1298        MaxX : integer,\r
1299        MinX : integer;\r
1300    \r
1301         Unit virtual AfficheSuite : procedure;  (* descend de bottons *)\r
1302         Begin\r
1303          call Rectanglef(x1+18,y1+3,x2-18,y2-3,Noir);\r
1304          MaxX:=x2-18-LX;\r
1305          MinX:=x1+18;\r
1306         End AfficheSuite;\r
1307 \r
1308         Unit DeplacerLeft : procedure;\r
1309         var e : elm;\r
1310         Begin\r
1311          call Bs(2).bot_disable;\r
1312          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1313          PosX:=PosX-C;\r
1314          if PosX<MinX\r
1315          then PosX:=MinX;\r
1316               Bs(1).etat:=False;\r
1317               call Bs(1).bot_disable;\r
1318          fi;\r
1319          if not (Bs(3).etat)\r
1320          then Bs(3).etat:=True;\r
1321               call Bs(3).bot_enable;\r
1322          fi; \r
1323          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
1324          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
1325          call Bs(2).affiche;\r
1326         End DeplacerLeft;\r
1327         \r
1328         Unit virtual Deplacer : procedure (x : integer);\r
1329         Begin\r
1330          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1331          PosX:=x;\r
1332          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
1333          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
1334          call Bs(2).affiche;\r
1335         End Deplacer;\r
1336 \r
1337         Unit DeplacerRight : procedure;\r
1338         var e : elm;\r
1339         Begin\r
1340          call Bs(2).bot_disable;\r
1341          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1342          PosX:=PosX+C;\r
1343          if PosX>MaxX\r
1344          then PosX:=MaxX;\r
1345               Bs(3).etat:=False;\r
1346               call Bs(3).bot_disable;\r
1347          fi;\r
1348          if not (Bs(1).etat)\r
1349          then Bs(1).etat:=True;\r
1350               call Bs(1).bot_enable;\r
1351          fi;  \r
1352          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
1353          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
1354          call Bs(2).affiche;\r
1355         End DeplacerRight;\r
1356 \r
1357         Unit virtual Reset_Bot : procedure;\r
1358         Begin\r
1359          call Bs(2).bot_disable;\r
1360          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1361          x:=(x2-x1)/2;\r
1362          PosX:=x-5;\r
1363          PosY:=y1+3;\r
1364          LX:=11;\r
1365          LY:=y2-y1-6;\r
1366          Bs(2).x1:=PosX;\r
1367          Bs(2).y1:=PosY;\r
1368          Bs(2).x2:=PosX+LX;\r
1369          Bs(2).y2:=PosY+LY;\r
1370          call Bs(2).affiche;\r
1371         End Reset_Bot;\r
1372 \r
1373     Begin  \r
1374       array Bs dim (1:3);\r
1375       Bs(1):=new Racc(id+1,T_FLDTE,x1+2,y1+2,x1+15,y1+15,spr_right);\r
1376       Bs(1).etat:=True;\r
1377       x:=(x2-x1)/2;\r
1378       PosX:=x-5;\r
1379       PosY:=y1+3;\r
1380       LX:=11;\r
1381       LY:=y2-y1-6;\r
1382       Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);\r
1383       Bs(2).etat:=True;\r
1384       Bs(3):=new Racc(id+3,T_FLGCH,x2-15,y2-16,x2-2,y2-3,spr_left);\r
1385       Bs(3).etat:=True;\r
1386    End AccelerateH;\r
1387 \r
1388 (***************************************************************************)\r
1389 (*             definition de AccelerateV d\82rivant de Accelerate            *)\r
1390 (***************************************************************************)\r
1391 \r
1392    Unit AccelerateV : Accelerate class;\r
1393    Var y    : integer,\r
1394        MaxY : integer,\r
1395        MinY : integer;     \r
1396 \r
1397         Unit virtual AfficheSuite : procedure;  (* descend de bottons *)\r
1398         Begin\r
1399          call Rectanglef(x1+3,y1+18,x2-3,y2-18,Noir);\r
1400          MaxY:=y2-18-LY;\r
1401          MinY:=y1+18;\r
1402         End AfficheSuite;\r
1403       \r
1404         Unit DeplacerUp : procedure;\r
1405         var e : elm;\r
1406         Begin\r
1407          call Bs(2).bot_disable;\r
1408          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1409          PosY:=PosY-C;\r
1410          if PosY<MinY\r
1411          then PosY:=MinY;\r
1412               Bs(1).etat:=False;\r
1413               call Bs(1).bot_disable;\r
1414          fi;\r
1415          if not (Bs(3).etat)\r
1416          then Bs(3).etat:=True;\r
1417               call Bs(3).bot_enable;\r
1418          fi; \r
1419          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
1420          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
1421          call Bs(2).affiche;\r
1422         End DeplacerUp;\r
1423 \r
1424         Unit virtual Deplacer : procedure (y : integer);\r
1425         Begin\r
1426          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1427          PosY:=y;\r
1428          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
1429          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
1430          call Bs(2).affiche;\r
1431         End Deplacer;\r
1432         \r
1433         Unit DeplacerDown : procedure;\r
1434         var e : elm;\r
1435         Begin\r
1436          call Bs(2).bot_disable;\r
1437          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1438          PosY:=PosY+C;\r
1439          if PosY>MaxY\r
1440          then PosY:=MaxY;\r
1441               Bs(3).etat:=False;\r
1442               call Bs(3).bot_disable;\r
1443          fi;\r
1444          if not (Bs(1).etat)\r
1445          then Bs(1).etat:=True;\r
1446               call Bs(1).bot_enable;\r
1447          fi; \r
1448          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
1449          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
1450          call Bs(2).affiche;\r
1451         End DeplacerDown;\r
1452 \r
1453         Unit virtual Reset_Bot : procedure;\r
1454         Begin\r
1455          call Bs(2).bot_disable;\r
1456          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1457          y:=(y2-y1)/2;\r
1458          PosX:=x1+3;\r
1459          PosY:=y-5;\r
1460          LX:=x2-x1-6;\r
1461          LY:=11;\r
1462          Bs(2).x1:=PosX;\r
1463          Bs(2).y1:=PosY;\r
1464          Bs(2).x2:=PosX+LX;\r
1465          Bs(2).y2:=PosY+LY;\r
1466          call Bs(2).affiche;\r
1467         End Reset_Bot;\r
1468 \r
1469    Begin\r
1470       array Bs dim (1:3);\r
1471       Bs(1):=new Racc(id+1,T_FLHAU,x1+2,y1+2,x1+15,y1+15,spr_upper);\r
1472       Bs(1).etat:=True;\r
1473       y:=(y2-y1)/2;\r
1474       PosX:=x1+3;\r
1475       PosY:=y-5;\r
1476       LX:=x2-x1-6;\r
1477       LY:=11;\r
1478       Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);\r
1479       Bs(2).etat:=True;\r
1480       Bs(3):=new Racc(id+3,T_FLBAS,x2-15,y2-16,x2-2,y2-3,spr_lower);\r
1481       Bs(3).etat:=True;\r
1482    End AccelerateV;\r
1483 \r
1484 \r
1485 (***************************************************************************)\r
1486 (*          definition de la classe Ensemble (c'est une liste)             *)\r
1487 (***************************************************************************)\r
1488 \r
1489    Unit Ensemble : class;\r
1490    Var Head    : Node,\r
1491        Courant : Node,\r
1492        Last    : Node;\r
1493 \r
1494         Unit Node : class(data : elmt);\r
1495         Var next  : Node;\r
1496         End Node;\r
1497         \r
1498         Unit virtual egalite : function (x,y : elmt) :boolean;\r
1499         End egalite;\r
1500 \r
1501         Unit Empty : function : boolean;        \r
1502         Begin\r
1503          if Head=none\r
1504          then result:=True;\r
1505          else result:=False;\r
1506          fi;\r
1507         End;\r
1508 \r
1509         Unit Member : function (n : elmt) : boolean;\r
1510         Var bl      : boolean,\r
1511             saveCou : Node;\r
1512         Begin\r
1513          Courant:=Head;\r
1514          saveCou:=Courant;\r
1515          bl:=False;\r
1516          While (Courant<>none)\r
1517           do\r
1518            if not egalite(Courant.data,n)\r
1519            then saveCou:=Courant; Courant:=Courant.next;\r
1520            else bl:=True; exit;\r
1521            fi;\r
1522           od;\r
1523          Courant:=SaveCou;\r
1524          result:=bl;\r
1525         End Member;\r
1526 \r
1527         Unit Insert : procedure (n : elmt);\r
1528         Var bl : boolean;\r
1529         Begin\r
1530          bl:=Member(n);\r
1531          if not bl\r
1532          then if Empty\r
1533               then Head:=new Node(n); Last:=Head;\r
1534               else Last.next:=new Node(n);\r
1535                    Last:=Last.next;\r
1536               fi;\r
1537          fi;\r
1538         End Insert;\r
1539 \r
1540         Unit Delete : procedure (n : elmt);\r
1541         Var bl   : boolean,\r
1542             flag : Node;\r
1543         Begin \r
1544          bl:=Member(n);\r
1545          if bl\r
1546          then flag:=Courant.next; \r
1547               if flag=Last\r
1548               then Last:=Courant; courant.next:=none; kill(flag);\r
1549               else if Courant.next<>none \r
1550                    then Courant.next:=Courant.next.next; kill(flag);\r
1551                    fi;\r
1552               fi;\r
1553          fi;\r
1554         End Delete;\r
1555 \r
1556    End Ensemble;\r
1557         \r
1558 (***************************************************************************)\r
1559 (*      definition de la classe cliquer derivant de la classe ensemble     *) \r
1560 (***************************************************************************)\r
1561    \r
1562    Unit cliquer : Ensemble class;        \r
1563    \r
1564         Unit virtual egalite : function (x,y : elmt) : boolean;\r
1565         Begin\r
1566          if (x.id)=(y.id)\r
1567          then result:=True;\r
1568          else result:=False;\r
1569          fi;\r
1570         End egalite;\r
1571         \r
1572         Unit Appartient : function(x,y : integer) : integer;\r
1573         var bl : boolean;\r
1574         Begin\r
1575           bl:=False;\r
1576           Courant:=Head;\r
1577           while (Courant<>none)\r
1578           do\r
1579            if(x<(Courant.data qua elm.x2) and x>(Courant.data qua elm.x1) and \r
1580               y<(Courant.data qua elm.y2) and y>(Courant.data qua elm.y1))\r
1581            then bl:=True; exit;\r
1582            else Courant:=Courant.next;\r
1583            fi;\r
1584           od;\r
1585           if bl\r
1586           then result:=Courant.data qua elm.id;\r
1587           else result:=-1;\r
1588           fi;\r
1589         End Appartient;\r
1590 \r
1591    End cliquer;\r
1592 \r
1593 (***************************************************************************)\r
1594 (*          definition de la classe Listbot d\82rivant de ensemble           *)\r
1595 (***************************************************************************)\r
1596    \r
1597    Unit Listbot : Ensemble class;\r
1598 \r
1599         Unit virtual egalite : function (x,y : elmt) : boolean;\r
1600         Begin\r
1601          if (x.id) = (y.id)\r
1602          then result:=True;\r
1603          else result:=False;\r
1604          fi;\r
1605         End egalite;\r
1606 \r
1607    End Listbot;\r
1608 \r
1609 (***************************************************************************)\r
1610 (*          definition de la classe ListKey d\82rivant de ensemble           *)\r
1611 (***************************************************************************)\r
1612    \r
1613    Unit ListKey : Ensemble class;\r
1614 \r
1615         Unit virtual egalite : function (x,y : elmt) : boolean;\r
1616         Begin\r
1617          if (x.id) = (y.id)\r
1618          then result:=True;\r
1619          else result:=False;\r
1620          fi;\r
1621         End egalite;\r
1622 \r
1623         Unit Appartient : function(x : integer) : boolean;\r
1624         var bl : boolean;\r
1625         Begin\r
1626           bl:=False;\r
1627           Courant:=Head;\r
1628           while (Courant<>none)\r
1629           do\r
1630            if(Courant.data.id = x)\r
1631            then bl:=True; exit;\r
1632            else Courant:=Courant.next;\r
1633            fi;\r
1634           od;\r
1635           result:=bl;\r
1636         End Appartient;\r
1637 \r
1638    End ListKey;\r
1639 \r
1640 (***************************************************************************)\r
1641 (*           definition de la classe ListW d\82rivant de ensemble            *)\r
1642 (***************************************************************************)\r
1643  \r
1644    Unit ListW : Ensemble class;\r
1645 \r
1646         Unit virtual egalite : function (x,y : elmt) : boolean;\r
1647         Begin\r
1648      (*    if (x qua Son.numero) = (y qua Son.numero)\r
1649          then result:=True;\r
1650          else result:=False;\r
1651          fi; *)\r
1652         End egalite;\r
1653 \r
1654    End ListW;\r
1655 \r
1656 (***************************************************************************)\r
1657 (*             procedure d'affichage des sprites des boutons               *)\r
1658 (***************************************************************************)\r
1659 \r
1660 (***************************************************************************)\r
1661    Unit spr_upper : procedure(x1,y1,x2,y2,couleur : integer);\r
1662    var i,x,y : integer;\r
1663    Begin\r
1664     x:=(x2-x1)/2;\r
1665     y:=(y2-y1)/2;\r
1666     for i:=1 to y\r
1667     do\r
1668      call Line(x1+x-i/2,y1+y/2+i,x1+x+i/2,y1+y/2+i,couleur);\r
1669     od\r
1670    End spr_upper;\r
1671 \r
1672 (***************************************************************************)\r
1673    Unit spr_lower : procedure(x1,y1,x2,y2,couleur : integer);\r
1674    var i,x,y : integer;\r
1675    Begin\r
1676     x:=(x2-x1)/2;\r
1677     y:=(y2-y1)/2;\r
1678     for i:=1 to y\r
1679     do\r
1680      call Line(x1+x-i/2,y2-y/2-i,x1+x+i/2,y2-y/2-i,couleur);\r
1681     od\r
1682    End spr_lower;\r
1683 \r
1684 (***************************************************************************)\r
1685    Unit spr_left : procedure(x1,y1,x2,y2,couleur : integer);\r
1686    var i,x,y : integer;\r
1687    Begin\r
1688     x:=(x2-x1)/2;\r
1689     y:=(y2-y1)/2;\r
1690     for i:=1 to x\r
1691     do\r
1692      call Line(x2-x/2-i,y1+y-i/2,x2-x/2-i,y1+y+i/2,couleur);\r
1693     od\r
1694    End spr_left;\r
1695 \r
1696 (***************************************************************************)\r
1697    Unit spr_right : procedure(x1,y1,x2,y2,couleur : integer);\r
1698    var i,x,y : integer;\r
1699    Begin\r
1700     x:=(x2-x1)/2;\r
1701     y:=(y2-y1)/2;\r
1702     for i:=1 to x\r
1703     do\r
1704      call Line(x1+x/2+i,y1+y-i/2,x1+x/2+i,y1+y+i/2,couleur);\r
1705     od\r
1706    End spr_right;\r
1707 \r
1708 (***************************************************************************)\r
1709    Unit spr_close : procedure(x1,y1,x2,y2,couleur : integer);\r
1710    var y : integer;\r
1711    Begin\r
1712     y:=(y2-y1)/2;\r
1713     call Rectanglef(x1+3,y1+y-1,x2-3,y1+y+1,couleur);\r
1714    End spr_close;\r
1715 \r
1716 (***************************************************************************)\r
1717    Unit spr_point : procedure(x1,y1,x2,y2,couleur : integer);;\r
1718    var x,y : integer;\r
1719    Begin\r
1720     y:=(y2-y1)/2;\r
1721     x:=(x2-x1)/2;\r
1722     call Rectanglef(x1+x-1,y1+y-1,x1+x+1,y1+y+1,couleur);\r
1723    End spr_point;\r
1724 \r
1725 (***************************************************************************)\r
1726 (*                   procedure de gestion  des boutons                     *)\r
1727 (***************************************************************************)\r
1728 \r
1729 (***************************************************************************)\r
1730    Unit Bot_Load : procedure;\r
1731    Const Largeur=300,\r
1732          Hauteur=100;\r
1733    Var   fenet     : Son,\r
1734          x,y       : integer,\r
1735          Posx,Posy : integer,\r
1736          code      : integer,\r
1737          flagbool  : boolean;\r
1738    Begin\r
1739     x:=(W.x2-W.x1)/2;\r
1740     y:=(W.y2-W.y1)/2;\r
1741     Posx:=x-Largeur/2;\r
1742     Posy:=y-Hauteur/2;\r
1743     fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,\r
1744                    2,False,False,False);\r
1745     attach(fenet);\r
1746     fenet.hauteur:=Haut_Bot;\r
1747     fenet.cborder:=RougeClair;\r
1748     fenet.cbande:=Rouge;\r
1749     kill(clics);\r
1750     clics:=new cliquer;\r
1751     call fenet.affiche;\r
1752     flagbool:=fenet.moveto(10,10);\r
1753     call color(BleuClair);\r
1754     flagbool:=fenet.outgtext("Chargement de Ville.dat en cours",32);\r
1755     flagbool:=fenet.moveto(10,25);\r
1756     call color(VertClair);\r
1757     flagbool:=fenet.outgtext(".",1);\r
1758     call Lit_Ville(fenet);\r
1759     flagbool:=fenet.moveto(10,40);\r
1760     call color(BleuClair);\r
1761     flagbool:=fenet.outgtext("Chargement termine : 'Enter'",28);\r
1762     fenet.B(0).etat:=True;\r
1763     call fenet.bout.insert(fenet.B(0));\r
1764     call fenet.B(0).affiche;\r
1765     call keys.insert(new elmt(Tou_Ent));\r
1766     call showcursor;\r
1767     do\r
1768      code:=fenet.gestionnaire;\r
1769      if code=Tou_Ent or code=11 then exit fi;\r
1770     od;\r
1771     call hidecursor;\r
1772     attach(fenet);\r
1773     kill(fenet);\r
1774     kill(clics);\r
1775     clics:=new cliquer;\r
1776     call cls;\r
1777     call Etat_Menu(True,True,False,False,True);\r
1778     call W.affiche;\r
1779     COEF_X:=Larg_Aff/Larg_Vil;\r
1780     COEF_Y:=Haut_Aff/Haut_Vil;\r
1781     boolaf:=True;\r
1782     call Ville_aff(1);\r
1783     call showcursor;\r
1784    End Bot_Load;\r
1785 \r
1786 (***************************************************************************)\r
1787    Unit Bot_Run : procedure;\r
1788    Const Largeur=330,\r
1789          Hauteur=100;\r
1790    Var   fenet     : Son,\r
1791          x,y       : integer,\r
1792          Posx,Posy : integer,\r
1793          code      : integer,\r
1794          flagbool  : boolean,\r
1795          nbcar     : integer;\r
1796    Begin\r
1797     x:=(W.x2-W.x1)/2;\r
1798     y:=(W.y2-W.y1)/2;\r
1799     Posx:=x-Largeur/2;\r
1800     Posy:=y-Hauteur/2;\r
1801     fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,\r
1802                    2,False,False,False);\r
1803     attach(fenet);\r
1804     fenet.hauteur:=Haut_Bot;\r
1805     fenet.cborder:=RougeClair;\r
1806     fenet.cbande:=Rouge;\r
1807     kill(clics);\r
1808     clics:=new cliquer;\r
1809     call fenet.affiche;\r
1810     call color(BleuClair);\r
1811     flagbool:=fenet.moveto(10,10);\r
1812     flagbool:=fenet.outgtext("Entrez le nombre de voitures (1-50)",32);\r
1813     flagbool:=fenet.moveto(145,30);\r
1814     nbcar:=gscanf(1,50);\r
1815     call prg.generator(nbcar);\r
1816     attach(fenet);\r
1817     kill(fenet);\r
1818     kill(clics);\r
1819     clics:=new cliquer;\r
1820     call cls;\r
1821     call Etat_Menu(False,False,True,False,False);\r
1822     call W.affiche;\r
1823     call Ville_aff(1);\r
1824    End Bot_Run;\r
1825 \r
1826 (***************************************************************************)\r
1827    Unit Bot_Stop : procedure;\r
1828    Const Largeur=280,\r
1829          Hauteur=100;\r
1830    Var   fenet     : Son,\r
1831          x,y       : integer,\r
1832          Posx,Posy : integer,\r
1833          code      : integer,\r
1834          flagbool  : boolean;\r
1835    Begin\r
1836     x:=(W.x2-W.x1)/2;\r
1837     y:=(W.y2-W.y1)/2;\r
1838     Posx:=x-Largeur/2;\r
1839     Posy:=y-Hauteur/2;\r
1840     fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,\r
1841                    2,False,False,False);\r
1842     attach(fenet);\r
1843     fenet.hauteur:=Haut_Bot;\r
1844     fenet.cborder:=RougeClair;\r
1845     fenet.cbande:=Rouge;\r
1846     kill(clics);\r
1847     clics:=new cliquer;\r
1848     call fenet.affiche;\r
1849     call color(BleuClair);\r
1850     flagbool:=fenet.moveto(60,10);\r
1851     flagbool:=fenet.outgtext("Simulation stopp\82e",18);\r
1852     flagbool:=fenet.moveto(40,30);\r
1853     flagbool:=fenet.outgtext("Appuyez sur une touche",22);\r
1854     do\r
1855      code:=inkey;\r
1856      if code<>0 then exit; fi;\r
1857     od;\r
1858     attach(fenet);\r
1859     kill(fenet);\r
1860     kill(clics);\r
1861     clics:=new cliquer;\r
1862     call cls;\r
1863     call Etat_Menu(True,False,False,True,True);\r
1864     call W.affiche;\r
1865     call Ville_aff(1);\r
1866    End Bot_Stop;\r
1867 \r
1868 (***************************************************************************)\r
1869    Unit Bot_continue : procedure;\r
1870    Const Largeur=300,\r
1871          Hauteur=100;\r
1872    Var   fenet     : Son,\r
1873          x,y       : integer,\r
1874          Posx,Posy : integer,\r
1875          code      : integer,\r
1876          flagbool  : boolean;\r
1877    Begin\r
1878     x:=(W.x2-W.x1)/2;\r
1879     y:=(W.y2-W.y1)/2;\r
1880     Posx:=x-Largeur/2;\r
1881     Posy:=y-Hauteur/2;\r
1882     fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,\r
1883                    2,False,False,False);\r
1884     attach(fenet);\r
1885     fenet.hauteur:=Haut_Bot;\r
1886     fenet.cborder:=RougeClair;\r
1887     fenet.cbande:=Rouge;\r
1888     kill(clics);\r
1889     clics:=new cliquer;\r
1890     call fenet.affiche;\r
1891     do\r
1892      code:=inkey;\r
1893      if code=13 then exit fi;\r
1894     od;\r
1895     attach(fenet);\r
1896     kill(fenet);\r
1897     kill(clics);\r
1898     clics:=new cliquer;\r
1899     call cls;\r
1900     call Etat_Menu(False,False,True,False,False);\r
1901     call W.affiche;\r
1902     call Ville_aff(1);\r
1903    End Bot_Continue;\r
1904 \r
1905 (***************************************************************************)\r
1906    Unit Bot_Quit : function : boolean;\r
1907    Const Largeur=300,\r
1908          Hauteur=90;\r
1909    Var   fenet     : Son,\r
1910          x,y       : integer,\r
1911          Posx,Posy : integer,\r
1912          fin       : boolean,\r
1913          code      : integer,\r
1914          Yes,No    : Menu;\r
1915    Begin\r
1916     x:=(W.x2-W.x1)/2;\r
1917     y:=(W.y2-W.y1)/2;\r
1918     Posx:=x-Largeur/2;\r
1919     Posy:=y-Hauteur/2;\r
1920     fenet:=new Son(10,Posx,Posy,Posx+Largeur,Posy+hauteur,2,True,False,False);\r
1921     attach(fenet);\r
1922     fenet.hauteur:=Haut_Bot;\r
1923     fenet.cborder:=RougeClair;\r
1924     fenet.nom:="Q U I T";\r
1925     fenet.cnom:=RougeClair;\r
1926     fenet.cbande:=Rouge;\r
1927     kill(clics);\r
1928     clics:=new cliquer;\r
1929     Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);\r
1930     Yes.nom:="Yes";\r
1931     Yes.etat:=True;\r
1932     call fenet.Bout.Insert(Yes);\r
1933     No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);\r
1934     No.nom:="No";\r
1935     No.etat:=True;\r
1936     call fenet.Bout.Insert(No);\r
1937     call fenet.affiche;\r
1938     call move(Posx+10,Posy+35);\r
1939     call color(BleuClair);\r
1940     call outstring("Do you want to quit the application");\r
1941     call Keys.Insert(new elmt(T_ESC));\r
1942     call showcursor;\r
1943     do\r
1944      code:=fenet.gestionnaire;\r
1945      case code\r
1946       when T_ESC : fin:=False; exit; (* touche racc exit *)\r
1947       when T_Y   : fin:=True;  exit; (* touche Y         *)\r
1948       when T_N   : fin:=False; exit; (* touche N         *)\r
1949       when 1       : fin:=True;  exit; (* bouton yes       *)\r
1950       when 2       : fin:=False; exit; (* bouton no        *) \r
1951       when 11      : fin:=False; exit; (* racc exit        *)\r
1952      esac;\r
1953     od; \r
1954     call hidecursor;\r
1955     if not fin\r
1956     then attach(fenet);\r
1957          kill(fenet);\r
1958          kill(clics);\r
1959          clics:=new cliquer;\r
1960          call cls;\r
1961          call W.affiche;\r
1962          call Ville_aff(1);\r
1963          result:=False;\r
1964     else result:=True;\r
1965     fi;\r
1966     call showcursor;\r
1967    End Bot_Quit;\r
1968 \r
1969 (***************************************************************************)\r
1970    Unit Bot_Help : procedure;\r
1971    Const Largeur=410,\r
1972          Hauteur=350;\r
1973    Var   fen         : Son,\r
1974          x,y,i,j     : integer,\r
1975          code        : integer,\r
1976          COORD_Y     : integer,\r
1977          fp          : file,\r
1978          tmp         : char,\r
1979          boolaff     : boolean,\r
1980          help        : arrayof arrayof char,\r
1981          nb_lign_hlp : integer;\r
1982 \r
1983    \r
1984       Unit affiche_hlp : procedure;\r
1985       Begin\r
1986         call fen.clear;\r
1987         call color(BleuClair);\r
1988         for i:=COORD_Y to imin(COORD_Y+18,nb_lign_hlp)\r
1989          do\r
1990           for j:=1 to 37\r
1991            do\r
1992             if (ord(help(i,j))>=28 and ord(help(i,j))<=255)\r
1993             then boolaff:=fen.outchar(help(i,j));\r
1994             fi;\r
1995            od;   \r
1996          od;\r
1997       End affiche_hlp;\r
1998    \r
1999    Begin\r
2000     x:=(W.x2-W.x1)/2;\r
2001     y:=(W.y2-W.y1)/2;\r
2002     fen:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,2,\r
2003                  True,False,False);\r
2004     attach(fen);\r
2005     fen.cnom:=RougeClair;\r
2006     fen.nom:="H E L P";\r
2007     fen.hauteur:=Haut_Bot;\r
2008     fen.largeur:=Larg_Bot;\r
2009     fen.cborder:=RougeClair;\r
2010     fen.cbande:=Rouge;\r
2011     kill(clics);\r
2012     clics:=new cliquer;\r
2013     kill(Keys);\r
2014     Keys:=new ListKey;\r
2015     x:=fen.x2-fen.lborder-1-fen.hauteur;\r
2016     y:=fen.y1+fen.hauteur+fen.lborder+1;\r
2017     fen.Verti:=new AccelerateV(20,-1,x,y,x+fen.largeur,fen.y2-fen.lborder-1,fen);\r
2018     call fen.affiche;\r
2019     call fen.Verti.deplacer(fen.Verti.MinY);\r
2020     call Keys.Insert(new elmt(T_ESC)); (* pour sortir de la fenetre *)\r
2021     call Keys.Insert(new elmt(T_PGUP)); (* page up *)\r
2022     call Keys.Insert(new elmt(T_PGDOWN)); (* page dow *)\r
2023     COORD_Y:=1;\r
2024     open(fp,text,unpack("simula.hlp"));\r
2025     call reset(fp);\r
2026     readln(fp,nb_lign_hlp);\r
2027     array help dim (1:nb_lign_hlp);\r
2028     for i:=1 to nb_lign_hlp\r
2029      do \r
2030       array help(i) dim (1:38);\r
2031      od;\r
2032     call color(BleuClair);\r
2033     i:=1;\r
2034     j:=1;\r
2035     while not eof(fp)\r
2036      do\r
2037       read(fp,help(i,j));\r
2038       j:=j+1;\r
2039       if j=39 then j:=1;\r
2040                    i:=i+1;\r
2041       fi;\r
2042      od;\r
2043     call affiche_hlp;\r
2044     call setposition(fen.x1,fen.y1);\r
2045     call showcursor;\r
2046     do\r
2047      code:=fen.gestionnaire;\r
2048      call hidecursor;\r
2049      if (code=T_ESC) or (code=11) then exit;\r
2050      else\r
2051       if (code=21) or (code=T_FLHAU) then COORD_Y:=COORD_Y-5;\r
2052                                           if COORD_Y<=0 then COORD_Y:=1; fi;\r
2053                                           call fen.Verti.DeplacerUp;\r
2054                                           call affiche_hlp;\r
2055       else\r
2056        if (code=22) then COORD_Y:=1;\r
2057                          call fen.Verti.Reset_Bot;\r
2058                          call affiche_hlp;\r
2059        else\r
2060         if (code=23) or (code=T_FLBAS) then COORD_Y:=COORD_Y+5;\r
2061                                             if COORD_Y>(nb_lign_hlp-5)\r
2062                                             then COORD_Y:=nb_lign_hlp-5;\r
2063                                             fi;\r
2064                                             call fen.Verti.DeplacerDown;\r
2065                                             call affiche_hlp;\r
2066         else\r
2067          if (code=T_PGUP) then COORD_Y:=COORD_Y-19;\r
2068                                if COORD_Y<=0\r
2069                                then COORD_Y:=1;\r
2070                                     call fen.Verti.Deplacer(fen.Verti.MinY);\r
2071                                else call fen.Verti.DeplacerDown;\r
2072                                fi;\r
2073                                call affiche_hlp;\r
2074          else\r
2075           if (code=T_PGDOWN) then COORD_Y:=COORD_Y+19;\r
2076                                   if COORD_Y>(nb_lign_hlp-5)\r
2077                                   then COORD_Y:=nb_lign_hlp-5;\r
2078                                        call fen.Verti.Deplacer(fen.Verti.MaxY);\r
2079                                   else call fen.Verti.DeplacerDown;\r
2080                                   fi;\r
2081                                   call affiche_hlp;\r
2082           fi;\r
2083          fi;\r
2084         fi;\r
2085        fi;\r
2086       fi;\r
2087      fi;\r
2088      call showcursor;\r
2089     od;\r
2090     attach(fen);  (* correspond a la 1ere etape kill *)\r
2091     kill(fen);\r
2092     kill(clics);\r
2093     clics:=new cliquer; (* on prepare pour la 'resurection' *)\r
2094     kill(Keys);\r
2095     Keys:=new ListKey;\r
2096     call cls;\r
2097     call W.affiche;\r
2098     call Ville_aff(1);\r
2099    End Bot_Help;\r
2100 \r
2101 (***************************************************************************)\r
2102    Unit Etat_Menu : procedure (ml,mr,ms,mc,mq : boolean);\r
2103    Begin\r
2104      if (ml and not M(1).etat)  (* load devient enable *)\r
2105      then M(1).etat:=True;\r
2106           M(1).Touche:=T_F1;\r
2107           call M(1).bot_enable;\r
2108      fi;\r
2109      if (not ml and M(1).etat) (* load devient disable *)\r
2110      then M(1).etat:=False;\r
2111           M(1).Touche:=-1;\r
2112           call M(1).bot_disable;\r
2113      fi;\r
2114      if (mr and not M(2).etat)  (* run devient enable *)\r
2115      then M(2).etat:=True;\r
2116           M(2).Touche:=T_F2;\r
2117           call M(2).bot_enable;\r
2118      fi;\r
2119      if (not mr and M(2).etat) (* run devient disable *)\r
2120      then M(2).etat:=False;\r
2121           M(2).Touche:=-1;\r
2122           call M(2).bot_disable;\r
2123      fi;\r
2124      if (ms and not M(3).etat)  (* stop devient enable *)\r
2125      then M(3).etat:=True;\r
2126           M(3).Touche:=T_F3;\r
2127           call M(3).bot_enable;\r
2128      fi;\r
2129      if (not ms and M(3).etat) (* stop devient disable *)\r
2130      then M(3).etat:=False;\r
2131           M(3).Touche:=-1;\r
2132           call M(3).bot_disable;\r
2133      fi;\r
2134      if (mc and not M(4).etat)  (* continue devient enable *)\r
2135      then M(4).etat:=True;\r
2136           M(4).Touche:=T_F4;\r
2137           call M(4).bot_enable;\r
2138      fi;\r
2139      if (not mc and M(4).etat) (* continue devient disable *)\r
2140      then M(4).etat:=False;\r
2141           M(4).Touche:=-1;\r
2142           call M(4).bot_disable;\r
2143      fi;\r
2144      if (mq and not M(5).etat)  (* quit devient enable *)\r
2145      then M(5).etat:=True;\r
2146           M(5).Touche:=T_F5;\r
2147           call M(5).bot_enable;\r
2148      fi;\r
2149      if (not mq and M(5).etat) (* quit devient disable *)\r
2150      then M(5).etat:=False;\r
2151           M(5).Touche:=-1;\r
2152           call M(5).bot_disable;\r
2153      fi;\r
2154    End;\r
2155 \r
2156 (***************************************************************************)\r
2157 (*    procedure d'affichage de la ville - on deborde de l'ecran            *)\r
2158 (*    tracer d'une ligne verticale qui peut depasser le cadre              *)\r
2159 (***************************************************************************)\r
2160   \r
2161   Unit Trace_Vil1 : procedure (x1,y1,x2,y2 : real ; zoom : integer);\r
2162   Var C     : integer,\r
2163       min_x : integer,\r
2164       max_x : integer,\r
2165       min_y : integer,\r
2166       max_y : integer;\r
2167   Begin\r
2168    C:=5*zoom;\r
2169    min_x:=imin(x1,x2);\r
2170    max_x:=imax(x1,x2);\r
2171    min_y:=imin(y1,y2);\r
2172    max_y:=imax(y1,y2);\r
2173    if (min_y>=Ydep_Aff and max_y<=(Ydep_Aff+Haut_Aff))\r
2174    then (* on est en plein dans le cadre, on peut tracer normalement *)\r
2175         call line(x1-C,imin(y1,y2)+C,x2-C,imax(y1,y2)-C,GrisClair);\r
2176         call linep(x1,imin(y1,y2)+C,x2,imax(y1,y2)-C,Blanc,C);\r
2177         call line(x1+C,imin(y1,y2)+C,x2+C,imax(y1,y2)-C,GrisClair);\r
2178    else if (min_y<Ydep_Aff) (* c'est le minimum qui pose pb *)\r
2179         then call line(x1-C,Ydep_Aff+C,x2-C,imax(y1,y2)-C,GrisClair);\r
2180              call linep(x1,Ydep_Aff+C,x2,imax(y1,y2)-C,Blanc,C);\r
2181              call line(x1+C,Ydep_Aff+C,x2+C,imax(y1,y2)-C,GrisClair);\r
2182         else call line(x1-C,imin(y1,y2)+C,x2-C,Ydep_Aff+Haut_Aff-C,GrisClair);\r
2183              call linep(x1,imin(y1,y2)+C,x2,Ydep_Aff+Haut_Aff-C,Blanc,C);\r
2184              call line(x1+C,imin(y1,y2)+C,x2+C,Ydep_Aff+Haut_Aff-C,GrisClair);\r
2185         fi;\r
2186    fi;\r
2187   End Trace_Vil1;\r
2188 \r
2189 \r
2190 (***************************************************************************)\r
2191 (*    procedure d'affichage de la ville - on deborde de l'ecran            *)\r
2192 (*    tracer d'une ligne horizontale qui peut depasser le cadre            *)\r
2193 (***************************************************************************)\r
2194   \r
2195   Unit Trace_Vil2 : procedure (x1,y1,x2,y2 : real ; zoom : integer);\r
2196   Var C     : integer,\r
2197       min_x : integer,\r
2198       max_x : integer,\r
2199       min_y : integer,\r
2200       max_y : integer;\r
2201   Begin\r
2202    C:=5*zoom;\r
2203    min_x:=imin(x1,x2);\r
2204    max_x:=imax(x1,x2);\r
2205    min_y:=imin(y1,y2);\r
2206    max_y:=imax(y1,y2);\r
2207    if (min_x>=Xdep_Aff and max_x<=(Xdep_Aff+Larg_Aff))\r
2208    then (* on est en plein dans le cadre, on peut tracer normalement *)\r
2209         call line(imin(x1,x2)+C,y1-C,imax(x2,x1)-C,y2-C,GrisClair);\r
2210         call linep(imin(x1,x2)+C,y1,imax(x2,x1)-C,y2,Blanc,C);\r
2211         call line(imin(x1,x2)+C,y1+C,imax(x1,x2)-C,y2+C,GrisClair);\r
2212    else if (min_x<Xdep_Aff)  (* c'est le minimum qui pose pb *)\r
2213         then  call line(Xdep_Aff+C,y1-C,imax(x1,x2)-C,y2-C,GrisClair);\r
2214               call linep(Xdep_Aff+C,y1,imax(x1,x2)-C,y2,Blanc,C);\r
2215               call line(Xdep_Aff+C,y1+C,imax(x1,x2)-C,y2+C,GrisClair);\r
2216         else  call line(imin(x1,x2)+C,y1-C,Xdep_Aff+Larg_Aff-C,y2-C,GrisClair);\r
2217               call linep(imin(x1,x2)+C,y1,Xdep_Aff+Larg_Aff-C,y2,Blanc,C);\r
2218               call line(imin(x1,x2)+C,y1+C,Xdep_Aff+Larg_Aff-C,y2+C,GrisClair);\r
2219         fi;\r
2220    fi;\r
2221   End Trace_Vil2;\r
2222 \r
2223 (***************************************************************************)\r
2224 (*                     procedure d'affichage de la ville                   *)\r
2225 (***************************************************************************)\r
2226    Unit Ville_Aff : procedure(zoom : integer);\r
2227    var r     : arcs,\r
2228        s     : sommets,\r
2229        l     : Liste,\r
2230        C     : integer,\r
2231        x1,y1 : integer,\r
2232        x2,y2 : integer,\r
2233        min_x : integer,\r
2234        max_x : integer,\r
2235        min_y : integer,\r
2236        max_y : integer;\r
2237    Begin\r
2238     if boolaf\r
2239     then\r
2240       call W.clear;\r
2241       r:=RaciArcs;\r
2242       while (r<> none)\r
2243        do \r
2244         x1:=Xdep_Aff+COORD_X+(r.initial.colonne*COEF_X*zoom);\r
2245         y1:=Ydep_Aff+COORD_Y+(r.initial.Ligne*COEF_Y*zoom);\r
2246         x2:=Xdep_Aff+COORD_X+(r.final.colonne*COEF_X*zoom);\r
2247         y2:=Ydep_Aff+COORD_Y+(r.final.Ligne*COEF_Y*zoom);\r
2248         min_x:=imin(x1,x2);\r
2249         max_x:=imax(x1,x2);\r
2250         min_y:=imin(y1,y2);\r
2251         max_y:=imax(y1,y2);\r
2252         if(x1=x2)        (* c'est une ligne verticale *)\r
2253         then \r
2254          if (x1<Xdep_Aff or x2>(Xdep_Aff+Larg_Aff)) (* on est hors de l'ecran*)\r
2255          then (* on ne fait rien *) \r
2256          else (* on va peut etre afficher qqch *)\r
2257               if (max_y<Ydep_Aff or min_y>(Ydep_Aff+Haut_Aff))\r
2258               then (* on ne doit rien afficher *) \r
2259               else (* on va afficher qqch *)\r
2260                    call trace_vil1(x1,y1,x2,y2,zoom);\r
2261               fi;\r
2262          fi;\r
2263         fi;\r
2264         if(y1=y2)        (* c'est une ligne horizontale   *)\r
2265         then \r
2266          if (y1<Ydep_Aff or y2>(Ydep_Aff+Haut_Aff)) (* on est hors de l'ecran*)\r
2267          then (*on ne fait rien *)\r
2268          else (*on va peut etre afficher qqch *)\r
2269               if (max_x<Xdep_Aff or min_x>(Xdep_Aff+Larg_Aff))\r
2270               then (* on ne doit rien afficher *) \r
2271               else (* on va afficher qqch *)\r
2272                    call trace_vil2(x1,y1,x2,y2,zoom);\r
2273               fi;\r
2274          fi;\r
2275         fi;\r
2276         r:=r.suivants;\r
2277        od;\r
2278       s:=RaciSomm;\r
2279       C:=5*zoom;\r
2280       while(s<>none)\r
2281        do\r
2282         x1:=Xdep_Aff+COORD_X+(s.colonne*COEF_X*zoom);\r
2283         y1:=Ydep_Aff+COORD_Y+(s.Ligne*COEF_Y*zoom);\r
2284         if (x1>=Xdep_Aff and x1<=(Xdep_Aff+Larg_Aff) \r
2285            and y1>=Ydep_Aff and y1<=(Ydep_Aff+Haut_Aff))\r
2286         then case s.afftype\r
2287                when 1  : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);\r
2288                          call line(x1+C,y1-C,x1+C,y1+C,GrisClair);\r
2289                when 2  : call line(x1-C,y1+C,x1+C,y1+C,GrisClair);\r
2290                          call line(x1+C,y1+C,x1+C,y1-C,GrisClair);\r
2291                when 3  : call line(x1-C,y1+C,x1-C,y1-C,GrisClair);\r
2292                          call line(x1-C,y1-C,x1+C,y1-C,GrisClair);\r
2293                when 4  : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);\r
2294                          call line(x1-C,y1+C,x1+C,y1+C,GrisClair);\r
2295                when 5  : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);\r
2296                when 6  : call line(x1-C,y1+C,x1+C,y1+C,GrisClair);\r
2297                when 7  : call line(x1+C,y1-C,x1+C,y1+C,GrisClair);\r
2298                when 8  : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);\r
2299                when 9  :\r
2300                when 10 : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);\r
2301                          call line(x1-C,y1+C,x1+C,y1+C,GrisClair);\r
2302                when 11 : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);\r
2303                          call line(x1+C,y1-C,x1+C,y1+C,GrisClair);\r
2304              esac;\r
2305         fi;\r
2306         s:=s.suivant;\r
2307        od;\r
2308     fi;\r
2309    End Ville_Aff;\r
2310 \r
2311 (***************************************************************************)\r
2312 (*                                                                         *)\r
2313 (***************************************************************************)\r
2314 Unit prog : Lists class;\r
2315 \r
2316 (***************************************************************************)\r
2317 (*         procedure de mise en route du generateur de voitures            *)\r
2318 (***************************************************************************)\r
2319    Unit generator : procedure (nbcar : integer);\r
2320    Begin\r
2321     call schedule(new Generate(nbcar),time);\r
2322     call hold(10);\r
2323    End generator;\r
2324 \r
2325 (***************************************************************************)\r
2326 (*               simprocess de generation des voitures                     *)\r
2327 (***************************************************************************)\r
2328    Unit Generate : Simprocess class(nbcar : integer);\r
2329    Begin\r
2330     do\r
2331      if NbCarActiv<=nbcar\r
2332      then call schedule(new car,time);\r
2333           NbCarActiv:=NbCarActiv+1;\r
2334      fi;\r
2335      call hold(10);\r
2336     od;\r
2337    End Generate;\r
2338 \r
2339 (***************************************************************************)\r
2340 (*                     simprocess des voitures                             *)\r
2341 (*       on se limite au cas o\97 toutes les voies sont \85 double sens        *)\r
2342 (***************************************************************************)\r
2343    Unit Car : Simprocess class;\r
2344    \r
2345         (* procedure d'affichage de la voiture dans la ville *)\r
2346         Unit affiche_car : procedure;\r
2347         Begin\r
2348 \r
2349         End affiche_car;\r
2350         \r
2351         (* fonction se deplacant dans l'arc courant *)\r
2352         Unit avance : function : boolean;\r
2353         Begin\r
2354          if sens=1\r
2355          then arccour.occpsens(km):=none;\r
2356               km:=km+1;\r
2357               if km<=arccour.distance\r
2358               then arccour.occpsens(km):=this car;\r
2359                    result:=True; (* on n'a pas encore fini *)\r
2360               else result:=False; (* on est arrive au sommet final *)\r
2361               fi;\r
2362          else arccour.occpinve(km):=none;\r
2363               km:=km+1;\r
2364               if km<=arccour.distance\r
2365               then arccour.occpinve(km):=this car;\r
2366                    result:=True; (* on n'a pas encore fini *)\r
2367               else result:=False; (* on est arrive au sommet final *)\r
2368               fi;\r
2369          fi;\r
2370          call affiche_car; \r
2371         End avance;\r
2372    \r
2373         (* fonction choisissant le sommet de depart *)\r
2374         Unit choix_sommet : function : sommets;\r
2375         var som : sommets,\r
2376             ch  : integer,\r
2377             i   : integer;\r
2378         Begin\r
2379          som:=RaciSomm;\r
2380          ch:=RANDOM*NBSOMMETS+1; (* on choisit le numero du sommet *)\r
2381          for i:=1 to ch-1\r
2382           do\r
2383            som:=som.suivant;\r
2384           od;\r
2385          result:=som;\r
2386         End choix_sommet;\r
2387 \r
2388         (* fonction choisissant l'arc suivant que l'on va prendre *)        \r
2389         Unit choix_arc : function : arcs;\r
2390         Var i         : integer,\r
2391             nbarcs    : integer,\r
2392             numarcdep : integer,\r
2393             lst       : liste;\r
2394         Begin\r
2395          nbarcs:=2;\r
2396          if (dep.afftype<=8 and dep.afftype>=5)\r
2397          then nbarcs:=nbarcs+1;\r
2398          else if dep.afftype=9\r
2399               then nbarcs:=nbarcs+2;\r
2400               fi;\r
2401          fi;\r
2402          numarcdep:=RANDOM*nbarcs+1;\r
2403          lst:=dep.ptrarc;\r
2404          for i:=1 to numarcdep-1   (* on recherche cet arc dans la liste *)\r
2405           do\r
2406            lst:=lst.suivante;\r
2407           od;\r
2408          km:=1; (* kilometrage dans l'arc *)\r
2409          result:=lst.pointeur;  (* on poss\8ade l'arc *)\r
2410          if result.initial=dep\r
2411          then sens:=1;\r
2412          else sens:=-1;\r
2413          fi;\r
2414         End choix_arc;\r
2415 \r
2416    Var dep       : sommets, (* sommet de depart du voyage *)\r
2417        arccour   : arcs,    (* arc de depart du voyage *)\r
2418        boo       : boolean,\r
2419        sens      : integer, (* 1 si ini-fin , -1 si fin-ini *)\r
2420        km        : integer; (* distance ds l'arc courant depuis sommet initial*)\r
2421    Begin\r
2422      dep:=choix_sommet;\r
2423      arccour:=choix_arc;\r
2424      do\r
2425       boo:=avance; (* on avance d'un pas *)\r
2426       if boo (* on est \85 la fin de l'arc, il faut savoir si on va en *)\r
2427               (* prendre un autre *)\r
2428       then km:=RANDOM*100;\r
2429            if km>60 \r
2430            then arccour:=choix_arc; (* on a 60% de chance de continuer *)\r
2431                 boo:=True;  (* on doit donc continuer *)\r
2432            else boo:=False; (* on s'arrete *)\r
2433            fi;\r
2434       fi;\r
2435       if boo  (* si boo alors on n'est pas encore au point d'arrivee *)\r
2436       then call hold(100);\r
2437       else exit;\r
2438       fi;\r
2439      od;\r
2440      NbCarActiv:=NbCarActiv-1;\r
2441      call passivate;\r
2442     End Car;\r
2443 \r
2444 \r
2445 (***************************************************************************)\r
2446 (*                   simprocess de gestion de l'affichage                  *)\r
2447 (***************************************************************************)\r
2448    Unit affichage : simprocess class;\r
2449    Begin\r
2450    do \r
2451     code:=W.Gestionnaire;\r
2452     call hidecursor;\r
2453     if (code=T_F1) or (code=1) then call Bot_Load; \r
2454     else \r
2455      if (code=T_F5) or (code=5) then if Bot_Quit then fin:=True; exit; fi; \r
2456      else \r
2457       if (code=T_F8) or (code=8) then call Bot_help; \r
2458       else \r
2459        if (code=T_ALTF4) then if Bot_Quit then fin:=True; exit; fi;\r
2460        else \r
2461         if (code=T_F2) or (code=2) then call Bot_Run;\r
2462         else \r
2463          if (code=T_F3) or (code=3) then call Bot_Stop;\r
2464          else \r
2465           if (code=T_f4) or (code=4) then call Bot_Continue;\r
2466           else \r
2467            if (code=T_FLGCH) or (code=51) then call W.Horiz.DeplacerLeft;\r
2468                                                COORD_X:=COORD_X+30;\r
2469                                                call Ville_Aff(ZOOM);\r
2470            else\r
2471             if (code=T_FLDTE) or (code=53) then call W.Horiz.DeplacerRight;\r
2472                                                 COORD_X:=COORD_X-30;\r
2473                                                 call Ville_Aff(ZOOM);\r
2474             else\r
2475              if (code=T_FLHAU) or (code=61) then call W.Verti.DeplacerUp;\r
2476                                                  COORD_Y:=COORD_Y+30;\r
2477                                                  call Ville_Aff(ZOOM);\r
2478              else\r
2479               if (code=T_FLBAS) or (code=63) then call W.verti.DeplacerDown;\r
2480                                                   COORD_Y:=COORD_Y-30;\r
2481                                                   call Ville_Aff(ZOOM);\r
2482               else\r
2483                if (code=101) then if Bot_Quit then fin:=True; exit fi;\r
2484                else\r
2485                 if (code=102) then call W.iconify;\r
2486                                    call Ville_Aff(ZOOM);\r
2487                 else\r
2488                  if (code=52) then COORD_X:=0; \r
2489                                    call W.Horiz.Reset_Bot;\r
2490                                    call Ville_Aff(ZOOM);\r
2491                  else\r
2492                   if (code=62) then COORD_Y:=0;\r
2493                                     call W.Verti.Reset_Bot;\r
2494                                     call Ville_Aff(ZOOM);\r
2495                   else \r
2496                    if (code=6) or (code=T_F6) \r
2497                         then Zoom:=Zoom+1;\r
2498                              if zoom=5 then M(6).etat:=False;\r
2499                                              call M(6).bot_disable;\r
2500                              fi;\r
2501                              if not M(7).etat then M(7).etat:=True;\r
2502                                                    call M(7).bot_enable;\r
2503                              fi;\r
2504                              C:=5*Zoom;\r
2505                              Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20-2*C;\r
2506                              Haut_Aff:=W.Verti.y2-W.Verti.y1-20-2*C;\r
2507                              Xdep_Aff:=W.Horiz.x1+10+C;\r
2508                              Ydep_Aff:=W.Verti.y1+10+C;\r
2509                              call Ville_Aff(Zoom);\r
2510                    else\r
2511                     if (code=7) or (code=T_F7)\r
2512                          then Zoom:=Zoom-1;\r
2513                               if zoom=1 then M(7).etat:=False;\r
2514                                              call M(7).bot_disable;\r
2515                               fi;\r
2516                               if not M(6).etat then M(6).etat:=True;\r
2517                                                     call M(6).bot_Enable;\r
2518                               fi;\r
2519                               C:=5*Zoom;\r
2520                               Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20-2*C;\r
2521                               Haut_Aff:=W.Verti.y2-W.Verti.y1-20-2*C;\r
2522                               Xdep_Aff:=W.Horiz.x1+10+C;\r
2523                               Ydep_Aff:=W.Verti.y1+10+C;\r
2524                               call Ville_Aff(Zoom);\r
2525                     fi;\r
2526                    fi;\r
2527                   fi;\r
2528                  fi;\r
2529                 fi;\r
2530                fi;\r
2531               fi;\r
2532              fi;\r
2533             fi;\r
2534            fi;\r
2535           fi;\r
2536          fi;\r
2537         fi;\r
2538        fi;\r
2539       fi;\r
2540      fi;\r
2541     fi;\r
2542     call showcursor;\r
2543    od;\r
2544    End affichage;\r
2545 \r
2546 Var sim_aff : affichage;\r
2547 Begin\r
2548  sim_aff:=new affichage;\r
2549  call schedule(sim_aff,time);\r
2550  call hold(1);\r
2551 End prog;\r
2552 \r
2553 (***************************************************************************)\r
2554 (*                 P R O G R A M M E   P R I  N C I P A L                  *)\r
2555 (***************************************************************************)\r
2556 Const  Larg_bot=18,\r
2557        Haut_bot=18;\r
2558 \r
2559 var    prg    : prog,\r
2560        fin    : boolean,\r
2561        x1,y1  : integer,\r
2562        x2,y2  : integer,\r
2563        ZOOM   : integer, (*coeficient de zoom *)\r
2564        C      : integer, (* largeur des voies *)\r
2565        boolAf : boolean; (* vrai si il faut afficher la ville *)\r
2566 \r
2567 Begin\r
2568    \r
2569    call gron(1);                (* mode 640x480x256 avec driver stealth.grn*)\r
2570    SIZEX:=640; \r
2571    SIZEY:=480;\r
2572 \r
2573    clics:=new cliquer;             (* ensemble des zones de clic possible  *)\r
2574 \r
2575    W:=new Maine(100,1,1,SIZEX,SIZEY,3,True,True,False);\r
2576    W.hauteur:=Haut_bot;\r
2577    W.cborder:=BleuClair;\r
2578    W.cbande:=GrisClair;\r
2579    W.cnom:=BleuClair;\r
2580    W.nom:="Simulation de r\82seau routier";\r
2581    W.icname:="Root";\r
2582    \r
2583    array M dim (1:8);\r
2584 \r
2585    y1:=W.y1+W.lborder+1+W.hauteur+2;\r
2586    y2:=y1+Haut_bot;\r
2587    M(1):=new Menu(1,T_F1,W.x1+8,y1,W.x1+50,y2);\r
2588    M(1).nom:="Load";\r
2589    M(1).etat:=True;\r
2590    call W.Bout.Insert(M(1));\r
2591 \r
2592    M(2):=new Menu(2,-1,W.x1+55,y1,W.x1+89,y2);\r
2593    M(2).nom:="Run";\r
2594    M(2).etat:=False;\r
2595    call W.Bout.Insert(M(2));\r
2596 \r
2597    M(3):=new Menu(3,-1,W.x1+94,y1,W.x1+136,y2);\r
2598    M(3).nom:="Stop";\r
2599    M(3).etat:=False;\r
2600    call W.Bout.Insert(M(3)); \r
2601    \r
2602    M(4):=new Menu(4,-1,W.x1+141,y1,W.x1+215,y2);\r
2603    M(4).nom:="Continue";\r
2604    M(4).etat:=False;\r
2605    call W.Bout.Insert(M(4));\r
2606 \r
2607    M(5):=new Menu(5,T_F5,W.x1+220,y1,W.x1+262,y2);\r
2608    M(5).nom:="Quit";\r
2609    M(5).etat:=True;\r
2610    call W.Bout.Insert(M(5));\r
2611    \r
2612    M(6):=new Menu(6,T_F6,W.x2-94,y1,W.x2-77,y2);\r
2613    M(6).nom:="+";\r
2614    M(6).etat:=True;\r
2615    call W.Bout.Insert(M(6));\r
2616 \r
2617    M(7):=new Menu(7,T_F7,W.x2-72,y1,W.x2-55,y2);\r
2618    M(7).nom:="-";\r
2619    M(7).etat:=False;\r
2620    call W.Bout.Insert(M(7));\r
2621    \r
2622    M(8):=new Menu(8,T_F8,W.x2-30,y1,W.x2-13,y2);\r
2623    M(8).nom:="?";\r
2624    M(8).etat:=True;\r
2625    call W.Bout.Insert(M(8)); \r
2626 \r
2627    x1:=W.x1+W.lborder+1;\r
2628    y1:=W.y2-W.lborder-Haut_bot-1;\r
2629    x2:=W.x2-W.lborder-Larg_bot-1;\r
2630    y2:=W.y2-W.lborder-1;\r
2631    W.Horiz:=new AccelerateH(50,-1,x1,y1,x2,y2,W);\r
2632 \r
2633    x1:=W.x2-W.lborder-Larg_bot-1; \r
2634    y1:=W.y1+W.lborder+2*(Haut_bot+2);\r
2635    x2:=W.x2-W.lborder-1;\r
2636    y2:=W.y2-W.lborder-Haut_bot;\r
2637    W.Verti:=new AccelerateV(60,-1,x1,y1,x2,y2,W);\r
2638    \r
2639    Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20;\r
2640    Haut_Aff:=W.Verti.y2-W.Verti.y1-20;\r
2641    Xdep_Aff:=W.Horiz.x1+10;\r
2642    Ydep_Aff:=W.Verti.y1+10;\r
2643    COEF_X:=1;\r
2644    COEF_Y:=1;\r
2645    COORD_X:=0;\r
2646    COORD_Y:=0;\r
2647    ZOOM:=1;\r
2648    C:=5*ZOOM;\r
2649    call W.affiche;\r
2650    \r
2651    call showcursor;\r
2652    \r
2653    prg:=new prog; (* on met la simulation en route *)\r
2654                   (* NB: elle commence par l'affichage et sa gestion *)\r
2655    call hidecursor;\r
2656    \r
2657    call cls;\r
2658    \r
2659    call groff;\r
2660 \r
2661    end\r
2662   end\r
2663 end.\r