examples/pataud/new5.log

   1 Program SystemedeFenetrage;\r
   2 \r
   3 Const Noir        =0,Bleu          =1,Vert        =2,Cyan          =3,\r
   4       Rouge       =4,Magenta       =5,Marron      =6,GrisCLair     =7,\r
   5       GrisFonce   =8,BleuClair     =9,VertClair  =10,CyanClair    =11,\r
   6       RougeClair =12,MagentaClair =13,Jaune      =14,Blanc        =15;\r
   7 \r
   8 Const MODE   = 0;\r
   9 Const XMAX   = 640, YMAX= 480;\r
  10 \r
  11    (*****************************************************************************)\r
  12    (*             premiere famille de classes : les classes graphiques          *)\r
  13    (*****************************************************************************)\r
  14    Unit Ptr : class;\r
  15    End Ptr;\r
  16 \r
  17    Unit Windows : process (node : integer,father :windows,x1,y1,x2,y2 : integer);\r
  18    Var lborder,cfond,cborder : integer,\r
  19        lbande,cfbande,cbbande : integer,\r
  20       hauteur,largeur       : integer,\r
  21       xpos,ypos,xmax,ymax   : integer,\r
  22       xdeb,ydeb             : integer,\r
  23       num_id                : integer,\r
  24       ListM                 : Lclic,\r
  25       ListK                 : LKey,\r
  26       Bout                  : arrayof bottons,\r
  27       nombande              : arrayof char,\r
  28       barcde                : menu,\r
  29       save_map              : arrayof integer;\r
  30 \r
  31 \r
  32       Unit option : procedure (l1,l2,l3,l4,l5,l6 : integer,l7 : string);\r
  33       Begin\r
  34        cfond:=l1; lborder:=l2; cborder:=l3; lbande:=l4;\r
  35        cfbande:=l5; cbbande:=l6;\r
  36        nombande:=unpack(l7);\r
  37        xdeb:=x1+lborder+3;\r
  38        ydeb:=y1+lborder+lbande+3;\r
  39        bout(1):=new racc(this windows,x1+lborder+1,y1+lborder+1,x1+lborder+1+\r
  40                       lbande,y1+lborder+1+lbande,spr_close);\r
  41        bout(2):=new racc(this windows,x2-lborder-2-lbande*2,y1+lborder+1,\r
  42                          x2-lborder-2-lbande,y1+lborder+1+lbande,spr_lower);\r
  43        bout(3):=new racc(this windows,x2-lborder-1-lbande,y1+lborder+1,\r
  44                          x2-lborder-1,y1+lborder+1+lbande,spr_upper);\r
  45       End option;\r
  46 \r
  47       Unit Affiche : procedure;\r
  48       Var i,j,k :integer;\r
  49       Begin\r
  50        call father.moveto(x1,y1);\r
  51        save_map:=father.getmape(x2,y2);\r
  52        call father.rectanglef(x1,y1,x2,y2,cfond);\r
  53        for i:=0 to lborder\r
  54         do\r
  55          call father.rectangle(x1+i,y1+i,x2-i,y2-i,cborder);\r
  56         od;\r
  57        i:=y1+lborder+1;\r
  58        call father.rectanglef(x1+lborder+1,i,x2-lborder-1,i+imax(14,lbande),cfbande);\r
  59        j:=(x2-x1-2*lborder-8*(upper(nombande)-lower(nombande)))/2;\r
  60        for i:=lower(nombande) to upper(nombande)\r
  61         do\r
  62          k:=x1+lborder+j+i*8;\r
  63          call father.outxyascii(k,y1+lborder+2,ord(nombande(i)),cbbande,cfbande);\r
  64         od;\r
  65         call affichesuite;\r
  66         if(barcde<>none)\r
  67         then call barcde.affichemenu;\r
  68         fi;\r
  69         call bout(1).affiche;\r
  70         call bout(2).affiche;\r
  71         call bout(3).affiche;\r
  72         call affichesuite;\r
  73       End Affiche;\r
  74 \r
  75       Unit virtual affichesuite :procedure;\r
  76       End affichesuite;\r
  77 \r
  78       Unit virtual moveto : procedure(x1,y1 : integer);\r
  79       Begin\r
  80        call father.moveto(x1,y1);\r
  81       End moveto;\r
  82 \r
  83       Unit virtual getmape : function(x2,y2 : integer) : arrayof integer;\r
  84       Begin\r
  85        result:=father.getmape(x2,y2);\r
  86       End getmape;\r
  87 \r
  88       Unit virtual putmape : procedure(a : arrayof integer);\r
  89       Begin\r
  90        call father.putmape(a);\r
  91       End putmape;\r
  92 \r
  93       Unit virtual rectangle : procedure(xx1,yy1,xx2,yy2,c :integer);\r
  94       Begin\r
  95        call father.rectangle(xx1,yy1,xx2,yy2,c);\r
  96       End rectangle;\r
  97 \r
  98       Unit virtual ligne : procedure (xx1,yy1,xx2,yy2,c : integer);\r
  99       Begin\r
 100        call father.ligne(xx1,yy1,xx2,yy2,c);\r
 101       End ligne;\r
 102 \r
 103       Unit virtual rectanglef : procedure(xx1,yy1,xx2,yy2,c : integer);\r
 104       Begin\r
 105        call father.rectanglef(xx1,yy1,xx2,yy2,c);\r
 106       End rectanglef;\r
 107 \r
 108       Unit virtual outxyascii : procedure(x,y,car,cf,cb : integer);\r
 109       Begin\r
 110        call father.outxyascii(x,y,car,cf,cb);\r
 111       End outxyascii;\r
 112 \r
 113       Unit virtual outxytext : procedure(x,y:integer,chaine:string,c1,c2:integer);\r
 114       Begin\r
 115        call father.outxytext(x,y,chaine,c1,c2);\r
 116       End outxytext;\r
 117 \r
 118       Unit virtual outxyint : procedure(x,y,val,cf,ce :integer);\r
 119       Begin\r
 120        call father.outxyint(x,y,val,cf,ce);\r
 121       End outxyint;\r
 122 \r
 123      unit ydebut: function: integer;\r
 124      begin\r
 125            result := ydeb\r
 126      end ydebut;\r
 127      \r
 128      unit xdebut: function: integer;\r
 129      begin\r
 130            result := xdeb\r
 131      end xdebut;\r
 132 \r
 133      Unit EndWindow : procedure;\r
 134      Begin\r
 135        call father.moveto(x1,y1);\r
 136        call putmape(save_map);\r
 137      End EndWindow;\r
 138 \r
 139    Begin\r
 140     hauteur:=y2-y1-2*lborder;\r
 141     largeur:=x2-x1-2*lborder;\r
 142     array bout dim (1:3);\r
 143     return;\r
 144 \r
 145     enable outxytext, outxyascii, rectanglef, rectangle, affichesuite,\r
 146            affiche, option, xdebut, ydebut, outxyint, ligne, moveto ,\r
 147            getmape, putmape, Endwindow;\r
 148     do\r
 149       accept\r
 150     od\r
 151    End Windows;\r
 152 \r
 153   (***********************************************************************)\r
 154     Unit graph : windows class;\r
 155 \r
 156      Unit enablegraph : procedure;\r
 157      Begin \r
 158      End enablegraph;\r
 159      \r
 160      Unit disablegraph : procedure;\r
 161      Begin\r
 162      End disablegraph;\r
 163      \r
 164      Unit virtual rectangle : iiuwgraph procedure (x1,y1,x2,y2,c : integer);\r
 165      Begin\r
 166       call patern(x1,y1,x2,y2,c,0);\r
 167      End rectangle;\r
 168 \r
 169      Unit virtual rectanglef : iiuwgraph procedure (x1,y1,x2,y2,c : integer);\r
 170      Begin\r
 171       call patern(x1,y1,x2,y2,c,1);\r
 172      End rectanglef;\r
 173 \r
 174      Unit virtual ligne : iiuwgraph procedure (x1,y1,x2,y2,c : integer);\r
 175      Begin\r
 176       call color(c);\r
 177       call move(x1,y1);\r
 178       call draw(x2,y2);\r
 179      End ligne;\r
 180 \r
 181      Unit virtual outxyascii : iiuwgraph procedure (x,y,car,cf,cb :integer);\r
 182      Begin\r
 183       call move(x,y);\r
 184       call color(cf);\r
 185       call border(cb);\r
 186       call hascii(car);\r
 187      End outxyascii;\r
 188 \r
 189      Unit virtual outxytext : iiuwgraph procedure (x,y :integer, \r
 190                                              chaine :string,c1,c2 :integer);\r
 191      Begin\r
 192       call outstring(x,y,chaine,c1,c2);\r
 193      End outxytext;\r
 194 \r
 195      Unit virtual outxyint : iiuwgraph procedure (x,y,val,cf,ce :integer);\r
 196      Begin\r
 197       call track(x,y,val,cf,ce);\r
 198      End outxyint;\r
 199 \r
 200      Unit virtual moveto : iiuwgraph procedure (x1,y1 : integer);\r
 201      Begin\r
 202       call move(x1,y1); \r
 203      End moveto;\r
 204 \r
 205      Unit virtual getmape : iiuwgraph function (x2,y2 : integer) : arrayof integer;\r
 206      Begin\r
 207       result:=getmap(x2,y2);\r
 208      End getmape;\r
 209 \r
 210      Unit virtual putmape : iiuwgraph procedure (a : arrayof integer);\r
 211      Begin\r
 212       call putmap(a);\r
 213      End putmape;\r
 214 \r
 215      Unit virtual affichesuite : procedure;\r
 216      Var x,y : integer;\r
 217      Begin\r
 218       x:=x1+100-lborder; y:=y1+lbande+lborder+1;\r
 219       call rectanglef(x,y,x+lborder,y2-lborder-1,cborder);\r
 220       x:=x+lborder; y:=y2-100-lborder;\r
 221       call rectanglef(x,y,x2-lborder,y+lborder,cborder);\r
 222       xdeb:=x1+100+10;\r
 223       ydeb:=y1+lborder+lbande+10;\r
 224      End affichesuite;\r
 225     \r
 226     Begin\r
 227      return;\r
 228 \r
 229      enable affichesuite,affiche, option, xdebut, ydebut,\r
 230             enablegraph,disablegraph;\r
 231      do\r
 232        accept\r
 233      od\r
 234     End graph;\r
 235 \r
 236 \r
 237    Unit Bitmap : Windows Class;\r
 238    End Bitmap;\r
 239 \r
 240    Unit Son : Windows Class;\r
 241    End Son;\r
 242 \r
 243    Unit Maine : Windows Class;\r
 244    End Maine;\r
 245 \r
 246    Unit Dialogue : Son Class;\r
 247    End Dialogue;\r
 248 \r
 249    Unit Catalogue : Dialogue Class;\r
 250    End Catalogue;\r
 251 \r
 252    Unit Question : Dialogue Class;\r
 253    End Question;\r
 254 \r
 255    Unit Widgets : class(father : windows);\r
 256    End Widgets;\r
 257 \r
 258    (**********************************************************************)\r
 259    Unit Menu : Widgets Class(x,y,col_e,col_f: integer);\r
 260    Var liste : ensemble;\r
 261 \r
 262     Unit item : element class(nom : string,key : integer,suite :Menu);\r
 263     End item;\r
 264 \r
 265     Unit insert : procedure(nom : string,key : integer,s : menu);\r
 266     var e : item;\r
 267     Begin\r
 268       e:=new item(nom,key,s);\r
 269       if(liste=none)\r
 270       then liste:=new ensemble;\r
 271       fi;\r
 272       call liste.insert(e);\r
 273     End insert;\r
 274 \r
 275     Unit virtual affichemenu : procedure;\r
 276     End affichemenu;\r
 277 \r
 278    End Menu;\r
 279 \r
 280    Unit Menu_V : Menu Class;\r
 281 \r
 282     Unit  virtual affichemenu : procedure;\r
 283     Var cour  : item,\r
 284         tlen  : arrayof char,\r
 285         len   : integer,\r
 286         xx,yy : integer;\r
 287     Begin\r
 288      (* ... *)\r
 289     End affichemenu;\r
 290 \r
 291    End Menu_V;\r
 292 \r
 293    Unit Menu_H : Menu Class;\r
 294    \r
 295     Unit  virtual affichemenu : procedure;\r
 296     Var cour  : item,\r
 297         tlen  : arrayof char,\r
 298         len   : integer,\r
 299         xx,yy : integer;\r
 300     Begin\r
 301      (* ... *)\r
 302     End affichemenu;\r
 303    \r
 304    End Menu_H;\r
 305 \r
 306   (***********************************************************************)\r
 307    Unit Bottons : Widgets Class(x1,y1,x2,y2 : integer);\r
 308     Unit affiche : procedure;\r
 309     Begin\r
 310      call father.rectanglef(x1,y1,x2,y2,GrisClair);\r
 311      call father.ligne(x1,y1,x2,y1,blanc);\r
 312      call father.ligne(x1,y1+1,x2-1,y1+1,blanc);\r
 313      call father.ligne(x1,y1,x1,y2,blanc);\r
 314      call father.ligne(x1+1,y1+2,x1+1,y2-1,blanc);\r
 315      call father.ligne(x1+1,y2,x2,y2,GrisFonce);\r
 316      call father.ligne(x1+2,y2-1,x2-1,y2-1,GrisFonce);\r
 317      call father.ligne(x2,y2,x2,y1+1,GrisFonce);\r
 318      call father.ligne(x2-1,y2-1,x2-1,y1+2,GrisFonce);\r
 319      call affichesuite;\r
 320     End affiche;\r
 321 \r
 322     Unit virtual affichesuite : procedure;\r
 323     End affichesuite;\r
 324 \r
 325    End Bottons;\r
 326 \r
 327    Unit Racc : Bottons Class(procedure sprite(x1,y1,x2,y2,c : integer,\r
 328                                                 father :windows));\r
 329     Unit virtual affichesuite : procedure;\r
 330     Begin\r
 331      call sprite(x1,y1,x2,y2,Noir,father);\r
 332     End affichesuite;\r
 333    End Racc;\r
 334 \r
 335    Unit Opt_list : Bottons Class;\r
 336    End Opt_list;\r
 337 \r
 338    Unit Oneline : Opt_list Class;\r
 339    End Oneline;\r
 340 \r
 341    Unit Multiline : Opt_list Class;\r
 342    End Multiline;\r
 343 \r
 344    Unit Botton : Bottons Class;\r
 345    End Botton;\r
 346 \r
 347    Unit Lift : Widgets Class;\r
 348    End Lift;\r
 349 \r
 350    Unit Lift_V : Lift Class;\r
 351    End Lift_V;\r
 352 \r
 353    Unit Lift_H : Lift Class;\r
 354    End Lift_H;\r
 355 \r
 356 \r
 357 \r
 358 \r
 359 (***************************************************************************)\r
 360 (*             procedure d'affichage des sprites des boutons               *)\r
 361 (***************************************************************************)\r
 362 \r
 363 (***************************************************************************)\r
 364    Unit spr_upper : procedure(x1,y1,x2,y2,couleur : integer,father:windows);\r
 365    var i,x,y : integer;\r
 366    Begin\r
 367     x:=(x2-x1)/2;\r
 368     y:=(y2-y1)/2;\r
 369     for i:=1 to y\r
 370     do\r
 371      call father.Ligne(x1+x-i/2,y1+y/2+i,x1+x+i/2,y1+y/2+i,couleur);\r
 372     od\r
 373    End spr_upper;\r
 374 \r
 375 (***************************************************************************)\r
 376    Unit spr_lower : procedure(x1,y1,x2,y2,couleur : integer,father:windows);\r
 377    var i,x,y : integer;\r
 378    Begin\r
 379     x:=(x2-x1)/2;\r
 380     y:=(y2-y1)/2;\r
 381     for i:=1 to y\r
 382     do\r
 383      call father.Ligne(x1+x-i/2,y2-y/2-i,x1+x+i/2,y2-y/2-i,couleur);\r
 384     od\r
 385    End spr_lower;\r
 386 \r
 387 (***************************************************************************)\r
 388    Unit spr_left : procedure(x1,y1,x2,y2,couleur : integer,father:windows);\r
 389    var i,x,y : integer;\r
 390    Begin\r
 391     x:=(x2-x1)/2;\r
 392     y:=(y2-y1)/2;\r
 393     for i:=1 to x\r
 394     do\r
 395      call father.Ligne(x2-x/2-i,y1+y-i/2,x2-x/2-i,y1+y+i/2,couleur);\r
 396     od\r
 397    End spr_left;\r
 398 \r
 399 (***************************************************************************)\r
 400    Unit spr_right : procedure(x1,y1,x2,y2,couleur : integer,father:windows);\r
 401    var i,x,y : integer;\r
 402    Begin\r
 403     x:=(x2-x1)/2;\r
 404     y:=(y2-y1)/2;\r
 405     for i:=1 to x\r
 406     do\r
 407      call father.Ligne(x1+x/2+i,y1+y-i/2,x1+x/2+i,y1+y+i/2,couleur);\r
 408     od\r
 409    End spr_right;\r
 410 \r
 411 (***************************************************************************)\r
 412    Unit spr_close : procedure(x1,y1,x2,y2,couleur : integer,father:windows);\r
 413    var y : integer;\r
 414    Begin\r
 415     y:=(y2-y1)/2;\r
 416     call father.Rectanglef(x1+3,y1+y-1,x2-3,y1+y+1,couleur);\r
 417    End spr_close;\r
 418 \r
 419 (***************************************************************************)\r
 420    Unit spr_point : procedure(x1,y1,x2,y2,couleur : integer,father:windows);\r
 421    var x,y : integer;\r
 422    Begin\r
 423     y:=(y2-y1)/2;\r
 424     x:=(x2-x1)/2;\r
 425     call father.Rectanglef(x1+x-1,y1+y-1,x1+x+1,y1+y+1,couleur);\r
 426    End spr_point;\r
 427 \r
 428 \r
 429 \r
 430    (*****************************************************************************)\r
 431    (*          deuxieme famille de classes : les structures de donnees          *)\r
 432    (*****************************************************************************)\r
 433    Unit element : class;  (* general *)\r
 434    End element;\r
 435 \r
 436    Unit elm_c : element class(id,x1,y1,x2,y2 : integer); (* listclic *)\r
 437    End elm_c;\r
 438 \r
 439    Unit elm_a : element class(p : Applications);  (* liste application *)\r
 440    End elm_a;\r
 441 \r
 442 \r
 443    Unit Ensemble : CLass;\r
 444    Var root,last : node,\r
 445        courant   : node;\r
 446 \r
 447     Unit node : class(elm : element);\r
 448     Var next : node;\r
 449     End node;\r
 450 \r
 451     Unit virtual insert : procedure(e : element);\r
 452     Begin\r
 453      if not member(e)\r
 454      then if empty\r
 455           then root:=new node(e);\r
 456                last:=root;\r
 457           else last.next:=new node(e);\r
 458                last:=last.next;\r
 459           fi\r
 460      fi\r
 461     End insert;\r
 462 \r
 463     Unit virtual delete : procedure(e : element);\r
 464     Var flag : node;\r
 465     Begin\r
 466      if member(e)\r
 467      then flag:=courant.next;\r
 468           if flag=last\r
 469           then last:=courant;\r
 470                courant.next:=none;\r
 471                kill(flag);\r
 472           else if courant.next<>none\r
 473                then courant.next:=courant.next.next;\r
 474                     kill(flag);\r
 475                fi\r
 476           fi\r
 477      fi\r
 478     End delete;\r
 479 \r
 480     Unit virtual member : function (e : element) : boolean;\r
 481     Var  savecou : node,\r
 482          bl : boolean;\r
 483     Begin\r
 484      courant:=root;\r
 485      savecou:=courant;\r
 486      bl:=false;\r
 487      while(courant<>none)\r
 488       do\r
 489        if not egalite(courant.elm,e)\r
 490        then savecou:=courant;\r
 491             courant:=courant.next;\r
 492        else bl:=true;\r
 493             exit;\r
 494        fi\r
 495       od;\r
 496       courant:=savecou;\r
 497       result:=bl;\r
 498     End member;\r
 499 \r
 500     Unit virtual egalite : function (e1,e2 :element) :boolean;\r
 501     End egalite;\r
 502 \r
 503     Unit empty : function : boolean;\r
 504     Begin\r
 505      result:=(root=none);\r
 506     End empty;\r
 507 \r
 508     Unit initialise : procedure;\r
 509     Begin\r
 510      courant:=root;\r
 511     End initialise;\r
 512 \r
 513     Unit getelm : function(output e : element) :boolean;\r
 514     Begin\r
 515      if(courant<>none)\r
 516      then e:=courant.elm;\r
 517           result:=true;\r
 518           courant:=courant.next;\r
 519      else result:=false;\r
 520      fi\r
 521     End getelm;\r
 522 \r
 523    End Ensemble;\r
 524 \r
 525    Unit Queue : Ensemble Class;\r
 526    End Queue;\r
 527 \r
 528    Unit Ofpriority : Queue Class;\r
 529    End Ofpriority;\r
 530 \r
 531    Unit ListD : Ensemble Class;\r
 532    End ListD;\r
 533 \r
 534    Unit LClic : ListD Class;\r
 535 \r
 536     Unit virtual egalite : function (e1,e2 :element) :boolean;\r
 537     Begin\r
 538      if (e1 qua elm_c.x1=e2 qua elm_c.x1 and e1 qua elm_c.x2=e2 qua elm_c.x2\r
 539          and e1 qua elm_c.y1=e2 qua elm_c.y1 and e1 qua elm_c.y2=e2 qua elm_c.y2)\r
 540      then result:=TRUE;\r
 541      else result:=FALSE;\r
 542      fi\r
 543     End egalite;\r
 544 \r
 545     Unit appartient : function (x,y : integer) : boolean;\r
 546     Var e : elm_c,\r
 547         b : boolean;\r
 548     Begin\r
 549      call initialise;\r
 550      b:=false;\r
 551      while(getelm(e))\r
 552       do\r
 553        if (x>=e.x1 and x<=e.x2 and y>=e.y1 and y<=e.y2)\r
 554        then  b:=TRUE;\r
 555              exit;\r
 556        fi\r
 557       od;\r
 558      result:=b;\r
 559     End appartient;\r
 560 \r
 561    End LClic;\r
 562 \r
 563    Unit LBot : ListD Class;\r
 564    End LBot;\r
 565 \r
 566    Unit LAppli : ListD Class;\r
 567     Unit egalite : function (e1,e2 :elm_a) :boolean;\r
 568     Begin\r
 569      if (e1 qua elm_a.p = e2 qua elm_a.p)\r
 570      then result:=TRUE;\r
 571      else result:=FALSE;\r
 572      fi;\r
 573     End egalite;\r
 574    End LAppli;\r
 575 \r
 576    Unit LKey : ListD Class;\r
 577    End LKey;\r
 578 \r
 579    Unit LWin : ListD Class;\r
 580    End LWin;\r
 581 \r
 582    Unit Stack : Ensemble Class;\r
 583    End Stack;\r
 584 \r
 585 \r
 586 \r
 587    (*****************************************************************************)\r
 588    (*                           Famille de process                              *)\r
 589    (*****************************************************************************)\r
 590    Unit Applications : process (node,x1,y1,x2,y2: integer,father: Gest_Wind);\r
 591    Var w      : windows, (* maine *)\r
 592        j      : graph,\r
 593        Filles : windows, (* son *)\r
 594        i      : integer,\r
 595        nom    : string;\r
 596 \r
 597     Unit virtual gestionnaire : procedure(id : integer);\r
 598     Begin\r
 599     End gestionnaire;\r
 600 \r
 601     Unit affecte : procedure ( nm : string);\r
 602     Begin\r
 603      nom:=nm;\r
 604     End affecte;\r
 605 \r
 606    Begin\r
 607       w:=new windows(0,father.getw,x1,y1,x2,y2);\r
 608       resume(w);\r
 609       return;\r
 610       accept affecte;\r
 611       call w.option(Noir,3,Bleu,15,Bleu,Blanc,nom);\r
 612       call w.affiche;\r
 613    End Applications;\r
 614 \r
 615   (************************************************************************)\r
 616   (************************************************************************)\r
 617    Unit Gest_event : mouse process (node : integer,gest : gest_wind);\r
 618 \r
 619     Unit ready : procedure;\r
 620     End ready;\r
 621 \r
 622     Unit event : function(output v,h,p,l,r,c : integer) : boolean;\r
 623     Begin\r
 624      result:=getpress(v,h,p,l,r,c);\r
 625     End;\r
 626 \r
 627    Var i :integer,\r
 628        v,h,p,l,r,c : integer;\r
 629    Begin\r
 630       return;\r
 631       accept ready;\r
 632       call init(1,1);\r
 633       call showcursor;\r
 634       do\r
 635        if(event(v,h,p,l,r,c))\r
 636        then call gest.event(v,h,p,l,r,c);\r
 637        fi;\r
 638       od\r
 639    End Gest_event;\r
 640 \r
 641   (***********************************************************************)\r
 642   (***********************************************************************)\r
 643    Unit Gest_wind : iiuwgraph process(node,x1,y1,x2,y2 : integer,\r
 644                                                      gest:gest_event);\r
 645 \r
 646    Var i,k,px,py :integer,\r
 647        v,p,h,l,r,c : integer,\r
 648        ListK       : LKey,\r
 649        ListM       : LClic,\r
 650        ListA       : LAppli,\r
 651        w           : windows,\r
 652        j           : graph;\r
 653 \r
 654 \r
 655     Unit getinfo : procedure (g : gest_event);\r
 656     Begin\r
 657      gest:=g;\r
 658      disable getinfo;\r
 659     End getinfo;\r
 660 \r
 661     Unit event : procedure (input lv,lh,lp,ll,lr,lc : integer);\r
 662     Begin\r
 663      v:=lv; h:=lh; p:=lp; l:=ll; r:=lr; c:=lc;\r
 664      call traitement;\r
 665     End event;\r
 666 \r
 667 \r
 668     Unit traitement : procedure;\r
 669   \r
 670       Unit fin : procedure;\r
 671       begin\r
 672         call groff;\r
 673         call endrun;\r
 674       End fin;\r
 675   \r
 676     Begin\r
 677      if((p=164 and l=27) or   c=3)\r
 678      then call fin;\r
 679      fi;\r
 680      (* recherche dans un arbre des fenetres filles si l'evenement *)\r
 681      (* appartient a qqn                                           *)\r
 682      (* ici c'est a refaire, c'est juste pour tester *)\r
 683      if(c=1)\r
 684      then if(v>110 and v<400 and h>50 and h<250)\r
 685           then writeln("coucou");\r
 686           fi;\r
 687      fi;\r
 688     End traitement;\r
 689 \r
 690 \r
 691 \r
 692     Unit initialisation2 : procedure;\r
 693     Begin\r
 694      ListA:=new LAppli;\r
 695     End initialisation2;\r
 696 \r
 697     Unit xdeb :  function : integer;\r
 698     Begin\r
 699      result:=j.xdebut;\r
 700     End xdeb;\r
 701 \r
 702     Unit ydeb : function : integer;\r
 703     Begin\r
 704      result:=j.ydebut;\r
 705     End ydeb;\r
 706 \r
 707     Unit getw : function : windows;\r
 708     Begin\r
 709      result:=w;\r
 710     End getw;\r
 711 \r
 712     \r
 713     Unit insertA : procedure(e : applications);\r
 714     Begin\r
 715      call ListA.insert(new elm_a(e));\r
 716     end; \r
 717     \r
 718 \r
 719 \r
 720    Begin\r
 721       call gron(MODE);  (* 5 = 1024x768x256 *)\r
 722       j:=new graph(0,none,x1,y1,x2,y2);\r
 723       resume(j);\r
 724       w:=new windows(0,j,x1,y1,x2,y2);\r
 725       resume(w);\r
 726       call w.option(Grisfonce,3,BleuClair,15,BleuCLair,Blanc,"Gest_Wind");\r
 727       call w.affiche;\r
 728       call J.option(Grisfonce,3,BleuClair,15,BleuCLair,Blanc,"Gst_Windows");\r
 729       call j.affichesuite;\r
 730       return;\r
 731 \r
 732       accept getinfo;\r
 733       enable xdeb,ydeb,getw,insertA;\r
 734       call gest.ready;\r
 735       call initialisation2;           \r
 736       enable event;\r
 737       px:=w.xdebut; py:=w.ydebut;\r
 738       i:=1;\r
 739       do\r
 740        call w.outxyint(px,py,i,Bleu,Blanc);\r
 741        i:=i+1;\r
 742       od;\r
 743       call groff;\r
 744    End Gest_wind;\r
 745 \r
 746 \r
 747    Unit Appli : Applications class;\r
 748    Var px,py : integer;\r
 749    Begin   \r
 750      px:=w.xdebut; py:=w.ydebut;\r
 751      call w.outxytext(px,py,"coucou",Vert,Noir);\r
 752      i:=1;\r
 753      do\r
 754       call w.outxyint(px,py+20,i,Bleu,Blanc);\r
 755       i:=i+1;\r
 756      od\r
 757    End Appli;\r
 758 \r
 759 \r
 760 (*****************************************************************************)\r
 761 (*                   P r o g r a m  m e   P r i n c i p a l                  *)\r
 762 (*****************************************************************************)\r
 763 Var i  : integer,\r
 764     G1 : Gest_wind,\r
 765     Z1,Z2 : appli,\r
 766     G2 : Gest_event,\r
 767     x,y :integer;\r
 768 \r
 769 Begin\r
 770    G1:=new Gest_wind(0,0,0,XMAX,YMAX,none);\r
 771    G2:=new Gest_event(0,G1);\r
 772    resume(G1);\r
 773    resume(G2);\r
 774    call G1.getinfo(G2);\r
 775 \r
 776    x:=G1.xdeb;\r
 777    y:=G1.ydeb;\r
 778    \r
 779    Z1:=new appli(0,x+10,y+10,x+330,y+210,G1);\r
 780    resume(Z1);\r
 781    call G1.insertA(Z1);\r
 782    call Z1.affecte("Application - 1 -");\r
 783    \r
 784    Z2:=new appli(0,x+250,y+80,x+520,y+250,G1);\r
 785    resume(Z2);\r
 786    call G1.insertA(Z2);\r
 787    call Z2.affecte("Application - 2 -");\r
 788 \r
 789 \r
 790 End.\r
 791 \r
 792 \r
 793 \r
 794 \r
 795 \r
 796 \r
 797 \r
 798 \r