examples/pataud/windows.log

   1 Program systemefenetrage;\r
   2 \r
   3 (***************************************************************************)\r
   4 (* Programme de syst\8ame de fenetrage avec boutons et gestion de la souris  *)\r
   5 (* PATAUD Fr\82d\82ric & PEYRAT Fran\87ois                             1993/1994 *)\r
   6 (***************************************************************************)\r
   7 \r
   8 Begin\r
   9 Pref iiuwgraph block\r
  10   \r
  11   Begin\r
  12   Pref mouse block\r
  13 \r
  14  Const Noir        = 0,\r
  15        Bleu        = 1,\r
  16        Vert        = 2,\r
  17        Cyan        = 3,\r
  18        Rouge       = 4,\r
  19        Magenta     = 5,\r
  20        Marron      = 6,\r
  21        GrisClair   = 7,\r
  22        GrisFonce   = 8,\r
  23        BleuClair   = 9,\r
  24        VertClair   =10,\r
  25        CyanClair   =11,\r
  26        RougeClair  =12,\r
  27        MagentaClair=13,\r
  28        Jaune       =14,\r
  29        Blanc       =15;\r
  30  \r
  31  Const Touche_F1   =-59,\r
  32        Touche_F2   =-60,\r
  33        Touche_F3   =-61,\r
  34        Touche_F4   =-62,\r
  35        Touche_F5   =-63,\r
  36        Touche_F6   =-64,\r
  37        Touche_F7   =-65,\r
  38        Touche_F8   =-66,\r
  39        Touche_F9   =-67,\r
  40        Touche_F10  =-68,\r
  41        Touche_F11  =-69,\r
  42        Touche_F12  =-70;\r
  43 \r
  44  Const SIZEX = 639,\r
  45        SIZEY = 348;\r
  46 \r
  47  Var code     : integer,\r
  48      COOR_X   : integer,  (*coordonn\82e relative en X dans la fenetre maine*)\r
  49      COOR_Y   : integer,  (*coordonn\82e relative en Y dans la fenetre maine*)\r
  50      W        : Maine,\r
  51      B        : arrayof Racc,\r
  52      M        : arrayof Menu,\r
  53      clics    : cliquer;\r
  54 \r
  55    \r
  56 (***************************************************************************)\r
  57 (*          definition des procedures d'utilitaires graphiques             *)\r
  58 (***************************************************************************)\r
  59    \r
  60    Unit Line : procedure (x1,y1,x2,y2,c : integer);\r
  61    Begin\r
  62       call color(c);\r
  63       call move(x1,y1);\r
  64       call draw(x2,y2);\r
  65    End Line;\r
  66 \r
  67    Unit Rectangle : procedure (x1,y1,x2,y2,c : integer);\r
  68    Begin\r
  69     call color(c);\r
  70     call move(x1,y1);\r
  71     call draw(x2,y1);\r
  72     call draw(x2,y2);\r
  73     call draw(x1,y2);\r
  74     call draw(x1,y1);\r
  75    End Rectangle;\r
  76    \r
  77    Unit Rectanglef : procedure (x1,y1,x2,y2,c : integer);\r
  78    var i : integer;\r
  79    Begin\r
  80     for i:=y1 to y2\r
  81     do\r
  82       call Line(x1,i,x2,i,c);\r
  83     od\r
  84    End Rectanglef;\r
  85 \r
  86 (***************************************************************************)\r
  87 (*                definition des classes d'\82l\82ments des listes             *)\r
  88 (***************************************************************************)\r
  89         \r
  90    Unit Elmt : class(id : integer);\r
  91    End Elmt;\r
  92         \r
  93    Unit elm : Elmt class(x1,y1,x2,y2 :integer);\r
  94    End elm;\r
  95 \r
  96 (***************************************************************************)\r
  97 (*                   definition de la classe Bottons                       *)\r
  98 (***************************************************************************)\r
  99    \r
 100    Unit Bottons : Elmt class(x1,y1,x2,y2 : integer);  \r
 101                                (* x2-x1 et y2-y1 doit au mini etre de 8*)\r
 102       (*  x1,y1   : integer  coordonn\82es du point haut gauche          *)\r
 103       (*  x2,y2   : integer  coordonn\82es du point bas droit            *)\r
 104    Var etat    : boolean; (* true si bouton enable                     *)\r
 105    \r
 106         Unit affiche : procedure;\r
 107         Begin\r
 108           call Line(x1,y1,x2,y1,Blanc);                 (* Lignes en blanc *) \r
 109           call Line(x1,y1+1,x2-1,y1+1,Blanc);\r
 110           call Line(x1,y1,x1,y2,Blanc);\r
 111           call Line(x1+1,y1+2,x1+1,y2-1,Blanc);\r
 112           call Line(x1+1,y2,x2,y2,GrisFonce);      (* Lignes en gris fonce *)\r
 113           call Line(x1+2,y2-1,x2,y2-1,GrisFonce);\r
 114           call Line(x2,y2,x2,y1+1,GrisFonce);\r
 115           call Line(x2-1,y2-1,x2-1,y1+2,GrisFonce);\r
 116           call Rectanglef(x1+2,y1+2,x2-2,y2-2,GrisClair); (* centre en gris *)\r
 117           call AfficheSuite;\r
 118         End affiche;\r
 119 \r
 120         Unit virtual AfficheSuite : procedure;\r
 121         End;\r
 122 \r
 123         Unit virtual bot_enable : procedure;\r
 124         End;\r
 125 \r
 126         Unit virtual bot_disable : procedure;\r
 127         End;\r
 128    \r
 129    End Bottons;\r
 130 \r
 131 (***************************************************************************)\r
 132 (*            definition de la classe Menu derivant de Bottons             *)\r
 133 (***************************************************************************)\r
 134    \r
 135    Unit Menu : Bottons class;\r
 136    Var cnom    : integer, (* couleur du nom du bouton                  *) \r
 137        nom     : string;  (* nom du bouton                             *)\r
 138         \r
 139         Unit affiche_nom : procedure;\r
 140         Begin \r
 141           call move(x1+5,y1+(y2-y1)/4+1);\r
 142           call color(cnom);\r
 143           call outstring(nom);\r
 144         End affiche_nom;\r
 145 \r
 146         Unit virtual bot_enable : procedure;\r
 147         var e : elm;\r
 148         Begin\r
 149          cnom:=RougeClair;\r
 150          e:=new elm(id,x1,y1,x2,y2);\r
 151          call clics.Insert(e);\r
 152          call affiche_nom;\r
 153         End bot_enable;\r
 154 \r
 155         Unit virtual bot_disable : procedure;\r
 156         var e : elm;\r
 157         Begin\r
 158          cnom:=Rouge;\r
 159          e:=new elm(id,x1,y1,x2,y2);\r
 160          call clics.Delete(e);\r
 161          call affiche_nom;\r
 162         End bot_disable;\r
 163 \r
 164         Unit virtual AfficheSuite : procedure;\r
 165         Begin\r
 166           if (etat) \r
 167           then call bot_enable;\r
 168           else call bot_disable;\r
 169           fi;\r
 170         End AfficheSuite;\r
 171 \r
 172    End Menu;\r
 173 \r
 174 (***************************************************************************)\r
 175 (*            definition de la classe Racc derivant de Bottons             *)\r
 176 (***************************************************************************)\r
 177    \r
 178    Unit Racc : Bottons class (procedure sprite(x1,y1,x2,y2 :integer));\r
 179 \r
 180         Unit virtual bot_enable : procedure;\r
 181         var e : elm;\r
 182         Begin \r
 183          e:=new elm(id,x1,y1,x2,y2);\r
 184          call clics.Insert(e);\r
 185          call sprite(x1,y1,x2,y2);\r
 186         End bot_enable;\r
 187 \r
 188         Unit virtual bot_disable : procedure;\r
 189         var e : elm;\r
 190         Begin \r
 191          e:=new elm(id,x1,y1,x2,y2);\r
 192          call clics.Delete(e);\r
 193          call sprite(x1,y1,x2,y2);\r
 194         End bot_disable;\r
 195 \r
 196         Unit virtual AfficheSuite : procedure;\r
 197         Begin\r
 198          if etat\r
 199          then call bot_enable;\r
 200          else call bot_disable;\r
 201          fi;\r
 202         End AfficheSuite;\r
 203 \r
 204    End Racc;\r
 205 \r
 206 (***************************************************************************)\r
 207 (*                       definition de la classe Windows                   *)\r
 208 (***************************************************************************)\r
 209    \r
 210    Unit Windows : class(x1,y1,x2,y2 : integer);   \r
 211                            (* x2-x1 et y2-y1 doit au mini etre 33      *)\r
 212    Var numero  : integer,  (* numero d'identification de la fenetre    *)\r
 213        cborder : integer;  (* couleur du pourtour                      *)\r
 214         \r
 215        Unit affiche : procedure;\r
 216         Begin\r
 217          call Line(x1,y1,x2,y1,cborder);      (* lignes haut *)\r
 218          call Line(x1,y1+1,x2,y1+1,cborder);\r
 219          call Line(x1,y1,x1,y2,cborder);      (* lignes gauche *)\r
 220          call Line(x1+1,y1,x1+1,y2,cborder);\r
 221          call Line(x2,y1,x2,y2,cborder);      (* Lignes droite *)\r
 222          call Line(x2-1,y1,x2-1,y2,cborder);\r
 223          call Line(x1,y2,x2,y2,cborder);      (* Lignes bas *)\r
 224          call Line(x1,y2-1,x2,y2-1,cborder);\r
 225          call Line(x1+16,y1,x1+16,y1+1,Noir);  (* Lignes noires *)\r
 226          call Line(x2-16,y1,x2-16,y1+1,Noir);\r
 227          call Line(x1+16,y2,x1+16,y2-1,Noir);\r
 228          call Line(x2-16,y2,x2-16,y2-1,Noir);\r
 229          call Line(x1,y1+16,x1+1,y1+16,Noir);\r
 230          call Line(x1,y2-16,x1+1,y2-16,Noir);\r
 231          call Line(x2,y1+16,x2-1,y1+16,Noir);\r
 232          call Line(x2,y2-16,x2-1,y2-16,Noir);\r
 233          call AffSuite;\r
 234         End affiche;\r
 235    \r
 236         Unit virtual AffSuite : procedure;\r
 237         End AffSuite;\r
 238 \r
 239         Unit gestionnaire : function : integer;\r
 240         Var  l,r,c : boolean,\r
 241              x,y   : integer,\r
 242              rep   : integer,\r
 243              nbbot : integer;\r
 244         Begin\r
 245          do\r
 246           call getpress(0,x,y,nbbot,l,r,c);\r
 247           if l\r
 248           then result:=clics.Appartient(x,y); exit;\r
 249           fi;\r
 250           rep:=inkey;\r
 251           if (rep>=Touche_F5 and rep<=Touche_F1) \r
 252           then result:=-rep-58; exit;\r
 253           fi;\r
 254          od;\r
 255         End gestionnaire;\r
 256 \r
 257 \r
 258    End Windows;\r
 259 \r
 260 (***************************************************************************)\r
 261 (*            definition de main d\82rivant de la classe Windows             *)\r
 262 (***************************************************************************)\r
 263    \r
 264    Unit Maine : Windows class;\r
 265    var cnom    : integer,  (* couleur du nom de la fenetre             *)\r
 266        nom     : string,   (* nom de la fenetre                        *)\r
 267        cbande  : integer,  (* couleur de la bande du nom de la fenetre *)\r
 268        Bout    : Listbot,  (* liste des boutons rattach\82s \85 la fenetre *)\r
 269        Lwind   : ListW,    (* liste des fenetres filles                *)\r
 270        Horiz   : AccelerateH, (* accelerateur horizontal               *)\r
 271        Verti   : AccelerateV; (* accelerateur vertical                 *)\r
 272 \r
 273  var i :integer;\r
 274 \r
 275         Unit virtual AffSuite : procedure;\r
 276         Begin\r
 277          call Rectanglef(x1+17,y1+2,x2-17,y1+15,cbande);\r
 278          call Rectanglef(x1+3,y1+17,x2-3,y1+33,cbande);\r
 279          call move(x1+(x2-x1)/3,y1+5);\r
 280          call color(cnom);\r
 281          call outstring(nom);\r
 282          if (Horiz<>none)\r
 283          then call Horiz.affiche;\r
 284          fi;\r
 285          if (Verti<>none)\r
 286          then call Verti.affiche;\r
 287          fi;\r
 288          Bout.Courant:=Bout.head;\r
 289          while(Bout.Courant<>none)\r
 290           do\r
 291            call Bout.Courant.data qua Bottons.affiche;\r
 292            Bout.Courant:=Bout.Courant.next;\r
 293           od;\r
 294         End AffSuite;\r
 295 \r
 296 \r
 297         Unit iconify : procedure;\r
 298         var i     : integer,\r
 299             l,r,c : boolean,\r
 300             x,y   : integer,\r
 301             nboot : integer,\r
 302             rep   : integer;\r
 303 \r
 304         Begin\r
 305           call cls;\r
 306           kill(clics);\r
 307           call rectangle(1,SIZEY-40,40,SIZEY,BleuClair);\r
 308           call rectangle(2,SIZEY-39,39,SIZEY-1,BleuClair);\r
 309           call move(5,SIZEY-20);\r
 310           call outstring("Root");\r
 311           call showcursor;\r
 312           do\r
 313             call getpress(0,x,y,nboot,l,r,c);\r
 314             if l \r
 315             then if(x>=1 and x<=40 and y<=SIZEY and y>=SIZEY-40)\r
 316                  then exit;\r
 317                  fi;\r
 318             fi;\r
 319             rep:=inkey;\r
 320             if (rep=13)   (* validation *)\r
 321             then exit;\r
 322             fi;\r
 323           od;\r
 324           call hidecursor;\r
 325           call cls;\r
 326           clics:=new cliquer;\r
 327           call W.affiche;\r
 328         End iconify;\r
 329 \r
 330    End Maine;\r
 331 \r
 332 (***************************************************************************)\r
 333 (*    definition de Accelerate d\82rivant des classes Windows et Bottons     *)\r
 334 (***************************************************************************)\r
 335    \r
 336    Unit Accelerate : Bottons class;\r
 337    Var Bs   : arrayof Racc,\r
 338        PosX : integer,\r
 339        PosY : integer,\r
 340        LX,LY: integer;\r
 341        \r
 342         Unit virtual AfficheSuite : procedure;  (* descend de bottons *)\r
 343         End AfficheSuite;\r
 344        \r
 345         Unit virtual bot_enable : procedure;\r
 346         Begin\r
 347          call W.Bout.Insert(Bs(1));\r
 348          call W.Bout.Insert(Bs(2));\r
 349          Call W.Bout.Insert(Bs(3));\r
 350          etat:=True;\r
 351         End bot_enable;\r
 352 \r
 353         Unit virtual bot_disable : procedure;\r
 354         Begin\r
 355          call W.Bout.Delete(Bs(1));\r
 356          call W.Bout.Delete(Bs(2));\r
 357          call W.Bout.Delete(Bs(3));\r
 358          etat:=False;\r
 359         End bot_disable;\r
 360 \r
 361         Unit virtual Deplace : procedure;\r
 362         End Deplace;\r
 363   \r
 364    Begin  \r
 365     inner;\r
 366     call bot_enable;\r
 367    End Accelerate;\r
 368 \r
 369 (***************************************************************************)\r
 370 (*             definition de AccelerateH d\82rivant de Accelerate            *)\r
 371 (***************************************************************************)\r
 372 \r
 373    Unit AccelerateH : Accelerate class;\r
 374    Var x    : integer,     \r
 375        MaxX : integer,\r
 376        MinX : integer;\r
 377    \r
 378         Unit virtual AfficheSuite : procedure;  (* descend de bottons *)\r
 379         Begin\r
 380          call Rectanglef(x1+18,y1+3,x2-18,y2-3,Noir);\r
 381          MaxX:=x2-18-LX;\r
 382          MinX:=x1+18;\r
 383         End AfficheSuite;\r
 384 \r
 385         Unit virtual DeplacerLeft : procedure;\r
 386         var e : elm;\r
 387         Begin\r
 388          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
 389          PosX:=PosX-5;\r
 390          if PosX<MinX\r
 391          then PosX:=MinX;\r
 392               Bs(1).etat:=False;\r
 393               e:=new elm(Bs(1).id,Bs(1).x1,Bs(1).y1,Bs(1).x2,Bs(1).y2);\r
 394               call clics.Delete(e);\r
 395               kill(e);\r
 396          fi;\r
 397          if not (Bs(3).etat)\r
 398          then Bs(3).etat:=True;\r
 399               e:=new elm(Bs(3).id,Bs(3).x1,Bs(3).y1,Bs(3).x2,Bs(3).y2);\r
 400               call clics.Insert(e);\r
 401          fi;\r
 402          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
 403          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
 404          call Bs(2).affiche;\r
 405         End DeplacerLeft;\r
 406 \r
 407         Unit virtual DeplacerRight : procedure;\r
 408         var e : elm;\r
 409         Begin\r
 410          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
 411          PosX:=PosX+5;\r
 412          if PosX>MaxX\r
 413          then PosX:=MaxX;\r
 414               Bs(3).etat:=False;\r
 415               e:=new elm(Bs(3).id,Bs(3).x1,Bs(3).y1,Bs(3).x2,Bs(3).y2);\r
 416               call clics.Delete(e);\r
 417               kill(e);\r
 418          fi;\r
 419          if not (Bs(1).etat)\r
 420          then Bs(1).etat:=True;\r
 421               e:=new elm(Bs(1).id,Bs(1).x1,Bs(1).y1,Bs(1).x2,Bs(1).y2);\r
 422               call clics.Insert(e);\r
 423          fi;\r
 424          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
 425          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
 426          call Bs(2).affiche;\r
 427         End DeplacerRight;\r
 428 \r
 429     Begin  \r
 430       array Bs dim (1:3);\r
 431       Bs(1):=new Racc(id+1,x1+2,y1+2,x1+15,y1+15,spr_right);\r
 432       Bs(1).etat:=True;\r
 433       x:=(x2-x1)/2;\r
 434       PosX:=x-5;\r
 435       PosY:=y1+3;\r
 436       LX:=11;\r
 437       LY:=y2-y1-6;\r
 438       Bs(2):=new Racc(id+2,PosX,PosY,PosX+LX,PosY+LY,spr_point);\r
 439       Bs(2).etat:=True;\r
 440       Bs(3):=new Racc(id+3,x2-15,y2-15,x2-2,y2-2,spr_left);\r
 441       Bs(3).etat:=True;\r
 442    End AccelerateH;\r
 443 \r
 444 (***************************************************************************)\r
 445 (*             definition de AccelerateV d\82rivant de Accelerate            *)\r
 446 (***************************************************************************)\r
 447 \r
 448    Unit AccelerateV : Accelerate class;\r
 449    Var y    : integer,\r
 450        MaxY : integer,\r
 451        MinY : integer;     \r
 452 \r
 453         Unit virtual AfficheSuite : procedure;  (* descend de bottons *)\r
 454         Begin\r
 455          call Rectanglef(x1+3,y1+18,x2-3,y2-18,Noir);\r
 456          MaxY:=y2-18-LY;\r
 457          MinY:=y1+18;\r
 458         End AfficheSuite;\r
 459       \r
 460         Unit virtual DeplacerUp : procedure;\r
 461         var e : elm;\r
 462         Begin\r
 463          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
 464          PosY:=PosY-5;\r
 465          if PosY<MinY\r
 466          then PosY:=MinY;\r
 467               Bs(1).etat:=False;\r
 468               e:=new elm(Bs(1).id,Bs(1).x1,Bs(1).y1,Bs(1).x2,Bs(1).y2);\r
 469               call clics.Delete(e);\r
 470               kill(e);\r
 471          fi;\r
 472          if not (Bs(3).etat)\r
 473          then Bs(3).etat:=True;\r
 474               e:=new elm(Bs(3).id,Bs(3).x1,Bs(3).y1,Bs(3).x2,Bs(3).y2);\r
 475               call clics.Insert(e);\r
 476          fi;\r
 477          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
 478          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
 479          call Bs(2).affiche;\r
 480         End DeplacerUp;\r
 481 \r
 482         Unit virtual DeplacerDown : procedure;\r
 483         var e : elm;\r
 484         Begin\r
 485          call Rectanglef(PosX,PosY,PosX+LX,PosY+LY,Noir);\r
 486          PosY:=PosY+5;\r
 487          if PosY>MaxY\r
 488          then PosY:=MaxY;\r
 489               Bs(3).etat:=False;\r
 490               e:=new elm(Bs(3).id,Bs(3).x1,Bs(3).y1,Bs(3).x2,Bs(3).y2);\r
 491               call clics.Delete(e);\r
 492               kill(e);\r
 493          fi;\r
 494          if not (Bs(1).etat)\r
 495          then Bs(1).etat:=True;\r
 496               e:=new elm(Bs(1).id,Bs(1).x1,Bs(1).y1,Bs(1).x2,Bs(1).y2);\r
 497               call clics.Insert(e);\r
 498          fi;\r
 499          Bs(2).x1:=PosX;    Bs(2).y1:=PosY;\r
 500          Bs(2).x2:=PosX+LX; Bs(2).y2:=PosY+LY;\r
 501          call Bs(2).affiche;\r
 502         End DeplacerDown;\r
 503 \r
 504 \r
 505    Begin\r
 506       array Bs dim (1:3);\r
 507       Bs(1):=new Racc(id+1,x1+2,y1+2,x1+15,y1+15,spr_upper);\r
 508       Bs(1).etat:=True;\r
 509       y:=(y2-y1)/2;\r
 510       PosX:=x1+3;\r
 511       PosY:=y-5;\r
 512       LX:=x2-x1-6;\r
 513       LY:=11;\r
 514       Bs(2):=new Racc(id+2,PosX,PosY,PosX+LX,PosY+LY,spr_point);\r
 515       Bs(2).etat:=True;\r
 516       Bs(3):=new Racc(id+3,x2-15,y2-15,x2-2,y2-2,spr_lower);\r
 517       Bs(3).etat:=True;\r
 518    End AccelerateV;\r
 519 \r
 520 \r
 521 (***************************************************************************)\r
 522 (*    definition de la classe Son d\82rivant des classes Windows et elmt     *)\r
 523 (***************************************************************************)\r
 524    \r
 525    Unit Son : Elmt coroutine;\r
 526    Var aa      : Windows,\r
 527        Horiz   : AccelerateH, (* accelerateur horizontal               *)\r
 528        Verti   : AccelerateV; (* accelerateur vertical                 *)\r
 529    Begin\r
 530      pref Windows(0,0,0,0) block\r
 531      begin\r
 532        aa:=this Windows;\r
 533 \r
 534         (* instructions *)\r
 535        detach;\r
 536 \r
 537      end\r
 538    End Son;\r
 539 \r
 540 (***************************************************************************)\r
 541 (*          definition de la classe Ensemble (c'est une liste)             *)\r
 542 (***************************************************************************)\r
 543 \r
 544    Unit Ensemble : class;\r
 545    Var Head    : Node,\r
 546        Courant : Node,\r
 547        Last    : Node;\r
 548 \r
 549         Unit Node : class(data : elmt);\r
 550         Var next  : Node;\r
 551         End Node;\r
 552         \r
 553         Unit virtual egalite : function (x,y : elmt) :boolean;\r
 554         End egalite;\r
 555 \r
 556         Unit Empty : function : boolean;        \r
 557         Begin\r
 558          if Head=none\r
 559          then result:=True;\r
 560          else result:=False;\r
 561          fi;\r
 562         End;\r
 563 \r
 564         Unit Member : function (n : elmt) : boolean;\r
 565         Var bl      : boolean,\r
 566             saveCou : Node;\r
 567         Begin\r
 568          Courant:=Head;\r
 569          saveCou:=Courant;\r
 570          bl:=False;\r
 571          While (Courant<>none)\r
 572           do\r
 573            if not egalite(Courant.data,n)\r
 574            then saveCou:=Courant; Courant:=Courant.next;\r
 575            else bl:=True; exit;\r
 576            fi;\r
 577           od;\r
 578          Courant:=SaveCou;\r
 579          result:=bl;\r
 580         End Member;\r
 581 \r
 582         Unit Insert : procedure (n : elmt);\r
 583         Var bl : boolean;\r
 584         Begin\r
 585          bl:=Member(n);\r
 586          if not bl\r
 587          then if Empty\r
 588               then Head:=new Node(n); Last:=Head;\r
 589               else Last.next:=new Node(n);\r
 590                    Last:=Last.next;\r
 591               fi;\r
 592          fi;\r
 593         End Insert;\r
 594 \r
 595         Unit Delete : procedure (n : elmt);\r
 596         Var bl   : boolean,\r
 597             flag : Node;\r
 598         Begin \r
 599          bl:=Member(n);\r
 600          if bl\r
 601          then flag:=Courant.next; \r
 602               if flag=Last\r
 603               then Last:=Courant; courant.next:=none; kill(flag);\r
 604               else courant.next:=Courant.next.next; kill(flag);\r
 605               fi;\r
 606          fi;\r
 607         End Delete;\r
 608 \r
 609    End Ensemble;\r
 610         \r
 611 (***************************************************************************)\r
 612 (*      definition de la classe cliquer derivant de la classe ensemble     *) \r
 613 (***************************************************************************)\r
 614    \r
 615    Unit cliquer : Ensemble class;        \r
 616    \r
 617         Unit virtual egalite : function (x,y : elmt) : boolean;\r
 618         Begin\r
 619          if (x.id)=(y.id)\r
 620          then result:=True;\r
 621          else result:=False;\r
 622          fi;\r
 623         End egalite;\r
 624         \r
 625         Unit Appartient : function(x,y : integer) : integer;\r
 626         var bl : boolean;\r
 627         Begin\r
 628           bl:=False;\r
 629           Courant:=Head;\r
 630           while (Courant<>none)\r
 631           do\r
 632            if(x<(Courant.data qua elm.x2) and x>(Courant.data qua elm.x1) and \r
 633               y<(Courant.data qua elm.y2) and y>(Courant.data qua elm.y1))\r
 634            then bl:=True; exit;\r
 635            else Courant:=Courant.next;\r
 636            fi;\r
 637           od;\r
 638           if bl\r
 639           then result:=Courant.data qua elm.id;\r
 640           else result:=-1;\r
 641           fi;\r
 642         End Appartient;\r
 643 \r
 644    End cliquer;\r
 645 \r
 646 (***************************************************************************)\r
 647 (*          definition de la classe Listbot d\82rivant de ensemble           *)\r
 648 (***************************************************************************)\r
 649    \r
 650    Unit Listbot : Ensemble class;\r
 651 \r
 652         Unit virtual egalite : function (x,y : elmt) : boolean;\r
 653         Begin\r
 654          if (x.id) = (y.id)\r
 655          then result:=True;\r
 656          else result:=False;\r
 657          fi;\r
 658         End egalite;\r
 659 \r
 660    End Listbot;\r
 661 \r
 662 (***************************************************************************)\r
 663 (*           definition de la classe ListW d\82rivant de ensemble            *)\r
 664 (***************************************************************************)\r
 665  \r
 666    Unit ListW : Ensemble class;\r
 667 \r
 668         Unit virtual egalite : function (x,y : elmt) : boolean;\r
 669         Begin\r
 670          if (x qua Son.aa qua Windows.numero) \r
 671                = (y qua Son.aa qua Windows.numero)\r
 672          then result:=True;\r
 673          else result:=False;\r
 674          fi;\r
 675         End egalite;\r
 676 \r
 677    End ListW;\r
 678 \r
 679 (***************************************************************************)\r
 680 (*             procedure d'affichage des sprites des boutons               *)\r
 681 (***************************************************************************)\r
 682 \r
 683 (***************************************************************************)\r
 684    Unit spr_upper : procedure(x1,y1,x2,y2 : integer);\r
 685    var i,x,y : integer;\r
 686    Begin\r
 687     x:=(x2-x1)/2;\r
 688     y:=(y2-y1)/2;\r
 689     for i:=1 to y\r
 690     do\r
 691      call Line(x1+x-i/2,y1+y/2+i,x1+x+i/2,y1+y/2+i,Noir);\r
 692     od\r
 693    End spr_upper;\r
 694 \r
 695 (***************************************************************************)\r
 696    Unit spr_lower : procedure(x1,y1,x2,y2 : integer);\r
 697    var i,x,y : integer;\r
 698    Begin\r
 699     x:=(x2-x1)/2;\r
 700     y:=(y2-y1)/2;\r
 701     for i:=1 to y\r
 702     do\r
 703      call Line(x1+x-i/2,y2-y/2-i,x1+x+i/2,y2-y/2-i,Noir);\r
 704     od\r
 705    End spr_lower;\r
 706 \r
 707 (***************************************************************************)\r
 708    Unit spr_left : procedure(x1,y1,x2,y2 : integer);\r
 709    var i,x,y : integer;\r
 710    Begin\r
 711     x:=(x2-x1)/2;\r
 712     y:=(y2-y1)/2;\r
 713     for i:=1 to x\r
 714     do\r
 715      call Line(x2-x/2-i,y1+y-i/2,x2-x/2-i,y1+y+i/2,Noir);\r
 716     od\r
 717    End spr_left;\r
 718 \r
 719 (***************************************************************************)\r
 720    Unit spr_right : procedure(x1,y1,x2,y2 : integer);\r
 721    var i,x,y : integer;\r
 722    Begin\r
 723     x:=(x2-x1)/2;\r
 724     y:=(y2-y1)/2;\r
 725     for i:=1 to x\r
 726     do\r
 727      call Line(x1+x/2+i,y1+y-i/2,x1+x/2+i,y1+y+i/2,Noir);\r
 728     od\r
 729    End spr_right;\r
 730 \r
 731 (***************************************************************************)\r
 732    Unit spr_close : procedure(x1,y1,x2,y2 : integer);;\r
 733    var y : integer;\r
 734    Begin\r
 735     y:=(y2-y1)/2;\r
 736     call Rectanglef(x1+3,y1+y-1,x2-3,y1+y+1,Noir);\r
 737    End spr_close;\r
 738 \r
 739 (***************************************************************************)\r
 740    Unit spr_point : procedure(x1,y1,x2,y2 : integer);;\r
 741    var x,y : integer;\r
 742    Begin\r
 743     y:=(y2-y1)/2;\r
 744     x:=(x2-x1)/2;\r
 745     call Rectanglef(x1+x-1,y1+y-1,x1+x+1,y1+y+1,Noir);\r
 746    End spr_point;\r
 747 \r
 748 (***************************************************************************)\r
 749 (*                   procedure de gestion  des boutons                     *)\r
 750 (***************************************************************************)\r
 751 \r
 752 (***************************************************************************)\r
 753    Unit Bot_Load : procedure;\r
 754    Const Largeur=200,\r
 755          Hauteur=100;\r
 756    Var   fenet  : Son,\r
 757          x,y    : integer,\r
 758          savcli : cliquer;\r
 759    Begin\r
 760     x:=(W.x2-W.x1)/2;\r
 761     y:=(W.y2-W.y1)/2;\r
 762     fenet:=new Son(20); (* identite = 20 *)\r
 763     fenet.aa.x1:=x-Largeur/2;\r
 764     fenet.aa.y1:=y-Hauteur/2;\r
 765     fenet.aa.x2:=x+Largeur/2;\r
 766     fenet.aa.y2:=y+Hauteur/2;\r
 767     fenet.aa.numero:=10;\r
 768     savcli:=clics;          (* on sauvegarde l'ensemble des zones de clics *)\r
 769     clics:=none;\r
 770     call fenet.aa.affiche;\r
 771    End Bot_Load;\r
 772 \r
 773 (***************************************************************************)\r
 774    Unit Bot_Quit : procedure;\r
 775    Const Largeur=200,\r
 776          Hauteur=100;\r
 777    Var   fenet  : Son,\r
 778          x,y    : integer,\r
 779          savcli : cliquer;\r
 780    Begin\r
 781     x:=(W.x2-W.x1)/2;\r
 782     y:=(W.y2-W.y1)/2;\r
 783     fenet:=new Son(30);  (* identite = 30 *)\r
 784     fenet.aa.x1:=x-Largeur/2;\r
 785     fenet.aa.y1:=y-Hauteur/2;\r
 786     fenet.aa.x2:=x+Largeur/2;\r
 787     fenet.aa.y2:=y+Hauteur/2;\r
 788     fenet.aa.numero:=10;\r
 789     savcli:=clics;          (* on sauvegarde l'ensemble des zones de clics *)\r
 790     clics:=none;\r
 791     call fenet.aa.affiche;\r
 792    End Bot_Quit;\r
 793 \r
 794 (***************************************************************************)\r
 795 (*                 P R O G R A M M E   P R I  N C I P A L                  *)\r
 796 (***************************************************************************)\r
 797    Begin\r
 798    call gron(4);\r
 799    \r
 800    clics:=new cliquer;  (* ensemble des zones de clic possible  *)\r
 801 \r
 802    W:=new Maine(1,1,SIZEX,SIZEY);\r
 803    W.numero:=1;\r
 804    W.cborder:=BleuClair;\r
 805    W.cbande:=GrisClair;\r
 806    W.cnom:=BleuClair;\r
 807    W.nom:="Simulation de r\82seau routier";\r
 808    \r
 809    W.Bout:=new ListBot;\r
 810    \r
 811    array B dim (0:2);\r
 812 \r
 813    B(2):=new Racc(102,W.x2-16,W.y1+2,W.x2-3,W.y1+15,spr_upper);\r
 814    B(2).etat:=True;\r
 815    call W.Bout.Insert(B(2));\r
 816    \r
 817    B(1):=new Racc(101,B(2).x1-14,B(2).y1,B(2).x1-1,B(2).y2,spr_lower);\r
 818    B(1).etat:=True;\r
 819    call W.Bout.Insert(B(1));\r
 820    \r
 821    B(0):=new Racc(100,W.x1+3,B(1).y1,W.x1+16,B(1).y2,spr_close);\r
 822    B(0).etat:=True;\r
 823    call W.Bout.Insert(B(0));\r
 824 \r
 825    array M dim (0:4);\r
 826 \r
 827    M(0):=new Menu(1,W.x1+8,W.y1+18,W.x1+50,W.y1+32);\r
 828    M(0).nom:="Load";\r
 829    M(0).etat:=True;\r
 830    call W.Bout.Insert(M(0));\r
 831 \r
 832    M(1):=new Menu(2,W.x1+55,W.y1+18,W.x1+89,W.y1+32);\r
 833    M(1).nom:="Run";\r
 834    M(1).etat:=False;\r
 835    call W.Bout.Insert(M(1));\r
 836 \r
 837    M(2):=new Menu(3,W.x1+94,W.y1+18,W.x1+136,W.y1+32);\r
 838    M(2).nom:="Stop";\r
 839    M(2).etat:=False;\r
 840    call W.Bout.Insert(M(2));\r
 841    \r
 842    M(3):=new Menu(4,W.x1+141,W.y1+18,W.x1+215,W.y1+32);\r
 843    M(3).nom:="Continue";\r
 844    M(3).etat:=False;\r
 845    call W.Bout.Insert(M(3));\r
 846 \r
 847    M(4):=new Menu(5,W.x1+220,W.y1+18,W.x1+262,W.y1+32);\r
 848    M(4).nom:="Quit";\r
 849    M(4).etat:=True;\r
 850    call W.Bout.Insert(M(4));\r
 851    \r
 852    W.Horiz:=new AccelerateH(50,W.x1+2,W.y2-18,W.x2-18,W.y2-2);\r
 853 \r
 854    W.Verti:=new AccelerateV(60,W.x2-18,W.y1+34,W.x2-2,W.y2-18);\r
 855    \r
 856    call W.affiche;\r
 857    \r
 858    call showcursor;\r
 859    do\r
 860     code:=W.Gestionnaire;\r
 861     call hidecursor;\r
 862     case code\r
 863      when 1   : call Bot_Load; (* f1 : Load *)\r
 864      when 5   : exit;   (* f5 : quit *)\r
 865      when 51  : call W.Horiz.DeplacerLeft;\r
 866      when 53  : call W.Horiz.DeplacerRight;\r
 867      when 61  : call W.Verti.DeplacerUp;\r
 868      when 63  : call W.verti.DeplacerDown;\r
 869      when 100 : exit;   (* racc fin *)\r
 870      when 101 : call W.iconify;\r
 871     esac;\r
 872     call showcursor;\r
 873    od;\r
 874    call hidecursor;\r
 875    \r
 876    call groff;\r
 877  \r
 878    end\r
 879   end\r
 880 end.\r