examples/apply/windo.log

   1 PROGRAM TestWindow;\r
   2 \r
   3 BEGIN\r
   4  PREF IIUWGRAPH BLOCK\r
   5 \r
   6 (* -------------------- Limites de l'\82cran -------------------- *)\r
   7 \r
   8    CONST    XTailleEcran=638, YTailleEcran=348;\r
   9 \r
  10 \r
  11 (* ================================================================== *)\r
  12 (*                         CLASSE Fenetre                             *)                              \r
  13 (* ================================================================== *)\r
  14 \r
  15 UNIT Fenetre : CLASS (x,y,largeur,hauteur,numero : INTEGER);\r
  16    \r
  17    VAR ArrierePlan     : ARRAYOF INTEGER,\r
  18        BufferFenetre   : ARRAYOF INTEGER,\r
  19        ContenuFenetre : ARRAYOF INTEGER,\r
  20        Buffer         : ARRAYOF INTEGER,\r
  21        Titre        : ARRAYOF CHAR,\r
  22        Active       : BOOLEAN,\r
  23        CurseurX,CurseurY,x1,y1 : INTEGER;\r
  24 \r
  25 \r
  26 (* -------------------- PROCEDURE InitFenetre -------------------- *)\r
  27 \r
  28 UNIT InitFenetre : PROCEDURE;\r
  29    VAR Cx, Cy, i, k : INTEGER;\r
  30 \r
  31 BEGIN\r
  32    IF Active\r
  33       THEN \r
  34          Cx:=CurseurX; Cy:=CurseurY;\r
  35          CALL MettreCurseur(0,0);\r
  36          CALL OUTSTRING("Fen\88tre ");\r
  37          CALL HASCII(0); CALL HASCII(numero+48);\r
  38          CurseurX:=Cx; CurseurY:=Cy;\r
  39          k:=8*9;\r
  40          CALL COLOR(1);\r
  41          CALL STYLE(4);\r
  42          FOR i:=1 TO 7\r
  43          DO\r
  44             CALL MOVE(x+k,y+i); CALL HFILL(x1-8);\r
  45             CALL MOVE(x1-i,y+1); CALL VFILL(y1-1); \r
  46             CALL MOVE(x+1,y1-i); CALL HFILL(x1-1);\r
  47             CALL MOVE(x+i,y+10); CALL VFILL(y1-1);\r
  48          OD;\r
  49          CALL STYLE(1);\r
  50    FI;\r
  51 END InitFenetre;\r
  52 \r
  53 \r
  54 (* -------------------- PROCEDURE MettreCurseur -------------------- *)\r
  55 \r
  56 UNIT MettreCurseur : PROCEDURE (ligne, colonne : INTEGER);\r
  57 \r
  58 BEGIN\r
  59    CurseurX:=x+8*colonne;\r
  60    CurseurY:=y+10*ligne;\r
  61    IF Active \r
  62       THEN CALL MOVE(CurseurX,CurseurY);\r
  63    FI;\r
  64 END MettreCurseur;\r
  65 \r
  66 \r
  67 (* -------------------- PROCEDURE SauveFenetre -------------------- *)\r
  68 \r
  69 UNIT SauveFenetre : PROCEDURE;\r
  70 \r
  71 BEGIN\r
  72   IF Active\r
  73      THEN\r
  74         CALL MOVE(x,y);\r
  75         BufferFenetre:=GETMAP(x1,y1);\r
  76         Active:=FALSE;\r
  77   FI;\r
  78 END SauveFenetre;\r
  79 \r
  80 \r
  81 (* -------------------- PROCEDURE CacheFenetre -------------------- *)\r
  82 \r
  83 UNIT CacheFenetre : PROCEDURE;\r
  84 \r
  85 BEGIN\r
  86    IF Active \r
  87       THEN CALL MOVE(x,y);\r
  88            BufferFenetre:=GETMAP(x1,y1);\r
  89            CALL XORMAP(BufferFenetre);\r
  90            CALL MOVE(x,y);\r
  91            CALL PUTMAP(ArrierePlan);\r
  92            KILL(ArrierePlan);\r
  93            Active:=FALSE;\r
  94    FI;\r
  95 END CacheFenetre;\r
  96            \r
  97 \r
  98 (* -------------------- PROCEDURE AfficheFenetre -------------------- *)\r
  99 \r
 100 UNIT AfficheFenetre : PROCEDURE;\r
 101 \r
 102 BEGIN\r
 103    IF NOT Active\r
 104       THEN\r
 105          CALL MOVE(x,y);\r
 106          ArrierePlan:=GETMAP(x1,y1);\r
 107          CALL XORMAP(ArrierePlan);\r
 108          CALL MOVE(x,y);\r
 109          CALL PUTMAP(BufferFenetre);\r
 110          KILL(BufferFenetre);\r
 111          Active:=TRUE;\r
 112    FI;\r
 113 END AfficheFenetre;\r
 114 \r
 115 \r
 116 (* -------------------- PROCEDURE EffaceFenetre -------------------- *)\r
 117 \r
 118 UNIT EffaceFenetre : PROCEDURE;\r
 119 \r
 120 BEGIN\r
 121    IF Active\r
 122       THEN\r
 123          CALL MOVE(x+8,y+8);\r
 124          ContenuFenetre:=GETMAP(x1-8,y1-8);\r
 125          CALL XORMAP(ContenuFenetre);\r
 126          KILL(ContenuFenetre);\r
 127          CALL MettreCurseur(1,1);\r
 128    FI;\r
 129 END EffaceFenetre;\r
 130 \r
 131 \r
 132 (* -------------------- PROCEDURE DeplaceFenetre -------------------- *)\r
 133 \r
 134 UNIT DeplaceFenetre : PROCEDURE (dx, dy : INTEGER);\r
 135 \r
 136 BEGIN\r
 137    IF x=0 AND dx<0 THEN EXIT FI;\r
 138    IF y=0 AND dy<0 THEN EXIT FI;\r
 139    IF x1=XTailleEcran AND dx>0 THEN EXIT FI;\r
 140    IF y1=YTailleEcran AND dy>0 THEN EXIT FI;\r
 141    IF x+dx<0 THEN dx:=-x FI;\r
 142    IF y+dy<0 THEN dy:=-y FI;\r
 143    CurseurX:=(CurseurX-x)/8;\r
 144    CurseurY:=(CurseurY-y)/10;\r
 145    IF Active\r
 146       THEN\r
 147          CALL MOVE(x,y);\r
 148          IF ContenuFenetre=/=none THEN KILL(ContenuFenetre) FI;\r
 149          BufferFenetre:=GETMAP(x1,y1);\r
 150    FI;\r
 151    IF x1+dx>XTailleEcran THEN dx:=XTailleEcran-x1 FI;\r
 152    IF y1+dy>YTailleEcran THEN dy:=YTailleEcran-y1 FI;\r
 153    x:=x+dx;\r
 154    y:=y+dy;\r
 155    x1:=x1+dx;\r
 156    y1:=y1+dy;\r
 157    IF Active\r
 158       THEN\r
 159          CALL XORMAP(BufferFenetre);\r
 160          CALL MOVE(x,y);\r
 161          CALL PUTMAP(BufferFenetre);\r
 162          KILL(BufferFenetre);\r
 163    FI;\r
 164    CALL MettreCurseur(CurseurY,CurseurX);\r
 165 END DeplaceFenetre;\r
 166 \r
 167 \r
 168 (* -------------------- PROCEDURE ChangeTaille -------------------- *)\r
 169 \r
 170 UNIT ChangeTaille : PROCEDURE (dc, dl : INTEGER);\r
 171    \r
 172    VAR x2,y2 : INTEGER;\r
 173 \r
 174 BEGIN\r
 175    IF Active\r
 176       THEN\r
 177          IF x1+8>XTailleEcran AND dc>0 THEN EXIT FI;\r
 178          IF y1+10>YTailleEcran AND dl>0 THEN EXIT FI;\r
 179          x2:=x1+8*dc;\r
 180          y2:=y1+10*dl;\r
 181          IF x2<x+24 \r
 182             THEN largeur:=3\r
 183          ELSE IF x2>XTailleEcran\r
 184                  THEN largeur:=(XTailleEcran-x)/8\r
 185               ELSE \r
 186                  largeur:=largeur+dc\r
 187               FI;\r
 188          FI;\r
 189          IF y2<y+30\r
 190             THEN hauteur:=2 \r
 191          ELSE IF y2>YTailleEcran \r
 192                  THEN hauteur:=(YTailleEcran-y)/10\r
 193               ELSE\r
 194                  hauteur:=hauteur+dl\r
 195               FI;\r
 196          FI;\r
 197          x2:=x+8*largeur;\r
 198          y2:=y+10*hauteur;\r
 199          IF x2<x1 THEN CurseurX:=x+8 FI;\r
 200          IF y2<y1 THEN CurseurY:=y+10 FI;\r
 201          CALL MOVE(IMIN(x1,x2)-8,y);\r
 202          Buffer:=GETMAP(IMAX(x1,x2),IMAX(y1,y2));\r
 203          CALL XORMAP(Buffer);\r
 204          KILL(Buffer);\r
 205          CALL MOVE(x,IMIN(y1,y2)-10);\r
 206          Buffer:=GETMAP(IMIN(x1,x2),IMAX(y1,y2));\r
 207          CALL XORMAP(Buffer);\r
 208          KILL(Buffer);\r
 209          x1:=x2;\r
 210          y1:=y2;\r
 211          CALL InitFenetre;\r
 212    FI;\r
 213 END ChangeTaille;\r
 214 \r
 215 \r
 216 (* -------------------- PROCEDURE SaisirChaine -------------------- *)\r
 217 \r
 218 UNIT SaisirChaine : PROCEDURE (INOUT chaine : ARRAYOF CHAR;\r
 219                                OUTPUT long  : INTEGER);\r
 220    VAR touche,i,col,lig : INTEGER;\r
 221 \r
 222 BEGIN\r
 223    IF Active\r
 224      THEN\r
 225        i:=LOWER(chaine);\r
 226        CALL MOVE(CurseurX,CurseurY);\r
 227        col:=(CurseurX-x)/8;\r
 228        lig:=(CurseurY-y)/10;\r
 229        DO\r
 230           CALL HASCII(0);\r
 231           CALL HASCII(0);\r
 232           CALL HASCII(95);\r
 233           CALL MOVE(INXPOS-8,INYPOS);\r
 234           touche:=INKEY;\r
 235           IF touche<>0 THEN EXIT FI;\r
 236        OD;\r
 237        WHILE touche<>13\r
 238        DO\r
 239           CALL HASCII(0);\r
 240           IF touche=8\r
 241              THEN\r
 242                 IF i>LOWER(chaine) THEN i:=i-1 FI;\r
 243                 CALL MOVE(INXPOS-8,INYPOS);\r
 244                 col:=col-1;\r
 245                 IF col=0\r
 246                    THEN\r
 247                       col:=largeur-2;\r
 248                       lig:=lig-1;\r
 249                       IF lig=0 THEN lig:=1; col:=1 FI;\r
 250                       CALL MettreCurseur(lig,col);\r
 251                 FI;\r
 252                 CALL HASCII(0);\r
 253                 CALL MettreCurseur(lig,col);\r
 254           ELSE\r
 255              CALL HASCII(touche);\r
 256              chaine(i):=CHR(touche);\r
 257              i:=i+1;\r
 258              IF i>UPPER(chaine) THEN EXIT FI;\r
 259              col:=col+1;\r
 260              IF col=largeur-1\r
 261                 THEN\r
 262                    col:=1;\r
 263                    lig:=lig+1;\r
 264                    if lig=hauteur-1 THEN EXIT FI;\r
 265                    CALL MettreCurseur(lig,col);\r
 266              ELSE\r
 267                 CurseurX:=CurseurX+8;\r
 268              FI;\r
 269           FI;\r
 270           DO\r
 271              CALL HASCII(0);\r
 272              CALL HASCII(0);\r
 273              CALL HASCII(95);\r
 274              CALL MOVE(INXPOS-8,INYPOS);\r
 275              touche:=INKEY;\r
 276              IF touche<>0 THEN EXIT FI;\r
 277           OD;\r
 278        OD;\r
 279        IF touche=13\r
 280           THEN\r
 281              CALL MOVE(INXPOS-8,INYPOS);\r
 282              CALL HASCII(32);\r
 283              chaine(touche):=CHR(13);\r
 284              long:=i;\r
 285        FI;\r
 286    FI;\r
 287 END SaisirChaine;\r
 288 \r
 289 \r
 290 (* -------------------- PROCEDURE AfficheChaine -------------------- *)\r
 291 \r
 292 UNIT AfficheChaine : PROCEDURE (chaine : ARRAYOF CHAR);\r
 293 \r
 294    VAR lig, col, i : INTEGER;\r
 295 \r
 296 BEGIN\r
 297    col:=(CurseurX-x)/8;\r
 298    lig:=(CurseurY-y)/10;\r
 299    FOR i:=LOWER(chaine) TO UPPER(chaine)\r
 300    DO\r
 301       CALL MOVE(CurseurX,CurseurY);\r
 302       IF chaine(i)=CHR(13) THEN EXIT FI;\r
 303       CALL HASCII(0);\r
 304       CALL HASCII(ORD(chaine(i)));\r
 305       col:=col+1;\r
 306       IF col=largeur-1\r
 307          THEN\r
 308             col:=1;\r
 309             CurseurX:=x+8;\r
 310             CurseurY:=y+10;\r
 311             IF CurseurY>y1-12 THEN CurseurY:=y+10 FI;\r
 312             lig:=lig+1;\r
 313             IF lig=hauteur-1 THEN EXIT FI;\r
 314          ELSE\r
 315             CurseurX:=CurseurX+8;\r
 316       FI;\r
 317    OD;\r
 318 END AfficheChaine;\r
 319                \r
 320 \r
 321 (* -------------------- INITIALISATION Fenetre -------------------- *)\r
 322 \r
 323 BEGIN\r
 324    IF x<0\r
 325       THEN x:=0;\r
 326       ELSE IF x>XTailleEcran\r
 327               THEN x:=0;\r
 328            FI;\r
 329    FI;\r
 330    IF y<0\r
 331       THEN y:=0;\r
 332       ELSE IF y>YTailleEcran\r
 333               THEN y:=0;\r
 334            FI;\r
 335    FI;\r
 336    IF x+8*largeur>XTailleEcran\r
 337       THEN largeur:=ENTIER((XtailleEcran-x)/8);\r
 338    FI;\r
 339    IF y+10*hauteur>YTailleEcran\r
 340       THEN hauteur:=ENTIER((YTailleEcran-y)/10);\r
 341    FI;\r
 342    x1:=x+8*largeur;\r
 343    y1:=y+10*hauteur;\r
 344    CALL MOVE(x,y);\r
 345    ArrierePlan:=GETMAP(x1,y1);\r
 346    CALL XORMAP(ArrierePlan);\r
 347    Active:=TRUE;\r
 348    CALL InitFenetre;\r
 349    CurseurX:=x+8;\r
 350    CurseurY:=y+10;\r
 351 END Fenetre;\r
 352 \r
 353 \r
 354 (* ==================== PROGRAMME PRINCIPAL ==================== *)\r
 355 \r
 356   BEGIN\r
 357    PREF MOUSE BLOCK\r
 358 \r
 359 UNIT Coord : PROCEDURE (posx,posy : INTEGER); \r
 360    VAR tourx,toury,i : INTEGER,\r
 361        xx,yy : ARRAYOF INTEGER;\r
 362 \r
 363 BEGIN\r
 364    CALL COLOR(6);\r
 365    CALL MOVE(0,0);\r
 366    CALL OUTSTRING("                       ");\r
 367    CALL MOVE(0,0);\r
 368    CALL OUTSTRING("COORDONNEES : ");\r
 369    ARRAY xx DIM (1:3);\r
 370    ARRAY yy DIM (1:3);\r
 371    IF posx<10 THEN tourx:=1;\r
 372       ELSE IF posx<100 THEN tourx:=2;\r
 373               ELSE tourx:=3;\r
 374    FI; FI;\r
 375    IF posy<10 THEN toury:=1;\r
 376       ELSE IF posy<100 THEN toury:=2;\r
 377               ELSE toury:=3;\r
 378    FI; FI;\r
 379    FOR i:=tourx DOWNTO 1\r
 380    DO \r
 381       xx(i):=posx MOD 10; \r
 382       posx:= posx DIV 10;\r
 383    OD;\r
 384    FOR i:=toury DOWNTO 1\r
 385    DO\r
 386       yy(i):=posy MOD 10;\r
 387       posy:=posy DIV 10;\r
 388    OD;\r
 389    FOR i:=1 TO tourx\r
 390    DO\r
 391       CALL HASCII(xx(i)+48);\r
 392    OD;\r
 393    CALL OUTSTRING("  ");\r
 394    FOR i:=1 to toury\r
 395    DO \r
 396       CALL HASCII(yy(i)+48);\r
 397    OD;\r
 398 END Coord;\r
 399 \r
 400 \r
 401 (* -------------------- PROCEDURE Deplace -------------------- *)\r
 402 \r
 403 UNIT Deplace : PROCEDURE (i : INTEGER);\r
 404  \r
 405    VAR touche : INTEGER;\r
 406 \r
 407 BEGIN\r
 408   DO touche:=INKEY; IF touche<>0 THEN EXIT FI; OD;\r
 409   WHILE touche=/=102 \r
 410   DO\r
 411      IF touche=-72 \r
 412         THEN CALL fen(i).DeplaceFenetre(0,-5); \r
 413      ELSE IF touche=-80 \r
 414              THEN CALL fen(i).DeplaceFenetre(0,5);\r
 415           ELSE IF touche=-75 \r
 416                   THEN CALL fen(i).DeplaceFenetre(-5,0);\r
 417                ELSE IF touche=-77 \r
 418                        THEN CALL fen(i).DeplaceFenetre(5,0);\r
 419                     FI;\r
 420                FI;\r
 421           FI;\r
 422      FI;\r
 423      DO touche:=INKEY; IF touche<>0 THEN EXIT FI; OD;\r
 424   OD;\r
 425 END Deplace;      \r
 426 \r
 427 \r
 428 (* -------------------- PROCEDURE taille -------------------- *)\r
 429 \r
 430 UNIT Taille : PROCEDURE (i : INTEGER);\r
 431  \r
 432    VAR touche : INTEGER;\r
 433 \r
 434 BEGIN\r
 435   DO touche:=INKEY; IF touche<>0 THEN EXIT FI; OD;\r
 436   WHILE touche=/=102 \r
 437   DO\r
 438      IF touche=-72 \r
 439         THEN CALL fen(i).ChangeTaille(0,-1); \r
 440      ELSE IF touche=-80 \r
 441              THEN CALL fen(i).ChangeTaille(0,1);\r
 442           ELSE IF touche=-75 \r
 443                   THEN CALL fen(i).ChangeTaille(-1,0);\r
 444                ELSE IF touche=-77 \r
 445                        THEN CALL fen(i).ChangeTaille(1,0);\r
 446                     FI;\r
 447                FI;\r
 448           FI;\r
 449      FI;\r
 450      DO touche:=INKEY; IF touche<>0 THEN EXIT FI; OD;\r
 451   OD;\r
 452 END Taille;      \r
 453   \r
 454 \r
 455 (* -------------------- PROCEDURE Saisir -------------------- *)\r
 456 \r
 457 UNIT Saisir : PROCEDURE (i : INTEGER);\r
 458 \r
 459 BEGIN\r
 460    CALL COLOR(4);\r
 461    CALL fen(i).SaisirChaine(chaines,longueur);\r
 462    CALL COLOR(16);\r
 463 END Saisir;\r
 464 \r
 465 \r
 466 (* -------------------- PROCEDURE Affiche -------------------- *)\r
 467 \r
 468 UNIT Affiche : PROCEDURE (i : INTEGER);\r
 469 \r
 470 BEGIN\r
 471    CALL COLOR(8);\r
 472    CALL fen(i).AfficheChaine(chaines);\r
 473    CALL COLOR(16);\r
 474 END Affiche;\r
 475 \r
 476 \r
 477 (* -------------------- PROCEDURE AfFen -------------------- *)\r
 478 \r
 479 UNIT AfFen : PROCEDURE (INOUT k : INTEGER; i : INTEGER);\r
 480 \r
 481    VAR touche : INTEGER;\r
 482 \r
 483 BEGIN\r
 484    CALL COLOR(10);\r
 485    k:=i-1;\r
 486    DO\r
 487       touche:=INKEY;\r
 488       IF touche=102 THEN EXIT FI;\r
 489       IF touche=115 THEN\r
 490            CALL fen(k).SauveFenetre;\r
 491            k:=k-1;\r
 492            IF k=0 THEN k:=i-1 FI;\r
 493            CALL fen(k).AfficheFenetre;\r
 494       FI;\r
 495    OD;\r
 496 END AfFen;\r
 497 \r
 498 \r
 499 (* -------------------- MAIN ------------------- *)\r
 500 \r
 501 VAR\r
 502    fen : ARRAYOF Fenetre,\r
 503    h,v,p : INTEGER,\r
 504    l,r,c : BOOLEAN,\r
 505    chaines : ARRAYOF CHAR,\r
 506    i,cour,touche,longueur : INTEGER;\r
 507 \r
 508 \r
 509 BEGIN\r
 510    CALL GRON(2);\r
 511    CALL CLS;\r
 512    CALL COLOR(16);\r
 513    CALL BORDER(15);\r
 514    CALL DEFCURSOR(0,1,13);\r
 515    CALL SHOWCURSOR;\r
 516    ARRAY fen DIM (1:50);\r
 517    ARRAY chaines DIM (1:50);\r
 518    i:=1;\r
 519    DO\r
 520       touche:=INKEY;\r
 521       CALL GETPRESS(1,h,v,p,l,r,c);\r
 522       IF l AND r THEN EXIT FI;\r
 523       CALL GETPRESS(0,h,v,p,l,r,c);\r
 524       IF l\r
 525          THEN \r
 526             CALL HIDECURSOR;\r
 527             CALL MOVE(0,0); CALL Coord(h,v);\r
 528             fen(i):=NEW Fenetre(h,v,20,7,1);\r
 529             CALL SHOWCURSOR;\r
 530             i:=i+1;\r
 531             cour:=i-1;\r
 532       FI;\r
 533       CASE touche \r
 534          WHEN 100 : CALL Deplace(cour);\r
 535          WHEN 115 : CALL Saisir(cour);\r
 536          WHEN 116 : CALL Taille(cour);\r
 537          WHEN 99 : CALL Affiche(cour);\r
 538          WHEN 101 : CALL fen(cour).EffaceFenetre;\r
 539          WHEN 32 : CALL fen(cour).CacheFenetre;\r
 540          WHEN 97 : CALL fen(cour).AfficheFenetre;\r
 541          WHEN 109 : CALL AfFen(cour,i);\r
 542       ESAC;\r
 543    OD;\r
 544    CALL GROFF;\r
 545 END;END;END\r
 546 \r