examples/pataud/simula2.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 (* ligne de commande de lancement : 'svgaint simula'                       *)\r
  10 (***************************************************************************)\r
  11 \r
  12 Begin\r
  13 Pref iiuwgraph block\r
  14   \r
  15   Begin\r
  16   Pref mouse block\r
  17 \r
  18 \r
  19   Const Noir       = 0, Bleu        = 1, Vert        = 2, Cyan        = 3,\r
  20         Rouge      = 4, Magenta     = 5, Marron      = 6, GrisClair   = 7,\r
  21         GrisFonce  = 8, BleuClair   = 9, VertClair   =10, CyanClair   =11,\r
  22         RougeClair =12, MagentaClair=13, Jaune       =14, Blanc       =15;\r
  23  \r
  24  Const T_F1     =315, T_F2     =316, T_F3     =317, T_F4     =318,\r
  25        T_F5     =319, T_F6     =320, T_F7     =321, T_F8     =322,\r
  26        T_F9     =323, T_F10    =324, T_SHFTF1 =340, T_SHFTF2 =341,\r
  27        T_SHFTF3 =342, T_SHFTF4 =343, T_SHFTF5 =344, T_SHFTF6 =345,\r
  28        T_SHFTF7 =346, T_SHFTF8 =347, T_SHFTF9 =348, T_SHFTF10=349,\r
  29        T_CTRLF1 =350, T_CTRLF2 =351, T_CTRLF3 =352, T_CTRLF4 =353, \r
  30        T_CTRLF5 =354, T_CTRLF6 =355, T_CTRLF7 =356, T_CTRLF8 =357, \r
  31        T_CTRLF9 =358, T_CTRLF10=359, T_ALTF1  =360, T_ALTF2  =361, \r
  32        T_ALTF3  =362, T_ALTF4  =363, T_ALTF5  =364, T_ALTF6  =365, \r
  33        T_ALTF7  =366, T_ALTF8  =367, T_ALTF9  =368, T_ALTF10 =369,\r
  34        Tou_Ent  =013, T_ESC    =027, T_N      =078, T_Y      =089,\r
  35        T_FLGCH  =331, T_FLDTE  =333, T_FLHAU  =328, T_FLBAS  =336,\r
  36        T_ALT1   =376, T_ALT2   =377, T_PGUP   =329, T_PGDOWN =337,\r
  37        T_Back   =008, T_ESPACE =032, T_CTRLENT=010;\r
  38 \r
  39 Const  Larg_bot=18, (* largeur des boutons *)\r
  40        Haut_bot=18; (* hauteur des boutons *)\r
  41 \r
  42  Var   SIZEX : integer,\r
  43        SIZEY : integer;\r
  44 \r
  45 \r
  46 (* les variables du syst\8ame de fenetrage   *)\r
  47 \r
  48  Var code     : integer,\r
  49      Larg_Vil : integer,  (* largeur de la ville                          *)\r
  50      Haut_Vil : integer,  (* Hauteur de la ville                          *)\r
  51      Larg_Aff : integer,  (* largeur de l'interieur de la fenetre maine   *)\r
  52      Haut_Aff : integer,  (* hauteur de l'interieur de la fenetre maine   *)\r
  53      Xdep_Aff : integer,  (* Point de depart de l'affichage en X ds maine *)\r
  54      Ydep_Aff : integer,  (* point de depart de l'affichage en Y ds maine *)\r
  55      COEF_X   : real,     (* coeficient de zoom en x                      *)\r
  56      COEF_Y   : real,     (* coeficient de zoom en y                      *)\r
  57      COORD_X  : integer,  (* coordonn\82e en X de Xdep_Aff en relatif       *)\r
  58      COORD_Y  : integer,  (* coordonn\82e en Y de Ydep_Aff en relatif       *)\r
  59      Keys     : ListKey,\r
  60      SLKEYS   : arrayof listkey,\r
  61      SLCLICS  : arrayof cliquer,\r
  62      clics    : cliquer,\r
  63      EDIT     : editor,\r
  64      edit_bool: boolean,\r
  65      SIMULA   : simulateur,\r
  66      DOS      : MS_DOS;\r
  67  \r
  68 \r
  69 (* les variables de la simulation *)\r
  70 \r
  71  Var RaciSomm   : Sommets,\r
  72      RaciArcs   : Arcs,\r
  73      Activ      : arrayof Pointeur,  (* liste des vehicules en activite *)\r
  74      NbCarActiv : integer,\r
  75      NbMaxCar   : integer,\r
  76      NBSOMMETS  : integer,\r
  77      SimStop    : boolean;\r
  78 \r
  79 (***************************************************************************)\r
  80 (*                  Permet de cr\82er un pointeur en loglan                  *)\r
  81 (***************************************************************************)\r
  82  Unit Pointeur : class;\r
  83  End Pointeur;\r
  84 \r
  85 \r
  86 (***************************************************************************)\r
  87 (*          definition des classes et procedures de simprocess             *)\r
  88 (***************************************************************************)\r
  89 \r
  90 \r
  91 UNIT PRIORITYQUEUE: CLASS;\r
  92 \r
  93   (* HEAP AS BINARY LINKED TREE WITH FATHER LINK*)\r
  94 \r
  95 \r
  96      UNIT QUEUEHEAD: CLASS;\r
  97         (* HEAP ACCESING MODULE *)\r
  98              VAR LAST,ROOT:NODE;\r
  99  \r
 100              UNIT MIN: FUNCTION: ELEM;\r
 101                   BEGIN\r
 102                 IF ROOT=/= NONE THEN RESULT:=ROOT.EL FI;\r
 103                  END MIN;\r
 104  \r
 105              UNIT INSERT: PROCEDURE(R:ELEM);\r
 106                (* INSERTION INTO HEAP *)\r
 107                    VAR X,Z:NODE;\r
 108                  BEGIN\r
 109                        X:= R.LAB;\r
 110                        IF LAST=NONE THEN\r
 111                          ROOT:=X;\r
 112                          ROOT.LEFT,ROOT.RIGHT,LAST:=ROOT\r
 113                        ELSE\r
 114                          IF LAST.NS=0 THEN\r
 115                            LAST.NS:=1;\r
 116                            Z:=LAST.LEFT;\r
 117                            LAST.LEFT:=X;\r
 118                            X.UP:=LAST;\r
 119                            X.LEFT:=Z;\r
 120                            Z.RIGHT:=X;\r
 121                          ELSE\r
 122                            LAST.NS:=2;\r
 123                            Z:=LAST.RIGHT;\r
 124                            LAST.RIGHT:=X;\r
 125                            X.RIGHT:=Z;\r
 126                            X.UP:=LAST;\r
 127                            Z.LEFT:=X;\r
 128                            LAST.LEFT.RIGHT:=X;\r
 129                            X.LEFT:=LAST.LEFT;\r
 130                            LAST:=Z;\r
 131                          FI\r
 132                        FI;\r
 133                        CALL CORRECT(R,FALSE)\r
 134                        END INSERT;\r
 135 \r
 136 UNIT DELETE: PROCEDURE(R: ELEM);\r
 137      VAR X,Y,Z:NODE;\r
 138      BEGIN\r
 139      X:=R.LAB;\r
 140      Z:=LAST.LEFT;\r
 141      IF LAST.NS =0 THEN\r
 142            Y:= Z.UP;\r
 143            Y.RIGHT:= LAST;\r
 144            LAST.LEFT:=Y;\r
 145            LAST:=Y;\r
 146                    ELSE\r
 147            Y:= Z.LEFT;\r
 148            Y.RIGHT:= LAST;\r
 149             LAST.LEFT:= Y;\r
 150                     FI;\r
 151        Z.EL.LAB:=X;\r
 152        X.EL:= Z.EL;\r
 153        LAST.NS:= LAST.NS-1;\r
 154        R.LAB:=Z;\r
 155        Z.EL:=R;\r
 156        IF X.LESS(X.UP) THEN CALL CORRECT(X.EL,FALSE)\r
 157                        ELSE CALL CORRECT(X.EL,TRUE) FI;\r
 158      END DELETE;\r
 159 \r
 160 UNIT CORRECT: PROCEDURE(R:ELEM,DOWN:BOOLEAN);\r
 161    (* CORRECTION OF THE HEAP WITH STRUCTURE BROKEN BY R *)\r
 162      VAR X,Z:NODE,T:ELEM,FIN,LOG:BOOLEAN;\r
 163      BEGIN\r
 164      Z:=R.LAB;\r
 165      IF DOWN THEN\r
 166           WHILE NOT FIN DO\r
 167                  IF Z.NS =0 THEN FIN:=TRUE ELSE\r
 168                       IF Z.NS=1 THEN X:=Z.LEFT ELSE\r
 169                       IF Z.LEFT.LESS(Z.RIGHT) THEN X:=Z.LEFT ELSE X:=Z.RIGHT\r
 170                        FI; FI;\r
 171                       IF Z.LESS(X) THEN FIN:=TRUE ELSE\r
 172                             T:=X.EL;\r
 173                             X.EL:=Z.EL;\r
 174                             Z.EL:=T;\r
 175                             Z.EL.LAB:=Z;\r
 176                            X.EL.LAB:=X\r
 177                       FI; FI;\r
 178                  Z:=X;\r
 179                        OD\r
 180               ELSE\r
 181     X:=Z.UP;\r
 182     IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z); FI;\r
 183     WHILE NOT LOG DO\r
 184           T:=Z.EL;\r
 185           Z.EL:=X.EL;\r
 186            X.EL:=T;\r
 187           X.EL.LAB:=X;\r
 188           Z.EL.LAB:=Z;\r
 189           Z:=X;\r
 190           X:=Z.UP;\r
 191            IF X=NONE THEN LOG:=TRUE ELSE LOG:=X.LESS(Z);\r
 192             FI;\r
 193                 OD\r
 194      FI;\r
 195  END CORRECT;\r
 196 \r
 197 END QUEUEHEAD;\r
 198 \r
 199 \r
 200      UNIT NODE: CLASS (EL:ELEM);\r
 201        (* ELEMENT OF THE HEAP *)\r
 202            VAR LEFT,RIGHT,UP: NODE, NS:INTEGER;\r
 203            UNIT LESS: FUNCTION(X:NODE): BOOLEAN;\r
 204                BEGIN\r
 205                IF X= NONE THEN RESULT:=FALSE\r
 206                          ELSE RESULT:=EL.LESS(X.EL) FI;\r
 207                END LESS;\r
 208           END NODE;\r
 209 \r
 210 \r
 211      UNIT ELEM: CLASS(PRIOR:REAL);\r
 212        (* PREFIX OF INFORMATION TO BE STORED IN NODE *)\r
 213         VAR LAB: NODE;\r
 214         UNIT VIRTUAL LESS: FUNCTION(X:ELEM):BOOLEAN;\r
 215                  BEGIN\r
 216                  IF X=NONE THEN RESULT:= FALSE ELSE\r
 217                                 RESULT:= PRIOR< X.PRIOR FI;\r
 218                  END LESS;\r
 219          BEGIN\r
 220          LAB:= NEW NODE(THIS ELEM);\r
 221          END ELEM;\r
 222 \r
 223 \r
 224 END PRIORITYQUEUE;\r
 225 \r
 226 \r
 227  \r
 228 UNIT SIMULATION: PRIORITYQUEUE CLASS;\r
 229 (* THE LANGUAGE FOR SIMULATION PURPOSES *)\r
 230  \r
 231   VAR CURR: SIMPROCESS,  (*ACTIVE PROCESS *)\r
 232       PQ:QUEUEHEAD,  (* THE TIME AXIS *)\r
 233        MAINPR: MAINPROGRAM;\r
 234  \r
 235  \r
 236       UNIT SIMPROCESS: pointeur COROUTINE;\r
 237         (* USER PROCESS PREFIX *)\r
 238              VAR EVENT,  (* ACTIVATION MOMENT NOTICE *)\r
 239                  EVENTAUX: EVENTNOTICE,\r
 240                  (* THIS IS FOR AVOIDING MANY NEW CALLS AS AN RESULT OF *)\r
 241                  (* SUBSEQUENT PASSIVATIONS AND ACTIVATIONS             *)\r
 242                  FINISH: BOOLEAN;\r
 243  \r
 244              UNIT IDLE: FUNCTION: BOOLEAN;\r
 245                    BEGIN\r
 246                    RESULT:= EVENT= NONE;\r
 247                    END IDLE;\r
 248  \r
 249              UNIT TERMINATED: FUNCTION :BOOLEAN;\r
 250                    BEGIN\r
 251                   RESULT:= FINISH;\r
 252                    END TERMINATED;\r
 253  \r
 254              UNIT EVTIME: FUNCTION: REAL;\r
 255              (* TIME OF ACTIVATION *)\r
 256                   BEGIN\r
 257                   IF IDLE THEN CALL ERROR1;\r
 258                                            FI;\r
 259                   RESULT:= EVENT.EVENTTIME;\r
 260                   END EVTIME;\r
 261  \r
 262     UNIT ERROR1:PROCEDURE;\r
 263                 BEGIN\r
 264                 ATTACH(MAIN);\r
 265                 WRITELN(" AN ATTEMPT TO ACCESS AN IDLE PROCESS TIME");\r
 266                 END ERROR1;\r
 267  \r
 268      UNIT ERROR2:PROCEDURE;\r
 269                  BEGIN\r
 270                  ATTACH(MAIN);\r
 271                  WRITELN(" AN ATTEMPT TO ACCESS A TERMINATED PROCESS TIME");\r
 272                  END ERROR2;\r
 273              BEGIN\r
 274  \r
 275              RETURN;\r
 276              INNER;\r
 277              FINISH:=TRUE;\r
 278               CALL PASSIVATE;\r
 279              CALL ERROR2;\r
 280           END SIMPROCESS;\r
 281  \r
 282  \r
 283 UNIT EVENTNOTICE: ELEM CLASS;\r
 284   (* A PROCESS ACTIVATION NOTICE TO BE PLACED ONTO THE TIME AXIS PQ *)\r
 285       VAR EVENTTIME: REAL, PROC: SIMPROCESS;\r
 286  \r
 287       UNIT VIRTUAL LESS: FUNCTION(X: EVENTNOTICE):BOOLEAN;\r
 288        (* OVERWRITE THE FORMER VERSION CONSIDERING EVENTTIME *)\r
 289                   BEGIN\r
 290                   IF X=NONE THEN RESULT:= FALSE ELSE\r
 291                   RESULT:= EVENTTIME< X.EVENTTIME OR\r
 292                   (EVENTTIME=X.EVENTTIME AND PRIOR< X.PRIOR); FI;\r
 293  \r
 294                END LESS;\r
 295     END EVENTNOTICE;\r
 296  \r
 297  \r
 298 UNIT MAINPROGRAM: SIMPROCESS CLASS;\r
 299  (* IMPLEMENTING MASTER PROGRAM AS A PROCESS *)\r
 300       BEGIN\r
 301       DO ATTACH(MAIN) OD;\r
 302       END MAINPROGRAM;\r
 303  \r
 304 UNIT TIME:FUNCTION:REAL;\r
 305  (* CURRENT VALUE OF SIMULATION TIME *)\r
 306      BEGIN\r
 307      RESULT:=CURRENT.EVTIME\r
 308      END TIME;\r
 309  \r
 310 UNIT CURRENT: FUNCTION: SIMPROCESS;\r
 311    (* THE FIRST PROCESS ON THE TIME AXIS *)\r
 312      BEGIN\r
 313      RESULT:=CURR;\r
 314      END CURRENT;\r
 315 \r
 316 UNIT SCHEDULE: PROCEDURE(P:SIMPROCESS,T:REAL);\r
 317  (* ACTIVATION OF PROCESS P AT TIME T AND DEFINITION OF "PRIOR"- PRIORITY *)\r
 318  (* WITHIN TIME MOMENT T                                                  *)\r
 319       BEGIN\r
 320       IF T<TIME THEN T:= TIME FI;\r
 321       IF P=CURRENT THEN CALL HOLD(T-TIME) ELSE\r
 322       IF P.IDLE AND P.EVENTAUX=NONE THEN (* HAS NOT BEEN SCHEDULED YET*)\r
 323                 P.EVENT,P.EVENTAUX:= NEW EVENTNOTICE(RANDOM);\r
 324                 P.EVENT.PROC:= P;\r
 325                                       ELSE\r
 326        IF P.IDLE (* P HAS ALREADY BEEN SCHEDULED *) THEN\r
 327                P.EVENT:= P.EVENTAUX;\r
 328                P.EVENT.PRIOR:=RANDOM;\r
 329                                           ELSE\r
 330    (* NEW SCHEDULING *)\r
 331                P.EVENT.PRIOR:=RANDOM;\r
 332                CALL PQ.DELETE(P.EVENT)\r
 333                                 FI; FI;\r
 334       P.EVENT.EVENTTIME:= T;\r
 335       CALL PQ.INSERT(P.EVENT) FI;\r
 336 END SCHEDULE;\r
 337  \r
 338 UNIT HOLD:PROCEDURE(T:REAL);\r
 339  (* MOVE THE ACTIVE PROCESS T MINUTES BACK ALONG PQ *)\r
 340  (* REDEFINE PRIOR                                  *)\r
 341      BEGIN\r
 342      CALL PQ.DELETE(CURRENT.EVENT);\r
 343      CURRENT.EVENT.PRIOR:=RANDOM;\r
 344      IF T<0 THEN T:=0; FI;\r
 345       CURRENT.EVENT.EVENTTIME:=TIME+T;\r
 346      CALL PQ.INSERT(CURRENT.EVENT);\r
 347      CALL CHOICEPROCESS;\r
 348      END HOLD;\r
 349  \r
 350 UNIT PASSIVATE: PROCEDURE;\r
 351   (* REMOVE THE ACTVE PROCESS FROM PQ AND ACTIVATE THE NEXT ONE *)\r
 352      BEGIN\r
 353       CALL PQ.DELETE(CURRENT.EVENT);\r
 354       CURRENT.EVENT:=NONE;\r
 355       CALL CHOICEPROCESS\r
 356      END PASSIVATE;\r
 357  \r
 358 UNIT RUN: PROCEDURE(P:SIMPROCESS);\r
 359  (* ACTIVATE P IMMEDIATELY AND DELAY THE FORMER FIRST PROCESS BY REDEFINING*)\r
 360  (* PRIOR                                                              *)\r
 361      BEGIN\r
 362      CURRENT.EVENT.PRIOR:=RANDOM;\r
 363      IF NOT P.IDLE THEN\r
 364             P.EVENT.PRIOR:=0;\r
 365             P.EVENT.EVENTTIME:=TIME;\r
 366             CALL PQ.CORRECT(P.EVENT,FALSE)\r
 367                     ELSE\r
 368       IF P.EVENTAUX=NONE THEN\r
 369             P.EVENT,P.EVENTAUX:=NEW EVENTNOTICE(0);\r
 370             P.EVENT.EVENTTIME:=TIME;\r
 371             P.EVENT.PROC:=P;\r
 372             CALL PQ.INSERT(P.EVENT)\r
 373                         ELSE\r
 374              P.EVENT:=P.EVENTAUX;\r
 375              P.EVENT.PRIOR:=0;\r
 376              P.EVENT.EVENTTIME:=TIME;\r
 377              P.EVENT.PROC:=P;\r
 378              CALL PQ.INSERT(P.EVENT);\r
 379                           FI;FI;\r
 380       CALL CHOICEPROCESS;\r
 381 END RUN;\r
 382  \r
 383 UNIT CANCEL:PROCEDURE(P: SIMPROCESS);\r
 384  (* REMOVE PROCESS P FROM PQ AND CONTINUE SIMULATION *)\r
 385    BEGIN\r
 386    IF P= CURRENT THEN CALL PASSIVATE ELSE\r
 387     CALL PQ.DELETE(P.EVENT);\r
 388     P.EVENT:=NONE;  FI;\r
 389  END CANCEL;\r
 390  \r
 391 UNIT CHOICEPROCESS:PROCEDURE;\r
 392  (* CHOOSE THE FIRST PROCESS FROM PQ TO BE ACTIVATED *)\r
 393    VAR P:SIMPROCESS;\r
 394    BEGIN\r
 395    P:=CURR;\r
 396    CURR:= PQ.MIN QUA EVENTNOTICE.PROC;\r
 397     IF CURR=NONE THEN WRITE(" ERROR IN THE HEAP"); WRITELN;\r
 398                       ATTACH(MAIN);\r
 399                  ELSE ATTACH(CURR); FI;\r
 400 END CHOICEPROCESS;\r
 401  \r
 402 BEGIN\r
 403   PQ:=NEW QUEUEHEAD;  (* SIMULATION TIME AXIS*)\r
 404   CURR,MAINPR:=NEW MAINPROGRAM;\r
 405   MAINPR.EVENT,MAINPR.EVENTAUX:=NEW EVENTNOTICE(0);\r
 406   MAINPR.EVENT.EVENTTIME:=0;\r
 407   MAINPR.EVENT.PROC:=MAINPR;\r
 408   CALL PQ.INSERT(MAINPR.EVENT);\r
 409   (* THE FIRST PROCESS TO BE ACTIVATED IS MAIN PROGRAM *)\r
 410   INNER;\r
 411   PQ:=NONE; \r
 412 END SIMULATION;\r
 413  \r
 414  \r
 415  \r
 416 UNIT LISTS:SIMULATION CLASS;\r
 417  (* WE WISH TO USE LISTS FOR QUEUEING PROCESSES DURING SIMULATION*)\r
 418  \r
 419            UNIT LINKAGE:CLASS;\r
 420             (*WE WILL USE TWO WAY LISTS *)\r
 421                 VAR SUC1,PRED1:LINKAGE;\r
 422                           END LINKAGE;\r
 423             UNIT HEAD:LINKAGE CLASS;\r
 424             (* EACH LIST WILL HAVE ONE ELEMENT ESTABLISHED *)\r
 425                       UNIT FIRST:FUNCTION:LINK;\r
 426                                  BEGIN\r
 427                              IF SUC1 IN LINK THEN RESULT:=SUC1\r
 428                                              ELSE RESULT:=NONE FI;\r
 429                                  END;\r
 430                       UNIT EMPTY:FUNCTION:BOOLEAN;\r
 431                                  BEGIN\r
 432                                  RESULT:=SUC1=THIS LINKAGE;\r
 433                                  END EMPTY;\r
 434                    BEGIN\r
 435                    SUC1,PRED1:=THIS LINKAGE;\r
 436                      END HEAD;\r
 437  \r
 438           UNIT LINK:LINKAGE CLASS;\r
 439            (* ORDINARY LIST ELEMENT PREFIX *)\r
 440                      UNIT OUT:PROCEDURE;\r
 441                               BEGIN\r
 442                               IF SUC1=/=NONE THEN\r
 443                                     SUC1.PRED1:=PRED1;\r
 444                                     PRED1.SUC1:=SUC1;\r
 445                                     SUC1,PRED1:=NONE FI;\r
 446                                END OUT;\r
 447                      UNIT INTO:PROCEDURE(S:HEAD);\r
 448                                BEGIN\r
 449  \r
 450                                CALL OUT;\r
 451                                IF S=/= NONE THEN\r
 452                                     IF S.SUC1=/=NONE THEN\r
 453                                             SUC1:=S;\r
 454                                             PRED1:=S.PRED1;\r
 455                                             PRED1.SUC1:=THIS LINKAGE;\r
 456                                             S.PRED1:=THIS LINKAGE;\r
 457                                                  FI FI;\r
 458                                   END INTO;\r
 459                   END LINK;\r
 460 \r
 461      UNIT ELEM:LINK CLASS(SPROCESS:SIMPROCESS);\r
 462      (* USER DEFINED  PROCESS WILL BE JOINED INTO LISTS  *)\r
 463                     END ELEM;\r
 464 \r
 465     END LISTS;\r
 466 \r
 467 \r
 468 \r
 469 (***************************************************************************)\r
 470 (* definition des procedures de lecture des fichiers de donn\82es et mise en *)\r
 471 (* m\82moire des structures de la ville.                                     *)\r
 472 (***************************************************************************)\r
 473 \r
 474 (***************************************************************************)\r
 475 (*                 Structure d une place de parking                        *)\r
 476 (***************************************************************************)\r
 477 \r
 478 Unit Place : class (N : integer );\r
 479 var P1 : arrayof boolean;\r
 480 Begin\r
 481    array P1 dim (1:N);\r
 482 End Place;\r
 483 \r
 484 (***************************************************************************)\r
 485 (*        Structure de la liste des arc qui peuvent etre atteind           *)\r
 486 (***************************************************************************)\r
 487 \r
 488 Unit Liste : class;\r
 489 var pointeur: Arcs,\r
 490     suivante: Liste;\r
 491 end Liste;\r
 492 \r
 493 (***************************************************************************)\r
 494 (*                         Structure des arcs                              *)\r
 495 (***************************************************************************)\r
 496 Unit Arcs : class;\r
 497 Var Numero   : integer,  (* Identification de l'arc *)\r
 498     Initial  : Sommets,  (* Sommet initial *)\r
 499     Final    : Sommets,  (* Sommet final *)\r
 500     Sens     : integer,  (* Sens de circulation *)\r
 501     Distance : integer,  (* Distance de initial a final*)\r
 502     NbvoieIF : integer,  (* Nombre de voie dans le sens 1 *)\r
 503     NbvoieFI : integer,  (* Nombre de voie dans le sens -1 *)\r
 504     Suivants : Arcs,     (* pointeur sur l'arc suivant dans la liste *)\r
 505      (* pointeur sera de type car lors des affectations *)\r
 506     occpsens : arrayof pointeur, (*si <>none alors il y a une voiture cette place*)\r
 507     occpinve : arrayof pointeur; (*en sens inverse de initial final *)\r
 508 End Arcs;\r
 509 \r
 510 (***************************************************************************)\r
 511 (*                          Structure des sommets                          *)\r
 512 (***************************************************************************)\r
 513 \r
 514 Unit Sommets : class;\r
 515 var Nom      : char,     (* Nom du sommet *) \r
 516     typecar  : integer,  (* Type carrefour 0:feu , 1:priorite , 2:stop *)\r
 517     afftype  : integer,  (* type carrefour 1..9 pour affichage *)\r
 518     Ligne    : integer,  (* Correspond a la position en Y sur ecran *)\r
 519     Colonne  : integer,  (* Correspond a la position en X sur ecran *)\r
 520     etat     : integer,  (* Etat du carrefour *)\r
 521     ptrarc   : Liste,    (* Pointeur sur la liste pointant sur les arcs *)\r
 522     suivant  : Sommets;  (* Pointeur sur les suivants *)\r
 523 End Sommets;\r
 524 \r
 525 (***************************************************************************)\r
 526 (*              Procedure creant la liste des Sommets                      *)\r
 527 (*    Ici il y a juste creation d un liste simple de sommet en mode pile   *)\r
 528 (***************************************************************************)\r
 529 \r
 530 Unit CreeSomm : procedure( f: file);\r
 531 var Noeud : Sommets,\r
 532     tampon: char,\r
 533     arret : boolean;\r
 534 \r
 535 Begin\r
 536    readln(f);\r
 537    arret := false;\r
 538    while  not arret \r
 539    do\r
 540       read(f,tampon);\r
 541       if ( tampon <> '.') then\r
 542              Noeud := new Sommets;\r
 543              NBSOMMETS:=NBSOMMETS+1; (* on comptabilise le nombre de sommets*)\r
 544              Noeud.Nom := tampon;\r
 545              read(f,Noeud.typecar);\r
 546              read(f,Noeud.afftype);\r
 547              read(f,Noeud.colonne);\r
 548              (* on met en place les variables permettant de d\82finir les coef*)\r
 549              (* de l'affichage en vectoriel                                 *)\r
 550              if(Noeud.colonne>Larg_Vil) then Larg_Vil:=Noeud.colonne; fi;\r
 551              readln(f,Noeud.ligne);\r
 552              if(Noeud.ligne>Haut_Vil) then Haut_Vil:=Noeud.ligne; fi;\r
 553              Noeud.etat := 0; (* servira pour les \82volutions futures *)\r
 554              Noeud.ptrarc := none;\r
 555              Noeud.Suivant := RaciSomm;\r
 556              RaciSomm := Noeud;\r
 557          else arret := true;\r
 558       fi\r
 559    od;\r
 560 End CreeSomm;\r
 561 \r
 562 \r
 563 (***************************************************************************)\r
 564 (* Procedure affichant chaque sommet ainsi que les arcs que l'on peut      *)\r
 565 (* prendre depuis ce sommet en considerant les sens de circulation etc...  *)\r
 566 (***************************************************************************)\r
 567 Unit ParcSomm : procedure;\r
 568 var Noeud : Sommets;\r
 569 var parcours : Liste;\r
 570 Begin\r
 571    Noeud := RaciSomm;\r
 572    while (Noeud <> none)\r
 573    do\r
 574      write("Nom: ");\r
 575      writeln(Noeud.Nom);\r
 576      writeln("X : ",Noeud.Colonne);\r
 577      writeln("Y : ",Noeud.ligne);\r
 578      parcours := Noeud.ptrarc;\r
 579      while (parcours <> none )\r
 580      do\r
 581        writeln("Arc: ",parcours.pointeur.Numero);\r
 582        parcours := parcours.suivante;\r
 583      od;\r
 584      Noeud := Noeud.suivant;\r
 585    od;\r
 586 End ParcSomm;\r
 587 \r
 588 (***************************************************************************)\r
 589 (*                      Procedure affichant chaque arc                     *)\r
 590 (***************************************************************************)\r
 591 Unit ParcArc : procedure;\r
 592 var Noeud : arcs;\r
 593 var parcours : Liste;\r
 594 Begin\r
 595    Noeud := RaciArcs;\r
 596    while (Noeud <> none)\r
 597    do\r
 598      write("Numero: ");\r
 599      write(Noeud.Numero);\r
 600      write(" Sommet initial: ");\r
 601      write(Noeud.initial.nom);\r
 602      write(" Sommet final: ");\r
 603      write(Noeud.final.nom);\r
 604      write(" Distance: ");\r
 605      writeln(Noeud.Distance);\r
 606      Noeud := Noeud.suivants;\r
 607    od;\r
 608 End ParcArc;\r
 609 \r
 610 \r
 611 (***************************************************************************)\r
 612 (*              Procedure creant la liste des Arc                          *)\r
 613 (* Ici on cree la liste des Arc sur la base d'une pile, puis il y a        *)\r
 614 (* rattachement des pointeurs final et initial avec la liste des sommets   *)\r
 615 (* et ce grace a la procedure rattache.                                    *)           \r
 616 (***************************************************************************)\r
 617 \r
 618 Unit CreeArcs : procedure( f: file);\r
 619 var Noeud : Arcs;\r
 620 var aux1 : char,\r
 621     aux2 : char,\r
 622     aux3 : char;\r
 623 Begin\r
 624    readln(f);\r
 625    readln(f);\r
 626    while ( not(eof(f)))\r
 627    do\r
 628       Noeud := new Arcs;\r
 629       read(f,Noeud.Numero);\r
 630       read(f,aux3);\r
 631       read(f,aux1);\r
 632       read(f,aux3);\r
 633       read(f,aux2);\r
 634       read(f,aux3);\r
 635       read(f,Noeud.Sens);\r
 636       read(f,Noeud.distance);\r
 637       (* on va supposer qu'il y a toujours 2 voies, une dans chaque sens *)\r
 638       array Noeud.occpsens dim (1:Noeud.distance); (* on met la voie en place*)\r
 639       array Noeud.occpinve dim (1:Noeud.distance);\r
 640       read(f,Noeud.NbvoieIF);\r
 641       readln(f,Noeud.NbvoieFI);\r
 642       Noeud.Initial := none;\r
 643       Noeud.Final := none;\r
 644       Noeud.Suivants:= RaciArcs;\r
 645       RaciArcs := Noeud;\r
 646       Call rattache(Noeud,aux1,aux2);\r
 647    od;\r
 648 End CreeArcs;\r
 649 \r
 650 (***************************************************************************)\r
 651 (*             Rattachement du pointeur arc avec le sommet                 *)\r
 652 (* Cette procedure rattache les pointeurs final et initial des arcs avec   *)\r
 653 (* un sommet de la liste des sommets.                                      *)\r
 654 (* Puis il y a la procedure creant la liste des arcs que l'on peut         *)\r
 655 (* emprunter depuis ce sommet. Cette procedure est appele ici.             *) \r
 656 (* Pour l appelle de cette procedure RattaListe nous verifions le sens de  *)\r
 657 (* circulation dans les arcs, en effet des arcs ne peuvent pas etre pris a *)\r
 658 (* partir de certain sommets, donc il ne doivent pas figurer dans cette    *)\r
 659 (* liste( Sens interdits ).                                                *)\r
 660 (***************************************************************************)\r
 661 Unit Rattache : procedure ( inout  Noeud : Arcs ; aux1,aux2:char);\r
 662 var Parcours : Sommets;\r
 663 \r
 664 begin\r
 665    Parcours := RaciSomm;\r
 666    while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))\r
 667    do\r
 668       Parcours := Parcours.suivant;\r
 669    od;\r
 670    if Parcours.Nom = aux1\r
 671       then\r
 672         Noeud.Initial := Parcours;\r
 673         if Noeud.Sens <> -1\r
 674         then\r
 675             Call rattaListe(Parcours,Noeud);\r
 676         fi;\r
 677       else if Parcours.Nom = aux2  \r
 678                 then\r
 679                    Noeud.Final := Parcours;         \r
 680                    if Noeud.Sens <> 1\r
 681                    then\r
 682                        Call rattaListe(Parcours,Noeud);\r
 683                    fi\r
 684                 else\r
 685                     write("ERREUR de rattachement initial");\r
 686                     exit;\r
 687            fi;\r
 688    fi;\r
 689    Parcours := Parcours.suivant;\r
 690    while((Parcours<>none) and (Parcours.Nom<>aux1) and (Parcours.Nom<>aux2))\r
 691    do\r
 692       Parcours := Parcours.suivant;\r
 693    od;\r
 694    if Parcours.Nom = aux1\r
 695       then\r
 696          Noeud.Initial := Parcours;         \r
 697          if Noeud.Sens <> -1\r
 698          then\r
 699               Call rattaListe(Parcours,Noeud);\r
 700          fi;\r
 701       else if Parcours.Nom = aux2  \r
 702                 then\r
 703                     Noeud.final := parcours;\r
 704                     if Noeud.Sens <> 1\r
 705                     then\r
 706                          Call rattaListe(Parcours,Noeud);\r
 707                     fi;\r
 708                 else\r
 709                    write("ERREUR de rattachement du final");\r
 710            fi;\r
 711    fi;\r
 712 end rattache;\r
 713 \r
 714 (***************************************************************************)\r
 715 (*  Rattachement des sommets a la liste des arc qui peuvent etres atteinds *)\r
 716 (***************************************************************************)\r
 717 Unit RattaListe : procedure (inout NoeudSom : sommets; NoeudArc : Arcs);\r
 718 var Noeud : Liste;\r
 719 \r
 720 begin\r
 721   Noeud := new Liste;\r
 722   Noeud.suivante := NoeudSom.ptrarc;\r
 723   Noeud.pointeur := NoeudArc;\r
 724   NoeudSom.ptrarc := Noeud;\r
 725 End RattaListe;\r
 726 \r
 727 \r
 728 (***************************************************************************)\r
 729 (*           Procedure de lecture de la ville appell\82e par bo_load         *)\r
 730 (***************************************************************************)\r
 731 \r
 732 Unit Lit_Ville : procedure( fenet : Windows; a : arrayof char);\r
 733 var fichier  : file,\r
 734     flagbool : boolean;\r
 735 begin\r
 736    Larg_Vil:=0;\r
 737    Haut_Vil:=0;\r
 738    NBSOMMETS:=0;\r
 739    open (fichier,text,a);\r
 740    call color(VertClair);\r
 741    flagbool:=fenet.outgtext(".",1);\r
 742    call reset (fichier);\r
 743    call color(VertClair);\r
 744    flagbool:=fenet.outgtext("..",2);\r
 745    Call CreeSomm(fichier);\r
 746    call color(VertClair);\r
 747    flagbool:=fenet.outgtext("..",2);\r
 748    Call CreeArcs(fichier);\r
 749    call color(VertClair);\r
 750    flagbool:=fenet.outgtext("..",2);\r
 751 end Lit_Ville;\r
 752 \r
 753 (***************************************************************************)\r
 754 (*          definition des procedures d'utilitaires graphiques             *)\r
 755 (***************************************************************************)\r
 756 \r
 757 (***************************************************************************)\r
 758 (*        trace une ligne entre 2 points, change la position courante      *)\r
 759 (***************************************************************************)\r
 760    Unit Line : procedure (x1,y1,x2,y2,c : integer);\r
 761    Begin\r
 762       call color(c);\r
 763       call move(x1,y1);\r
 764       call draw(x2,y2);\r
 765    End Line;\r
 766 \r
 767 (***************************************************************************)\r
 768 (* tracer d'une ligne de pointill\82s, ne fonctionne qu'en horiz ou en verti *)\r
 769 (***************************************************************************)\r
 770    Unit Linep : procedure (x1,y1,x2,y2,c,s :integer);\r
 771    Var i :integer;\r
 772    Begin (* ne fonctionne que pour des horizontales ou des verticales *)\r
 773     if (x1=x2)\r
 774     then for i:=y1 step s*2 to y2 \r
 775          do\r
 776           call line(x1,i,x1,i+s,c);\r
 777          od;\r
 778     else if (y1=y2)\r
 779          then for i:=x1 step s*2 to x2 \r
 780               do\r
 781                call line(i,y1,i+s,y1,c);\r
 782               od;\r
 783          fi;\r
 784     fi;\r
 785    End linep;\r
 786 \r
 787 (***************************************************************************)\r
 788    Unit Rectangle : procedure (x1,y1,x2,y2,c : integer);\r
 789    Begin\r
 790     call color(c);\r
 791     call move(x1,y1);\r
 792     call draw(x2,y1);\r
 793     call draw(x2,y2);\r
 794     call draw(x1,y2);\r
 795     call draw(x1,y1);\r
 796    End Rectangle;\r
 797 \r
 798 (***************************************************************************)\r
 799 (*                   tracer d'un rectangle plein                           *)\r
 800 (***************************************************************************)\r
 801    Unit Rectanglef : procedure (x1,y1,x2,y2,c : integer);\r
 802    var i : integer;\r
 803    Begin\r
 804     for i:=imin(y1,y2) to imax(y1,y2)\r
 805     do\r
 806       call Line(x1,i,x2,i,c);\r
 807     od\r
 808    End Rectanglef;\r
 809 \r
 810 (****************************************************************************)\r
 811 (*     Lecture d'une touche (bloquant) en affichant un curseur clignotant   *)\r
 812 (***************************************************************************)\r
 813    Unit Readcara : function (x,y,col_f,col_e : integer) : integer;\r
 814    Var i    : integer,\r
 815       sx,sy : integer;\r
 816    Begin\r
 817     sx:=x;\r
 818     sy:=y;\r
 819     i:=inkey;\r
 820     while i=0\r
 821      do\r
 822       call color(col_f);\r
 823       call move(x,y);\r
 824       call outstring("_");\r
 825       for i:=1 to 300 do od;\r
 826       call color(col_e);\r
 827       call move(x,y);\r
 828       call outstring("_");\r
 829       for i:=1 to 100 do od;\r
 830       i:=inkey;\r
 831      od;\r
 832      call color(col_f);\r
 833      call move(x,y);\r
 834      call outstring("_");\r
 835      call move(sx,sy);\r
 836      call color(col_e);\r
 837      result:=i;\r
 838    End Readcara;\r
 839 \r
 840 (****************************************************************************)\r
 841 (*   lecture d'un entier en mode graphique, esc revient au debut de saisie  *)\r
 842 (*  l'entier doit se trouver dans une plage d\82finie par rangmin et rangmax  *)\r
 843 (****************************************************************************)\r
 844    Unit gscanf_num : function (rangmin,rangmax : integer) : integer;\r
 845    Var valeur : integer,\r
 846        sauvx  : integer,\r
 847        sauvy  : integer,\r
 848        flag   : integer;\r
 849    Begin\r
 850      sauvx:=inxpos;\r
 851      sauvy:=inypos;\r
 852      do\r
 853        valeur:=0;\r
 854        do\r
 855         flag:=readcara(inxpos,inypos,Noir,BleuClair);\r
 856         if (flag>=48 and flag<=57)\r
 857         then valeur:=valeur*10+flag-48;\r
 858              call move(inxpos,inypos);\r
 859              call hascii(flag);\r
 860         fi;\r
 861         if (flag=13) then exit; fi;\r
 862         if (flag=27)                          (* on a demand\82 annulation *)\r
 863         then valeur:=0;\r
 864              call rectanglef(sauvx-1,sauvy-1,inxpos,sauvy+13,Noir);\r
 865              call color(BleuClair);\r
 866              call move(sauvx,sauvy);\r
 867         fi;\r
 868        od;\r
 869       if (valeur>=rangmin and valeur<=rangmax)\r
 870       then exit;\r
 871       else call rectanglef(sauvx-1,sauvy-1,inxpos,sauvy+13,Noir);\r
 872            call color(BleuClair);\r
 873            call move(sauvx,sauvy);\r
 874       fi;\r
 875      od;\r
 876      result:=valeur;\r
 877    End gscanf_num;\r
 878 \r
 879 (****************************************************************************)\r
 880 (*  lecture d'une chaine en mode graphique, esc revient au debut de saisie  *)\r
 881 (****************************************************************************)\r
 882    Unit gscanf_char : function (x,y,larg : integer;inout nbmax : integer) : arrayof char;\r
 883    Var depx,posx   : integer,\r
 884        rep         : integer,\r
 885        col_e,col_f : integer,\r
 886        resultat    : arrayof char; \r
 887 \r
 888     Unit affiche : procedure;\r
 889     Var i :integer;\r
 890     Begin\r
 891      call Rectanglef(x-1,y-1,x+larg*8,y+14,col_f);\r
 892      for i:=depx to posx\r
 893       do\r
 894        call move(x+(i-depx)*8,y);\r
 895        call hascii(ord(resultat(i)));\r
 896       od;\r
 897     End;\r
 898 \r
 899    Begin\r
 900     call hidecursor;\r
 901     array resultat dim (0:nbmax);\r
 902     resultat(0):=chr(0);\r
 903     col_f:=BleuClair;\r
 904     col_e:=Noir;\r
 905     depx:=0;\r
 906     posx:=0;\r
 907     call affiche;\r
 908     do\r
 909      do\r
 910       if depx=0\r
 911       then rep:=readcara(x+posx*8,y,col_f,col_e);\r
 912       else rep:=readcara(x+(larg-1)*8,y,col_f,col_e);\r
 913       fi;\r
 914       if ((rep>=32 and rep<=122) or rep=T_Back or rep=Tou_Ent)\r
 915       then exit;\r
 916       fi;\r
 917      od;\r
 918       if (rep>=32 and rep<=122)\r
 919       then resultat(posx):=chr(rep);\r
 920            posx:=posx+1;\r
 921            if posx>=nbmax\r
 922            then posx:=posx-1;\r
 923            else if posx>=larg\r
 924                 then depx:=depx+1;\r
 925                 fi;\r
 926            fi;\r
 927            call affiche;\r
 928       else if rep=Tou_ent\r
 929            then exit;\r
 930            else posx:=posx-1;\r
 931                 if posx<0 then posx:=0; fi;\r
 932                 resultat(posx):=chr(0);\r
 933                 depx:=depx-1;\r
 934                 if depx<0 then depx:=0; fi;\r
 935                 call affiche;\r
 936            fi;\r
 937       fi;\r
 938     od;\r
 939     nbmax:=posx;\r
 940     call showcursor;\r
 941     result:=resultat;\r
 942    End gscanf_char;\r
 943 \r
 944 \r
 945 (****************************************************************************)\r
 946 (*          affiche un entier en mode graphique, maximum 10 chiffres        *)\r
 947 (****************************************************************************)\r
 948 unit writint : procedure( valeur : integer);\r
 949 var flag,i : integer;\r
 950 var tbl    : arrayof integer;\r
 951 begin\r
 952   array tbl dim (1:10);\r
 953   flag:=1;                                  (* on 'empile' en ordre reverse *)\r
 954   while valeur<>0\r
 955   do\r
 956    tbl(flag):=valeur mod 10;\r
 957    valeur:=valeur div 10;\r
 958    flag:=flag+1\r
 959   od;\r
 960   for i:=flag-1 downto 1                    (* on affiche dans le bon ordre *)\r
 961   do\r
 962    call hascii(48+tbl(i))\r
 963   od\r
 964 end writint;\r
 965 \r
 966 \r
 967 \r
 968 (***************************************************************************)\r
 969 (*                definition des classes d'\82l\82ments des listes             *)\r
 970 (***************************************************************************)\r
 971         \r
 972    Unit Elmt : class(id : integer);\r
 973    End Elmt;\r
 974         \r
 975    Unit elm : Elmt class(x1,y1,x2,y2 :integer);\r
 976    End elm;\r
 977 \r
 978 (***************************************************************************)\r
 979 (*                   definition de la classe Bottons                       *)\r
 980 (***************************************************************************)\r
 981    \r
 982    Unit Bottons : Elmt class(touche,x1,y1,x2,y2 : integer);  \r
 983                                (* x2-x1 et y2-y1 doit au mini etre de 8*)\r
 984       (*  x1,y1   : integer  coordonn\82es du point haut gauche          *)\r
 985       (*  x2,y2   : integer  coordonn\82es du point bas droit            *)\r
 986    Var etat    : boolean; (* true si bouton enable                     *)\r
 987    \r
 988         Unit affiche : procedure;\r
 989         Begin\r
 990           call Line(x1,y1,x2,y1,Blanc);                 (* Lignes en blanc *) \r
 991           call Line(x1,y1+1,x2-1,y1+1,Blanc);\r
 992           call Line(x1,y1,x1,y2,Blanc);\r
 993           call Line(x1+1,y1+2,x1+1,y2-1,Blanc);\r
 994           call Line(x1+1,y2,x2,y2,GrisFonce);      (* Lignes en gris fonce *)\r
 995           call Line(x1+2,y2-1,x2,y2-1,GrisFonce);\r
 996           call Line(x2,y2,x2,y1+1,GrisFonce);\r
 997           call Line(x2-1,y2-1,x2-1,y1+2,GrisFonce);\r
 998           call Rectanglef(x1+2,y1+2,x2-2,y2-2,GrisClair); (* centre en gris *)\r
 999           call AfficheSuite;\r
1000         End affiche;\r
1001 \r
1002         Unit virtual AfficheSuite : procedure;\r
1003         End;\r
1004 \r
1005         Unit virtual bot_enable : procedure;\r
1006         End;\r
1007 \r
1008         Unit virtual bot_disable : procedure;\r
1009         End;\r
1010    \r
1011    End Bottons;\r
1012 \r
1013 (***************************************************************************)\r
1014 (*            definition de la classe Menu derivant de Bottons             *)\r
1015 (***************************************************************************)\r
1016    \r
1017    Unit Menu : Bottons class;\r
1018    Var cnom    : integer, (* couleur du nom du bouton                  *) \r
1019        nom     : string;  (* nom du bouton                             *)\r
1020         \r
1021         Unit affiche_nom : procedure;\r
1022         Begin \r
1023           call move(x1+5,y1+(y2-y1)/4-1);\r
1024           call color(cnom);\r
1025           call outstring(nom);\r
1026         End affiche_nom;\r
1027 \r
1028         Unit virtual bot_enable : procedure;\r
1029         var e : elm;\r
1030         Begin\r
1031          cnom:=RougeClair;\r
1032          e:=new elm(id,x1,y1,x2,y2);\r
1033          call clics.Insert(e);\r
1034          if (touche<>-1)\r
1035          then call Keys.Insert(new elmt(touche));\r
1036          fi;\r
1037          call affiche_nom;\r
1038         End bot_enable;\r
1039 \r
1040         Unit virtual bot_disable : procedure;\r
1041         var e : elm;\r
1042         Begin\r
1043          cnom:=Rouge;\r
1044          e:=new elm(id,x1,y1,x2,y2);\r
1045          call clics.Delete(e);\r
1046          if (touche<>-1)\r
1047          then call Keys.delete(new elmt(touche));\r
1048          fi;\r
1049          call affiche_nom;\r
1050         End bot_disable;\r
1051 \r
1052         Unit virtual AfficheSuite : procedure;\r
1053         Begin\r
1054           if (etat) \r
1055           then call bot_enable;\r
1056           else call bot_disable;\r
1057           fi;\r
1058         End AfficheSuite;\r
1059 \r
1060    End Menu;\r
1061 \r
1062 (***************************************************************************)\r
1063 (*            definition de la classe Racc derivant de Bottons             *)\r
1064 (* la procedure sprite permet d'afficher le sprite correspondant au bouton *)\r
1065 (***************************************************************************)\r
1066    Unit Racc : Bottons class (procedure sprite(x1,y1,x2,y2,col :integer));\r
1067 \r
1068         Unit virtual bot_enable : procedure;\r
1069         var e : elm;\r
1070         Begin \r
1071          e:=new elm(id,x1,y1,x2,y2);\r
1072          call clics.Insert(e);\r
1073          if (touche<>-1) (* si une touche a \82t\82 d\82finie pour ce bouton *)\r
1074          then call Keys.Insert(new elmt(touche));\r
1075          fi;\r
1076         End bot_enable;\r
1077 \r
1078         Unit virtual bot_disable : procedure;\r
1079         var e : elm;\r
1080         Begin \r
1081          e:=new elm(id,x1,y1,x2,y2);\r
1082          call clics.Delete(e);\r
1083          if (touche<>-1) (* si une touche a \82t\82 d\82finie pour ce bouton *)\r
1084          then call Keys.delete(new elmt(touche));\r
1085          fi;\r
1086         End bot_disable;\r
1087 \r
1088         Unit virtual AfficheSuite : procedure;\r
1089         Begin\r
1090          if etat\r
1091          then call bot_enable;\r
1092               call sprite(x1,y1,x2,y2,Noir);\r
1093          else call bot_disable;\r
1094               call sprite(x1,y1,x2,y2,GrisFonce);\r
1095          fi;\r
1096         End AfficheSuite;\r
1097 \r
1098    End Racc;\r
1099 \r
1100 (***************************************************************************)\r
1101 (*                       definition de la classe Windows                   *)\r
1102 (***************************************************************************)\r
1103    \r
1104    Unit Windows : class(numero,x1,y1,x2,y2,lborder : integer; \r
1105                         r1,r2,r3 : boolean);   \r
1106    hidden x,y,xp,yp;   \r
1107                            (* x2-x1 et y2-y1 doit au mini etre 33      *)\r
1108    Var cborder : integer,  (* couleur du pourtour                      *)\r
1109        cnom    : integer,  (* couleur du nom de la fenetre             *)\r
1110        nom     : string,   (* nom de la fenetre, sera affich\82 en haut  *)\r
1111        Bout    : ListBot,  (* liste des boutons rattaches              *)\r
1112        Hauteur : integer,  (* hauteur de la bande                      *)\r
1113        Largeur : integer,  (* largeur des raccourcis                   *)\r
1114        cbande  : integer,  (* couleur de la bande                      *)\r
1115        WhereXd : integer,  (* position en x de depart dans la fenetre  *)\r
1116        WhereX  : integer,  (* position courante en X dans la fenetre   *)\r
1117        WhereYd : integer,  (* position en y de depart dans la fenetre  *)\r
1118        WhereY  : integer;  (* position courante en Y dans la fenetre   *)\r
1119    var B       : arrayof Racc, (* variables locales *)\r
1120        x,y     : integer,\r
1121        xp,yp   : integer,\r
1122        map     : arrayof integer, (* pour le getmap du dessous *)\r
1123        savmap  : arrayof integer; (* pour le getmap du dessus *)\r
1124         \r
1125        Unit affiche : procedure;\r
1126        var i : integer; \r
1127         Begin\r
1128          call move(x1,y1);\r
1129          map:=getmap(x2,y2);\r
1130          call rectanglef(x1,y1,x2,y2,Noir);\r
1131          for i:=0 to lborder\r
1132          do\r
1133           call rectangle(x1+i,y1+i,x2-i,y2-i,cborder);\r
1134          od;\r
1135          call Line(x1+16,y1,x1+16,y1+lborder,Noir);  (* Lignes noires *)\r
1136          call Line(x2-16,y1,x2-16,y1+lborder,Noir);\r
1137          call Line(x1+16,y2,x1+16,y2-lborder,Noir);\r
1138          call Line(x2-16,y2,x2-16,y2-lborder,Noir);\r
1139          call Line(x1,y1+16,x1+lborder,y1+16,Noir);\r
1140          call Line(x1,y2-16,x1+lborder,y2-16,Noir);\r
1141          call Line(x2,y1+16,x2-lborder,y1+16,Noir);\r
1142          call Line(x2,y2-16,x2-lborder,y2-16,Noir);\r
1143          call Rectanglef(x1+lborder+1,y1+lborder+1,x2-lborder-1,\r
1144                          y1+lborder+hauteur+1,cbande);\r
1145          call move(x1+(x2-x1)/3,y1+lborder+hauteur/4);\r
1146          call color(cnom);\r
1147          call outstring(nom);\r
1148          call AffSuite;\r
1149          call move(x1,y1);\r
1150          savmap:=getmap(x2,y2);\r
1151         End affiche;\r
1152    \r
1153         Unit virtual AffSuite : procedure;\r
1154         End AffSuite;\r
1155 \r
1156         Unit restore : procedure;\r
1157         Begin\r
1158          call move(x1,y1);\r
1159          call putmap(map);\r
1160          kill(map);\r
1161         End restore;\r
1162 \r
1163         Unit virtual clear : procedure;\r
1164         End clear;\r
1165         \r
1166         (* gestionnaire d'\82v\82nement de la fenetre *)\r
1167         Unit gestionnaire : function : integer;\r
1168         Var  l,r,c : boolean,\r
1169              x,y   : integer,\r
1170              rep   : integer,\r
1171              nbbot : integer;\r
1172         Begin\r
1173         do\r
1174           call getpress(0,x,y,nbbot,l,r,c);\r
1175           if (l) and (clics<>none)\r
1176           then result:=clics.Appartient(x,y); exit;\r
1177           fi;\r
1178           rep:=inkey;\r
1179           if (rep>=97 and rep<=122) (* passe les lettres en majuscule *)\r
1180           then rep:=rep-32;\r
1181           fi;\r
1182           if keys.Appartient(rep)\r
1183           then result:=rep; exit;\r
1184           fi;\r
1185    (* ligne rajoutee pour que cela ne soit pas bloquant pdt la simulation *)\r
1186           if not SimStop then exit fi;\r
1187          od;\r
1188         End gestionnaire;\r
1189 \r
1190         (* permet de se deplacer dans la fenetre *)\r
1191         Unit moveto : function (x,y :integer) : boolean;\r
1192         Begin\r
1193           if (x>0 and x<(x2-x1)) and (y>0 and y<y2-y1)\r
1194           then WhereX:=WhereXd+x;\r
1195                WhereY:=WhereYd+y;\r
1196                call move(WhereX,WhereY);\r
1197                result:=True;\r
1198           else result:=False;\r
1199           fi;\r
1200         End moveto;\r
1201 \r
1202         (* affichage d'une chaine de longueur connue 'long' *)\r
1203         Unit outgtext : function (chaine : string; long : integer) : boolean;\r
1204         Begin\r
1205          if (long*8+WhereX)<(x2-lborder-5)\r
1206          then call move(WhereX,WhereY);\r
1207               call outstring(chaine);\r
1208               WhereX:=WhereX+long*8;\r
1209               if WhereX>= x2-lborder-16\r
1210               then WhereX:=WhereXd;\r
1211                    WhereY:=WhereY+16;\r
1212               fi;\r
1213               result:=True;\r
1214          else result:=False;\r
1215          fi;\r
1216         End outgtext;\r
1217 \r
1218         (* affichage d'un caract\8are *)\r
1219         Unit outchar : function (tmp : char) : boolean;\r
1220         Begin\r
1221          if (10+WhereX)<(x2-lborder-5-largeur)\r
1222          then call move(WhereX,WhereY);\r
1223               call hascii(ord(tmp));\r
1224               WhereX:=WhereX+10;\r
1225               if WhereX>= x2-lborder-16-largeur\r
1226               then WhereX:=WhereXd;\r
1227                    WhereY:=WhereY+16;\r
1228               fi;\r
1229               result:=True;\r
1230          else result:=False;\r
1231          fi;\r
1232         End outchar;\r
1233 \r
1234    Begin\r
1235     \r
1236     Bout:=new ListBot; (* liste des boutons rattach\82s *)\r
1237     \r
1238     array B dim (0:2);\r
1239 \r
1240     x:=x2-Larg_bot-lborder-1;\r
1241     y:=y1+lborder+1;\r
1242     xp:=x2-lborder-1;\r
1243     yp:=y+Haut_bot;\r
1244     B(2):=new Racc(numero+3,-1,x,y,xp,yp,spr_upper);\r
1245     B(2).etat:=r3;\r
1246     call Bout.Insert(B(2));\r
1247    \r
1248     xp:=x-1;\r
1249     x:=xp-Larg_bot;\r
1250     B(1):=new Racc(numero+2,-1,x,y,xp,yp,spr_lower);\r
1251     B(1).etat:=r2;\r
1252     call Bout.Insert(B(1));\r
1253    \r
1254     x:=x1+lborder+1;\r
1255     xp:=x+Larg_bot;\r
1256     B(0):=new Racc(numero+1,-1,x,y,xp,yp,spr_close);\r
1257     B(0).etat:=r1;\r
1258     call Bout.Insert(B(0));\r
1259 \r
1260    End Windows;\r
1261 \r
1262 (***************************************************************************)\r
1263 (*            definition de main d\82rivant de la classe Windows             *)\r
1264 (***************************************************************************)\r
1265    \r
1266    Unit Maine : Windows class;\r
1267    var icname  : string,   (* nom une fois iconise                     *)\r
1268        Lwind   : ListW,    (* liste des fenetres filles                *)\r
1269        Horiz   : AccelerateH, (* accelerateur horizontal               *)\r
1270        Verti   : AccelerateV1; (* accelerateur vertical                 *)\r
1271 \r
1272        Unit virtual AffSuite : procedure;\r
1273         Begin\r
1274          call Rectanglef(x1+lborder+1,y1+lborder+hauteur+3,\r
1275                          x2-lborder-1,y1+lborder+2*(hauteur+2),cbande);\r
1276          if (Horiz<>none)\r
1277          then call Horiz.affiche;\r
1278          fi;\r
1279          if (Verti<>none)\r
1280          then call Verti.affiche;\r
1281          fi;\r
1282          Bout.Courant:=Bout.head;\r
1283          while(Bout.Courant<>none)\r
1284           do\r
1285            call Bout.Courant.data qua Bottons.affiche;\r
1286            Bout.Courant:=Bout.Courant.next;\r
1287           od;\r
1288          call Keys.Insert(new elmt(T_ALTF4)); (* alt/f4 pour quitter *)\r
1289          call Keys.Insert(new elmt(T_SHFTF4)); (* shift/f4 pour about *)\r
1290          call Keys.Insert(new elmt(T_CTRLF4)); (* ctrl/f4 pour iconify *)\r
1291         End AffSuite;\r
1292 \r
1293         Unit virtual clear : procedure;\r
1294         Var xf,yf : integer;\r
1295         Begin\r
1296          if Verti<>none then xf:=Verti.x1-1;\r
1297          else xf:=x2-lborder-1;\r
1298          fi;\r
1299          if Horiz<>none then yf:=Horiz.y1-1;\r
1300          else yf:=y2-lborder-1;\r
1301          fi;\r
1302          call Rectanglef(x1+lborder+1,y1+lborder+2*(hauteur+2)+1,xf,yf,Noir);\r
1303          WhereX:=WhereXd;\r
1304          WhereY:=WhereYd;\r
1305         end;\r
1306 \r
1307         Unit iconify : procedure;\r
1308         var i     : integer,\r
1309             l,r,c : boolean,\r
1310             x,y   : integer,\r
1311             nboot : integer,\r
1312             rep   : integer,\r
1313             sclic : cliquer,\r
1314             mmap  : arrayof integer;\r
1315 \r
1316         Begin\r
1317           call move(x1,y1);\r
1318           mmap:=getmap(x2,y2);\r
1319           call move(1,1);\r
1320           call putmap(this maine qua windows.map);\r
1321           sclic:=clics;\r
1322           clics:=none;\r
1323           call rectangle(1,SIZEY-40,40,SIZEY,BleuClair);\r
1324           call rectangle(2,SIZEY-39,39,SIZEY-1,BleuClair);\r
1325           call move(5,SIZEY-20);\r
1326           call outstring(icname);\r
1327           call showcursor;\r
1328           do\r
1329             call getpress(0,x,y,nboot,l,r,c);\r
1330             if l \r
1331             then if(x>=1 and x<=40 and y<=SIZEY and y>=SIZEY-40)\r
1332                  then exit;\r
1333                  fi;\r
1334             fi;\r
1335             rep:=inkey;\r
1336             if (rep=13)   (* validation *)\r
1337             then exit;\r
1338             fi;\r
1339           od;\r
1340           call hidecursor;\r
1341           kill(clics);\r
1342           clics:=sclic;\r
1343           call move(1,1);\r
1344           call putmap(mmap);\r
1345           kill(mmap);\r
1346         End iconify;\r
1347 \r
1348    Begin\r
1349     WhereXd:=x1+lborder+5;\r
1350     WhereYd:=y1+lborder+2*(Haut_Bot+2)+5+8;\r
1351     WhereX:=WhereXd;\r
1352     WhereY:=WhereYd;\r
1353    End Maine;\r
1354 \r
1355 (***************************************************************************)\r
1356 (*    definition de la classe Son d\82rivant des classes Windows et elmt     *)\r
1357 (***************************************************************************)\r
1358    \r
1359    Unit Son : Windows coroutine;\r
1360    Var aa      : Elmt,\r
1361        Horiz   : AccelerateH, (* accelerateur horizontal               *)\r
1362        Verti   : AccelerateV1; (* accelerateur vertical                 *)\r
1363    \r
1364         Unit virtual AffSuite : procedure;\r
1365         Begin\r
1366          if Horiz<>none\r
1367          then call Horiz.affiche;\r
1368          fi;\r
1369          if Verti<>none\r
1370          then call Verti.affiche;\r
1371          fi;\r
1372          Bout.Courant:=Bout.Head;\r
1373          while(Bout.Courant<>none)\r
1374          do\r
1375           call Bout.Courant.data qua Bottons.affiche;\r
1376           Bout.Courant:=bout.Courant.next;\r
1377          od;\r
1378          call AffSuite1;\r
1379         End AffSuite;\r
1380 \r
1381         Unit virtual AffSuite1 : procedure;\r
1382         End AffSuite1;\r
1383 \r
1384         Unit virtual clear : procedure;\r
1385         Var xf,yf : integer;\r
1386         Begin\r
1387          if Verti<>none then xf:=Verti.x1-1;\r
1388          else xf:=x2-lborder-1;\r
1389          fi;\r
1390          if Horiz<>none then yf:=Horiz.y1-1;\r
1391          else yf:=y2-lborder-1;\r
1392          fi;\r
1393          call Rectanglef(x1+lborder+1,y1+lborder+(hauteur+1)+1,xf,yf,Noir);\r
1394          WhereX:=WhereXd;\r
1395          WhereY:=WhereYd;\r
1396         end;\r
1397        \r
1398    Begin\r
1399      return;\r
1400      pref Elmt(0) block\r
1401      begin\r
1402        aa:=this Elmt;\r
1403        WhereXd:=x1+lborder+5;\r
1404        WhereYd:=y1+lborder+(Haut_Bot+1)+5+8;\r
1405        WhereX:=WhereXd;\r
1406        WhereY:=WhereYd;\r
1407        detach;\r
1408      end\r
1409    End Son;\r
1410 \r
1411 (***************************************************************************)\r
1412 (*      definition de la classe dialogue d\82rivant de la classe Son         *)\r
1413 (***************************************************************************)\r
1414    \r
1415    Unit Dialogue : Son coroutine;\r
1416    Var ok, cancel : Menu,\r
1417        nomfic     : arrayof char,\r
1418        lgnomfic   : integer,\r
1419        flagbool   : boolean,\r
1420        temp       : file,\r
1421        pwd        : arrayof char,\r
1422        rep,i,j    : integer,\r
1423        lgpwd      : integer,\r
1424        fichiers   : liste_chaine,\r
1425        nbfichiers : integer,\r
1426        tampon     : arrayof arrayof char,\r
1427        creation   : boolean; (* true si le fichier doit \88tre cr\82\82 *)\r
1428 \r
1429      \r
1430       Unit virtual AffSuite1 : procedure;\r
1431       var j : integer;\r
1432       Begin \r
1433        call color(RougeClair);\r
1434        flagbool:=moveto(5,1);\r
1435        flagbool:=outgtext("Nom du fichier:",15);\r
1436        flagbool:=moveto(175,1);\r
1437        flagbool:=outgtext("Repertoires:",12);\r
1438        flagbool:=moveto(175,18);\r
1439        if lgpwd<13\r
1440        then for j:=0 to lgpwd \r
1441              do\r
1442               flagbool:=outchar(pwd(j));\r
1443              od;\r
1444        else for j:=0 to 2\r
1445              do\r
1446                flagbool:=outchar(pwd(j));\r
1447              od;\r
1448             flagbool:=outchar('.');\r
1449             flagbool:=outchar('.');\r
1450             flagbool:=outchar('.');\r
1451             for j:=lgpwd-8 to lgpwd\r
1452              do\r
1453               flagbool:=outchar(pwd(j));\r
1454              od;\r
1455        fi;\r
1456        call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);\r
1457        call clics.insert(new elm(512,x1+9,y1+52,x1+147,y1+66));\r
1458        call rectangle(x1+18,y1+70,x1+147,y1+150,BleuClair);\r
1459        call affiche_fic(0);\r
1460        if nbfichiers>5\r
1461        then verti:=new accelerateV1(520,-1,x1+148,y1+70,x1+164,y1+150,this windows);\r
1462             call verti.affiche;\r
1463             Bout.courant:=Bout.head;\r
1464             while(Bout.Courant<>none)\r
1465              do\r
1466               call Bout.courant.data qua Bottons.affiche;\r
1467               Bout.courant:=Bout.courant.next;\r
1468              od;\r
1469        fi;\r
1470       End AffSuite1;\r
1471 \r
1472       Unit affiche_fic : procedure (depuis : integer);\r
1473       Var i,j : integer;\r
1474       Begin\r
1475         call rectanglef(x1+19,y1+71,x1+146,y1+149,Noir);\r
1476         call color(BleuClair);\r
1477         fichiers.depl:=fichiers.root;\r
1478         for i:=1 to depuis\r
1479          do\r
1480           fichiers.depl:=fichiers.depl.ptr;\r
1481          od;\r
1482         (* on est positionn\82 sur le premier *)\r
1483         for j:=0 to imin(4,nbfichiers-depuis-1)\r
1484          do\r
1485           flagbool:=moveto(15,39+j*15);\r
1486           call clics.insert(new elm(j+1,x1+20,y1+72+j*15,x1+147,y1+72+(j+1)*15));\r
1487           tampon(j):=copy(fichiers.depl.data);\r
1488           for i:=0 to 11\r
1489            do\r
1490             if fichiers.depl.data(i)=chr(0) then exit fi;\r
1491             flagbool:=outchar(fichiers.depl.data(i));\r
1492            od;\r
1493           fichiers.depl:=fichiers.depl.ptr;\r
1494          od;\r
1495       End affiche_fic;\r
1496 \r
1497       Unit Lecture : function : boolean;\r
1498       Var rep          : integer,  \r
1499           depuis       : integer;\r
1500        \r
1501        Unit Aff_nom : procedure;\r
1502        Var i : integer;\r
1503        Begin\r
1504         call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);\r
1505         nomfic:=copy(tampon(rep-1));\r
1506         for i:=0 to upper(tampon(rep-1))\r
1507          do\r
1508           if tampon(rep-1,i)=chr(0) then exit fi;\r
1509           flagbool:=moveto(3+i*8,18);\r
1510           flagbool:=outchar(tampon(rep-1,i));\r
1511          od;\r
1512        End Aff_nom;\r
1513 \r
1514        Unit Veux_creation : function : boolean;\r
1515        Const Largeur=320,\r
1516              Hauteur=100;\r
1517        Var x,y,code     : integer,\r
1518            Posx,Posy    : integer,\r
1519            fille        : son,\r
1520            fille_yes    : Menu,\r
1521            fille_no     : Menu,\r
1522            skey         : listkey,\r
1523            sclic        : cliquer,\r
1524            flagbool     : boolean;\r
1525        \r
1526        Begin\r
1527          x:=(x2-x1-largeur)/2;\r
1528          y:=(y2-y1-hauteur)/2;\r
1529          Posx:=x1+x;\r
1530          Posy:=y1+y;\r
1531          sclic:=clics;\r
1532          clics:=new cliquer;\r
1533          skey:=keys;\r
1534          keys:=new listkey;\r
1535          fille:=new Son(20,Posx,Posy,Posx+Largeur,Posy+hauteur,2,\r
1536                    True,False,False);\r
1537          attach(fille);\r
1538          fille.hauteur:=Haut_Bot;\r
1539          fille.cborder:=RougeClair;\r
1540          fille.cbande:=Rouge;\r
1541          call color(RougeClair);\r
1542          fille_Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);\r
1543          fille_Yes.nom:="Yes";\r
1544          fille_Yes.etat:=True;\r
1545          call fille.Bout.Insert(fille_Yes);\r
1546          fille_No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);\r
1547          fille_No.nom:="No";\r
1548          fille_No.etat:=True;\r
1549          call fille.Bout.Insert(fille_No);\r
1550          call keys.insert(new elmt(T_ESC));\r
1551          call hidecursor;\r
1552          call fille.affiche;       \r
1553          flagbool:=fille.outgtext(" File not found : Do you want to creat",30);\r
1554          call showcursor;\r
1555          do\r
1556           code:=fille.gestionnaire;\r
1557           case code\r
1558            when T_ESC : result:=false; exit;\r
1559            when T_N   : result:=false; exit;\r
1560            when T_Y   : result:=true; exit;\r
1561            when 1     : result:=true; exit; (* menu yes *)\r
1562            when 2     : result:=false; exit; (* menu no *)\r
1563            when 11    : result:=false; exit; (*racc exit *)\r
1564           esac; \r
1565          od;\r
1566          call hidecursor;\r
1567          call fille.restore;\r
1568          attach(fille);\r
1569          kill(fille);\r
1570          kill(keys);\r
1571          keys:=skey;\r
1572          kill(clics);\r
1573          clics:=sclic;\r
1574          call showcursor;\r
1575        End Veux_creation;\r
1576 \r
1577       Begin\r
1578        do\r
1579         rep:=gestionnaire;\r
1580         if rep=512 or rep=T_ESPACE (* zone clics pr entr\82e clavier nomfichier *)\r
1581         then lgnomfic:=80;\r
1582              nomfic:=gscanf_char(x1+10,y1+52,17,lgnomfic);\r
1583              if nomfic(0)=chr(0)\r
1584              then call hidecursor;\r
1585                   call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);\r
1586                   call showcursor;\r
1587                   call ok.bot_disable;\r
1588              else if not fichiers.appartient(nomfic)\r
1589                   then if Veux_creation\r
1590                        then result:=true;\r
1591                             creation:=true;\r
1592                             exit;\r
1593                        else call hidecursor;\r
1594                             call rectanglef(x1+9,y1+51,x1+147,y1+66,BleuClair);\r
1595                             call showcursor;\r
1596                             nomfic(0):=chr(0);\r
1597                             call ok.bot_disable;\r
1598                        fi;\r
1599                   else call ok.bot_enable;\r
1600                   fi;\r
1601              fi;\r
1602         else if rep>=1 and rep<=5\r
1603              then call aff_nom;\r
1604                   call ok.bot_enable;\r
1605              else if rep=510 or rep=Tou_Ent\r
1606                   then result:=true; exit;\r
1607                   else if rep=511  or rep=T_ESC\r
1608                        then result:=false; exit;\r
1609                        else if rep=521 or rep=T_FLHAU (* il y a plus de 5 fichiers : up *)\r
1610                             then depuis:=depuis-1;\r
1611                                  if depuis<0 then depuis:=0; fi;\r
1612                                  call affiche_fic(depuis);\r
1613                             else if rep=523 or rep=T_FLBAS(*  down *)\r
1614                                  then depuis:=depuis+1; \r
1615                                       if depuis>(nbfichiers-4)\r
1616                                       then depuis:=nbfichiers-4;\r
1617                                       fi;\r
1618                                       call affiche_fic(depuis);\r
1619                                  fi;\r
1620                             fi;\r
1621                        fi;\r
1622                   fi;\r
1623              fi;\r
1624         fi;\r
1625        od;\r
1626       End Lecture;\r
1627 \r
1628       Unit liste_chaine : class;\r
1629       Var root : node,\r
1630           depl : node, (* pour les parcours *)\r
1631           cour : node;\r
1632 \r
1633         Unit node : class;\r
1634         Var data : arrayof char,\r
1635             ptr  : node;\r
1636         End node;\r
1637 \r
1638         Unit appartient : function (a : arrayof char) : boolean;\r
1639         Var fl :boolean;  \r
1640         \r
1641           Unit egalite : function (a,b : arrayof char) :boolean;\r
1642           Var i,j : integer;\r
1643 \r
1644             Unit toupper : function (a : char) : char;\r
1645             Begin\r
1646              if (ord(a)>=97 and ord(a)<=122)\r
1647              then result:=chr(ord(a)-32);\r
1648              else result:=a;\r
1649              fi;\r
1650             End toupper;\r
1651 \r
1652           Begin\r
1653            result:=true;\r
1654            i:=0;\r
1655            while i<=upper(a)\r
1656             do\r
1657              if toupper(a(i))<>toupper(b(i))\r
1658              then result:=false;\r
1659                   exit;\r
1660              fi;\r
1661              i:=i+1;\r
1662              if a(i)=chr(0) then exit; fi;\r
1663             od\r
1664           End egalite;\r
1665 \r
1666         Begin\r
1667          depl:=root;\r
1668          fl:=false;\r
1669          call move(10,400);\r
1670          while (not(fl) and depl<>none)\r
1671           do\r
1672            fl:=egalite(a,depl.data);\r
1673            depl:=depl.ptr;\r
1674           od;\r
1675           result:=fl; \r
1676         End appartient;\r
1677 \r
1678         Unit insert : procedure (a : arrayof char);\r
1679         Var nouveau : node;\r
1680         Begin\r
1681          nouveau:=new node;\r
1682          nouveau.data:=copy(a);\r
1683          if root=none\r
1684          then root:=nouveau;\r
1685               cour:=root;\r
1686          else cour.ptr:=nouveau;\r
1687               cour:=nouveau;\r
1688          fi;\r
1689         End insert;\r
1690       \r
1691       End liste_chaine;\r
1692 \r
1693    Begin\r
1694      return;\r
1695     (* on va maintenant lire le pwd  et le mettre dans la variable pwd *)\r
1696      rep:=exec(unpack("cd > simula.tmp"));\r
1697      open(temp,text,unpack("simula.tmp"));\r
1698      call reset(temp);\r
1699      i:=0;\r
1700      array pwd dim (0:256);\r
1701      lgnomfic:=256;\r
1702      array nomfic dim (0:lgnomfic);\r
1703      while (not(eof(temp)) and i<=256)\r
1704       do\r
1705        read(temp,pwd(i));\r
1706        i:=i+1;\r
1707       od;\r
1708      lgpwd:=i-2;  (* -1 pour le i:=i+1 en trop + -1 pour le RC *)\r
1709      call unlink(temp);\r
1710      rep:=exec(unpack("dir *.dat /a /b > simula.tmp")); \r
1711      open(temp,text,unpack("simula.tmp"));\r
1712      call reset(temp);\r
1713      fichiers:=new liste_chaine;\r
1714      while not(eof(temp))\r
1715       do\r
1716        i:=0;\r
1717         do\r
1718           read(temp,nomfic(i));\r
1719           if nomfic(i)=' ' then nomfic(i):=chr(0); fi;\r
1720           if nomfic(i)=chr(10) or eof(temp)\r
1721           then nomfic(i):=chr(0);\r
1722                exit\r
1723           else i:=i+1;\r
1724           fi;\r
1725         od;\r
1726         call fichiers.insert(nomfic);\r
1727         nbfichiers:=nbfichiers+1;\r
1728       od;\r
1729      call unlink(temp);\r
1730      array tampon dim (0:5);\r
1731      for i:=0 to 5\r
1732       do\r
1733        array tampon(i) dim (0:15);\r
1734       od;\r
1735      ok:=new menu(510,Tou_Ent,x2-56,y1+30,x2-16,y1+30+Haut_Bot);\r
1736      ok.nom:=" Ok ";\r
1737      ok.etat:=False;\r
1738      call Bout.insert(ok);\r
1739      cancel:=new menu(511,T_ESC,x2-66,y1+60,x2-8,y1+60+Haut_Bot);\r
1740      cancel.nom:="Cancel";\r
1741      cancel.etat:=True;\r
1742      call Bout.insert(cancel);\r
1743      call Keys.insert(new elmt(T_ESPACE));\r
1744      detach;\r
1745    End Dialogue;\r
1746 \r
1747 \r
1748 (***************************************************************************)\r
1749 (*    definition de Accelerate d\82rivant des classes Windows et Bottons     *)\r
1750 (***************************************************************************)\r
1751    \r
1752    Unit Accelerate : Bottons class(mother : Windows);\r
1753    Var Bs   : arrayof Racc,\r
1754        PosX : integer,\r
1755        PosY : integer,\r
1756        LX,LY: integer,\r
1757        C    : integer;  (* valeur du pas d'affichage *)\r
1758        \r
1759         Unit virtual AfficheSuite : procedure;  (* descend de bottons *)\r
1760         End AfficheSuite;\r
1761        \r
1762         Unit virtual bot_enable : procedure;\r
1763         Begin\r
1764          call mother.Bout.Insert(Bs(1));\r
1765          call mother.Bout.Insert(Bs(3));\r
1766          call bot_enable_suite;\r
1767          etat:=True;\r
1768         End bot_enable;\r
1769 \r
1770         Unit virtual bot_enable_suite : procedure;\r
1771         End bot_enable_suite;\r
1772 \r
1773         Unit virtual bot_disable : procedure;\r
1774         Begin\r
1775          call mother.Bout.Delete(Bs(1));\r
1776          call mother.Bout.Delete(Bs(3));\r
1777          call bot_disable_suite;\r
1778          etat:=False;\r
1779         End bot_disable;\r
1780 \r
1781         Unit virtual bot_disable_suite : procedure;\r
1782         End bot_disable_suite;\r
1783 \r
1784         Unit virtual Deplacer : procedure( i :integer);\r
1785         End Deplacer;\r
1786   \r
1787         Unit virtual Reset_Bot : procedure;\r
1788         End Reset_Bot;\r
1789 \r
1790    Begin  \r
1791     C:=5; (* valeur par defaut *)\r
1792     inner;\r
1793     call bot_enable;\r
1794    End Accelerate;\r
1795 \r
1796 (***************************************************************************)\r
1797 (*             definition de AccelerateH d\82rivant de Accelerate            *)\r
1798 (***************************************************************************)\r
1799 \r
1800    Unit AccelerateH : Accelerate class;\r
1801    Var x    : integer,     \r
1802        MaxX : integer,\r
1803        MinX : integer;\r
1804    \r
1805         Unit virtual bot_enable_suite : procedure;\r
1806         Begin\r
1807          call mother.bout.insert(Bs(2));\r
1808         End bot_enable_suite;\r
1809         \r
1810         Unit virtual bot_disable_suite : procedure;\r
1811         Begin\r
1812          call mother.bout.delete(Bs(2));\r
1813         End bot_disable_suite;\r
1814         \r
1815         Unit virtual AfficheSuite : procedure;  (* descend de bottons *)\r
1816         Begin\r
1817          call Rectanglef(x1+18,y1+3,x2-18,y2-3,Noir);\r
1818          MaxX:=x2-18-LX;\r
1819          MinX:=x1+18;\r
1820         End AfficheSuite;\r
1821 \r
1822         Unit DeplacerLeft : procedure;\r
1823         var e : elm;\r
1824         Begin\r
1825          call Bs(2).bot_disable;\r
1826          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1827          PosX:=PosX-C;\r
1828          if PosX<MinX\r
1829          then PosX:=MinX;\r
1830               Bs(1).etat:=False;\r
1831               call Bs(1).bot_disable;\r
1832          fi;\r
1833          if not (Bs(3).etat)\r
1834          then Bs(3).etat:=True;\r
1835               call Bs(3).bot_enable;\r
1836          fi; \r
1837          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
1838          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
1839          call Bs(2).affiche;\r
1840         End DeplacerLeft;\r
1841         \r
1842         Unit virtual Deplacer : procedure (x : integer);\r
1843         Begin\r
1844          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1845          PosX:=x;\r
1846          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
1847          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
1848          call Bs(2).affiche;\r
1849         End Deplacer;\r
1850 \r
1851         Unit DeplacerRight : procedure;\r
1852         var e : elm;\r
1853         Begin\r
1854          call Bs(2).bot_disable;\r
1855          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1856          PosX:=PosX+C;\r
1857          if PosX>MaxX\r
1858          then PosX:=MaxX;\r
1859               Bs(3).etat:=False;\r
1860               call Bs(3).bot_disable;\r
1861          fi;\r
1862          if not (Bs(1).etat)\r
1863          then Bs(1).etat:=True;\r
1864               call Bs(1).bot_enable;\r
1865          fi;  \r
1866          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
1867          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
1868          call Bs(2).affiche;\r
1869         End DeplacerRight;\r
1870 \r
1871         Unit virtual Reset_Bot : procedure;\r
1872         Begin\r
1873          call Bs(2).bot_disable;\r
1874          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1875          x:=(x2-x1)/2;\r
1876          PosX:=x-5;\r
1877          PosY:=y1+3;\r
1878          LX:=11;\r
1879          LY:=y2-y1-6;\r
1880          Bs(2).x1:=PosX;\r
1881          Bs(2).y1:=PosY;\r
1882          Bs(2).x2:=PosX+LX;\r
1883          Bs(2).y2:=PosY+LY;\r
1884          call Bs(2).affiche;\r
1885         End Reset_Bot;\r
1886 \r
1887     Begin  \r
1888       array Bs dim (1:3);\r
1889       Bs(1):=new Racc(id+1,T_FLDTE,x1+2,y1+2,x1+15,y1+15,spr_right);\r
1890       Bs(1).etat:=True;\r
1891       x:=(x2-x1)/2;\r
1892       PosX:=x-5;\r
1893       PosY:=y1+3;\r
1894       LX:=11;\r
1895       LY:=y2-y1-6;\r
1896       Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);\r
1897       Bs(2).etat:=True;\r
1898       Bs(3):=new Racc(id+3,T_FLGCH,x2-15,y2-16,x2-2,y2-3,spr_left);\r
1899       Bs(3).etat:=True;\r
1900    End AccelerateH;\r
1901 \r
1902 (***************************************************************************)\r
1903 (*             definition de AccelerateV1 d\82rivant de Accelerate           *)\r
1904 (***************************************************************************)\r
1905 \r
1906    Unit AccelerateV1 : Accelerate class;\r
1907    Var y    : integer,\r
1908        MaxY : integer,\r
1909        MinY : integer;     \r
1910 \r
1911         Unit virtual AfficheSuite : procedure;  (* descend de bottons *)\r
1912         Begin\r
1913          call Rectanglef(x1+3,y1+18,x2-3,y2-18,Noir);\r
1914          MaxY:=y2-18-LY;\r
1915          MinY:=y1+18;\r
1916         End AfficheSuite;\r
1917         \r
1918         Unit virtual bot_enable_suite : procedure;\r
1919         End bot_enable_suite;\r
1920       \r
1921         Unit virtual bot_disable_suite : procedure;\r
1922         End bot_disable_suite;\r
1923 \r
1924         Unit virtual DeplacerUp : procedure;\r
1925         var e : elm;\r
1926         Begin\r
1927          PosY:=PosY-C;\r
1928          if PosY<MinY\r
1929          then PosY:=MinY;\r
1930               Bs(1).etat:=False;\r
1931               call Bs(1).bot_disable;\r
1932          fi;\r
1933          if not (Bs(3).etat)\r
1934          then Bs(3).etat:=True;\r
1935               call Bs(3).bot_enable;\r
1936          fi; \r
1937         End DeplacerUp;\r
1938 \r
1939         Unit virtual Deplacer : procedure (y : integer);\r
1940         End Deplacer;\r
1941         \r
1942         Unit virtual DeplacerDown : procedure;\r
1943         var e : elm;\r
1944         Begin\r
1945          PosY:=PosY+C;\r
1946          if PosY>MaxY\r
1947          then PosY:=MaxY;\r
1948               Bs(3).etat:=False;\r
1949               call Bs(3).bot_disable;\r
1950          fi;\r
1951          if not (Bs(1).etat)\r
1952          then Bs(1).etat:=True;\r
1953               call Bs(1).bot_enable;\r
1954          fi; \r
1955         End DeplacerDown;\r
1956 \r
1957         Unit virtual Reset_Bot : procedure;\r
1958         End Reset_Bot;\r
1959 \r
1960    Begin\r
1961       array Bs dim (1:3);\r
1962       Bs(1):=new Racc(id+1,T_FLHAU,x1+2,y1+2,x1+15,y1+15,spr_upper);\r
1963       Bs(1).etat:=True;\r
1964       y:=(y2-y1)/2;\r
1965       PosX:=x1+3;\r
1966       PosY:=y-5;\r
1967       LX:=x2-x1-6;\r
1968       LY:=11;\r
1969       inner;\r
1970       Bs(3):=new Racc(id+3,T_FLBAS,x2-15,y2-16,x2-2,y2-3,spr_lower);\r
1971       Bs(3).etat:=True;\r
1972    End AccelerateV1;\r
1973 \r
1974 (***************************************************************************)\r
1975 (*             definition de AccelerateV2 d\82rivant de AccelerateV1         *)\r
1976 (***************************************************************************)\r
1977 \r
1978    Unit AccelerateV2 : AccelerateV1 class;\r
1979 \r
1980         Unit virtual bot_enable_suite : procedure;\r
1981         Begin\r
1982          call mother.bout.insert(Bs(2));\r
1983         End bot_enable_suite;\r
1984         \r
1985         Unit virtual bot_disable_suite : procedure;\r
1986         Begin\r
1987          call mother.bout.delete(Bs(2));\r
1988         End bot_disable_suite;\r
1989         \r
1990         Unit virtual DeplacerUp : procedure;\r
1991         var e : elm;\r
1992         Begin\r
1993          call Bs(2).bot_disable;\r
1994          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
1995          PosY:=PosY-C;\r
1996          if PosY<MinY\r
1997          then PosY:=MinY;\r
1998               Bs(1).etat:=False;\r
1999               call Bs(1).bot_disable;\r
2000          fi;\r
2001          if not (Bs(3).etat)\r
2002          then Bs(3).etat:=True;\r
2003               call Bs(3).bot_enable;\r
2004          fi; \r
2005          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
2006          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
2007          call Bs(2).affiche;\r
2008         End DeplacerUp;\r
2009 \r
2010         Unit virtual Deplacer : procedure (y : integer);\r
2011         Begin\r
2012          if y>=MinY and y<=MaxY\r
2013          then call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
2014               PosY:=y;\r
2015               Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
2016               Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
2017               call Bs(2).affiche;\r
2018          fi;\r
2019         End Deplacer;\r
2020         \r
2021         Unit virtual DeplacerDown : procedure;\r
2022         var e : elm;\r
2023         Begin\r
2024          call Bs(2).bot_disable;\r
2025          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
2026          PosY:=PosY+C;\r
2027          if PosY>MaxY\r
2028          then PosY:=MaxY;\r
2029               Bs(3).etat:=False;\r
2030               call Bs(3).bot_disable;\r
2031          fi;\r
2032          if not (Bs(1).etat)\r
2033          then Bs(1).etat:=True;\r
2034               call Bs(1).bot_enable;\r
2035          fi; \r
2036          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
2037          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
2038          call Bs(2).affiche;\r
2039         End DeplacerDown;\r
2040 \r
2041         Unit virtual Reset_Bot : procedure;\r
2042         Begin\r
2043          call Bs(2).bot_disable;\r
2044          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
2045          y:=(y2-y1)/2;\r
2046          PosX:=x1+3;\r
2047          PosY:=y-5;\r
2048          LX:=x2-x1-6;\r
2049          LY:=11;\r
2050          Bs(2).x1:=PosX;\r
2051          Bs(2).y1:=PosY;\r
2052          Bs(2).x2:=PosX+LX;\r
2053          Bs(2).y2:=PosY+LY;\r
2054          call Bs(2).affiche;\r
2055         End Reset_Bot;\r
2056 \r
2057    Begin\r
2058       Bs(2):=new Racc(id+2,-1,PosX,PosY,PosX+LX,PosY+LY,spr_point);\r
2059       Bs(2).etat:=True;\r
2060    End AccelerateV2;\r
2061 \r
2062 (***************************************************************************)\r
2063 (*          definition de la classe Ensemble (c'est une liste)             *)\r
2064 (***************************************************************************)\r
2065 \r
2066    Unit Ensemble : class;\r
2067    Var Head    : Node,\r
2068        Courant : Node,\r
2069        Last    : Node;\r
2070 \r
2071         Unit Node : class(data : elmt);\r
2072         Var next  : Node;\r
2073         End Node;\r
2074         \r
2075         Unit virtual egalite : function (x,y : elmt) :boolean;\r
2076         End egalite;\r
2077 \r
2078         Unit Empty : function : boolean;        \r
2079         Begin\r
2080          if Head=none\r
2081          then result:=True;\r
2082          else result:=False;\r
2083          fi;\r
2084         End;\r
2085 \r
2086         Unit Member : function (n : elmt) : boolean;\r
2087         Var bl      : boolean,\r
2088             saveCou : Node;\r
2089         Begin\r
2090          Courant:=Head;\r
2091          saveCou:=Courant;\r
2092          bl:=False;\r
2093          While (Courant<>none)\r
2094           do\r
2095            if not egalite(Courant.data,n)\r
2096            then saveCou:=Courant; Courant:=Courant.next;\r
2097            else bl:=True; exit;\r
2098            fi;\r
2099           od;\r
2100          Courant:=SaveCou;\r
2101          result:=bl;\r
2102         End Member;\r
2103 \r
2104         Unit Insert : procedure (n : elmt);\r
2105         Var bl : boolean;\r
2106         Begin\r
2107          bl:=Member(n);\r
2108          if not bl\r
2109          then if Empty\r
2110               then Head:=new Node(n); Last:=Head;\r
2111               else Last.next:=new Node(n);\r
2112                    Last:=Last.next;\r
2113               fi;\r
2114          fi;\r
2115         End Insert;\r
2116 \r
2117         Unit Delete : procedure (n : elmt);\r
2118         Var bl   : boolean,\r
2119             flag : Node;\r
2120         Begin \r
2121          bl:=Member(n);\r
2122          if bl\r
2123          then flag:=Courant.next; \r
2124               if flag=Last\r
2125               then Last:=Courant; courant.next:=none; kill(flag);\r
2126               else if Courant.next<>none \r
2127                    then Courant.next:=Courant.next.next; kill(flag);\r
2128                    fi;\r
2129               fi;\r
2130          fi;\r
2131         End Delete;\r
2132 \r
2133    End Ensemble;\r
2134         \r
2135 (***************************************************************************)\r
2136 (*      definition de la classe cliquer derivant de la classe ensemble     *) \r
2137 (***************************************************************************)\r
2138    \r
2139    Unit cliquer : Ensemble class;        \r
2140    \r
2141         Unit virtual egalite : function (x,y : elmt) : boolean;\r
2142         Begin\r
2143          if (x.id)=(y.id)\r
2144          then result:=True;\r
2145          else result:=False;\r
2146          fi;\r
2147         End egalite;\r
2148         \r
2149         Unit Appartient : function(x,y : integer) : integer;\r
2150         var bl : boolean;\r
2151         Begin\r
2152           bl:=False;\r
2153           Courant:=Head;\r
2154           while (Courant<>none)\r
2155           do\r
2156            if(x<(Courant.data qua elm.x2) and x>(Courant.data qua elm.x1) and \r
2157               y<(Courant.data qua elm.y2) and y>(Courant.data qua elm.y1))\r
2158            then bl:=True; exit;\r
2159            else Courant:=Courant.next;\r
2160            fi;\r
2161           od;\r
2162           if bl\r
2163           then result:=Courant.data qua elm.id;\r
2164           else result:=-1;\r
2165           fi;\r
2166         End Appartient;\r
2167 \r
2168    End cliquer;\r
2169 \r
2170 (***************************************************************************)\r
2171 (*          definition de la classe Listbot d\82rivant de ensemble           *)\r
2172 (***************************************************************************)\r
2173    \r
2174    Unit Listbot : Ensemble class;\r
2175 \r
2176         Unit virtual egalite : function (x,y : elmt) : boolean;\r
2177         Begin\r
2178          if (x.id) = (y.id)\r
2179          then result:=True;\r
2180          else result:=False;\r
2181          fi;\r
2182         End egalite;\r
2183 \r
2184    End Listbot;\r
2185 \r
2186 (***************************************************************************)\r
2187 (*          definition de la classe ListKey d\82rivant de ensemble           *)\r
2188 (***************************************************************************)\r
2189    \r
2190    Unit ListKey : Ensemble class;\r
2191 \r
2192         Unit virtual egalite : function (x,y : elmt) : boolean;\r
2193         Begin\r
2194          if (x.id) = (y.id)\r
2195          then result:=True;\r
2196          else result:=False;\r
2197          fi;\r
2198         End egalite;\r
2199 \r
2200         Unit Appartient : function(x : integer) : boolean;\r
2201         var bl : boolean;\r
2202         Begin\r
2203           bl:=False;\r
2204           Courant:=Head;\r
2205           while (Courant<>none)\r
2206           do\r
2207            if(Courant.data.id = x)\r
2208            then bl:=True; exit;\r
2209            else Courant:=Courant.next;\r
2210            fi;\r
2211           od;\r
2212           result:=bl;\r
2213         End Appartient;\r
2214 \r
2215    End ListKey;\r
2216 \r
2217 (***************************************************************************)\r
2218 (*           definition de la classe ListW d\82rivant de ensemble            *)\r
2219 (***************************************************************************)\r
2220  \r
2221    Unit ListW : Ensemble class;\r
2222 \r
2223         Unit virtual egalite : function (x,y : elmt) : boolean;\r
2224         Begin\r
2225      (*    if (x qua Son.numero) = (y qua Son.numero)\r
2226          then result:=True;\r
2227          else result:=False;\r
2228          fi; *)\r
2229         End egalite;\r
2230 \r
2231    End ListW;\r
2232 \r
2233 (***************************************************************************)\r
2234 (*             procedure d'affichage des sprites des boutons               *)\r
2235 (***************************************************************************)\r
2236 \r
2237 (***************************************************************************)\r
2238    Unit spr_upper : procedure(x1,y1,x2,y2,couleur : integer);\r
2239    var i,x,y : integer;\r
2240    Begin\r
2241     x:=(x2-x1)/2;\r
2242     y:=(y2-y1)/2;\r
2243     for i:=1 to y\r
2244     do\r
2245      call Line(x1+x-i/2,y1+y/2+i,x1+x+i/2,y1+y/2+i,couleur);\r
2246     od\r
2247    End spr_upper;\r
2248 \r
2249 (***************************************************************************)\r
2250    Unit spr_lower : procedure(x1,y1,x2,y2,couleur : integer);\r
2251    var i,x,y : integer;\r
2252    Begin\r
2253     x:=(x2-x1)/2;\r
2254     y:=(y2-y1)/2;\r
2255     for i:=1 to y\r
2256     do\r
2257      call Line(x1+x-i/2,y2-y/2-i,x1+x+i/2,y2-y/2-i,couleur);\r
2258     od\r
2259    End spr_lower;\r
2260 \r
2261 (***************************************************************************)\r
2262    Unit spr_left : procedure(x1,y1,x2,y2,couleur : integer);\r
2263    var i,x,y : integer;\r
2264    Begin\r
2265     x:=(x2-x1)/2;\r
2266     y:=(y2-y1)/2;\r
2267     for i:=1 to x\r
2268     do\r
2269      call Line(x2-x/2-i,y1+y-i/2,x2-x/2-i,y1+y+i/2,couleur);\r
2270     od\r
2271    End spr_left;\r
2272 \r
2273 (***************************************************************************)\r
2274    Unit spr_right : procedure(x1,y1,x2,y2,couleur : integer);\r
2275    var i,x,y : integer;\r
2276    Begin\r
2277     x:=(x2-x1)/2;\r
2278     y:=(y2-y1)/2;\r
2279     for i:=1 to x\r
2280     do\r
2281      call Line(x1+x/2+i,y1+y-i/2,x1+x/2+i,y1+y+i/2,couleur);\r
2282     od\r
2283    End spr_right;\r
2284 \r
2285 (***************************************************************************)\r
2286    Unit spr_close : procedure(x1,y1,x2,y2,couleur : integer);\r
2287    var y : integer;\r
2288    Begin\r
2289     y:=(y2-y1)/2;\r
2290     call Rectanglef(x1+3,y1+y-1,x2-3,y1+y+1,couleur);\r
2291    End spr_close;\r
2292 \r
2293 (***************************************************************************)\r
2294    Unit spr_point : procedure(x1,y1,x2,y2,couleur : integer);;\r
2295    var x,y : integer;\r
2296    Begin\r
2297     y:=(y2-y1)/2;\r
2298     x:=(x2-x1)/2;\r
2299     call Rectanglef(x1+x-1,y1+y-1,x1+x+1,y1+y+1,couleur);\r
2300    End spr_point;\r
2301 \r
2302 \r
2303 (***************************************************************************)\r
2304 (***************************************************************************)\r
2305 (*                    PROGRAMME NUMERO 1 : SIMULATEUR                      *)\r
2306 (***************************************************************************)\r
2307 (***************************************************************************)\r
2308 Unit simulateur : Logiciel coroutine;\r
2309 \r
2310 var    prg    : prog,    (* programme principal, g\82r\82 par des simprocess *)\r
2311        fin    : boolean,\r
2312        x1,y1  : integer,\r
2313        x2,y2  : integer,\r
2314        ZOOM   : integer, (* coeficient de zoom *)\r
2315        C      : integer, (* largeur des voies *)\r
2316        M      : arrayof Menu,\r
2317        boolAf : boolean; (* vrai si il faut afficher la ville *)\r
2318 \r
2319 (***************************************************************************)\r
2320    Unit Bot_Load : procedure;\r
2321    Const Largeur1=400,\r
2322          Hauteur1=180,\r
2323          Largeur2=340,\r
2324          Hauteur2=100;\r
2325    Var   fenet1    : Dialogue,\r
2326          fenet2    : Son,\r
2327          x,y,i     : integer,\r
2328          code      : integer,\r
2329          flagbool  : boolean,\r
2330          sclic     : cliquer,\r
2331          skey      : listkey;\r
2332 \r
2333    Begin\r
2334     x:=(W.x2-W.x1)/2;\r
2335     y:=(W.y2-W.y1)/2;\r
2336     sclic:=clics;\r
2337     clics:=new cliquer;\r
2338     skey:=keys;\r
2339     keys:=new listkey;\r
2340     fenet1:=new dialogue(10,x-Largeur1/2,y-Hauteur1/2,x+Largeur1/2,y+Hauteur1/2,\r
2341                    2,False,False,False);\r
2342     attach(fenet1);\r
2343     attach(fenet1);\r
2344     fenet1.hauteur:=Haut_Bot;\r
2345     fenet1.cborder:=RougeClair;\r
2346     fenet1.cbande:=Rouge;\r
2347     call fenet1.affiche;\r
2348     call showcursor;\r
2349     flagbool:=fenet1.lecture;\r
2350     if flagbool and not fenet1.creation\r
2351     then call hidecursor;\r
2352          kill(keys);\r
2353          keys:=new listkey;\r
2354          kill(clics);\r
2355          clics:=new cliquer; \r
2356          fenet2:=new Son(20,x-Largeur2/2,y-Hauteur2/2,x+Largeur2/2,y+hauteur2/2,2,\r
2357                    False,False,False);\r
2358          attach(fenet2);\r
2359          fenet2.hauteur:=Haut_Bot;\r
2360          fenet2.cborder:=RougeClair;\r
2361          fenet2.cbande:=Rouge;\r
2362          call fenet2.affiche;\r
2363          flagbool:=fenet2.moveto(10,10);\r
2364          call color(BleuClair);\r
2365          flagbool:=fenet2.outgtext("Chargement de",14);  \r
2366          for i:=0 to 12\r
2367           do\r
2368            if fenet1.nomfic(i)=chr(0) then exit fi;\r
2369            flagbool:=fenet2.outchar(fenet1.nomfic(i));\r
2370           od;\r
2371          flagbool:=fenet2.outgtext("  en cours",8);\r
2372          flagbool:=fenet2.moveto(10,25);\r
2373          call color(VertClair);\r
2374          flagbool:=fenet2.outgtext(".",1);\r
2375          if RaciSomm<>none then RaciSomm:=none; fi;\r
2376          if RaciArcs<>none then RaciArcs:=none; fi;\r
2377          call W.verti.reset_bot;\r
2378          call W.horiz.reset_bot;\r
2379          call Lit_Ville(fenet2,fenet1.nomfic);\r
2380          flagbool:=fenet2.moveto(10,40);\r
2381          call color(BleuClair);\r
2382          flagbool:=fenet2.outgtext("Chargement termin\82 : 'Enter'",28);\r
2383          fenet2.B(0).etat:=True;\r
2384          call fenet2.bout.insert(fenet2.B(0));\r
2385          call fenet2.B(0).affiche;\r
2386          call keys.insert(new elmt(Tou_Ent));\r
2387          call showcursor;\r
2388          do\r
2389           code:=fenet2.gestionnaire;\r
2390           if (code=Tou_Ent or code=21) then exit; fi;\r
2391          od;\r
2392          call hidecursor;\r
2393          call fenet2.restore;\r
2394     else if flagbool and fenet1.creation\r
2395          then EDIT.nomfic:=fenet1.nomfic;\r
2396               attach(EDIT);\r
2397               if edit_bool (* on a cr\82\82 un fichier coherant *)\r
2398               then\r
2399                call Etat_Menu(True,True,False,False,False,True);\r
2400                COEF_X:=Larg_Aff/Larg_Vil;\r
2401                COEF_Y:=Haut_Aff/Haut_Vil;\r
2402                boolaf:=True;\r
2403                Zoom:=1;\r
2404                COORD_X:=0;\r
2405                COORD_Y:=0;\r
2406                call ville_aff(zoom);\r
2407               fi;\r
2408               call hidecursor;\r
2409          else call hidecursor;\r
2410          fi;\r
2411     fi;\r
2412     call fenet1.restore;\r
2413     kill(keys);\r
2414     keys:=skey;\r
2415     kill(clics);\r
2416     clics:=sclic;\r
2417     if flagbool and not fenet1.creation\r
2418     then attach(fenet2);\r
2419          kill(fenet2);\r
2420          call Etat_Menu(True,True,False,False,False,True);\r
2421          COEF_X:=Larg_Aff/Larg_Vil;\r
2422          COEF_Y:=Haut_Aff/Haut_Vil;\r
2423          boolaf:=True;\r
2424          Zoom:=1;\r
2425          COORD_X:=0;\r
2426          COORD_Y:=0;\r
2427          call ville_aff(zoom);\r
2428     fi;\r
2429     attach(fenet1);\r
2430     kill(fenet1);\r
2431     call showcursor;\r
2432    End Bot_Load;\r
2433 \r
2434 (***************************************************************************)\r
2435    Unit Bot_Run : procedure;\r
2436    Const Largeur=330,\r
2437          Hauteur=100;\r
2438    Var   fenet     : Son,\r
2439          x,y       : integer,\r
2440          Posx,Posy : integer,\r
2441          code      : integer,\r
2442          flagbool  : boolean,\r
2443          sclic     : cliquer,\r
2444          skey      : listkey;\r
2445 \r
2446    Begin\r
2447     x:=(W.x2-W.x1)/2;\r
2448     y:=(W.y2-W.y1)/2;\r
2449     Posx:=x-Largeur/2;\r
2450     Posy:=y-Hauteur/2;\r
2451     sclic:=clics;\r
2452     clics:=new cliquer;\r
2453     skey:=keys;\r
2454     keys:=new listkey;\r
2455     fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,\r
2456                    2,False,False,False);\r
2457     attach(fenet);\r
2458     fenet.hauteur:=Haut_Bot;\r
2459     fenet.cborder:=RougeClair;\r
2460     fenet.cbande:=Rouge;\r
2461     kill(clics);\r
2462     clics:=new cliquer;\r
2463     call fenet.affiche;\r
2464     call color(BleuClair);\r
2465     flagbool:=fenet.moveto(10,10);\r
2466     flagbool:=fenet.outgtext("Entrez le nombre de voitures (1-50)",32);\r
2467     flagbool:=fenet.moveto(145,30);\r
2468     NbMaxCar:=gscanf_num(1,50);\r
2469     array Activ dim (0:NbMaxCar); (* on genere le tableau des car actives *)\r
2470     call fenet.restore;\r
2471     kill(keys);\r
2472     keys:=skey;\r
2473     kill(clics);\r
2474     clics:=sclic;\r
2475     attach(fenet);\r
2476     kill(fenet);\r
2477     call Etat_Menu(False,False,True,False,False,False);\r
2478     SimStop:=False;\r
2479   End Bot_Run;\r
2480 \r
2481 (***************************************************************************)\r
2482    Unit Bot_Stop : procedure;\r
2483    Const Largeur=280,\r
2484          Hauteur=100;\r
2485    Var   fenet     : Son,\r
2486          x,y       : integer,\r
2487          Posx,Posy : integer,\r
2488          code      : integer,\r
2489          flagbool  : boolean,\r
2490          skey      : listkey,\r
2491          sclic     : cliquer;\r
2492 \r
2493    Begin\r
2494     x:=(W.x2-W.x1)/2;\r
2495     y:=(W.y2-W.y1)/2;\r
2496     Posx:=x-Largeur/2;\r
2497     Posy:=y-Hauteur/2;\r
2498     sclic:=clics;\r
2499     clics:=new cliquer;\r
2500     skey:=keys;\r
2501     keys:=new listkey;\r
2502     fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,\r
2503                    2,False,False,False);\r
2504     attach(fenet);\r
2505     fenet.hauteur:=Haut_Bot;\r
2506     fenet.cborder:=RougeClair;\r
2507     fenet.cbande:=Rouge;\r
2508     kill(clics);\r
2509     clics:=new cliquer;\r
2510     call fenet.affiche;\r
2511     call color(BleuClair);\r
2512     flagbool:=fenet.moveto(60,10);\r
2513     flagbool:=fenet.outgtext("Simulation stopp\82e",18);\r
2514     flagbool:=fenet.moveto(40,30);\r
2515     flagbool:=fenet.outgtext("Appuyez sur une touche",22);\r
2516     call showcursor;\r
2517     do\r
2518      code:=inkey;\r
2519      if code<>0 then exit; fi;\r
2520     od;\r
2521     call hidecursor;\r
2522     call fenet.restore;\r
2523     kill(keys);\r
2524     keys:=skey;\r
2525     kill(clics);\r
2526     clics:=sclic;\r
2527     attach(fenet);\r
2528     kill(fenet);\r
2529     call Etat_Menu(True,False,False,True,True,True);\r
2530     SimStop:=True;\r
2531    End Bot_Stop;\r
2532 \r
2533 (***************************************************************************)\r
2534    Unit Bot_continue : procedure;\r
2535    Const Largeur=290,\r
2536          Hauteur=100;\r
2537    Var   fenet     : Son,\r
2538          x,y       : integer,\r
2539          Posx,Posy : integer,\r
2540          code      : integer,\r
2541          flagbool  : boolean,\r
2542          sclic     : cliquer,\r
2543          skey      : listkey;\r
2544 \r
2545    Begin\r
2546     x:=(W.x2-W.x1)/2;\r
2547     y:=(W.y2-W.y1)/2;\r
2548     Posx:=x-Largeur/2;\r
2549     Posy:=y-Hauteur/2;\r
2550     sclic:=clics;\r
2551     clics:=new cliquer;\r
2552     skey:=keys;\r
2553     keys:=new listkey;\r
2554     fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,\r
2555                    2,False,False,False);\r
2556     attach(fenet);\r
2557     fenet.hauteur:=Haut_Bot;\r
2558     fenet.cborder:=RougeClair;\r
2559     fenet.cbande:=Rouge;\r
2560     call fenet.affiche;\r
2561     call color(BleuClair);\r
2562     flagbool:=fenet.moveto(20,10);\r
2563     flagbool:=fenet.outgtext("La simulation va reprendre...",29);\r
2564     flagbool:=fenet.moveto(50,30);\r
2565     flagbool:=fenet.outgtext("Appuyez sur une touche",22);\r
2566     call showcursor;\r
2567     code:=0;\r
2568     do\r
2569      code:=inkey;\r
2570      if code<>0 then exit fi;\r
2571     od;\r
2572     call hidecursor;\r
2573     call fenet.restore;\r
2574     kill(keys);\r
2575     keys:=skey;\r
2576     kill(clics);\r
2577     clics:=sclic;\r
2578     attach(fenet);\r
2579     kill(fenet);\r
2580     call Etat_Menu(False,False,True,False,False,False);\r
2581     SimStop:=False;\r
2582    End Bot_Continue;\r
2583 \r
2584 (***************************************************************************)\r
2585    Unit Bot_Quit : function : boolean;\r
2586    Const Largeur=300,\r
2587          Hauteur=90;\r
2588    Var   fenet     : Son,\r
2589          x,y       : integer,\r
2590          Posx,Posy : integer,\r
2591          fin       : boolean,\r
2592          code      : integer,\r
2593          Yes,No    : Menu,\r
2594          sclic     : cliquer,\r
2595          skey      : listkey;\r
2596 \r
2597    Begin\r
2598     x:=(W.x2-W.x1)/2;\r
2599     y:=(W.y2-W.y1)/2;\r
2600     Posx:=x-Largeur/2;\r
2601     Posy:=y-Hauteur/2;\r
2602     sclic:=clics;\r
2603     clics:=new cliquer;\r
2604     skey:=keys;\r
2605     keys:=new listkey;\r
2606     fenet:=new Son(10,Posx,Posy,Posx+Largeur,Posy+hauteur,2,True,False,False);\r
2607     attach(fenet);\r
2608     fenet.hauteur:=Haut_Bot;\r
2609     fenet.cborder:=RougeClair;\r
2610     fenet.nom:="Q U I T";\r
2611     fenet.cnom:=RougeClair;\r
2612     fenet.cbande:=Rouge;\r
2613     Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);\r
2614     Yes.nom:="Yes";\r
2615     Yes.etat:=True;\r
2616     call fenet.Bout.Insert(Yes);\r
2617     No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);\r
2618     No.nom:="No";\r
2619     No.etat:=True;\r
2620     call fenet.Bout.Insert(No);\r
2621     call fenet.affiche;\r
2622     call move(Posx+10,Posy+35);\r
2623     call color(BleuClair);\r
2624     call outstring("Do you want to quit the simulation");\r
2625     call Keys.Insert(new elmt(T_ESC));\r
2626     call showcursor;\r
2627     do\r
2628      code:=fenet.gestionnaire;\r
2629      case code\r
2630       when T_ESC : fin:=False; exit; (* touche racc exit *)\r
2631       when T_Y   : fin:=True;  exit; (* touche Y         *)\r
2632       when T_N   : fin:=False; exit; (* touche N         *)\r
2633       when 1       : fin:=True;  exit; (* bouton yes       *)\r
2634       when 2       : fin:=False; exit; (* bouton no        *) \r
2635       when 11      : fin:=False; exit; (* racc exit        *)\r
2636      esac;\r
2637     od; \r
2638     call hidecursor;\r
2639     if not fin\r
2640     then result:=False;\r
2641     else result:=True;\r
2642     fi;\r
2643     call fenet.restore;\r
2644     kill(keys);\r
2645     keys:=skey;\r
2646     kill(clics);\r
2647     clics:=sclic;\r
2648     attach(fenet);\r
2649     kill(fenet);\r
2650     call showcursor;\r
2651    End Bot_Quit;\r
2652 \r
2653 (***************************************************************************)\r
2654    Unit Bot_Help : procedure;\r
2655    Const Largeur=410,\r
2656          Hauteur=350;\r
2657    Var   fen         : Son,\r
2658          x,y,i,j     : integer,\r
2659          code        : integer,\r
2660          COORD_Y     : integer,\r
2661          fp          : file,\r
2662          tmp         : char,\r
2663          boolaff     : boolean,\r
2664          help        : arrayof arrayof char,\r
2665          nb_lign_hlp : integer,\r
2666          skey        : ListKey,\r
2667          sclic       : cliquer;\r
2668 \r
2669    \r
2670       Unit affiche_hlp : procedure;\r
2671       Begin\r
2672         call fen.clear;\r
2673         call color(BleuClair);\r
2674         for i:=COORD_Y to imin(COORD_Y+18,nb_lign_hlp)\r
2675          do\r
2676           for j:=1 to 37\r
2677            do\r
2678             if (ord(help(i,j))>=28 and ord(help(i,j))<=255)\r
2679             then boolaff:=fen.outchar(help(i,j));\r
2680             fi;\r
2681            od;   \r
2682          od;\r
2683       End affiche_hlp;\r
2684    \r
2685    Begin\r
2686     x:=(W.x2-W.x1)/2;\r
2687     y:=(W.y2-W.y1)/2;\r
2688     sclic:=clics;\r
2689     clics:=new cliquer;\r
2690     skey:=keys;\r
2691     keys:=new listkey;\r
2692     fen:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,2,\r
2693                  True,False,False);\r
2694     attach(fen);\r
2695     fen.cnom:=RougeClair;\r
2696     fen.nom:="H E L P";\r
2697     fen.hauteur:=Haut_Bot;\r
2698     fen.largeur:=Larg_Bot;\r
2699     fen.cborder:=RougeClair;\r
2700     fen.cbande:=Rouge;\r
2701     x:=fen.x2-fen.lborder-1-fen.hauteur;\r
2702     y:=fen.y1+fen.hauteur+fen.lborder+1;\r
2703     fen.Verti:=new AccelerateV2(20,-1,x,y,x+fen.largeur,fen.y2-fen.lborder-1,fen);\r
2704     call fen.affiche;\r
2705     call fen.Verti.deplacer(fen.Verti.MinY);\r
2706     call Keys.Insert(new elmt(T_ESC)); (* pour sortir de la fenetre *)\r
2707     call Keys.Insert(new elmt(T_PGUP)); (* page up *)\r
2708     call Keys.Insert(new elmt(T_PGDOWN)); (* page dow *)\r
2709     COORD_Y:=1;\r
2710     open(fp,text,unpack("simula.hlp"));\r
2711     call reset(fp);\r
2712     readln(fp,nb_lign_hlp);\r
2713     array help dim (1:nb_lign_hlp);\r
2714     for i:=1 to nb_lign_hlp\r
2715      do \r
2716       array help(i) dim (1:38);\r
2717      od;\r
2718     call color(BleuClair);\r
2719     i:=1;\r
2720     j:=1;\r
2721     while not eof(fp)\r
2722      do\r
2723       read(fp,help(i,j));\r
2724       j:=j+1;\r
2725       if j=39 then j:=1;\r
2726                    i:=i+1;\r
2727       fi;\r
2728      od;\r
2729     call affiche_hlp;\r
2730     call setposition(fen.x1,fen.y1);\r
2731     call showcursor;\r
2732     do\r
2733      code:=fen.gestionnaire;\r
2734      call hidecursor;\r
2735      if (code=T_ESC) or (code=11) then exit;\r
2736      else\r
2737       if (code=21) or (code=T_FLHAU) then COORD_Y:=COORD_Y-5;\r
2738                                           if COORD_Y<=0 then COORD_Y:=1; fi;\r
2739                                           call fen.Verti.DeplacerUp;\r
2740                                           call affiche_hlp;\r
2741       else\r
2742        if (code=22) then COORD_Y:=1;\r
2743                          call fen.Verti.Reset_Bot;\r
2744                          call affiche_hlp;\r
2745        else\r
2746         if (code=23) or (code=T_FLBAS) then COORD_Y:=COORD_Y+5;\r
2747                                             if COORD_Y>(nb_lign_hlp-5)\r
2748                                             then COORD_Y:=nb_lign_hlp-5;\r
2749                                             fi;\r
2750                                             call fen.Verti.DeplacerDown;\r
2751                                             call affiche_hlp;\r
2752         else\r
2753          if (code=T_PGUP) then COORD_Y:=COORD_Y-19;\r
2754                                if COORD_Y<=0\r
2755                                then COORD_Y:=1;\r
2756                                     call fen.Verti.Deplacer(fen.Verti.MinY);\r
2757                                else call fen.Verti.DeplacerDown;\r
2758                                fi;\r
2759                                call affiche_hlp;\r
2760          else\r
2761           if (code=T_PGDOWN) then COORD_Y:=COORD_Y+19;\r
2762                                   if COORD_Y>(nb_lign_hlp-5)\r
2763                                   then COORD_Y:=nb_lign_hlp-5;\r
2764                                        call fen.Verti.Deplacer(fen.Verti.MaxY);\r
2765                                   else call fen.Verti.DeplacerDown;\r
2766                                   fi;\r
2767                                   call affiche_hlp;\r
2768           fi;\r
2769          fi;\r
2770         fi;\r
2771        fi;\r
2772       fi;\r
2773      fi;\r
2774      call showcursor;\r
2775     od;\r
2776     call fen.restore; (* restore le getmap et free de la ram *)\r
2777     kill(keys);\r
2778     Keys:=skey;\r
2779     kill(clics);\r
2780     clics:=sclic;\r
2781     attach(fen);  (* correspond a la 1ere etape kill *)\r
2782     kill(fen);\r
2783    End Bot_Help;\r
2784 \r
2785 (***************************************************************************)\r
2786    Unit About : procedure;\r
2787    Const Largeur=400,\r
2788          Hauteur=195;\r
2789    Var   fenet     : Son,\r
2790          x,y       : integer,\r
2791          Posx,Posy : integer,\r
2792          code      : integer,\r
2793          flagbool  : boolean,\r
2794          sclic     : cliquer,\r
2795          skey      : Listkey;\r
2796 \r
2797    Begin\r
2798     x:=(W.x2-W.x1)/2;\r
2799     y:=(W.y2-W.y1)/2;\r
2800     Posx:=x-Largeur/2;\r
2801     Posy:=y-Hauteur/2;\r
2802     sclic:=clics;\r
2803     clics:=new cliquer;\r
2804     skey:=keys;\r
2805     keys:=new listkey;\r
2806     fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,2,\r
2807                    True,False,False);\r
2808     attach(fenet);\r
2809     fenet.hauteur:=Haut_Bot;\r
2810     fenet.cborder:=RougeClair;\r
2811     fenet.cbande:=Rouge;\r
2812     call fenet.affiche;\r
2813     call color(BleuClair);\r
2814     flagbool:=fenet.moveto(18,10);\r
2815     flagbool:=fenet.outgtext("Logiciel r\82alis\82 dans  le cadre d'un projet",43);\r
2816     flagbool:=fenet.moveto(18,40);\r
2817     flagbool:=fenet.outgtext("de Licence Informatique - Univertit\82 de PAU",43);\r
2818     flagbool:=fenet.moveto(10,70);\r
2819     flagbool:=fenet.outgtext("BARETS Olivier/PATAUD Fr\82d\82ric/PEYRAT Fran\87ois",43);\r
2820     flagbool:=fenet.moveto(10,100);\r
2821     flagbool:=fenet.outgtext("LI1                                  1993/1994",43);\r
2822     flagbool:=fenet.moveto(10,130);\r
2823     flagbool:=fenet.outgtext("M\82moire disponible : ",25);\r
2824     call writint(memavail*4); (* sizeof (word) = 32 *)\r
2825     flagbool:=fenet.moveto(230,130);\r
2826     flagbool:=fenet.outgtext("Ko",2);\r
2827     call Keys.Insert(new elmt(Tou_Ent));\r
2828     call Keys.Insert(new elmt(T_ESC));\r
2829     call showcursor;\r
2830     do\r
2831      code:=fenet.gestionnaire;\r
2832      if (code=11 or code=Tou_Ent or code=T_ESC) then exit; fi;\r
2833     od;\r
2834     call hidecursor;\r
2835     call fenet.restore;\r
2836     kill(keys);\r
2837     Keys:=skey;\r
2838     kill(clics);\r
2839     clics:=sclic;\r
2840     attach(fenet);\r
2841     kill(fenet);\r
2842    End About;\r
2843 \r
2844 \r
2845 \r
2846 (***************************************************************************)\r
2847    Unit Etat_Menu : procedure (ml,mr,msto,mc,msta,mq : boolean);\r
2848    Begin\r
2849      if (ml and not M(1).etat)  (* load devient enable *)\r
2850      then M(1).etat:=True;\r
2851           M(1).Touche:=T_F1;\r
2852           call M(1).bot_enable;\r
2853      fi;\r
2854      if (not ml and M(1).etat) (* load devient disable *)\r
2855      then M(1).etat:=False;\r
2856           M(1).Touche:=-1;\r
2857           call M(1).bot_disable;\r
2858      fi;\r
2859      if (mr and not M(2).etat)  (* run devient enable *)\r
2860      then M(2).etat:=True;\r
2861           M(2).Touche:=T_F2;\r
2862           call M(2).bot_enable;\r
2863      fi;\r
2864      if (not mr and M(2).etat) (* run devient disable *)\r
2865      then M(2).etat:=False;\r
2866           M(2).Touche:=-1;\r
2867           call M(2).bot_disable;\r
2868      fi;\r
2869      if (msto and not M(3).etat)  (* stop devient enable *)\r
2870      then M(3).etat:=True;\r
2871           M(3).Touche:=T_F3;\r
2872           call M(3).bot_enable;\r
2873      fi;\r
2874      if (not msto and M(3).etat) (* stop devient disable *)\r
2875      then M(3).etat:=False;\r
2876           M(3).Touche:=-1;\r
2877           call M(3).bot_disable;\r
2878      fi;\r
2879      if (mc and not M(4).etat)  (* continue devient enable *)\r
2880      then M(4).etat:=True;\r
2881           M(4).Touche:=T_F4;\r
2882           call M(4).bot_enable;\r
2883      fi;\r
2884      if (not mc and M(4).etat) (* continue devient disable *)\r
2885      then M(4).etat:=False;\r
2886           M(4).Touche:=-1;\r
2887           call M(4).bot_disable;\r
2888      fi;\r
2889      if (msta and not M(5).etat)  (* stats devient enable *)\r
2890      then M(5).etat:=True;\r
2891           M(5).Touche:=T_F5;\r
2892           call M(5).bot_enable;\r
2893      fi;\r
2894      if (not msta and M(5).etat) (* stats devient disable *)\r
2895      then M(5).etat:=False;\r
2896           M(5).Touche:=-1;\r
2897           call M(5).bot_disable;\r
2898      fi;\r
2899      if (mq and not M(6).etat)  (* quit devient enable *)\r
2900      then M(6).etat:=True;\r
2901           M(6).Touche:=T_F6;\r
2902           call M(6).bot_enable;\r
2903      fi;\r
2904      if (not mq and M(6).etat) (* quit devient disable *)\r
2905      then M(6).etat:=False;\r
2906           M(6).Touche:=-1;\r
2907           call M(6).bot_disable;\r
2908      fi;\r
2909    End;\r
2910 \r
2911 (***************************************************************************)\r
2912 (*    procedure d'affichage de la ville - on deborde de l'ecran            *)\r
2913 (*    tracer d'une ligne verticale qui peut depasser le cadre              *)\r
2914 (***************************************************************************)\r
2915   \r
2916   Unit Trace_Vil1 : procedure (x1,y1,x2,y2 : real ; zoom : integer);\r
2917   Var C     : integer,\r
2918       min_x : integer,\r
2919       max_x : integer,\r
2920       min_y : integer,\r
2921       max_y : integer;\r
2922   Begin\r
2923    C:=5*zoom;\r
2924    min_x:=imin(x1,x2);\r
2925    max_x:=imax(x1,x2);\r
2926    min_y:=imin(y1,y2);\r
2927    max_y:=imax(y1,y2);\r
2928    if (min_y>=Ydep_Aff and max_y<=(Ydep_Aff+Haut_Aff))\r
2929    then (* on est en plein dans le cadre, on peut tracer normalement *)\r
2930         call line(x1-C,imin(y1,y2)+C,x2-C,imax(y1,y2)-C,GrisClair);\r
2931         call linep(x1,imin(y1,y2)+C,x2,imax(y1,y2)-C,Blanc,C);\r
2932         call line(x1+C,imin(y1,y2)+C,x2+C,imax(y1,y2)-C,GrisClair);\r
2933    else if (min_y<Ydep_Aff) (* c'est le minimum qui pose pb *)\r
2934         then call line(x1-C,Ydep_Aff+C,x2-C,imax(y1,y2)-C,GrisClair);\r
2935              call linep(x1,Ydep_Aff+C,x2,imax(y1,y2)-C,Blanc,C);\r
2936              call line(x1+C,Ydep_Aff+C,x2+C,imax(y1,y2)-C,GrisClair);\r
2937         else call line(x1-C,imin(y1,y2)+C,x2-C,Ydep_Aff+Haut_Aff-C,GrisClair);\r
2938              call linep(x1,imin(y1,y2)+C,x2,Ydep_Aff+Haut_Aff-C,Blanc,C);\r
2939              call line(x1+C,imin(y1,y2)+C,x2+C,Ydep_Aff+Haut_Aff-C,GrisClair);\r
2940         fi;\r
2941    fi;\r
2942   End Trace_Vil1;\r
2943 \r
2944 \r
2945 (***************************************************************************)\r
2946 (*    procedure d'affichage de la ville - on deborde de l'ecran            *)\r
2947 (*    tracer d'une ligne horizontale qui peut depasser le cadre            *)\r
2948 (***************************************************************************)\r
2949   \r
2950   Unit Trace_Vil2 : procedure (x1,y1,x2,y2 : real ; zoom : integer);\r
2951   Var C     : integer,\r
2952       min_x : integer,\r
2953       max_x : integer,\r
2954       min_y : integer,\r
2955       max_y : integer;\r
2956   Begin\r
2957    C:=5*zoom;\r
2958    min_x:=imin(x1,x2);\r
2959    max_x:=imax(x1,x2);\r
2960    min_y:=imin(y1,y2);\r
2961    max_y:=imax(y1,y2);\r
2962    if (min_x>=Xdep_Aff and max_x<=(Xdep_Aff+Larg_Aff))\r
2963    then (* on est en plein dans le cadre, on peut tracer normalement *)\r
2964         call line(imin(x1,x2)+C,y1-C,imax(x2,x1)-C,y2-C,GrisClair);\r
2965         call linep(imin(x1,x2)+C,y1,imax(x2,x1)-C,y2,Blanc,C);\r
2966         call line(imin(x1,x2)+C,y1+C,imax(x1,x2)-C,y2+C,GrisClair);\r
2967    else if (min_x<Xdep_Aff)  (* c'est le minimum qui pose pb *)\r
2968         then  call line(Xdep_Aff+C,y1-C,imax(x1,x2)-C,y2-C,GrisClair);\r
2969               call linep(Xdep_Aff+C,y1,imax(x1,x2)-C,y2,Blanc,C);\r
2970               call line(Xdep_Aff+C,y1+C,imax(x1,x2)-C,y2+C,GrisClair);\r
2971         else  call line(imin(x1,x2)+C,y1-C,Xdep_Aff+Larg_Aff-C,y2-C,GrisClair);\r
2972               call linep(imin(x1,x2)+C,y1,Xdep_Aff+Larg_Aff-C,y2,Blanc,C);\r
2973               call line(imin(x1,x2)+C,y1+C,Xdep_Aff+Larg_Aff-C,y2+C,GrisClair);\r
2974         fi;\r
2975    fi;\r
2976   End Trace_Vil2;\r
2977 \r
2978 (***************************************************************************)\r
2979 (*                     procedure d'affichage de la ville                   *)\r
2980 (***************************************************************************)\r
2981    Unit Ville_Aff : procedure(zoom : integer);\r
2982    var r     : arcs,\r
2983        s     : sommets,\r
2984        l     : Liste,\r
2985        C     : integer,\r
2986        x1,y1 : integer,\r
2987        x2,y2 : integer,\r
2988        min_x : integer,\r
2989        max_x : integer,\r
2990        min_y : integer,\r
2991        max_y : integer;\r
2992    Begin\r
2993     if boolaf\r
2994     then\r
2995       call W.clear;\r
2996       r:=RaciArcs;\r
2997       while (r<> none)\r
2998        do \r
2999         x1:=Xdep_Aff+COORD_X+(r.initial.colonne*COEF_X*zoom);\r
3000         y1:=Ydep_Aff+COORD_Y+(r.initial.Ligne*COEF_Y*zoom);\r
3001         x2:=Xdep_Aff+COORD_X+(r.final.colonne*COEF_X*zoom);\r
3002         y2:=Ydep_Aff+COORD_Y+(r.final.Ligne*COEF_Y*zoom);\r
3003         min_x:=imin(x1,x2);\r
3004         max_x:=imax(x1,x2);\r
3005         min_y:=imin(y1,y2);\r
3006         max_y:=imax(y1,y2);\r
3007         if(x1=x2)        (* c'est une ligne verticale *)\r
3008         then \r
3009          if (x1<Xdep_Aff or x2>(Xdep_Aff+Larg_Aff)) (* on est hors de l'ecran*)\r
3010          then (* on ne fait rien *) \r
3011          else (* on va peut etre afficher qqch *)\r
3012               if (max_y<Ydep_Aff or min_y>(Ydep_Aff+Haut_Aff))\r
3013               then (* on ne doit rien afficher *) \r
3014               else (* on va afficher qqch *)\r
3015                    call trace_vil1(x1,y1,x2,y2,zoom);\r
3016               fi;\r
3017          fi;\r
3018         fi;\r
3019         if(y1=y2)        (* c'est une ligne horizontale   *)\r
3020         then \r
3021          if (y1<Ydep_Aff or y2>(Ydep_Aff+Haut_Aff)) (* on est hors de l'ecran*)\r
3022          then (*on ne fait rien *)\r
3023          else (*on va peut etre afficher qqch *)\r
3024               if (max_x<Xdep_Aff or min_x>(Xdep_Aff+Larg_Aff))\r
3025               then (* on ne doit rien afficher *) \r
3026               else (* on va afficher qqch *)\r
3027                    call trace_vil2(x1,y1,x2,y2,zoom);\r
3028               fi;\r
3029          fi;\r
3030         fi;\r
3031         r:=r.suivants;\r
3032        od;\r
3033       s:=RaciSomm;\r
3034       C:=5*zoom;\r
3035       while(s<>none)\r
3036        do\r
3037         x1:=Xdep_Aff+COORD_X+(s.colonne*COEF_X*zoom);\r
3038         y1:=Ydep_Aff+COORD_Y+(s.Ligne*COEF_Y*zoom);\r
3039         if (x1>=Xdep_Aff and x1<=(Xdep_Aff+Larg_Aff) \r
3040            and y1>=Ydep_Aff and y1<=(Ydep_Aff+Haut_Aff))\r
3041         then case s.afftype\r
3042                when 1  : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);\r
3043                          call line(x1+C,y1-C,x1+C,y1+C,GrisClair);\r
3044                when 2  : call line(x1-C,y1+C,x1+C,y1+C,GrisClair);\r
3045                          call line(x1+C,y1+C,x1+C,y1-C,GrisClair);\r
3046                when 3  : call line(x1-C,y1+C,x1-C,y1-C,GrisClair);\r
3047                          call line(x1-C,y1-C,x1+C,y1-C,GrisClair);\r
3048                when 4  : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);\r
3049                          call line(x1-C,y1+C,x1+C,y1+C,GrisClair);\r
3050                when 5  : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);\r
3051                when 6  : call line(x1-C,y1+C,x1+C,y1+C,GrisClair);\r
3052                when 7  : call line(x1+C,y1-C,x1+C,y1+C,GrisClair);\r
3053                when 8  : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);\r
3054                when 9  :\r
3055                when 10 : call line(x1-C,y1-C,x1+C,y1-C,GrisClair);\r
3056                          call line(x1-C,y1+C,x1+C,y1+C,GrisClair);\r
3057                when 11 : call line(x1-C,y1-C,x1-C,y1+C,GrisClair);\r
3058                          call line(x1+C,y1-C,x1+C,y1+C,GrisClair);\r
3059              esac;\r
3060         fi;\r
3061         s:=s.suivant;\r
3062        od;\r
3063     fi;\r
3064    End Ville_Aff;\r
3065 \r
3066 (***************************************************************************)\r
3067 (*                                                                         *)\r
3068 (***************************************************************************)\r
3069 Unit prog : Lists class;\r
3070 \r
3071 (***************************************************************************)\r
3072    Unit Bot_Stats : procedure;\r
3073    Const Largeur=450,\r
3074          Hauteur=350;\r
3075    Var   fenet     : Son,\r
3076          x,y,i     : integer,\r
3077          Posx,Posy : integer,\r
3078          code      : integer,\r
3079          flagbool  : boolean,\r
3080          c         : integer,\r
3081          skey      : listkey,\r
3082          sclic     : cliquer;\r
3083    \r
3084    Begin\r
3085     x:=(W.x2-W.x1)/2;\r
3086     y:=(W.y2-W.y1)/2;\r
3087     Posx:=x-Largeur/2;\r
3088     Posy:=y-Hauteur/2;\r
3089     sclic:=clics;\r
3090     clics:=new cliquer;\r
3091     skey:=keys;\r
3092     keys:=new listkey;\r
3093     fenet:=new Son(10,x-Largeur/2,y-Hauteur/2,x+Largeur/2,y+Hauteur/2,\r
3094                    2,False,False,False);\r
3095     attach(fenet);\r
3096     fenet.hauteur:=Haut_Bot;\r
3097     fenet.cborder:=RougeClair;\r
3098     fenet.cbande:=Rouge;\r
3099     call fenet.affiche;\r
3100     call color(BleuClair);\r
3101     flagbool:=fenet.moveto(60,5);\r
3102     flagbool:=fenet.outgtext("Appuyez sur une touche pour continuer",38);\r
3103     call color(RougeClair);\r
3104     if NbCarActiv>0\r
3105     then for c:=0 to imax((NbCarActiv div 18)-1,0)\r
3106          do\r
3107           for i:=c*18 to imin(NbCarActiv-1-c*18,18*(c+1)) (*maxi 18 car \85 la fois *)\r
3108            do\r
3109             flagbool:=fenet.moveto(10,25+(i-c*18)*15);\r
3110             call color(RougeClair);\r
3111             call writint(i+1+c);\r
3112             flagbool:=fenet.moveto(40,25+(i-c*18)*15);\r
3113             call color(VertClair);\r
3114             flagbool:=fenet.outgtext("En partance de ",15);\r
3115             flagbool:=fenet.outchar(Activ(i) qua car.dep.nom);\r
3116             call color(BleuClair);\r
3117             flagbool:=fenet.moveto(170,25+(i-c*18)*15);\r
3118             if Activ(i) qua car.km<>0\r
3119             then flagbool:=fenet.outgtext(" position ",10);\r
3120                  call writint(Activ(i) qua car.km);\r
3121             else flagbool:=fenet.outgtext(" position 0",11);\r
3122             fi;\r
3123             call color(VertClair);\r
3124             flagbool:=fenet.moveto(266,25+(i-c*18)*15);\r
3125             flagbool:=fenet.outgtext(" vers ",6);\r
3126             if (Activ(i) qua car.arccour.initial.nom)=(Activ(i) qua car.dep.nom)\r
3127             then flagbool:=fenet.outchar(Activ(i) qua car.arccour.final.nom);\r
3128             else flagbool:=fenet.outchar(Activ(i) qua car.arccour.initial.nom);\r
3129             fi;\r
3130            od;\r
3131            code:=0;\r
3132            do\r
3133             code:=inkey;\r
3134             if code<>0 then exit fi;\r
3135            od;\r
3136            call fenet.clear;\r
3137            call color(BleuClair);\r
3138            flagbool:=fenet.moveto(60,5);\r
3139            flagbool:=fenet.outgtext("Appuyez sur une touche pour continuer",38);\r
3140           od;\r
3141     else flagbool:=fenet.moveto(10,25);\r
3142          flagbool:=fenet.outgtext("NbCarActiv = 0",14);\r
3143          code:=0;\r
3144          do\r
3145           code:=inkey;\r
3146           if code<>0 then exit fi;\r
3147          od;\r
3148     fi;\r
3149     call fenet.restore;\r
3150     kill(keys);\r
3151     keys:=skey;\r
3152     kill(clics);\r
3153     clics:=sclic;\r
3154     attach(fenet);\r
3155     kill(fenet);\r
3156    End Bot_Stats;\r
3157 \r
3158 \r
3159 (***************************************************************************)\r
3160 (*               simprocess de generation des voitures                     *)\r
3161 (***************************************************************************)\r
3162    Unit Generate : Simprocess class;\r
3163    Begin\r
3164     do\r
3165      if NbCarActiv<NbMaxCar\r
3166      then Activ(NbCarActiv):=new car;\r
3167           call schedule(Activ(NbCarActiv),time);\r
3168           NbCarActiv:=NbCarActiv+1;\r
3169           call hold(5);\r
3170      else call hold(70);\r
3171      fi;\r
3172     od;\r
3173    End Generate;\r
3174 \r
3175 (***************************************************************************)\r
3176 (*                     simprocess des voitures                             *)\r
3177 (*       on se limite au cas o\97 toutes les voies sont \85 double sens        *)\r
3178 (***************************************************************************)\r
3179    Unit Car : Simprocess class;\r
3180    \r
3181         (* procedure d'affichage de la voiture dans la ville *)\r
3182         Unit affiche_car : procedure;\r
3183         Var flagbool : boolean;\r
3184            \r
3185            Unit dessine_car : procedure (x1,y1,x2,y2 : integer);\r
3186            Begin\r
3187               call color(col);\r
3188               x1:=COORD_X+x1*COEF_X*Zoom;\r
3189               y1:=COORD_Y+y1*COEF_Y*Zoom;\r
3190               x2:=COORD_X+x2*COEF_X*Zoom;\r
3191               y2:=COORD_Y+y2*COEF_Y*Zoom;\r
3192               if (x1>=0 and y1>=0 and x2<=Larg_Aff and y2<=Haut_Aff)\r
3193               then call rectanglef(Xdep_Aff+x1,Ydep_Aff+y1,Xdep_Aff+x2,Ydep_Aff+y2,col);\r
3194               fi;\r
3195            End dessine_car;\r
3196 \r
3197         Begin\r
3198          if arccour.Initial.colonne=arccour.final.colonne\r
3199          then (* on est vertical *)\r
3200               if sens=1 \r
3201               then       (* on va de initial \85 final *)\r
3202                    if arccour.initial.ligne<arccour.final.ligne\r
3203                    then  (* l'initial est plus 'haut' que le final *)\r
3204                         call dessine_car(arccour.initial.colonne+1,\r
3205                            arccour.initial.ligne+(km-1),\r
3206                                          arccour.initial.colonne+(1+Zoom),\r
3207                              arccour.initial.ligne+(km));\r
3208                    else  (* l'initial est plus 'bas' que le final *)\r
3209                         call dessine_car(arccour.initial.colonne+1,\r
3210                            arccour.initial.ligne-(km-1),\r
3211                                          arccour.initial.colonne+(1+Zoom),\r
3212                              arccour.initial.ligne-(km));\r
3213                    fi;\r
3214               else       (* on va de final \85 initial *)\r
3215                    if arccour.initial.ligne<arccour.final.ligne\r
3216                    then  (* l'initial est plus 'haut' que le final *)\r
3217                         call dessine_car(arccour.final.colonne-1,\r
3218                            arccour.final.ligne-(km-1),\r
3219                                          arccour.final.colonne-(1+Zoom),\r
3220                              arccour.final.ligne-(km));\r
3221                    else  (* l'initial est plus 'bas' que le final *)\r
3222                         call dessine_car(arccour.final.colonne-1,\r
3223                            arccour.final.ligne+(km-1),\r
3224                                          arccour.final.colonne-(1+Zoom),\r
3225                              arccour.final.ligne+(km));\r
3226                    fi;\r
3227               fi;\r
3228          else (* on est horizontal *)\r
3229               if sens=1\r
3230               then (* on va de initial \85 final *)\r
3231                    if arccour.initial.colonne<arccour.final.colonne\r
3232                    then  (* l'initial est plus 'gche' que le final *)\r
3233                         call dessine_car(arccour.initial.colonne+(km-1),\r
3234                                                            arccour.initial.ligne+1,\r
3235                                            arccour.initial.colonne+(km),\r
3236                                                           arccour.initial.ligne+(1+Zoom));\r
3237                    else  (* l'initial est plus 'dte' que le final *)\r
3238                         call dessine_car(arccour.initial.colonne-(km-1),\r
3239                                                            arccour.initial.ligne+1,\r
3240                                            arccour.initial.colonne-(km),\r
3241                                                           arccour.initial.ligne+(1+Zoom));\r
3242                    fi;\r
3243               else (* on va de final \85 initial *)\r
3244                    if arccour.initial.colonne<arccour.final.colonne\r
3245                    then  (* l'initial est plus 'gche' que le final *)\r
3246                         call dessine_car(arccour.final.colonne-(km-1),\r
3247                                                            arccour.final.ligne-1,\r
3248                                            arccour.final.colonne-(km),\r
3249                                                           arccour.final.ligne-(1+Zoom));\r
3250                    else  (* l'initial est plus 'dte' que le final *)\r
3251                         call dessine_car(arccour.final.colonne+(km-1),\r
3252                                                            arccour.final.ligne-1,\r
3253                                            arccour.final.colonne+(km),\r
3254                                                           arccour.final.ligne-(1+Zoom));\r
3255                    fi;\r
3256               fi;\r
3257          fi;\r
3258         End affiche_car;\r
3259         \r
3260         (* fonction se deplacant dans l'arc courant *)\r
3261         Unit avance : function : boolean;\r
3262         Begin\r
3263          if sens=1\r
3264          then arccour.occpsens(km):=none;\r
3265               km:=km+1;\r
3266               if km<arccour.distance\r
3267               then if arccour.occpsens(km)=none (* si il n'y a personne devant*)\r
3268                    then arccour.occpsens(km):=this car;\r
3269                    else km:=km-1;\r
3270                    fi;\r
3271                    result:=True; (* on n'a pas encore fini *)\r
3272               else result:=False; (* on est arrive au sommet final *)\r
3273               fi;\r
3274          else arccour.occpinve(km):=none;\r
3275               km:=km+1;\r
3276               if km<=arccour.distance\r
3277               then if arccour.occpinve(km)=none (* s'il n'y a personne devant *)\r
3278                    then arccour.occpinve(km):=this car; (* on avance *)\r
3279                    else km:=km-1; (* sinon on reste en place *)\r
3280                    fi;\r
3281                    result:=True; (* on n'a pas encore fini *)\r
3282               else result:=False; (* on est arrive au sommet final *)\r
3283               fi;\r
3284          fi;\r
3285          call affiche_car; \r
3286         End avance;\r
3287    \r
3288         (* fonction choisissant le sommet de depart *)\r
3289         Unit choix_sommet : function : sommets;\r
3290         var som : sommets,\r
3291             ch  : integer,\r
3292             i   : integer;\r
3293         Begin\r
3294          som:=RaciSomm;\r
3295          ch:=RANDOM*NBSOMMETS+1; (* on choisit le numero du sommet *)\r
3296          for i:=1 to ch-1\r
3297           do\r
3298            som:=som.suivant;\r
3299           od;\r
3300          result:=som;\r
3301         End choix_sommet;\r
3302 \r
3303         (* fonction choisissant l'arc suivant que l'on va prendre *)        \r
3304         Unit choix_arc : function : arcs;\r
3305         Var i         : integer,\r
3306             nbarcs    : integer,\r
3307             numarcdep : integer,\r
3308             lst       : liste,\r
3309             sl        : liste;  (* sauvegarde du precedent *)\r
3310         Begin\r
3311          nbarcs:=2;\r
3312          if (dep.afftype<=8 and dep.afftype>=5)\r
3313          then nbarcs:=nbarcs+1;\r
3314          else if dep.afftype=9\r
3315               then nbarcs:=nbarcs+2;\r
3316               fi;\r
3317          fi;\r
3318          numarcdep:=RANDOM*nbarcs+1;\r
3319          lst:=dep.ptrarc;\r
3320          sl:=lst;\r
3321          for i:=1 to numarcdep-1   (* on recherche cet arc dans la liste *)\r
3322           do\r
3323            sl:=lst;\r
3324            lst:=lst.suivante;\r
3325           od;\r
3326          km:=1; (* kilometrage dans l'arc *)\r
3327          if lst.pointeur=arccour (* on a repris le meme arc *)\r
3328          then if sl<>lst\r
3329               then result:=sl.pointeur; (* on prend le precedent *)\r
3330               else result:=lst.suivante.pointeur; (* sinon le suivant *)\r
3331               fi;\r
3332          else result:=lst.pointeur;  (* on poss\8ade l'arc *)\r
3333          fi;\r
3334          if result.initial=dep\r
3335          then sens:=1;\r
3336          else sens:=-1;\r
3337          fi;\r
3338         End choix_arc;\r
3339 \r
3340    Var dep       : sommets, (* sommet de depart du voyage *)\r
3341        arccour   : arcs,    (* arc de depart du voyage *)\r
3342        boo       : boolean,\r
3343        sens      : integer, (* 1 si ini-fin , -1 si fin-ini *)\r
3344        km        : integer, (* distance ds l'arc courant depuis sommet initial*)\r
3345        pourcent  : integer,\r
3346        col       : integer;  (* couleur de la voiture *)\r
3347    Begin\r
3348      dep:=choix_sommet;\r
3349      arccour:=dep.ptrarc.pointeur;\r
3350      if dep=arccour.initial\r
3351      then sens:=1;\r
3352      else sens:=-1;\r
3353      fi;\r
3354      col:=RANDOM*15+1; (* tout sauf noir *)\r
3355      km:=1;\r
3356      do\r
3357       boo:=avance; (* on avance d'un pas *)\r
3358       if not boo (* on est \85 la fin de l'arc, il faut savoir si on va en *)\r
3359                  (* prendre un autre *)\r
3360       then pourcent:=RANDOM*100;\r
3361            if pourcent>20 \r
3362            then if dep=arccour.initial\r
3363                 then dep:=arccour.final;\r
3364                 else dep:=arccour.initial;\r
3365                 fi;\r
3366                 arccour:=choix_arc; (* on a 80% de chance de continuer *)\r
3367                 boo:=True;  (* on doit donc continuer *)\r
3368            else boo:=False; (* on s'arrete *)\r
3369            fi;\r
3370       fi;\r
3371       if boo  (* si boo alors on n'est pas encore au point d'arrivee *)\r
3372       then call hold(90);\r
3373       else exit;\r
3374       fi;\r
3375      od;\r
3376      NbCarActiv:=NbCarActiv-1;\r
3377      call passivate;\r
3378     End Car;\r
3379 \r
3380 \r
3381 (***************************************************************************)\r
3382 (*                   simprocess de gestion de l'affichage                  *)\r
3383 (***************************************************************************)\r
3384    Unit affichage : simprocess class;\r
3385    Begin\r
3386    do \r
3387     code:=W.Gestionnaire;\r
3388     call hidecursor;\r
3389     if (code=T_F1) or (code=1) then call Bot_Load; \r
3390     else \r
3391      if (code=T_F6) or (code=6) then if Bot_Quit then fin:=True; exit; fi; \r
3392      else \r
3393       if (code=T_F9) or (code=9) then call Bot_help; \r
3394       else \r
3395        if (code=T_ALTF4) then if Bot_Quit then fin:=True; exit; fi;\r
3396        else \r
3397         if (code=T_F2) or (code=2) then call Bot_Run;\r
3398         else \r
3399          if (code=T_F3) or (code=3) then call Bot_Stop;\r
3400          else \r
3401           if (code=T_f4) or (code=4) then call Bot_Continue;\r
3402           else \r
3403            if (code=T_FLGCH) or (code=51) then call W.Horiz.DeplacerLeft;\r
3404                                                COORD_X:=COORD_X+30;\r
3405                                                call Ville_Aff(ZOOM);\r
3406            else\r
3407             if (code=T_FLDTE) or (code=53) then call W.Horiz.DeplacerRight;\r
3408                                                 COORD_X:=COORD_X-30;\r
3409                                                 call Ville_Aff(ZOOM);\r
3410             else\r
3411              if (code=T_FLHAU) or (code=61) then call W.Verti.DeplacerUp;\r
3412                                                  COORD_Y:=COORD_Y+30;\r
3413                                                  call Ville_Aff(ZOOM);\r
3414              else\r
3415               if (code=T_FLBAS) or (code=63) then call W.verti.DeplacerDown;\r
3416                                                   COORD_Y:=COORD_Y-30;\r
3417                                                   call Ville_Aff(ZOOM);\r
3418               else\r
3419                if (code=101) then if Bot_Quit then fin:=True; exit fi;\r
3420                else\r
3421                 if (code=102) then call W.iconify;\r
3422                 else\r
3423                  if (code=52) then COORD_X:=0; \r
3424                                    call W.Horiz.Reset_Bot;\r
3425                                    call Ville_Aff(ZOOM);\r
3426                  else\r
3427                   if (code=62) then COORD_Y:=0;\r
3428                                     call W.Verti.Reset_Bot;\r
3429                                     call Ville_Aff(ZOOM);\r
3430                   else \r
3431                    if (code=7) or (code=T_F7) \r
3432                         then Zoom:=Zoom+1;\r
3433                              if zoom=5 then M(7).etat:=False;\r
3434                                              call M(7).bot_disable;\r
3435                              fi;\r
3436                              if not M(8).etat then M(8).etat:=True;\r
3437                                                    call M(8).bot_enable;\r
3438                              fi;\r
3439                              C:=5*Zoom;\r
3440                              Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20-2*C;\r
3441                              Haut_Aff:=W.Verti.y2-W.Verti.y1-20-2*C;\r
3442                              Xdep_Aff:=W.Horiz.x1+10+C;\r
3443                              Ydep_Aff:=W.Verti.y1+10+C;\r
3444                              call Ville_Aff(Zoom);\r
3445                    else\r
3446                     if (code=8) or (code=T_F8)\r
3447                          then Zoom:=Zoom-1;\r
3448                               if zoom=1 then M(8).etat:=False;\r
3449                                              call M(8).bot_disable;\r
3450                               fi;\r
3451                               if not M(7).etat then M(7).etat:=True;\r
3452                                                     call M(7).bot_Enable;\r
3453                               fi;\r
3454                               C:=5*Zoom;\r
3455                               Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20-2*C;\r
3456                               Haut_Aff:=W.Verti.y2-W.Verti.y1-20-2*C;\r
3457                               Xdep_Aff:=W.Horiz.x1+10+C;\r
3458                               Ydep_Aff:=W.Verti.y1+10+C;\r
3459                               call Ville_Aff(Zoom);\r
3460                     else\r
3461                      if (code=5) or (code=T_F5) then call Bot_Stats; \r
3462                      else\r
3463                       if (code=T_SHFTF4) then call About;\r
3464                       else\r
3465                        if (code=T_CTRLF4) then call W.iconify;\r
3466                        else\r
3467                         if code=T_CTRLENT then call rattacher(SIMULA,EDIT);\r
3468                         fi;\r
3469                        fi;\r
3470                       fi;\r
3471                      fi;\r
3472                     fi;\r
3473                    fi;\r
3474                   fi;\r
3475                  fi;\r
3476                 fi;\r
3477                fi;\r
3478               fi;\r
3479              fi;\r
3480             fi;\r
3481            fi;\r
3482           fi;\r
3483          fi;\r
3484         fi;\r
3485        fi;\r
3486       fi;\r
3487      fi;\r
3488     fi;\r
3489     call showcursor;\r
3490     (* si on n'est pas en pause dans la simulation, on doit faire un hold *)\r
3491     (* pour pouvoir passer la 'main' au generateur et aux voitures        *)\r
3492     if not SimStop then call hold(120); fi;\r
3493    od;\r
3494    End affichage;\r
3495 \r
3496 Var sim_aff : affichage;\r
3497 Begin\r
3498  sim_aff:=new affichage;\r
3499  call schedule(new generate,time); (* mise dans la file du generateur de car *)\r
3500  call hold(10);\r
3501  call schedule(sim_aff,time); (* mise dans la file du syst\8ame d'affichage *)\r
3502  do \r
3503   call hold(150);\r
3504   if fin then exit; fi;\r
3505  od;\r
3506 End prog;\r
3507 \r
3508 \r
3509 \r
3510 Begin\r
3511 \r
3512    W:=new Maine(100,1,1,SIZEX,SIZEY,3,True,True,False);\r
3513    W.hauteur:=Haut_bot;\r
3514    W.cborder:=BleuClair;\r
3515    W.cbande:=GrisClair;\r
3516    W.cnom:=BleuClair;\r
3517    W.nom:="Simulation de r\82seau routier";\r
3518    W.icname:="Root";\r
3519    \r
3520    array M dim (1:9);\r
3521 \r
3522    y1:=W.y1+W.lborder+1+W.hauteur+2;\r
3523    y2:=y1+Haut_bot;\r
3524    M(1):=new Menu(1,T_F1,W.x1+8,y1,W.x1+50,y2);\r
3525    M(1).nom:="Load";\r
3526    M(1).etat:=True;\r
3527    call W.Bout.Insert(M(1));\r
3528 \r
3529    M(2):=new Menu(2,-1,W.x1+55,y1,W.x1+89,y2);\r
3530    M(2).nom:="Run";\r
3531    M(2).etat:=False;\r
3532    call W.Bout.Insert(M(2));\r
3533 \r
3534    M(3):=new Menu(3,-1,W.x1+94,y1,W.x1+136,y2);\r
3535    M(3).nom:="Stop";\r
3536    M(3).etat:=False;\r
3537    call W.Bout.Insert(M(3)); \r
3538    \r
3539    M(4):=new Menu(4,-1,W.x1+141,y1,W.x1+215,y2);\r
3540    M(4).nom:="Continue";\r
3541    M(4).etat:=False;\r
3542    call W.Bout.Insert(M(4));\r
3543    \r
3544    M(5):=new Menu(5,-1,W.x1+220,y1,W.x1+270,y2);\r
3545    M(5).nom:="Stats";\r
3546    M(5).etat:=False;\r
3547    call W.Bout.Insert(M(5));\r
3548 \r
3549    M(6):=new Menu(6,T_F6,W.x1+275,y1,W.x1+317,y2);\r
3550    M(6).nom:="Quit";\r
3551    M(6).etat:=True;\r
3552    call W.Bout.Insert(M(6));\r
3553    \r
3554    M(7):=new Menu(7,T_F7,W.x2-94,y1,W.x2-77,y2);\r
3555    M(7).nom:="+";\r
3556    M(7).etat:=True;\r
3557    call W.Bout.Insert(M(7));\r
3558 \r
3559    M(8):=new Menu(8,T_F8,W.x2-72,y1,W.x2-55,y2);\r
3560    M(8).nom:="-";\r
3561    M(8).etat:=False;\r
3562    call W.Bout.Insert(M(8));\r
3563    \r
3564    M(9):=new Menu(9,T_F9,W.x2-30,y1,W.x2-13,y2);\r
3565    M(9).nom:="?";\r
3566    M(9).etat:=True;\r
3567    call W.Bout.Insert(M(9)); \r
3568 \r
3569    x1:=W.x1+W.lborder+1;\r
3570    y1:=W.y2-W.lborder-Haut_bot-1;\r
3571    x2:=W.x2-W.lborder-Larg_bot-1;\r
3572    y2:=W.y2-W.lborder-1;\r
3573    W.Horiz:=new AccelerateH(50,-1,x1,y1,x2,y2,W);\r
3574 \r
3575    x1:=W.x2-W.lborder-Larg_bot-1; \r
3576    y1:=W.y1+W.lborder+2*(Haut_bot+2);\r
3577    x2:=W.x2-W.lborder-1;\r
3578    y2:=W.y2-W.lborder-Haut_bot;\r
3579    W.Verti:=new AccelerateV2(60,-1,x1,y1,x2,y2,W);\r
3580    \r
3581    Larg_Aff:=W.Horiz.x2-W.Horiz.x1-20;\r
3582    Haut_Aff:=W.Verti.y2-W.Verti.y1-20;\r
3583    Xdep_Aff:=W.Horiz.x1+10;\r
3584    Ydep_Aff:=W.Verti.y1+10;\r
3585    COEF_X:=1;\r
3586    COEF_Y:=1;\r
3587    COORD_X:=0;\r
3588    COORD_Y:=0;\r
3589    ZOOM:=1;\r
3590    C:=5*ZOOM;\r
3591    \r
3592    return;\r
3593 \r
3594    call keys.insert(new elmt(T_CTRLENT)); (* pour le chgt de programme *)\r
3595 \r
3596    call W.affiche;\r
3597    notfirst:=true; (* on a deja fait un affichage de la fenetre *)\r
3598 \r
3599    call About;  (* about en presentation *)\r
3600    \r
3601    call showcursor;\r
3602 \r
3603    prg:=new prog; (* on met la simulation en route *)\r
3604                   (* NB: elle commence par l'affichage et sa gestion *)\r
3605    call hidecursor;\r
3606    \r
3607    call W.restore;\r
3608    \r
3609 end simulateur;\r
3610   \r
3611 (***************************************************************************)\r
3612 (***************************************************************************)\r
3613 (*                 PROGRAMME NUMERO 2 : EDITEUR DE VILLES                  *)\r
3614 (***************************************************************************)\r
3615 (***************************************************************************)\r
3616    Unit editor : Logiciel coroutine (nomfic : arrayof char;output resultat : boolean);\r
3617    Var largeur : integer,\r
3618        hauteur : integer,\r
3619        y1,y2   : integer,\r
3620        M       : arrayof menu;\r
3621 \r
3622 (***************************************************************************)\r
3623    Unit Bot_Quit : function : boolean;\r
3624    Const Largeur=300,\r
3625          Hauteur=90;\r
3626    Var   fenet     : Son,\r
3627          x,y       : integer,\r
3628          Posx,Posy : integer,\r
3629          fin       : boolean,\r
3630          code      : integer,\r
3631          Yes,No    : Menu,\r
3632          sclic     : cliquer,\r
3633          skey      : listkey;\r
3634 \r
3635    Begin\r
3636     x:=(W.x2-W.x1)/2;\r
3637     y:=(W.y2-W.y1)/2;\r
3638     Posx:=x-Largeur/2;\r
3639     Posy:=y-Hauteur/2;\r
3640     sclic:=clics;\r
3641     clics:=new cliquer;\r
3642     skey:=keys;\r
3643     keys:=new listkey;\r
3644     fenet:=new Son(10,Posx,Posy,Posx+Largeur,Posy+hauteur,2,True,False,False);\r
3645     attach(fenet);\r
3646     fenet.hauteur:=Haut_Bot;\r
3647     fenet.cborder:=RougeClair;\r
3648     fenet.nom:="Q U I T";\r
3649     fenet.cnom:=RougeClair;\r
3650     fenet.cbande:=Rouge;\r
3651     Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);\r
3652     Yes.nom:="Yes";\r
3653     Yes.etat:=True;\r
3654     call fenet.Bout.Insert(Yes);\r
3655     No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);\r
3656     No.nom:="No";\r
3657     No.etat:=True;\r
3658     call fenet.Bout.Insert(No);\r
3659     call fenet.affiche;\r
3660     call move(Posx+10,Posy+35);\r
3661     call color(BleuClair);\r
3662     call outstring("Do you want to quit the editor");\r
3663     call Keys.Insert(new elmt(T_ESC));\r
3664     call showcursor;\r
3665     do\r
3666      code:=fenet.gestionnaire;\r
3667      case code\r
3668       when T_ESC : fin:=False; exit; (* touche racc exit *)\r
3669       when T_Y   : fin:=True;  exit; (* touche Y         *)\r
3670       when T_N   : fin:=False; exit; (* touche N         *)\r
3671       when 1       : fin:=True;  exit; (* bouton yes       *)\r
3672       when 2       : fin:=False; exit; (* bouton no        *) \r
3673       when 11      : fin:=False; exit; (* racc exit        *)\r
3674      esac;\r
3675     od; \r
3676     call hidecursor;\r
3677     if not fin\r
3678     then result:=False;\r
3679     else result:=True;\r
3680     fi;\r
3681     call fenet.restore;\r
3682     kill(keys);\r
3683     keys:=skey;\r
3684     kill(clics);\r
3685     clics:=sclic;\r
3686     attach(fenet);\r
3687     kill(fenet);\r
3688     call showcursor;\r
3689    End Bot_Quit;\r
3690    \r
3691    \r
3692    \r
3693    \r
3694    Begin\r
3695     largeur:=SIZEX;\r
3696     hauteur:=SIZEY;\r
3697     W:=new Maine(100,1,1,largeur,hauteur,3,True,True,False);\r
3698     W.hauteur:=Haut_bot;\r
3699     W.cborder:=BleuClair;\r
3700     W.cbande:=GrisClair;\r
3701     W.cnom:=BleuClair;\r
3702     W.nom:="Editeur de r\82seau routier";\r
3703     W.icname:="Edit";\r
3704    \r
3705     array M dim (1:6);\r
3706 \r
3707     y1:=W.y1+W.lborder+1+W.hauteur+2;\r
3708     y2:=y1+Haut_bot;\r
3709     M(1):=new Menu(1,T_F1,W.x1+8,y1,W.x1+50,y2);\r
3710     M(1).nom:="Load";\r
3711     M(1).etat:=True;\r
3712     call W.Bout.Insert(M(1));\r
3713  \r
3714     M(2):=new Menu(2,T_F2,W.x1+55,y1,W.x1+99,y2);\r
3715     M(2).nom:="Save";\r
3716     M(2).etat:=False;\r
3717     call W.Bout.Insert(M(2));\r
3718  \r
3719     M(3):=new Menu(3,T_F3,W.x1+104,y1,W.x1+146,y2);\r
3720     M(3).nom:="Quit";\r
3721     M(3).etat:=True;\r
3722     call W.Bout.Insert(M(3)); \r
3723 \r
3724     M(4):=new Menu(4,T_F4,W.x2-94,y1,W.x2-77,y2);\r
3725     M(4).nom:="+";\r
3726     M(4).etat:=True;\r
3727     call W.Bout.Insert(M(4));\r
3728  \r
3729     M(5):=new Menu(5,-1,W.x2-72,y1,W.x2-55,y2);\r
3730     M(5).nom:="-";\r
3731     M(5).etat:=False;\r
3732     call W.Bout.Insert(M(5));\r
3733     \r
3734     M(6):=new Menu(6,T_F6,W.x2-30,y1,W.x2-13,y2);\r
3735     M(6).nom:="?";\r
3736     M(6).etat:=True;\r
3737     call W.Bout.Insert(M(6)); \r
3738     \r
3739     return; (* fin de l'initialisation de la coroutine *)\r
3740 \r
3741     call keys.insert(new elmt(T_CTRLENT)); (* pour le chgt de programme *)\r
3742 \r
3743     call W.affiche;\r
3744     notfirst:=true; (* on a deja fait un affichage de la fenetre *)\r
3745 \r
3746     do\r
3747      code:=W.gestionnaire;\r
3748      if code=T_F3 or code=3 then if bot_quit then exit; fi;\r
3749      else \r
3750       if code=T_F1 or code=1 then \r
3751       else \r
3752        if code=T_F2 or code=2 then\r
3753        else \r
3754         if code=T_CTRLF4 then call W.iconify;\r
3755         else \r
3756          if code=T_F4 or code=4 then\r
3757          else  \r
3758           if code=T_F5 or code=5 then\r
3759           else\r
3760            if code=T_F6 or code=6 then\r
3761            else\r
3762             if code=T_CTRLENT then call rattacher(EDIT,DOS);\r
3763             fi;\r
3764            fi;\r
3765           fi;\r
3766          fi;\r
3767         fi;\r
3768        fi;\r
3769       fi;\r
3770      fi;\r
3771     od;\r
3772     call hidecursor;\r
3773     call W.restore;\r
3774     call showcursor;\r
3775     kill(W);\r
3776    End editor;\r
3777 \r
3778   \r
3779 (***************************************************************************)\r
3780 (***************************************************************************)\r
3781 (*                 PROGRAMME NUMERO 3 : FENETRE MS-DOS                     *)\r
3782 (***************************************************************************)\r
3783 (***************************************************************************)\r
3784    Unit MS_DOS : Logiciel coroutine; \r
3785    Var largeur : integer,\r
3786        hauteur : integer,\r
3787        y1,y2   : integer,\r
3788        M       : arrayof menu;\r
3789 \r
3790 (***************************************************************************)\r
3791    Unit Bot_Quit : function : boolean;\r
3792    Const Largeur=300,\r
3793          Hauteur=90;\r
3794    Var   fenet     : Son,\r
3795          x,y       : integer,\r
3796          Posx,Posy : integer,\r
3797          fin       : boolean,\r
3798          code      : integer,\r
3799          Yes,No    : Menu,\r
3800          sclic     : cliquer,\r
3801          skey      : listkey;\r
3802 \r
3803    Begin\r
3804     x:=(W.x2-W.x1)/2;\r
3805     y:=(W.y2-W.y1)/2;\r
3806     Posx:=x-Largeur/2;\r
3807     Posy:=y-Hauteur/2;\r
3808     sclic:=clics;\r
3809     clics:=new cliquer;\r
3810     skey:=keys;\r
3811     keys:=new listkey;\r
3812     fenet:=new Son(10,Posx,Posy,Posx+Largeur,Posy+hauteur,2,True,False,False);\r
3813     attach(fenet);\r
3814     fenet.hauteur:=Haut_Bot;\r
3815     fenet.cborder:=RougeClair;\r
3816     fenet.nom:="Q U I T";\r
3817     fenet.cnom:=RougeClair;\r
3818     fenet.cbande:=Rouge;\r
3819     Yes:=new Menu(1,T_Y,Posx+60,Posy+61,Posx+100,Posy+61+Haut_bot);\r
3820     Yes.nom:="Yes";\r
3821     Yes.etat:=True;\r
3822     call fenet.Bout.Insert(Yes);\r
3823     No:=new Menu(2,T_N,Posx+190,Posy+61,Posx+220,Posy+61+Haut_bot);\r
3824     No.nom:="No";\r
3825     No.etat:=True;\r
3826     call fenet.Bout.Insert(No);\r
3827     call fenet.affiche;\r
3828     call move(Posx+10,Posy+35);\r
3829     call color(BleuClair);\r
3830     call outstring("Do you want to quit the DOS session");\r
3831     call Keys.Insert(new elmt(T_ESC));\r
3832     call showcursor;\r
3833     do\r
3834      code:=fenet.gestionnaire;\r
3835      case code\r
3836       when T_ESC : fin:=False; exit; (* touche racc exit *)\r
3837       when T_Y   : fin:=True;  exit; (* touche Y         *)\r
3838       when T_N   : fin:=False; exit; (* touche N         *)\r
3839       when 1       : fin:=True;  exit; (* bouton yes       *)\r
3840       when 2       : fin:=False; exit; (* bouton no        *) \r
3841       when 11      : fin:=False; exit; (* racc exit        *)\r
3842      esac;\r
3843     od; \r
3844     call hidecursor;\r
3845     if not fin\r
3846     then result:=False;\r
3847     else result:=True;\r
3848     fi;\r
3849     call fenet.restore;\r
3850     kill(keys);\r
3851     keys:=skey;\r
3852     kill(clics);\r
3853     clics:=sclic;\r
3854     attach(fenet);\r
3855     kill(fenet);\r
3856     call showcursor;\r
3857    End Bot_Quit;\r
3858    \r
3859    \r
3860    \r
3861    \r
3862    Begin\r
3863     largeur:=SIZEX;\r
3864     hauteur:=SIZEY;\r
3865     W:=new Maine(100,1,1,largeur,hauteur,3,True,True,False);\r
3866     W.hauteur:=Haut_bot;\r
3867     W.cborder:=BleuClair;\r
3868     W.cbande:=GrisClair;\r
3869     W.cnom:=BleuClair;\r
3870     W.nom:="Fenetre MS-DOS";\r
3871     W.icname:="MS-DOS";\r
3872    \r
3873     array M dim (1:2);\r
3874 \r
3875     y1:=W.y1+W.lborder+1+W.hauteur+2;\r
3876     y2:=y1+Haut_bot;\r
3877     M(1):=new Menu(1,T_F1,W.x1+8,y1,W.x1+50,y2);\r
3878     M(1).nom:="Quit";\r
3879     M(1).etat:=True;\r
3880     call W.Bout.Insert(M(1));\r
3881  \r
3882     M(2):=new Menu(2,T_F2,W.x2-30,y1,W.x2-13,y2);\r
3883     M(2).nom:="?";\r
3884     M(2).etat:=True;\r
3885     call W.Bout.Insert(M(2)); \r
3886     \r
3887     return; (* fin de l'initialisation de la coroutine *)\r
3888 \r
3889     call keys.insert(new elmt(T_CTRLENT)); (* pour le chgt de programme *)\r
3890 \r
3891     call W.affiche;\r
3892     notfirst:=true; (* on a deja fait un affichage de la fenetre *)\r
3893 \r
3894     do\r
3895      code:=W.gestionnaire;\r
3896      if code=T_F1 or code=1 then if bot_quit then exit; fi;\r
3897      else \r
3898       if code=T_CTRLF4 then call W.iconify;\r
3899       else \r
3900        if code=T_CTRLENT then call rattacher(DOS,SIMULA);\r
3901        fi;\r
3902       fi;\r
3903      fi;\r
3904     od;\r
3905     call hidecursor;\r
3906     call W.restore;\r
3907     call showcursor;\r
3908     kill(W);\r
3909    End MS_DOS;\r
3910 \r
3911   \r
3912   \r
3913 (***************************************************************************)\r
3914 (***************************************************************************)\r
3915 (*                P R O G R A M M  E     P R IN C I P A L                  *)\r
3916 (***************************************************************************)\r
3917 (***************************************************************************)\r
3918   \r
3919   Unit Logiciel : coroutine(id : integer);\r
3920   Var W        : Maine,\r
3921       notfirst : boolean; (* false si c'est la premi\8are fois *)\r
3922   End logiciel;\r
3923 \r
3924 \r
3925 \r
3926   Unit rattacher : procedure (co_prov,co_dest : Logiciel);\r
3927   Begin\r
3928     if co_dest<>none\r
3929     then SLKEYS(co_prov.id):=Keys; (* on sauve les liste de l'ancien actif *)\r
3930          SLCLICS(co_prov.id):=clics;\r
3931          call move(co_prov.W.x1,co_prov.W.y1);\r
3932          co_prov.W.savmap:=getmap(co_prov.W.x2,co_prov.W.y2);\r
3933       \r
3934          Keys:=SLKEYS(co_dest.id);   (* on met les listes du prog actif en place *)\r
3935          clics:=SLCLICS(co_dest.id);\r
3936          if co_dest.notfirst\r
3937          then call move(co_dest.W.x1,co_dest.W.y1);\r
3938               call putmap(co_dest.W.savmap);\r
3939          fi;\r
3940     \r
3941          attach(co_dest); (* on met actif le programme *)\r
3942     fi;\r
3943   End rattacher;\r
3944 \r
3945   \r
3946   Begin\r
3947     call gron(1);                (* mode 640x480x256 avec driver stealth.grn*)\r
3948     SIZEX:=640; \r
3949     SIZEY:=480;\r
3950 \r
3951     array SLKEYS  dim (1:3);\r
3952     array SLCLICS dim (1:3);\r
3953     \r
3954     clics:=new cliquer;             (* ensemble des zones de clic possible  *)\r
3955     Keys:=new ListKey;              (* liste des touches rattach\82es *)\r
3956     SIMULA:=new simulateur(1);\r
3957     SLKEYS(1):=keys;\r
3958     SLCLICS(1):=clics;\r
3959     \r
3960     clics:=new cliquer;             (* ensemble des zones de clic possible  *)\r
3961     Keys:=new ListKey;              (* liste des touches rattach\82es *)\r
3962     EDIT:=new editor(2,none,edit_bool);\r
3963     SLKEYS(2):=keys;\r
3964     SLCLICS(2):=clics;\r
3965     \r
3966     clics:=new cliquer;             (* ensemble des zones de clic possible  *)\r
3967     Keys:=new ListKey;              (* liste des touches rattach\82es *)\r
3968     DOS:=new MS_DOS(3);\r
3969     SLKEYS(3):=keys;\r
3970     SLCLICS(3):=clics;\r
3971 \r
3972     Keys:=SLKEYS(1);   (* on met les listes du prog actif en place *)\r
3973     clics:=SLCLICS(1);\r
3974     do\r
3975      attach(SIMULA);\r
3976     od;\r
3977     \r
3978     call groff;\r
3979   End\r
3980 \r
3981   end\r
3982 end.\r