examples/jeu/laby.log

   1 Program LABYRINTHE;\r
   2  \r
   3 Begin\r
   4  Pref MOUSE Block\r
   5  \r
   6   Unit LABYGRAPH: IIUWGRAPH Class;\r
   7  \r
   8     Unit LIFO: Class;\r
   9  \r
  10       Unit ELEM: Class (S: SALLE);\r
  11         Var ANTE: ELEM;\r
  12       End ELEM;\r
  13  \r
  14       Unit PILE: Class;\r
  15         Var PREM: ELEM;\r
  16       End PILE;\r
  17  \r
  18       Unit EMPIL: Procedure (InOut E: ELEM; InOut P: PILE);\r
  19       Begin\r
  20         If Not VIDE (P)\r
  21         Then\r
  22           E.ANTE:= P.PREM;\r
  23         Fi;\r
  24         P.PREM:= E;\r
  25       End EMPIL;\r
  26  \r
  27       Unit DEPIL: Procedure (InOut P: PILE);\r
  28         Var AUX: ELEM;\r
  29       Begin\r
  30         If Not VIDE (P)\r
  31         Then\r
  32           AUX:= P.PREM;\r
  33           If AUX.ANTE=/=None\r
  34           Then\r
  35             P.PREM:= AUX.ANTE;\r
  36           Fi;\r
  37           Kill (AUX.S);\r
  38           Kill (AUX);\r
  39         Fi;\r
  40       End DEPIL;\r
  41  \r
  42       Unit VIDE: Function (P: PILE): Boolean;\r
  43       Begin\r
  44         Result:= (P.PREM=None);\r
  45       End VIDE;\r
  46  \r
  47     End LIFO;\r
  48  \r
  49     Unit PIECE: Class (N,E,S,O: Boolean; MARQUE: Boolean);\r
  50     End PIECE;\r
  51  \r
  52     Unit SALLE: Class (L,C: Integer; PC: PIECE);\r
  53     End SALLE;\r
  54  \r
  55     Unit PRINCE: Procedure (X,Y: Integer);\r
  56     Begin\r
  57       Call Move (X+5,Y+10);  Call Draw (X+5,Y+6);\r
  58       Call Move (X+6,Y+5);   Call Draw (X+6,Y+6);\r
  59       Call Move (X+7,Y+2);   Call Draw (X+7,Y+3);\r
  60       Call Move (X+7,Y+5);   Call Draw (X+7,Y+15);\r
  61       Call Point (X+6,Y+15);\r
  62       Call Move (X+8,Y+1);   Call Draw (X+8,Y+10);\r
  63       Call Move (X+9,Y+1);   Call Draw (X+9,Y+10);\r
  64       Call Move (X+10,Y+2);  Call Draw (X+10,Y+3);\r
  65       Call Move (X+10,Y+5);  Call Draw (X+10,Y+15);\r
  66       Call Move (X+11,Y+5);  Call Draw (X+11,Y+6);\r
  67       Call Point (X+11,Y+15);\r
  68       Call Move (X+12,Y+6);  Call Draw (X+12,Y+10);\r
  69       Call Draw (X+15,Y+13); Call Draw (X+15,Y+15);\r
  70       Call Move (X+14,Y+14); Call Draw (X+16,Y+14);\r
  71     End;\r
  72  \r
  73     Unit PRINCNORD: Procedure (OutPut PNORD: ArrayOf Integer);\r
  74       Var X,Y: Integer;\r
  75     Begin\r
  76       X:=0;\r
  77       Y:=0;\r
  78       Call Cls;\r
  79       Call Move (X+5,Y+10);  Call Draw (X+5,Y+6);\r
  80       Call Move (X+6,Y+5);   Call Draw (X+6,Y+6);\r
  81       Call Move (X+7,Y+2);   Call Draw (X+7,Y+3);\r
  82       Call Move (X+7,Y+5);   Call Draw (X+7,Y+15);\r
  83       Call Point (X+6,Y+14);\r
  84       Call Move (X+8,Y+1);   Call Draw (X+8,Y+10);\r
  85       Call Move (X+9,Y+1);   Call Draw (X+9,Y+10);\r
  86       Call Move (X+10,Y+2);  Call Draw (X+10,Y+3);\r
  87       Call Move (X+10,Y+5);  Call Draw (X+10,Y+15);\r
  88       Call Move (X+11,Y+5);  Call Draw (X+11,Y+6);\r
  89       Call Point (X+11,Y+14);\r
  90       Call Move (X+12,Y+6);  Call Draw (X+12,Y+10);\r
  91       Call Move (X+13,Y+10); Call Draw (X+13,Y+16);\r
  92       Call GOODGET (PNORD);\r
  93     End;\r
  94  \r
  95     Unit PRINCEST: Procedure (OutPut PEST: ArrayOf Integer);\r
  96       Var X,Y: Integer;\r
  97     Begin\r
  98       X:=0;\r
  99       Y:=0;\r
 100       Call Cls;\r
 101       Call Move (X+1,Y+13);  Call Draw (X+4,Y+13);\r
 102       Call Draw (X+6,Y+11);  Call Draw (X+6,Y+9);\r
 103       Call Draw (X+10,Y+5);  Call Draw (X+10,Y+12);\r
 104       Call Draw (X+9,Y+13);  Call Draw (X+7,Y+13);\r
 105       Call Draw (X+7,Y+14);\r
 106       Call Move (X+10,Y+1);  Call Draw (X+10,Y+3);\r
 107       Call Move (X+11,Y+1);  Call Draw (X+11,Y+10);\r
 108       Call Move (X+12,Y+1);  Call Draw (X+12,Y+3);\r
 109       Call Point (X+13,Y+2);\r
 110       Call Move (X+12,Y+5);  Call Draw (X+12,Y+15);\r
 111       Call Point (X+13,Y+15);\r
 112       Call Point (X+13,Y+7);\r
 113       Call Move (X+14,Y+8);  Call Draw (X+15,Y+8);\r
 114       Call GOODGET (PEST);\r
 115     End;\r
 116  \r
 117     Unit PRINCSUD: Procedure (OutPut PSUD: ArrayOf Integer);\r
 118       Var X,Y: Integer;\r
 119     Begin\r
 120       X:=0;\r
 121       Y:=0;\r
 122       Call Cls;\r
 123       Call Move (X+4,Y+1);   Call Draw (X+4,Y+9);\r
 124       Call Point (X+5,Y+10);\r
 125       Call Move (X+6,Y+10);  Call Draw (X+6,Y+6);\r
 126       Call Move (X+7,Y+5);   Call Draw (X+7,Y+6);\r
 127       Call Move (X+8,Y+2);   Call Draw (X+8,Y+3);\r
 128       Call Move (X+8,Y+5);   Call Draw (X+8,Y+15);\r
 129       Call Point (X+7,Y+16);\r
 130       Call Move (X+9,Y+1);   Call Draw (X+9,Y+10);\r
 131       Call Move (X+10,Y+1);  Call Draw (X+10,Y+10);\r
 132       Call Move (X+11,Y+2);  Call Draw (X+11,Y+3);\r
 133       Call Move (X+11,Y+5);  Call Draw (X+11,Y+15);\r
 134       Call Move (X+12,Y+5);  Call Draw (X+12,Y+6);\r
 135       Call Move (X+12,Y+5);  Call Draw (X+12,Y+6);\r
 136       Call Point (X+12,Y+16);\r
 137       Call Move (X+13,Y+6);  Call Draw (X+13,Y+10);\r
 138       Call GOODGET (PSUD);\r
 139     End;\r
 140  \r
 141     Unit PRINCOUEST: Procedure (OutPut POUEST: ArrayOf Integer);\r
 142       Var X,Y: Integer;\r
 143     Begin\r
 144       X:=0;\r
 145       Y:=0;\r
 146       Call Cls;\r
 147       Call Move (X+2,Y+8);   Call Draw (X+3,Y+8);\r
 148       Call Point (X+4,Y+2);\r
 149       Call Point (X+4,Y+7);\r
 150       Call Move (X+5,Y+1);   Call Draw (X+5,Y+3);\r
 151       Call Move (X+5,Y+5);   Call Draw (X+5,Y+15);\r
 152       Call Draw (X+4,Y+15);\r
 153       Call Move (X+6,Y+1);   Call Draw (X+6,Y+10);\r
 154       Call Move (X+7,Y+1);   Call Draw (X+7,Y+3);\r
 155       Call Move (X+16,Y+4);  Call Draw (X+11,Y+4);\r
 156       Call Move (X+11,Y+5);\r
 157       Call Draw (X+9,Y+7);   Call Draw (X+7,Y+5);\r
 158       Call Draw (X+7,Y+12);  Call Draw (X+8,Y+13);\r
 159       Call Draw (X+10,Y+13); Call Draw (X+10,Y+14);\r
 160       Call GOODGET (POUEST);\r
 161     End;\r
 162  \r
 163     Unit PRINCESSE: Procedure (X,Y: Integer);\r
 164     Begin\r
 165       Call Point (X+5,Y+5);\r
 166       Call Point (X+12,Y+5);\r
 167       Call Move (X+8,Y+1);   Call Draw (X+11,Y+4);\r
 168       Call Move (X+9,Y+1);   Call Draw (X+6,Y+4);\r
 169       Call Move (X+7,Y+2);   Call Draw (X+13,Y+8);\r
 170       Call Move (X+10,Y+2);  Call Draw (X+4,Y+8);\r
 171       Call Point (X+4,Y+12);\r
 172       Call Move (X+5,Y+11);  Call Draw (X+5,Y+12);\r
 173       Call Move (X+6,Y+9);   Call Draw (X+6,Y+12);\r
 174       Call Point (X+7,Y+6);\r
 175       Call Move (X+7,Y+8);   Call Draw (X+7,Y+15);\r
 176       Call Move (X+8,Y+5);   Call Draw (X+8,Y+12);\r
 177       Call Move (X+9,Y+5);   Call Draw (X+9,Y+12);\r
 178       Call Point (X+10,Y+6);\r
 179       Call Move (X+10,Y+8);  Call Draw (X+10,Y+15);\r
 180       Call Move (X+11,Y+9);  Call Draw (X+11,Y+12);\r
 181       Call Move (X+12,Y+11); Call Draw (X+12,Y+12);\r
 182       Call Point (X+13,Y+12);\r
 183     End;\r
 184  \r
 185     Unit COEUR: Procedure (X,Y: Integer);\r
 186     Begin\r
 187       Call Move (X+8,Y+5);   Call Draw (X+6,Y+3);\r
 188       Call Draw (X+4,Y+3);   Call Draw (X+2,Y+5);\r
 189       Call Draw (X+2,Y+9);   Call Draw (X+7,Y+14);\r
 190       Call Draw (X+10,Y+14); Call Draw (X+15,Y+9);\r
 191       Call Draw (X+15,Y+5);  Call Draw (X+13,Y+3);\r
 192       Call Draw (X+11,Y+3);  Call Draw (X+9,Y+5);\r
 193       Call Move (X+4,Y+7);   Call Draw (X+4,Y+8);\r
 194       Call Draw (X+8,Y+12);  Call Draw (X+9,Y+12);\r
 195     End;\r
 196  \r
 197     Unit BBLANC: Procedure (X,Y: Integer);\r
 198     Begin\r
 199       Call Move (X+7,Y+3);   Call Draw (X+3,Y+7);\r
 200       Call Draw (X+3,Y+10);  Call Draw (X+7,Y+14);\r
 201       Call Draw (X+10,Y+14); Call Draw (X+14,Y+10);\r
 202       Call Draw (X+14,Y+7);  Call Draw (X+10,Y+3);\r
 203       Call Draw (X+7,Y+3);\r
 204       Call Move (X+5,Y+8);   Call Draw (X+5,Y+9);\r
 205       Call Draw (X+8,Y+12);  Call Draw (X+9,Y+12);\r
 206     End;\r
 207  \r
 208     Unit BNOIRE: Procedure (X,Y: Integer);\r
 209     Begin\r
 210       Call Move (X+3,Y+7);   Call Draw (X+3,Y+10);\r
 211       Call Move (X+4,Y+6);   Call Draw (X+4,Y+11);\r
 212       Call Move (X+5,Y+5);   Call Draw (X+5,Y+7);\r
 213       Call Move (X+5,Y+10);  Call Draw (X+5,Y+12);\r
 214       Call Move (X+6,Y+4);   Call Draw (X+6,Y+9);\r
 215       Call Move (X+6,Y+11);  Call Draw (X+6,Y+13);\r
 216       Call Move (X+7,Y+3);   Call Draw (X+7,Y+10);\r
 217       Call Move (X+7,Y+12);  Call Draw (X+7,Y+14);\r
 218       Call Move (X+8,Y+3);   Call Draw (X+8,Y+11);\r
 219       Call Move (X+8,Y+13);  Call Draw (X+8,Y+14);\r
 220       Call Move (X+9,Y+3);   Call Draw (X+9,Y+11);\r
 221       Call Move (X+9,Y+13);  Call Draw (X+9,Y+14);\r
 222       Call Move (X+10,Y+3);  Call Draw (X+10,Y+14);\r
 223       Call Move (X+11,Y+4);  Call Draw (X+11,Y+13);\r
 224       Call Move (X+12,Y+5);  Call Draw (X+12,Y+12);\r
 225       Call Move (X+13,Y+6);  Call Draw (X+13,Y+11);\r
 226       Call Move (X+14,Y+7);  Call Draw (X+14,Y+10);\r
 227     End;\r
 228  \r
 229     Unit BARNORD: Procedure (X,Y: Integer);\r
 230     Begin\r
 231       Call Move (X+5,Y+1);   Call Draw (X+5,Y+4);\r
 232       Call Move (X+12,Y+1);  Call Draw (X+12,Y+4);\r
 233     End;\r
 234  \r
 235     Unit BAROUEST: Procedure (X,Y: Integer);\r
 236     Begin\r
 237       Call Move (X+1,Y+5);   Call Draw (X+4,Y+5);\r
 238       Call Move (X+1,Y+12);  Call Draw (X+4,Y+12);\r
 239     End;\r
 240  \r
 241     Unit BARSUD: Procedure (X,Y: Integer);\r
 242     Begin\r
 243       Call Move (X+5,Y+13);  Call Draw (X+5,Y+16);\r
 244       Call Move (X+12,Y+13); Call Draw (X+12,Y+16);\r
 245     End;\r
 246  \r
 247     Unit BAREST: Procedure (X,Y: Integer);\r
 248     Begin\r
 249       Call Move (X+13,Y+5);  Call Draw (X+16,Y+5);\r
 250       Call Move (X+13,Y+12); Call Draw (X+16,Y+12);\r
 251     End;\r
 252  \r
 253     Unit BARHORIZ: Procedure (X,Y: Integer);\r
 254     Begin\r
 255       Call Move (X+1,Y+5);   Call Draw (X+16,Y+5);\r
 256       Call Move (X+1,Y+10);  Call Draw (X+16,Y+10);\r
 257       Call Move (X+1,Y+12);   Call Draw (X+16,Y+12);\r
 258     End;\r
 259  \r
 260     Unit BARVERTI: Procedure (X,Y: Integer);\r
 261     Begin\r
 262       Call Move (X+5,Y+1);   Call Draw (X+5,Y+16);\r
 263       Call Move (X+7,Y+1);   Call Draw (X+7,Y+16);\r
 264       Call Move (X+12,Y+1);  Call Draw (X+12,Y+16);\r
 265     End;\r
 266  \r
 267     Unit TOMBE: Procedure (X,Y: Integer);\r
 268     Begin\r
 269       Call Move (X+2,Y+5);   Call Draw (X+6,Y+3);\r
 270       Call Move (X+4,Y+1);   Call Draw (X+4,Y+8);\r
 271       Call Draw (X+6,Y+8);   Call Draw (X+15,Y+13);\r
 272       Call Draw (X+12,Y+16);\r
 273       Call Move (X+11,Y+16); Call Draw (X+2,Y+11);\r
 274       Call Move (X+2,Y+10);  Call Draw (X+4,Y+8);\r
 275       Call Move (X+4,Y+11);  Call Draw (X+11,Y+14);\r
 276     End;\r
 277  \r
 278     Unit PELOTE: Procedure (X,Y: Integer);\r
 279     Begin\r
 280       Call Move (X+6,Y+2);\r
 281       Call Draw (X+2,Y+6);   Call Draw (X+2,Y+11);\r
 282       Call Draw (X+6,Y+15);  Call Draw (X+11,Y+15);\r
 283       Call Draw (X+15,Y+11); Call Draw (X+15,Y+6);\r
 284       Call Draw (X+11,Y+2);  Call Draw (X+6,Y+2);\r
 285       Call Draw (X+6,Y+9);   Call Draw (X+11,Y+14);\r
 286       Call Draw (X+11,Y+8);\r
 287       Call Move (X+4,Y+5);   Call Draw (X+4,Y+10);\r
 288       Call Draw (X+8,Y+14);\r
 289       Call Move (X+13,Y+12); Call Draw (X+13,Y+5);\r
 290       Call Draw (X+9,Y+9);   Call Draw (X+9,Y+11);\r
 291       Call Point (X+8,Y+10);\r
 292       Call Move (X+9,Y+3);   Call Draw (X+7,Y+5);\r
 293       Call Move (X+11,Y+4);  Call Draw (X+7,Y+8);\r
 294     End PELOTE;\r
 295  \r
 296  \r
 297     Unit FIN: Procedure (X,Y: Integer);\r
 298     Begin\r
 299       Call Move (X,Y);       Call Draw (X+32,Y);\r
 300       Call Draw (X+32,Y+19); Call Draw (X,Y+19);\r
 301       Call Draw (X,Y);\r
 302       Call Move (X+10,Y+5);\r
 303       Call Draw (X+10,Y+4);  Call Draw (X+4,Y+4);\r
 304       Call Draw (X+4,Y+15);  Call Draw (X+6,Y+15);\r
 305       Call Draw (X+6,Y+4);\r
 306       Call Point (X+7,Y+10); Call Point (X+8,Y+10);\r
 307       Call Point (X+8,Y+11);\r
 308       Call Move (X+13,Y+4);  Call Draw (X+17,Y+4);\r
 309       Call Move (X+13,Y+15); Call Draw (X+17,Y+15);\r
 310       Call Move (X+14,Y+5);  Call Draw (X+14,Y+14);\r
 311       Call Move (X+16,Y+5);  Call Draw (X+16,Y+14);\r
 312       Call Move (X+22,Y+4);  Call Draw (X+20,Y+4);\r
 313       Call Draw (X+20,Y+15); Call Draw (X+22,Y+15);\r
 314       Call Draw (X+22,Y+4);  Call Draw (X+29,Y+15);\r
 315       Call Draw (X+29,Y+4);  Call Draw (X+28,Y+4);\r
 316     End FIN;\r
 317  \r
 318     Unit BLANC: Procedure (X,Y: Integer);\r
 319       Var I: Integer;\r
 320     Begin\r
 321       Call Color (0);\r
 322       For I:=1 To 16\r
 323       Do\r
 324         Call Move (X+1,Y+I);\r
 325         Call Draw (X+16,Y+I);\r
 326       Od;\r
 327       Call Color (15);\r
 328     End BLANC;\r
 329  \r
 330 (* ------------------------------------------------------------------------- *)\r
 331  \r
 332     Unit GOODGET: Procedure (OutPut PDIR: ArrayOf Integer);\r
 333       Var TAB: ArrayOf Integer,\r
 334           I,J: Integer;\r
 335     Begin\r
 336       Array PDIR Dim (1:66);\r
 337       Call Move (1,1);\r
 338       TAB:= GetMap (16,16);\r
 339       PDIR (1):= TAB (1);\r
 340       For I:=1 To 4\r
 341       Do\r
 342         For J:=1 To 8\r
 343         Do\r
 344           PDIR (1+8*(I-1)+J):= TAB (1+J);\r
 345         Od;\r
 346       Od;\r
 347       Kill (TAB);\r
 348     End GOODGET;\r
 349  \r
 350 (* ------------------------------------------------------------------------- *)\r
 351  \r
 352     Unit TEMPO: Procedure (T: Integer);\r
 353       Var I: Integer;\r
 354     Begin\r
 355       For I:=1 To T\r
 356       Do\r
 357       Od;\r
 358     End TEMPO;\r
 359  \r
 360 (* ------------------------------------------------------------------------- *)\r
 361  \r
 362       Unit XCASE: Function (XC: Integer): Integer;\r
 363       Begin\r
 364         Result:= BX+32*(XC-1)+16;\r
 365       End;\r
 366  \r
 367 (* ------------------------------------------------------------------------- *)\r
 368  \r
 369       Unit YCASE: Function (YC: Integer): Integer;\r
 370       Begin\r
 371         Result:= BY+32*(YC-1)+16;\r
 372       End;\r
 373  \r
 374 (* ------------------------------------------------------------------------- *)\r
 375 (* ------------------------------------------------------------------------- *)\r
 376  \r
 377     Unit INITLABY: Procedure (OutPut LABY: ArrayOf ArrayOf PIECE);\r
 378       Var I,J,LIG,COL: Integer;\r
 379     Begin\r
 380       LIG:= 10;\r
 381       COL:= 15;\r
 382       Array LABY Dim (1:LIG);\r
 383       For I:=1 To LIG\r
 384       Do\r
 385         Array LABY (I) Dim (1:COL);\r
 386         For J:=1 to COL\r
 387         Do\r
 388           LABY (I,J):= New PIECE (True,True,True,True,False);\r
 389         Od\r
 390       Od;\r
 391       BX:= (496-(COL*32+16)) DIV 2;\r
 392       BY:= (336-(LIG*32+16)) DIV 2;\r
 393     End INITLABY;\r
 394  \r
 395 (* ------------------------------------------------------------------------- *)\r
 396 (* ------------------------------------------------------------------------- *)\r
 397  \r
 398     Unit BATIR: Procedure (InOut LABY: ArrayOf ArrayOf PIECE;\r
 399                                                OutPut ENTREE,SORTIE: SALLE);\r
 400  \r
 401       Unit XBOUL: Function (XB: Integer): Integer;\r
 402       Begin\r
 403         Result:= BX+32*(XB-1);\r
 404       End;\r
 405  \r
 406 (* ------------------------------------------------------------------------- *)\r
 407  \r
 408       Unit YBOUL: Function (YB: Integer): Integer;\r
 409       Begin\r
 410         Result:= BY+32*(YB-1);\r
 411       End;\r
 412  \r
 413 (* ------------------------------------------------------------------------- *)\r
 414  \r
 415       Unit AFFMUR: Procedure (YDEB,XDEB: Integer; COUL,DIR: Boolean);\r
 416         Var X,Y: Integer;\r
 417       Begin\r
 418         If COUL\r
 419         Then\r
 420           Call Color (15);\r
 421         Else\r
 422           Call Color (0);\r
 423         Fi;\r
 424         X:= XBOUL (XDEB);\r
 425         Y:= YBOUL (YDEB);\r
 426         If DIR= VERTI\r
 427         Then\r
 428           Call BARSUD (X,Y);\r
 429           Call BARVERTI (X,Y+16);\r
 430           Call BARNORD (X,Y+32);\r
 431           If XDEB>1\r
 432           Then\r
 433             LABY(YDEB,XDEB-1).E:= Not COUL;\r
 434           Fi;\r
 435           If XDEB<=Upper (LABY (1))\r
 436           Then\r
 437             LABY(YDEB,XDEB).O:= Not COUL;\r
 438           Fi;\r
 439         Else                        (* DIR=HORIZ *)\r
 440           Call BAREST (X,Y);\r
 441           Call BARHORIZ (X+16,Y);\r
 442           Call BAROUEST (X+32,Y);\r
 443           If YDEB>1\r
 444           Then\r
 445             LABY(YDEB-1,XDEB).S:= Not COUL;\r
 446           Fi;\r
 447           If YDEB<=Upper (LABY)\r
 448           Then\r
 449             LABY(YDEB,XDEB).N:= Not COUL;\r
 450           Fi;\r
 451         Fi;\r
 452         Call Color (15);\r
 453       End AFFMUR;\r
 454  \r
 455 (* ------------------------------------------------------------------------- *)\r
 456  \r
 457       Unit AFFLONGMUR: Procedure (XDEB,YDEB,XFIN,YFIN: Integer,COUL: Boolean);\r
 458         Var DEB,FIN,I: Integer;\r
 459       Begin\r
 460         If XDEB=XFIN And YDEB=/=YFIN\r
 461         Then\r
 462           DEB:= IMIN (YDEB,YFIN);\r
 463           FIN:= IMAX (YDEB,YFIN);\r
 464           For I:= DEB To FIN-1\r
 465           Do\r
 466             Call AFFMUR (I,XDEB,COUL,VERTI);\r
 467           Od;\r
 468         Else\r
 469           If YDEB=YFIN And XDEB=/=XFIN\r
 470           Then\r
 471             DEB:= IMIN (XDEB,XFIN);\r
 472             FIN:= IMAX (XDEB,XFIN);\r
 473             For I:= DEB To FIN-1\r
 474             Do\r
 475               Call AFFMUR (YDEB,I,COUL,HORIZ);\r
 476             Od;\r
 477           Else\r
 478             Write (Chr(7));\r
 479           Fi;\r
 480         Fi;\r
 481       End AFFLONGMUR;\r
 482  \r
 483 (* ------------------------------------------------------------------------- *)\r
 484  \r
 485       Unit CREERLABY: Procedure (InOut LABY: ArrayOf ArrayOf PIECE);\r
 486  \r
 487         Unit BOULPROCH: Procedure (X,Y: Integer;\r
 488                                OutPut XBL,YBL: Integer; OutPut ERR: Boolean);\r
 489         Begin\r
 490           ERR:= False;\r
 491           XBL:= (X-BX+8) DIV 32+1;\r
 492           If XBL>Upper (LABY (1))+1\r
 493           Then\r
 494             ERR:= True;\r
 495           Else\r
 496             YBL:= (Y-BY+8) DIV 32+1;\r
 497             If YBL>Upper (LABY)+1\r
 498             Then\r
 499               ERR:= True;\r
 500             Fi;\r
 501           Fi;\r
 502         End BOULPROCH;\r
 503  \r
 504 (* ------------------------------------------------------------------------- *)\r
 505  \r
 506         Unit BOULBLNR: Procedure (XBL,YBL: Integer);\r
 507           Var X,Y: Integer;\r
 508         Begin\r
 509           X:= XBOUL (XBL);\r
 510           Y:= YBOUL (YBL);\r
 511           Call Move (X,Y);\r
 512           Call Color (0);\r
 513           Call BBLANC (X,Y);\r
 514           Call Color (15);\r
 515           Call BNOIRE (X,Y);\r
 516         End BOULBLNR;\r
 517  \r
 518 (* ------------------------------------------------------------------------- *)\r
 519  \r
 520         Unit BOULNRBL: Procedure (XBL,YBL: Integer);\r
 521           Var X,Y: Integer;\r
 522         Begin\r
 523           X:= XBOUL (XBL);\r
 524           Y:= YBOUL (YBL);\r
 525           Call Move (X,Y);\r
 526           Call Color (0);\r
 527           Call BNOIRE (X,Y);\r
 528           Call Color (15);\r
 529           Call BBLANC (X,Y);\r
 530         End BOULNRBL;\r
 531  \r
 532 (* ------------------------------------------------------------------------- *)\r
 533  \r
 534         Var X,Y,XDEB,YDEB,XFIN,YFIN: Integer,\r
 535             LEFT,RIGHT,CENTER,ERREUR,BORD: Boolean;\r
 536       Begin\r
 537         Call ShowCursor;\r
 538         Do\r
 539           Call Status (X,Y,LEFT,RIGHT,CENTER);\r
 540           If (LEFT Or RIGHT) And X>XFINI And X<XFINI+32\r
 541                              And Y>YFINI And Y<YFINI+18\r
 542           Then\r
 543             Exit;\r
 544           Else\r
 545             If LEFT\r
 546             Then\r
 547               Call BOULPROCH (X,Y,XDEB,YDEB,ERREUR);\r
 548               If Not ERREUR\r
 549               Then\r
 550                 Call HideCursor;\r
 551                 Call BOULBLNR (XDEB,YDEB);\r
 552                 Call ShowCursor;\r
 553                 Call TEMPO (200);\r
 554                 Do\r
 555                   Call Status (X,Y,LEFT,RIGHT,CENTER);\r
 556                   If RIGHT\r
 557                   Then\r
 558                     Call HideCursor;\r
 559                     Call BOULNRBL (XDEB,YDEB);\r
 560                     Call ShowCursor;\r
 561                     Call TEMPO (200);\r
 562                     Exit;\r
 563                   Else\r
 564                     If LEFT\r
 565                     Then\r
 566                       Call BOULPROCH (X,Y,XFIN,YFIN,ERREUR);\r
 567                       If Not ERREUR\r
 568                       Then\r
 569                         Call HideCursor;\r
 570                         Call BOULNRBL (XDEB,YDEB);\r
 571                         BORD:= (XDEB=XFIN And (XDEB=1 Or\r
 572                                 XDEB=Upper (LABY(1))+1)) Or\r
 573                                (YDEB=YFIN And (YDEB=1 Or\r
 574                                 YDEB=Upper (LABY)+1));\r
 575                         If Not BORD\r
 576                         Then\r
 577                           Call AFFLONGMUR (XDEB,YDEB,XFIN,YFIN,BLANC);\r
 578                           Call ShowCursor;\r
 579                           Call TEMPO (200);\r
 580                         Else\r
 581                           Call ShowCursor;\r
 582                           Write (Chr (7));\r
 583                         Fi;\r
 584                         Exit;\r
 585                       Fi;\r
 586                     Fi;\r
 587                   Fi;\r
 588                 Od;\r
 589               Fi;\r
 590             Else\r
 591               If RIGHT\r
 592               Then\r
 593                 Call BOULPROCH (X,Y,XDEB,YDEB,ERREUR);\r
 594                 If Not ERREUR\r
 595                 Then\r
 596                   Call HideCursor;\r
 597                   Call BOULBLNR (XDEB,YDEB);\r
 598                   Call ShowCursor;\r
 599                   Call TEMPO (200);\r
 600                   Do\r
 601                     Call Status (X,Y,LEFT,RIGHT,CENTER);\r
 602                     If LEFT\r
 603                     Then\r
 604                         Call HideCursor;\r
 605                         Call BOULNRBL (XDEB,YDEB);\r
 606                         Call ShowCursor;\r
 607                         Call TEMPO (200);\r
 608                         Exit;\r
 609                     Else\r
 610                       If RIGHT\r
 611                       Then\r
 612                         Call BOULPROCH (X,Y,XFIN,YFIN,ERREUR);\r
 613                         If Not ERREUR\r
 614                         Then\r
 615                           Call HideCursor;\r
 616                           Call BOULNRBL (XDEB,YDEB);\r
 617                           BORD:=(XDEB=XFIN And (XDEB=1 Or\r
 618                                  XDEB=Upper(LABY(1))+1)) Or\r
 619                                 (YDEB=YFIN And (YDEB=1 Or\r
 620                                  YDEB=Upper (LABY)+1));\r
 621                           If Not BORD\r
 622                           Then\r
 623                             Call AFFLONGMUR (XDEB,YDEB,XFIN,YFIN,NOIR);\r
 624                             Call ShowCursor;\r
 625                             Call TEMPO (200);\r
 626                           Else\r
 627                             Call ShowCursor;\r
 628                             Write (Chr (7));\r
 629                           Fi;\r
 630                           Exit;\r
 631                         Fi;\r
 632                       Fi;\r
 633                     Fi;\r
 634                   Od;\r
 635                 Fi;\r
 636               Fi;\r
 637             Fi;\r
 638           Fi;\r
 639         Od;\r
 640         Call HideCursor;\r
 641         Call TEMPO (200);\r
 642       End CREERLABY;\r
 643  \r
 644 (* ------------------------------------------------------------------------- *)\r
 645  \r
 646       Unit PLACENTSORT: Procedure (OutPut ENTREE,SORTIE: SALLE);\r
 647  \r
 648         Unit CASEPROCH: Procedure (X,Y: Integer;\r
 649                                OutPut XC,YC: Integer; OutPut ERR: Boolean);\r
 650         Begin\r
 651           ERR:= False;\r
 652           XC:= (X-BX-8) DIV 32+1;\r
 653           If XC>Upper (LABY (1)) Or XC<1\r
 654           Then\r
 655             ERR:= True;\r
 656           Else\r
 657             YC:= (Y-BY-8) DIV 32+1;\r
 658             If YC>Upper (LABY) Or YC<1\r
 659             Then\r
 660               ERR:= True;\r
 661             Fi;\r
 662           Fi;\r
 663         End CASEPROCH;\r
 664  \r
 665 (* ------------------------------------------------------------------------- *)\r
 666  \r
 667         Var X,Y,XC,YC: Integer,\r
 668             LEFT,RIGHT,CENTER,ERREUR,PLACENTREE,PLACSORTIE,OCCUPEE: Boolean;\r
 669       Begin\r
 670         Call ShowCursor;\r
 671         PLACENTREE:= False;\r
 672         PLACSORTIE:= False;\r
 673         Do\r
 674           Call Status (X,Y,LEFT,RIGHT,CENTER);\r
 675           If (LEFT Or RIGHT) And PLACENTREE And PLACSORTIE And X>XFINI\r
 676                              And X<XFINI+32 And Y>YFINI And Y<YFINI+16\r
 677           Then\r
 678             Exit;\r
 679           Else\r
 680             If LEFT\r
 681             Then\r
 682               Call CASEPROCH (X,Y,XC,YC,ERREUR);\r
 683               If Not ERREUR\r
 684               Then\r
 685                 If PLACENTREE AndIf ENTREE.L=YC And ENTREE.C=XC\r
 686                 Then\r
 687                   PLACENTREE:= False;\r
 688                   Kill (ENTREE);\r
 689                   Call HideCursor;\r
 690                   Call Color (0);\r
 691                   Call PRINCE (XCASE (XC),YCASE (YC));\r
 692                   Call Color (15);\r
 693                   Call ShowCursor;\r
 694                   Call TEMPO (200);\r
 695                 Else\r
 696                   If Not PLACENTREE\r
 697                   Then\r
 698                     If Not PLACSORTIE OrIf (PLACSORTIE And\r
 699                                            (SORTIE.L=/=YC Or SORTIE.C=/=XC))\r
 700                     Then\r
 701                       ENTREE:= New SALLE (YC,XC,LABY (YC,XC));\r
 702                       PLACENTREE:= True;\r
 703                       Call HideCursor;\r
 704                       Call PRINCE (XCASE (XC),YCASE (YC));\r
 705                       Call ShowCursor;\r
 706                       Call TEMPO (200);\r
 707                     Else\r
 708                       Write (Chr (7));\r
 709                     Fi;\r
 710                   Fi;\r
 711                 Fi;\r
 712               Fi;\r
 713             Else\r
 714               If RIGHT\r
 715               Then\r
 716                 Call CASEPROCH (X,Y,XC,YC,ERREUR);\r
 717                 If Not ERREUR\r
 718                 Then\r
 719                   If PLACSORTIE AndIf SORTIE.L=YC And SORTIE.C=XC\r
 720                   Then\r
 721                     PLACSORTIE:= False;\r
 722                     Kill (SORTIE);\r
 723                     Call HideCursor;\r
 724                     Call Color (0);\r
 725                     Call PRINCESSE (XCASE (XC),YCASE (YC));\r
 726                     Call Color (15);\r
 727                     Call ShowCursor;\r
 728                     Call TEMPO (200);\r
 729                   Else\r
 730                     If Not PLACSORTIE\r
 731                     Then\r
 732                       If Not PLACENTREE OrIf (PLACENTREE And\r
 733                                              (ENTREE.L=/=YC Or ENTREE.C=/=XC))\r
 734                       Then\r
 735                         SORTIE:= New SALLE (YC,XC,LABY (YC,XC));\r
 736                         PLACSORTIE:= True;\r
 737                         Call HideCursor;\r
 738                         Call PRINCESSE (XCASE (XC),YCASE (YC));\r
 739                         Call ShowCursor;\r
 740                         Call TEMPO (200);\r
 741                       Else\r
 742                         Write (Chr (7));\r
 743                       Fi;\r
 744                     Fi;\r
 745                   Fi;\r
 746                 Fi;\r
 747               Fi;\r
 748             Fi;\r
 749           Fi;\r
 750         Od;\r
 751         Call HideCursor;\r
 752         Call TEMPO (200);\r
 753       End PLACENTSORT;\r
 754  \r
 755 (* ------------------------------------------------------------------------- *)\r
 756  \r
 757       Const VERTI= True,\r
 758             HORIZ= False,\r
 759             BLANC= True,\r
 760             NOIR = False,\r
 761             XFINI= 552,\r
 762             YFINI= 310;\r
 763       Var LIG,COL: Integer;\r
 764     Begin\r
 765       Call Cls;\r
 766       For LIG:=1 To Upper (LABY)+1\r
 767       Do\r
 768         For COL:=1 To Upper (LABY (1))+1\r
 769         Do\r
 770           Call BBLANC (BX+32*(COL-1), BY+32*(LIG-1));\r
 771         Od;\r
 772       Od;\r
 773       Call AFFLONGMUR (1,1,Upper (LABY(1))+1,1,BLANC);\r
 774       Call AFFLONGMUR (1,Upper (LABY)+1,\r
 775                                       Upper (LABY(1))+1,Upper (LABY)+1,BLANC);\r
 776       Call AFFLONGMUR (1,1,1,Upper (LABY)+1,BLANC);\r
 777       Call AFFLONGMUR (Upper (LABY(1))+1,1,\r
 778                                        Upper(LABY(1))+1, Upper (LABY)+1,BLANC);\r
 779       Call FIN (XFINI,YFINI);\r
 780       Call CREERLABY (LABY);\r
 781       Call PLACENTSORT (ENTREE,SORTIE);\r
 782       Call Color (0);\r
 783       Call FIN (XFINI,YFINI);\r
 784       Call Color (15);\r
 785     End BATIR;\r
 786  \r
 787 (* ------------------------------------------------------------------------- *)\r
 788 (* ------------------------------------------------------------------------- *)\r
 789  \r
 790     Unit CHERCHER: LIFO Procedure (LABY: ArrayOf ArrayOf PIECE,\r
 791                                                         ENTREE,SORTIE: SALLE);\r
 792  \r
 793     Unit DEPNORD: Procedure (E: ELEM; InOut POS: Integer);\r
 794       Var I: Integer;\r
 795     Begin\r
 796       Call Color (COUL);\r
 797       If E.S.L+1=/=ENTREE.L Or E.S.C=/=ENTREE.C\r
 798       Then\r
 799         Case POS\r
 800           When 1 : Call Move (XCASE (E.S.C)+12,YCASE (E.S.L)+47);\r
 801                    Call Draw (XCASE (E.S.C)+12,YCASE (E.S.L)+32);\r
 802           When 2 : Call Move (XCASE (E.S.C),YCASE (E.S.L)+44);\r
 803                    Call Draw (XCASE (E.S.C)+6,YCASE (E.S.L)+44);\r
 804                    Call Move (XCASE (E.S.C)+7,YCASE (E.S.L)+43);\r
 805                    Call Draw (XCASE (E.S.C)+8,YCASE (E.S.L)+43);\r
 806                    Call Draw (XCASE (E.S.C)+11,YCASE (E.S.L)+40);\r
 807                    Call Draw (XCASE (E.S.C)+11,YCASE (E.S.L)+39);\r
 808                    Call Move (XCASE (E.S.C)+12,YCASE (E.S.L)+38);\r
 809                    Call Draw (XCASE (E.S.C)+12,YCASE (E.S.L)+32);\r
 810           When 4 : Call Move (XCASE (E.S.C)+15,YCASE (E.S.L)+35);\r
 811                    Call Draw (XCASE (E.S.C)+14,YCASE (E.S.L)+35);\r
 812                    Call Draw (XCASE (E.S.C)+12,YCASE (E.S.L)+33);\r
 813                    Call Draw (XCASE (E.S.C)+12,YCASE (E.S.L)+32);\r
 814         Esac;\r
 815       Fi;\r
 816       Call Move (XCASE (E.S.C),YCASE (E.S.L)+16);\r
 817       Call XorMap (PNORD);\r
 818       Call TEMPO (TEMPS);\r
 819       Call XorMap (PNORD);\r
 820       Call Move (XCASE (E.S.C)+12,YCASE (E.S.L)+31);\r
 821       Call Draw (XCASE (E.S.C)+12,YCASE (E.S.L)+16);\r
 822       Call Move (XCASE (E.S.C),YCASE (E.S.L));\r
 823       Call XorMap (PNORD);\r
 824       Call TEMPO (TEMPS);\r
 825       Call XorMap (PNORD);\r
 826       Call Color (15);\r
 827       POS:= 1;\r
 828     End DEPNORD;\r
 829  \r
 830 (* ------------------------------------------------------------------------- *)\r
 831  \r
 832     Unit DEPEST: Procedure (E: ELEM; InOut POS: Integer);\r
 833       Var I: Integer;\r
 834     Begin\r
 835       Call Color (COUL);\r
 836       If E.S.L=/=ENTREE.L Or E.S.C-1=/=ENTREE.C\r
 837       Then\r
 838         Case POS\r
 839           When 2 : Call Move (XCASE (E.S.C)-32,YCASE (E.S.L)+12);\r
 840                    Call Draw (XCASE (E.S.C)-17,YCASE (E.S.L)+12);\r
 841           When 3 : Call Move (XCASE (E.S.C)-29,YCASE (E.S.L));\r
 842                    Call Draw (XCASE (E.S.C)-29,YCASE (E.S.L)+6);\r
 843                    Call Move (XCASE (E.S.C)-28,YCASE (E.S.L)+7);\r
 844                    Call Draw (XCASE (E.S.C)-28,YCASE (E.S.L)+8);\r
 845                    Call Draw (XCASE (E.S.C)-27,YCASE (E.S.L)+11);\r
 846                    Call Draw (XCASE (E.S.C)-26,YCASE (E.S.L)+11);\r
 847                    Call Move (XCASE (E.S.C)-25,YCASE (E.S.L)+12);\r
 848                    Call Draw (XCASE (E.S.C)-17,YCASE (E.S.L)+12);\r
 849           When 1 : Call Move (XCASE (E.S.C)-20,YCASE (E.S.L)+15);\r
 850                    Call Draw (XCASE (E.S.C)-20,YCASE (E.S.L)+14);\r
 851                    Call Draw (XCASE (E.S.C)-18,YCASE (E.S.L)+12);\r
 852                    Call Draw (XCASE (E.S.C)-17,YCASE (E.S.L)+12);\r
 853         Esac;\r
 854       Fi;\r
 855       Call Move (XCASE (E.S.C)-16,YCASE (E.S.L));\r
 856       Call XorMap (PEST);\r
 857       Call TEMPO (TEMPS);\r
 858       Call XorMap (PEST);\r
 859       Call Move (XCASE (E.S.C)-16,YCASE (E.S.L)+12);\r
 860       Call Draw (XCASE (E.S.C)-1,YCASE (E.S.L)+12);\r
 861       Call Move (XCASE (E.S.C),YCASE (E.S.L));\r
 862       Call XorMap (PEST);\r
 863       Call TEMPO (TEMPS);\r
 864       Call XorMap (PEST);\r
 865       Call Color (15);\r
 866       POS:= 2;\r
 867     End DEPEST;\r
 868  \r
 869 (* ------------------------------------------------------------------------- *)\r
 870  \r
 871     Unit DEPSUD: Procedure (E: ELEM; InOut POS: Integer);\r
 872       Var I: Integer;\r
 873     Begin\r
 874       Call Color (COUL);\r
 875       If E.S.L-1=/=ENTREE.L Or E.S.C=/=ENTREE.C\r
 876       Then\r
 877         Case POS\r
 878           When 3 : Call Move (XCASE (E.S.C)+3,YCASE (E.S.L)-32);\r
 879                    Call Draw (XCASE (E.S.C)+3,YCASE (E.S.L)-17);\r
 880           When 4 : Call Move (XCASE (E.S.C)+15,YCASE (E.S.L)-29);\r
 881                    Call Draw (XCASE (E.S.C)+9,YCASE (E.S.L)-29);\r
 882                    Call Move (XCASE (E.S.C)+8,YCASE (E.S.L)-28);\r
 883                    Call Draw (XCASE (E.S.C)+7,YCASE (E.S.L)-28);\r
 884                    Call Draw (XCASE (E.S.C)+4,YCASE (E.S.L)-27);\r
 885                    Call Draw (XCASE (E.S.C)+4,YCASE (E.S.L)-26);\r
 886                    Call Move (XCASE (E.S.C)+3,YCASE (E.S.L)-25);\r
 887                    Call Draw (XCASE (E.S.C)+3,YCASE (E.S.L)-17);\r
 888           When 2 : Call Move (XCASE (E.S.C),YCASE (E.S.L)-20);\r
 889                    Call Draw (XCASE (E.S.C)+1,YCASE (E.S.L)-20);\r
 890                    Call Draw (XCASE (E.S.C)+3,YCASE (E.S.L)-18);\r
 891                    Call Draw (XCASE (E.S.C)+3,YCASE (E.S.L)-17);\r
 892         Esac;\r
 893       Fi;\r
 894       Call Move (XCASE (E.S.C),YCASE (E.S.L)-16);\r
 895       Call XorMap (PSUD);\r
 896       Call TEMPO (TEMPS);\r
 897       Call XorMap (PSUD);\r
 898       Call Move (XCASE (E.S.C)+3,YCASE (E.S.L)-16);\r
 899       Call Draw (XCASE (E.S.C)+3,YCASE (E.S.L)-1);\r
 900       Call Move (XCASE (E.S.C),YCASE (E.S.L));\r
 901       Call XorMap (PSUD);\r
 902       Call TEMPO (TEMPS);\r
 903       Call XorMap (PSUD);\r
 904       Call Color (15);\r
 905       POS:= 3;\r
 906     End DEPSUD;\r
 907  \r
 908 (* ------------------------------------------------------------------------- *)\r
 909  \r
 910     Unit DEPOUEST: Procedure (E: ELEM; InOut POS: Integer);\r
 911       Var I: Integer;\r
 912     Begin\r
 913       Call Color (COUL);\r
 914       If E.S.L=/=ENTREE.L Or E.S.C+1=/=ENTREE.C\r
 915       Then\r
 916         Case POS\r
 917           When 4 : Call Move (XCASE (E.S.C)+47,YCASE (E.S.L)+3);\r
 918                    Call Draw (XCASE (E.S.C)+32,YCASE (E.S.L)+3);\r
 919           When 1 : Call Move (XCASE (E.S.C)+44,YCASE (E.S.L)+15);\r
 920                    Call Draw (XCASE (E.S.C)+44,YCASE (E.S.L)+9);\r
 921                    Call Move (XCASE (E.S.C)+43,YCASE (E.S.L)+8);\r
 922                    Call Draw (XCASE (E.S.C)+43,YCASE (E.S.L)+7);\r
 923                    Call Draw (XCASE (E.S.C)+40,YCASE (E.S.L)+4);\r
 924                    Call Draw (XCASE (E.S.C)+39,YCASE (E.S.L)+4);\r
 925                    Call Move (XCASE (E.S.C)+38,YCASE (E.S.L)+3);\r
 926                    Call Draw (XCASE (E.S.C)+32,YCASE (E.S.L)+3);\r
 927           When 3 : Call Move (XCASE (E.S.C)+35,YCASE (E.S.L));\r
 928                    Call Draw (XCASE (E.S.C)+35,YCASE (E.S.L)+1);\r
 929                    Call Draw (XCASE (E.S.C)+33,YCASE (E.S.L)+3);\r
 930                    Call Draw (XCASE (E.S.C)+32,YCASE (E.S.L)+3);\r
 931         Esac;\r
 932       Fi;\r
 933       Call Move (XCASE (E.S.C)+16,YCASE (E.S.L));\r
 934       Call XorMap (POUEST);\r
 935       Call TEMPO (TEMPS);\r
 936       Call XorMap (POUEST);\r
 937       Call Move (XCASE (E.S.C)+31,YCASE (E.S.L)+3);\r
 938       Call Draw (XCASE (E.S.C)+16,YCASE (E.S.L)+3);\r
 939       Call Move (XCASE (E.S.C),YCASE (E.S.L));\r
 940       Call XorMap (POUEST);\r
 941       Call TEMPO (TEMPS);\r
 942       Call XorMap (POUEST);\r
 943       Call Color (15);\r
 944       POS:= 4;\r
 945     End DEPOUEST;\r
 946  \r
 947 (* ------------------------------------------------------------------------- *)\r
 948  \r
 949     Unit DEMITOUR: Procedure (E: ELEM; InOut POS: Integer, DMTR: Boolean);\r
 950     Begin\r
 951       If DMTR\r
 952       Then\r
 953         Call Color (COUL);\r
 954         Case POS\r
 955           When 1 : Call Move (XCASE (E.S.C)+3,YCASE (E.S.L));\r
 956                    Call Draw (XCASE (E.S.C)+3,YCASE (E.S.L)+5);\r
 957                    Call Draw (XCASE (E.S.C)+5,YCASE (E.S.L)+7);\r
 958                    Call Draw (XCASE (E.S.C)+10,YCASE (E.S.L)+7);\r
 959                    Call Draw (XCASE (E.S.C)+12,YCASE (E.S.L)+5);\r
 960                    Call Draw (XCASE (E.S.C)+12,YCASE (E.S.L));\r
 961           When 2 : Call Move (XCASE (E.S.C)+15,YCASE (E.S.L)+3);\r
 962                    Call Draw (XCASE (E.S.C)+10,YCASE (E.S.L)+3);\r
 963                    Call Draw (XCASE (E.S.C)+8,YCASE (E.S.L)+5);\r
 964                    Call Draw (XCASE (E.S.C)+8,YCASE (E.S.L)+10);\r
 965                    Call Draw (XCASE (E.S.C)+10,YCASE (E.S.L)+12);\r
 966                    Call Draw (XCASE (E.S.C)+15,YCASE (E.S.L)+12);\r
 967           When 3 : Call Move (XCASE (E.S.C)+3,YCASE (E.S.L)+15);\r
 968                    Call Draw (XCASE (E.S.C)+3,YCASE (E.S.L)+10);\r
 969                    Call Draw (XCASE (E.S.C)+5,YCASE (E.S.L)+8);\r
 970                    Call Draw (XCASE (E.S.C)+10,YCASE (E.S.L)+8);\r
 971                    Call Draw (XCASE (E.S.C)+12,YCASE (E.S.L)+10);\r
 972                    Call Draw (XCASE (E.S.C)+12,YCASE (E.S.L)+15);\r
 973           When 4 : Call Move (XCASE (E.S.C),YCASE (E.S.L)+3);\r
 974                    Call Draw (XCASE (E.S.C)+5,YCASE (E.S.L)+3);\r
 975                    Call Draw (XCASE (E.S.C)+7,YCASE (E.S.L)+5);\r
 976                    Call Draw (XCASE (E.S.C)+7,YCASE (E.S.L)+10);\r
 977                    Call Draw (XCASE (E.S.C)+5,YCASE (E.S.L)+12);\r
 978                    Call Draw (XCASE (E.S.C),YCASE (E.S.L)+12);\r
 979         Esac;\r
 980         Call Color (15);\r
 981         POS:= 0;\r
 982         DMTR:= False;\r
 983       Fi;\r
 984       If E.S.L=E.ANTE.S.L\r
 985       Then\r
 986         If E.S.C>E.ANTE.S.C\r
 987         Then\r
 988           Call DEPOUEST (E.ANTE,POS);\r
 989         Else\r
 990           Call DEPEST (E.ANTE,POS);\r
 991         Fi;\r
 992       Else\r
 993         If E.S.L>E.ANTE.S.L\r
 994         Then\r
 995           Call DEPSUD (E.ANTE,POS);\r
 996         Else\r
 997           Call DEPNORD (E.ANTE,POS);\r
 998         Fi;\r
 999       Fi;\r
1000     End DEMITOUR;\r
1001  \r
1002 (* ------------------------------------------------------------------------- *)\r
1003  \r
1004       Const TEMPS= 150,\r
1005             COUL= 7;\r
1006       Var I,POS: Integer,\r
1007           TROUVE,FIN,DMTR: Boolean,\r
1008           AUX,ENT: SALLE,\r
1009           E: ELEM,\r
1010           P: PILE,\r
1011           TAB: ArrayOf Integer;\r
1012     Begin\r
1013       DMTR:= True;\r
1014       P:= New PILE;\r
1015       ENTREE.PC.MARQUE:= True;\r
1016       E:= New ELEM (ENTREE);\r
1017       Call EMPIL (E,P);\r
1018       Call BLANC (XCASE (ENTREE.C),YCASE (ENTREE.L));\r
1019       Call PELOTE (XCASE (ENTREE.C),YCASE (ENTREE.L));\r
1020       ENT:= Copy (ENTREE);\r
1021       TROUVE:= False;\r
1022       While Not TROUVE\r
1023       Do\r
1024         FIN:= False;\r
1025         While Not FIN\r
1026         Do\r
1027           AUX:= E.S;\r
1028           If E.S.PC.N AndIf Not LABY (E.S.L-1,E.S.C).MARQUE\r
1029           Then\r
1030             E:= New ELEM (New SALLE (AUX.L-1,AUX.C,LABY (AUX.L-1,AUX.C)));\r
1031             E.S.PC.MARQUE:= True;\r
1032             Call EMPIL (E,P);\r
1033             Call DEPNORD (E,POS);\r
1034           Else\r
1035             If AUX.PC.E AndIf Not LABY (AUX.L,AUX.C+1).MARQUE\r
1036             Then\r
1037               E:= New ELEM (New SALLE (AUX.L,AUX.C+1,LABY (AUX.L,AUX.C+1)));\r
1038               E.S.PC.MARQUE:= True;\r
1039               Call EMPIL (E,P);\r
1040               Call DEPEST (E,POS);\r
1041             Else\r
1042               If AUX.PC.S AndIf Not LABY (AUX.L+1,AUX.C).MARQUE\r
1043               Then\r
1044                 E:= New ELEM (New SALLE (AUX.L+1,AUX.C,LABY (AUX.L+1,AUX.C)));\r
1045                 E.S.PC.MARQUE:= True;\r
1046                 Call EMPIL (E,P);\r
1047                 Call DEPSUD (E,POS);\r
1048               Else\r
1049                 If AUX.PC.O AndIf Not LABY (AUX.L,AUX.C-1).MARQUE\r
1050                 Then\r
1051                   E:= New ELEM (New SALLE (AUX.L,AUX.C-1,\r
1052                                                        LABY (AUX.L,AUX.C-1)));\r
1053                   E.S.PC.MARQUE:= True;\r
1054                   Call EMPIL (E,P);\r
1055                   Call DEPOUEST (E,POS);\r
1056                 Else\r
1057                   FIN:= True;\r
1058                 Fi;\r
1059               Fi;\r
1060             Fi;\r
1061           Fi;\r
1062           If Not FIN\r
1063           Then\r
1064             DMTR:= True;\r
1065             If E.S.L=SORTIE.L And E.S.C=SORTIE.C\r
1066             Then\r
1067               TROUVE:= True;\r
1068               FIN:= True;\r
1069             Fi;\r
1070           Fi;\r
1071         Od;\r
1072         If Not TROUVE\r
1073         Then\r
1074           Call DEMITOUR (E,POS,DMTR);\r
1075           Call DEPIL (P);\r
1076           If Not VIDE (P)\r
1077           Then\r
1078             E:= P.PREM;\r
1079           Else\r
1080             Exit;\r
1081           Fi;\r
1082         Fi;\r
1083       Od;\r
1084       If TROUVE\r
1085       Then\r
1086         Call BLANC (XCASE (SORTIE.C),YCASE (SORTIE.L));\r
1087         Call COEUR (XCASE (SORTIE.C),YCASE (SORTIE.L));\r
1088         Write (Chr(7));\r
1089         Write (Chr(7));\r
1090       Else\r
1091         Call BLANC (XCASE (ENT.C),YCASE (ENT.L));\r
1092         Call TOMBE (XCASE (ENT.C),YCASE (ENT.L));\r
1093         Call BLANC (XCASE (SORTIE.C),YCASE (SORTIE.L));\r
1094         Call TOMBE (XCASE (SORTIE.C),YCASE (SORTIE.L));\r
1095         Write (Chr(7));\r
1096       Fi;\r
1097     End CHERCHER;\r
1098  \r
1099 (* ------------------------------------------------------------------------- *)\r
1100  \r
1101   Unit TOUCHE: Procedure;\r
1102     Var I: Integer;\r
1103   Begin\r
1104     I:= 0;\r
1105     While I<>32\r
1106     Do\r
1107       I:= Inkey;\r
1108     Od;\r
1109   End TOUCHE;\r
1110  \r
1111 (* ------------------------------------------------------------------------- *)\r
1112  \r
1113     Var BX,BY,NBOUT: Integer,\r
1114         SOURIS: Boolean,\r
1115         PNORD,PEST,PSUD,POUEST: ArrayOf Integer;\r
1116   Begin\r
1117     Call Gron (1);\r
1118     Call PRINCNORD (PNORD);\r
1119     Call PRINCEST (PEST);\r
1120     Call PRINCSUD (PSUD);\r
1121     Call PRINCOUEST (POUEST);\r
1122     SOURIS:= Init (NBOUT);\r
1123     If SOURIS\r
1124     Then\r
1125       Inner;\r
1126     Fi;\r
1127     Call TOUCHE;\r
1128     Call Groff;\r
1129   End LABYGRAPH;\r
1130  \r
1131 (* ------------------------------------------------------------------------- *)\r
1132 (* ------------------------------------------------------------------------- *)\r
1133  \r
1134  Begin\r
1135  \r
1136   Pref LABYGRAPH Block\r
1137     Var LABY: ArrayOf ArrayOf PIECE,\r
1138         ENTREE,SORTIE: SALLE;\r
1139   Begin\r
1140     (*Do*)\r
1141       Call INITLABY (LABY);\r
1142       Call BATIR (LABY,ENTREE,SORTIE);\r
1143       Call CHERCHER (LABY,ENTREE,SORTIE);\r
1144     (*Od;*)\r
1145   End;\r
1146  End;\r
1147 End LABYRINTHE\r