examples/jeu/labyrint.log

   1 PROGRAM Labyrinthe;\r
   2  \r
   3 BEGIN\r
   4  \r
   5 pref iiuwgraph block ;\r
   6  \r
   7 var entree : couple,\r
   8     TailleMax : couple,\r
   9     F : file,\r
  10     SortieProg : Boolean,\r
  11     Choix : Char,\r
  12     Mat : Matrice ;\r
  13  \r
  14 UNIT couple : CLASS;\r
  15   Var absi, ordo :integer;\r
  16 END couple;\r
  17  \r
  18 UNIT Link : CLASS (Val: couple);\r
  19   Var Next : Link;\r
  20 END Link;\r
  21  \r
  22  \r
  23 UNIT pile : CLASS;\r
  24   var top : Link;\r
  25 End Pile;\r
  26  \r
  27 UNIT empty : FUNCTION (p: pile): boolean;\r
  28   Begin\r
  29     If p=none\r
  30     Then\r
  31       result:= True ;\r
  32     Else\r
  33       Result:= (p.top = none);\r
  34     Fi;\r
  35   END empty;\r
  36  \r
  37 UNIT push : FUNCTION ( Curseur :couple ; p: pile) : Pile;\r
  38 Var Aux : link;\r
  39   Begin\r
  40     aux := New Link( Curseur);\r
  41     If(not empty(p)) then\r
  42       Aux.next:= p.top;\r
  43     Fi;\r
  44     Result := New Pile;\r
  45     Result.top := Aux;\r
  46   END push;\r
  47  \r
  48 UNIT tete : FUNCTION ( P : pile ): couple;\r
  49   Begin\r
  50     Result := new couple;\r
  51     If(not empty(p)) then\r
  52       Result := P.top.Val;\r
  53     Fi;\r
  54   END tete;\r
  55  \r
  56 UNIT pop : FUNCTION (p : pile): pile;\r
  57 var lk : link;\r
  58   Begin\r
  59     If(not empty(p))\r
  60     Then\r
  61       lk := New Link(p.top.val);\r
  62       result:= new pile;\r
  63       result.top:= p.top.next;\r
  64       lk:= p.top;\r
  65       kill(lk);\r
  66     Fi;\r
  67   END pop;\r
  68  \r
  69  \r
  70  \r
  71 UNIT matrice : CLASS ;\r
  72   var A: arrayof arrayof integer;\r
  73   var i: integer;\r
  74  \r
  75  \r
  76   UNIT sortie : FUNCTION ( Curseur : couple ) : boolean;\r
  77        BEGIN\r
  78          If    NOT((entree.absi = Curseur.absi) AND\r
  79                    (entree.ordo = Curseur.ordo))  ANDIF\r
  80                ( (Curseur.absi = 1) OR (Curseur.absi = TailleMax.absi) OR\r
  81                  (Curseur.ordo = 1) OR (Curseur.ordo = TailleMax.ordo) )\r
  82          Then\r
  83            result:=true;\r
  84          Else\r
  85            result:=false;\r
  86          Fi;\r
  87        END sortie;\r
  88  \r
  89   UNIT droite : FUNCTION ( Curseur : couple ) : boolean;\r
  90        BEGIN\r
  91          If ( Curseur.Absi <> TailleMax.Absi) ANDIF\r
  92             ( A(Curseur.absi + 1, Curseur.ordo) = 1 )\r
  93          Then\r
  94            result:=true\r
  95          Else\r
  96            result:=false;\r
  97          Fi\r
  98        END droite;\r
  99  \r
 100   UNIT gauche : FUNCTION ( Curseur : couple ) : boolean;\r
 101        BEGIN\r
 102          If ( Curseur.Absi <> 1 ) ANDIF\r
 103             ( A(Curseur.absi-1 , Curseur.ordo) = 1)\r
 104          Then\r
 105            result:= true\r
 106          Else\r
 107            result:=false;\r
 108          Fi\r
 109        END gauche;\r
 110  \r
 111   UNIT devant : FUNCTION ( Curseur : couple ) : boolean;\r
 112        BEGIN\r
 113          If ( Curseur.Ordo <> TailleMax.Ordo) ANDIF\r
 114             ( A(Curseur.absi , Curseur.ordo+1) = 1 )\r
 115          Then\r
 116            result:=true\r
 117          Else\r
 118            result:=false;\r
 119          Fi\r
 120        END devant;\r
 121  \r
 122   UNIT derriere : FUNCTION ( Curseur : couple ) : boolean;\r
 123        BEGIN\r
 124          If ( Curseur.Ordo <> 1 ) ANDIF\r
 125             ( A(Curseur.absi , Curseur.ordo-1) = 1 )\r
 126          Then\r
 127            result:= true;\r
 128          Else\r
 129            result := false;\r
 130          Fi\r
 131        END derriere;\r
 132  \r
 133   END Matrice;\r
 134  \r
 135  \r
 136   UNIT CreatMat : PROCEDURE (mat : matrice);\r
 137   var i:integer;\r
 138        BEGIN\r
 139          Array Mat.A Dim (1 : TailleMax.Absi);\r
 140          For i:= 1 To TailleMax.Absi Do\r
 141              Array Mat.A(i) dim (1 : TailleMax.Ordo);\r
 142          Od;\r
 143         END CreatMat;\r
 144  \r
 145  UNIT InitMat : PROCEDURE (mat : matrice);\r
 146  var i, j :integer;\r
 147       BEGIN\r
 148        (* Initialisation de la matrice; toutes les cases sont des murs *)\r
 149        For i:= 1 To TailleMax.Ordo Do\r
 150            For j:= 1 To TailleMax.Absi Do\r
 151                Mat.A(j,i) := 0;\r
 152            Od;\r
 153        Od;\r
 154 END InitMat;\r
 155  \r
 156  \r
 157  \r
 158  \r
 159 (* Procedures n\82cessaires \85 l'affichage de la matrice *)\r
 160  \r
 161   UNIT Bold : PROCEDURE;\r
 162   Begin\r
 163     write( chr(27), "[1m")\r
 164   End Bold;\r
 165  \r
 166   UNIT Reverse : PROCEDURE;\r
 167   Begin\r
 168     write( chr(27), "[7m")\r
 169   End Reverse;\r
 170  \r
 171   UNIT Normal : PROCEDURE;\r
 172   Begin\r
 173     write( chr(27), "[0m")\r
 174   End Normal;\r
 175  \r
 176   UNIT Underscore : PROCEDURE;\r
 177   Begin\r
 178     write( chr(27), "[4m")\r
 179   End Underscore;\r
 180  \r
 181   UNIT EraseLine : PROCEDURE;\r
 182   Begin\r
 183     write( chr(27), "[K")\r
 184   End EraseLine;\r
 185  \r
 186  UNIT inchar : IIUWgraph FUNCTION : integer;\r
 187     var i : integer;\r
 188   Begin\r
 189     Do\r
 190       i := inkey;\r
 191       If i <> 0 Then exit Fi;\r
 192     Od;\r
 193     result := i;\r
 194   End inchar;\r
 195  \r
 196   UNIT NewPage : PROCEDURE;\r
 197   Begin\r
 198     write( chr(27), "[2J")\r
 199   End NewPage;\r
 200  \r
 201   UNIT SetCursor : PROCEDURE (row, column : integer);\r
 202     var c,d,e,f  : char,\r
 203         i,j : integer;\r
 204   Begin\r
 205     i := row div 10;\r
 206     j := row mod 10;\r
 207     c := chr(48+i);\r
 208     d := chr(48+j);\r
 209     i := column div 10;\r
 210     j := column mod 10;\r
 211     e := chr(48+i);\r
 212     f := chr(48+j);\r
 213     write( chr(27), "[", c, d, ";", e, f, "H")\r
 214   End SetCursor;\r
 215  \r
 216  \r
 217 (* Procedure d'affichage du labyrinthe *)\r
 218  \r
 219 UNIT AffichageLaby : PROCEDURE ( Mat : matrice);\r
 220  \r
 221 var i,j:integer;\r
 222  \r
 223 BEGIN\r
 224   call NewPage;\r
 225   writeln;\r
 226   For i:= 1 To TailleMax.Ordo Do\r
 227       Call Normal;\r
 228       write (" ");\r
 229       For j := 1 To TailleMax.Absi  Do\r
 230           call Reverse;\r
 231           call Bold;\r
 232           If Mat.A (j,i) = 0\r
 233           Then (* On a un mur *)\r
 234               write (" ",chr(88));\r
 235           Else\r
 236               write ("  ");\r
 237           Fi;\r
 238       Od;\r
 239       writeln (" ");\r
 240   Od;\r
 241   Call Normal;\r
 242  \r
 243 END AffichageLaby;\r
 244  \r
 245  \r
 246 UNIT RechChemin : PROCEDURE ( Mat : matrice );\r
 247  \r
 248 Var SolExiste : boolean,\r
 249     Curseur,Elem : couple,\r
 250     Retour : boolean,\r
 251     i : integer,\r
 252     P : Pile ;\r
 253  \r
 254     UNIT AfficheChemin : PROCEDURE ( Curseur : couple , Retour : boolean );\r
 255      Var i : integer;\r
 256       Begin\r
 257         i := 0;\r
 258         While i < 10\r
 259         Do\r
 260           Call SetCursor ( Curseur.ordo + 1 , (Curseur.absi*2) + 1 );\r
 261           Call Reverse;\r
 262           Call Underscore;\r
 263           If Retour\r
 264           Then\r
 265              write ( "." );\r
 266           Else\r
 267              write ( chr(254) );\r
 268           Fi;\r
 269           Call SetCursor ( Curseur.ordo + 1, (Curseur.absi*2) + 1 );\r
 270           Call Normal ;\r
 271           i := i+1;\r
 272        Od;\r
 273       End AfficheChemin;\r
 274  \r
 275 BEGIN\r
 276  \r
 277   Call SetCursor (22,10);\r
 278   Call EraseLine;\r
 279   Call SetCursor (23,15);\r
 280   Call EraseLine;\r
 281   Call SetCursor (24,15);\r
 282   Call EraseLine;\r
 283  \r
 284   Curseur := New Couple ;\r
 285   Curseur.Absi := Entree.absi;\r
 286   Curseur.Ordo := Entree.Ordo;\r
 287   Mat.A ( Curseur.absi, Curseur.Ordo ) := 2;\r
 288   Retour := False;\r
 289   Call AfficheChemin ( Curseur , Retour );\r
 290  \r
 291   SolExiste := true;\r
 292   P := new Pile;\r
 293  \r
 294   While (Not Mat.Sortie(curseur)) AND ( SolExiste )\r
 295   Do\r
 296     If Mat.Gauche(curseur)\r
 297     Then\r
 298        Retour := False;\r
 299        Call AfficheChemin ( Curseur, Retour );\r
 300        Elem := New Couple ;\r
 301        Elem.Absi := Curseur.Absi;\r
 302        Elem.Ordo := Curseur.Ordo;\r
 303        P := Push ( Elem , P );\r
 304        Curseur.absi := Curseur.absi - 1;\r
 305        Mat.A ( Curseur.Absi, Curseur.Ordo) := 2;\r
 306        Call AfficheChemin ( Curseur, Retour );\r
 307     Else\r
 308        If Mat.devant(curseur)\r
 309        Then\r
 310           Retour := False;\r
 311           Call AfficheChemin ( Curseur, Retour );\r
 312           Elem := New Couple;\r
 313           Elem.Absi := Curseur.Absi;\r
 314           Elem.Ordo := Curseur.ordo;\r
 315           P := Push ( Elem , P );\r
 316           Curseur.ordo := Curseur.ordo + 1;\r
 317           Mat.A(Curseur.Absi, Curseur.Ordo) := 2;\r
 318           Call AfficheChemin ( Curseur, Retour );\r
 319        Else\r
 320           If Mat.droite(curseur)\r
 321           Then\r
 322              Retour := False;\r
 323              Call AfficheChemin (Curseur, Retour );\r
 324              Elem := New Couple;\r
 325              Elem.absi := Curseur.absi;\r
 326              Elem.ordo := Curseur.ordo;\r
 327              P := push ( Elem ,P );\r
 328              Curseur.absi := curseur.absi + 1;\r
 329              Mat.A(Curseur.Absi, Curseur.Ordo) := 2;\r
 330              Call AfficheChemin ( Curseur, Retour );\r
 331           Else\r
 332              If Mat.Derriere(curseur)\r
 333              Then\r
 334                 Retour := False;\r
 335                 Call AfficheChemin(Curseur,Retour);\r
 336                 Elem := New Couple;\r
 337                 Elem.Absi := Curseur.absi;\r
 338                 Elem.Ordo := Curseur.ordo;\r
 339                 P := push ( Elem , P);\r
 340                 Curseur.ordo := Curseur.ordo - 1;\r
 341                 Mat.A(Curseur.absi, Curseur.Ordo) := 2;\r
 342                 Call AfficheChemin ( Curseur,Retour );\r
 343              Else\r
 344                If not empty (P)\r
 345                Then\r
 346                    (* On revient sur un endroit defja visit\82 *)\r
 347                    Retour := True;\r
 348                    Call AfficheChemin ( Curseur, Retour );\r
 349                    Elem := New Couple;\r
 350                    Elem := Tete(P);\r
 351                    Curseur.Ordo:= Elem.Ordo;\r
 352                    Curseur.Absi := Elem.Absi;\r
 353                    kill(Elem);\r
 354                    P := pop(P);\r
 355                    Call AfficheChemin ( Curseur , Retour);\r
 356                 Else\r
 357                    SolExiste := false;\r
 358                 Fi;\r
 359              Fi;\r
 360           Fi;\r
 361        Fi;\r
 362     Fi;\r
 363   Od;\r
 364   call Bold;\r
 365   If SolExiste then\r
 366     If Curseur.Ordo = 1 then\r
 367       call SetCursor(1, (Curseur.Absi*2)+1);\r
 368       write("S");\r
 369     Fi;\r
 370     If Curseur.Ordo = TailleMax.Ordo then\r
 371       call SetCursor(TailleMax.Ordo+2, (Curseur.Absi*2)+1);\r
 372       write("S");\r
 373     Fi;\r
 374     If Curseur.Absi = 1 then\r
 375       call SetCursor (Curseur.Ordo+1, 1);\r
 376       write("S");\r
 377     Fi;\r
 378     If Curseur.Absi = TailleMax.Absi then\r
 379       call SetCursor ( Curseur.ordo+1, (TailleMax.Absi*2)+3);\r
 380       write("S");\r
 381     Fi;\r
 382   else\r
 383     call SetCursor(22,15);\r
 384     write(" Le labyrinthe n'a pas de sortie ... ");\r
 385   fi;\r
 386   call Normal;\r
 387   call SetCursor(23,15);\r
 388   write(" Pour revenir au Menu :");\r
 389   call Bold;\r
 390   write(" Tapez ",chr(17), chr(217));\r
 391   call Normal;\r
 392   i := inchar;\r
 393   kill(curseur);\r
 394   kill(p);\r
 395 END RechChemin;\r
 396  \r
 397 UNIT ChargeLaby : PROCEDURE (output Mat : Matrice);\r
 398 var i, j : integer;\r
 399  \r
 400 Begin\r
 401   Mat := New Matrice;\r
 402   open(F,integer,unpack("donnees.lab"));\r
 403   call reset(F);\r
 404   get(F, Entree.Absi, Entree.Ordo, TailleMax.Absi, TailleMax.Ordo);\r
 405   call CreatMat(Mat);\r
 406   for i:= 1 to TailleMax.Ordo do\r
 407      for j:= 1 to TailleMax.Absi do\r
 408        get(F,Mat.A(j,i));\r
 409      od;\r
 410   od;\r
 411   kill(f);\r
 412   call AffichageLaby(Mat);\r
 413 End ChargeLaby;\r
 414  \r
 415  \r
 416 UNIT SauveLaby : PROCEDURE ( Entree : couple,\r
 417                              TailleMax : couple,\r
 418                              mat : matrice;\r
 419                              output F : file);\r
 420 var i, j : integer;\r
 421  \r
 422 BEGIN\r
 423   open(F,integer,unpack("donnees.lab"));\r
 424   call rewrite(f);\r
 425   put(f, Entree.Absi, Entree.Ordo, TailleMax.Absi, TailleMax.Ordo);\r
 426   for i:= 1 to TailleMax.Ordo do\r
 427     for j:= 1 to TailleMax.Absi do\r
 428      put(f,Mat.A(j,i));\r
 429     od;\r
 430   od;\r
 431   kill(f);\r
 432 END SauveLaby;\r
 433  \r
 434  \r
 435  \r
 436  \r
 437 UNIT CreationLaby : PROCEDURE ( inout mat : matrice);\r
 438  \r
 439  UNIT CreationChemin : PROCEDURE (inout Mat : Matrice);\r
 440    var Curseur : couple,\r
 441         I      : integer,\r
 442         Erreur : Boolean;\r
 443  \r
 444    BEGIN\r
 445  \r
 446     BLOCK; (* Affichage des moyens de deplacement du curseur *)\r
 447  \r
 448      Begin\r
 449  \r
 450       Call Bold;\r
 451       Call SetCursor(2, 77);\r
 452       write("8");\r
 453       Call Normal;\r
 454       Call SetCursor(3, 77);\r
 455       write(chr(30));\r
 456       Call Bold;\r
 457       Call SetCursor(4, 74);\r
 458       write("4");\r
 459       Call Normal;\r
 460       write(chr(17),"-|-",chr(16));\r
 461       Call Bold;\r
 462       write("6");\r
 463       Call Normal;\r
 464       Call SetCursor(5, 77);\r
 465       write(chr(31));\r
 466       Call Bold;\r
 467       Call SetCursor(6, 77);\r
 468       write("2");\r
 469  \r
 470       Call Normal;\r
 471       Call SetCursor(22, 10);\r
 472       write("Deplacez vous \85 l'aide des fl\82ches ");\r
 473       Call SetCursor(23,15);\r
 474       write("Selectionnez l'");\r
 475       Call Bold;\r
 476       write("Entr\82e");\r
 477       Call Normal;\r
 478       write(" du labyrinthe ");\r
 479       Call SetCursor(24, 15);\r
 480       write("Validez avec la touche ");\r
 481       Call Bold;\r
 482       write(chr(17),chr(217));\r
 483  \r
 484      End; (* block Affichage des moyens de deplacement du curseur *)\r
 485  \r
 486  \r
 487    BLOCK (* Validation de l'entree du Ladyrinthe *)\r
 488  \r
 489     Begin\r
 490       Entree.Ordo:= 0;\r
 491       Entree.absi:= 0;\r
 492  \r
 493       While NOT ( (Entree.Ordo = 1) Or (Entree.Ordo = TailleMax.Ordo) Or\r
 494                   (Entree.Absi = 1) Or (Entree.Absi = TailleMax.Absi) )\r
 495       Do\r
 496         (* Verification de la conformit\82 de l'entr\82e *)\r
 497  \r
 498         If Entree.Ordo <> 0\r
 499         Then\r
 500            Call Normal;\r
 501            Call Reverse;\r
 502            Call Bold;\r
 503            Call SetCursor ( Entree.ordo + 1 , (Entree.Absi*2) + 1 );\r
 504            write(chr(88));\r
 505            Call Normal;\r
 506            Call Bold;\r
 507            Call SetCursor ( 25, 10 ) ;\r
 508            write ("L'entr\82e S\82lectionn\82e n'est pas conforme ... Recommencez");\r
 509         Fi;\r
 510  \r
 511         Entree.Ordo := 1;\r
 512         Entree.Absi := 1;\r
 513         Call SetCursor ( 2, 3 );\r
 514         write(chr(219));\r
 515         Call SetCursor (2, 3);\r
 516  \r
 517         I := Inchar ;\r
 518         Call SetCursor( 25, 10 );\r
 519         Call EraseLine;\r
 520  \r
 521         Call SetCursor (2 , 3);\r
 522  \r
 523         While (I <> 13)  (* RC *)\r
 524         Do\r
 525            (* Avant de d\82placer le curseur on reinscrit un mur\r
 526               dans la case non validee *)\r
 527            Call Reverse;\r
 528            write(chr(88)); (* X *)\r
 529            Call SetCursor(Entree.ordo + 1 , ( Entree.Absi*2) + 1);\r
 530            Call Normal;\r
 531            Call Bold;\r
 532  \r
 533            Case I\r
 534            (* Placement de l'entree suivant les touches frappees *)\r
 535              When 50 : If Entree.Ordo < TailleMax.Ordo\r
 536                        Then\r
 537                           (* Bas *)\r
 538                           Entree.Ordo := Entree.Ordo + 1;\r
 539                        Fi;\r
 540              When 52 : If Entree.Absi > 1\r
 541                        Then\r
 542                           (* Gauche *)\r
 543                           Entree.Absi := Entree.Absi - 1;\r
 544                        Fi;\r
 545              When 54 : If Entree.Absi < TailleMax.Absi\r
 546                        Then\r
 547                           (* Droite *)\r
 548                           Entree.Absi := Entree.Absi + 1;\r
 549                        Fi;\r
 550              When 56 : If Entree.Ordo > 1\r
 551                        Then\r
 552                           (* Derriere *)\r
 553                           Entree.Ordo := Entree.Ordo - 1;\r
 554                        Fi;\r
 555             Otherwise  erreur:=True;\r
 556            Esac;\r
 557  \r
 558           (* On Place le curseur Sur les nouvelles coordonnees de l'entree *)\r
 559           Call SetCursor(Entree.ordo + 1 , ( Entree.Absi*2) + 1 );\r
 560           write(chr(219));\r
 561           Call SetCursor(Entree.ordo + 1 , ( Entree.Absi*2) + 1 );\r
 562  \r
 563           I:= inchar;\r
 564         Od;\r
 565       Od;\r
 566  \r
 567       (* Affichage D'un signe au point d'entree  *)\r
 568  \r
 569       If Entree.Ordo = 1\r
 570       Then\r
 571          Call SetCursor ( 1, (Entree.Absi*2) + 1 );\r
 572          Write("E");\r
 573          Call SetCursor ( 1, (Entree.Absi*2) + 1 );\r
 574       Fi;\r
 575  \r
 576       If Entree.Ordo = TailleMax.Ordo\r
 577       Then\r
 578          Call SetCursor ( Entree.Ordo + 2 , ( Entree.Absi*2 ) + 1 );\r
 579          Write("E");\r
 580          Call SetCursor ( Entree.Ordo + 2 , ( Entree.Absi*2 ) + 1 );\r
 581       Fi;\r
 582  \r
 583       If Entree.Absi = 1\r
 584       Then\r
 585          Call SetCursor ( Entree.Ordo + 1, 1);\r
 586          Write ("E");\r
 587          Call SetCursor ( Entree.Ordo + 1, 1);\r
 588       Fi;\r
 589  \r
 590       If Entree.Absi = TailleMax.Absi\r
 591       Then\r
 592          Call SetCursor ( Entree.Ordo + 1, (Entree.Absi* 2 ) + 3);\r
 593          Write ("E");\r
 594          Call SetCursor (Entree.Ordo + 1 , (Entree.Absi* 2) + 3);\r
 595       Fi;\r
 596  \r
 597    End; (* Block Validation de l'entree *)\r
 598  \r
 599  \r
 600    BLOCK (* Affichage des options *)\r
 601      Begin\r
 602  \r
 603       Call SetCursor(10,74);\r
 604       write("Espace");\r
 605       Call normal;\r
 606       Call SetCursor(11, 73);\r
 607       write("Restaure");\r
 608       Call SetCursor(12, 75);\r
 609       write("Mur");\r
 610  \r
 611       Call SetCursor(23, 15);\r
 612       Call EraseLine;\r
 613       write("Choisissez les ");\r
 614       Call Bold;\r
 615       write("Chemins");\r
 616       Call Normal;\r
 617       write(" du labyrinthe ");\r
 618       Call Bold;\r
 619       Call SetCursor(Entree.Ordo + 1 , (Entree.Absi*2) + 1 );\r
 620  \r
 621      End; (* Block Affichage des options *)\r
 622  \r
 623  \r
 624    BLOCK (* Validation du ou des Chemins du Labyrinthe *)\r
 625  \r
 626      Begin\r
 627       (* Positionnement sur le point d'entree *)\r
 628       Curseur := New Couple;\r
 629       Curseur.Absi := Entree.absi;\r
 630       Curseur.Ordo := Entree.ordo;\r
 631       Mat.A(Entree.Absi, Entree.Ordo):= 1;\r
 632  \r
 633       I:= Inchar;\r
 634  \r
 635       While (I <> 13)\r
 636       Do\r
 637          (* Creation des chemins *)\r
 638  \r
 639          (* Affichage de la valeur de la case avant d\82placement du curseur *)\r
 640          Call Reverse;\r
 641          Call SetCursor(Curseur.Ordo+1, (Curseur.Absi*2) + 1);\r
 642          If Mat.A ( Curseur.Absi, Curseur.Ordo ) = 0\r
 643          Then\r
 644             write ( chr(88) );\r
 645          Else\r
 646             write(" ");\r
 647          Fi;\r
 648          Call SetCursor(Curseur.Ordo + 1 , (Curseur.Absi*2) + 1) ;\r
 649          Call Normal;\r
 650          Call Bold;\r
 651  \r
 652          Erreur := False;\r
 653  \r
 654          Case I\r
 655            (* Interpretation de la touche frapp\82e *)\r
 656            When 50 : If Curseur.Ordo < TailleMax.Ordo\r
 657                      Then\r
 658                         (* Bas *)\r
 659                         Curseur.Ordo := Curseur.Ordo + 1;\r
 660                      Else\r
 661                         Erreur := True;\r
 662                      Fi;\r
 663            When 52 : If Curseur.Absi > 1\r
 664                      Then\r
 665                         (* Gauche *)\r
 666                         Curseur.Absi := Curseur.Absi - 1;\r
 667                      Else\r
 668                         Erreur := True;\r
 669                      Fi;\r
 670            When 54 : If Curseur.Absi < TailleMax.Absi\r
 671                      Then\r
 672                         (* Droite *)\r
 673                         Curseur.Absi := Curseur.Absi + 1;\r
 674                      Else\r
 675                         Erreur := True;\r
 676                      Fi;\r
 677            When 56 : If Curseur.Ordo > 1\r
 678                      Then\r
 679                         (* Derriere *)\r
 680                         Curseur.Ordo:= Curseur.Ordo-1;\r
 681                      Else\r
 682                         Erreur := True;\r
 683                      Fi;\r
 684            When 32 : If (Curseur.Ordo = Entree.Ordo) And\r
 685                         (Curseur.Absi = Entree.Absi)\r
 686                      Then\r
 687                         (* On ne peut pas murer l'entree *)\r
 688                         Erreur := True;\r
 689                      Fi;\r
 690            Otherwise\r
 691                      Erreur := True;\r
 692  \r
 693          Esac;\r
 694  \r
 695          If not Erreur\r
 696          Then\r
 697             If ( I = 32 ) (*Si on veut murer *)\r
 698             Then\r
 699                Mat.A(Curseur.Absi,Curseur.Ordo) := 0 ;\r
 700             Else\r
 701                Mat.A(Curseur.Absi, Curseur.Ordo) := 1;\r
 702             Fi;\r
 703          Fi;\r
 704  \r
 705  \r
 706          (* Affichage du curseur sur la nouvelle case *)\r
 707  \r
 708          Call SetCursor (Curseur.Ordo + 1 ,(Curseur.Absi*2) + 1 );\r
 709          If Mat.A ( Curseur.Absi, Curseur.Ordo) = 1\r
 710          Then\r
 711             Write(chr(219));\r
 712          Else\r
 713             Write (chr(88));\r
 714          Fi;\r
 715          Call SetCursor(Curseur.Ordo + 1 , (Curseur.Absi*2) + 1 );\r
 716  \r
 717          I:= Inchar;\r
 718  \r
 719       Od;\r
 720  \r
 721       Call SetCursor (Curseur.Ordo + 1, (Curseur.Absi * 2) + 1);\r
 722       Call Reverse;\r
 723       If Mat.A ( Curseur.Absi, Curseur.Ordo) = 1\r
 724       Then\r
 725         write ("  ");\r
 726       Else\r
 727         write ( chr(88));\r
 728       Fi;\r
 729       Call SetCursor (Curseur.Ordo + 1, (Curseur.Absi * 2) + 1);\r
 730       Call Normal;\r
 731  \r
 732      End ; (* Block Validation des chemins *)\r
 733  \r
 734    END CreationChemin;\r
 735  \r
 736   BEGIN (* creation labyrinthe *)\r
 737  \r
 738     Call Newpage;\r
 739     TailleMax.Ordo:=0;\r
 740     TailleMax.Absi:=0;\r
 741  \r
 742     While (TailleMax.Ordo < 1) Or (TailleMax.Ordo > 20) Or\r
 743           (TailleMax.Absi < 1) Or (TailleMax.Absi > 30)\r
 744     Do\r
 745        (* Lecture de la taille du labyrinthe *)\r
 746        writeln(" Entrez la hauteur du labyrinthe ");\r
 747        write(" comprise entre 1 et 20 : ");\r
 748        readln(TailleMax.Ordo);\r
 749        writeln;\r
 750        writeln(" Entrez la largeur du labyrinthe");\r
 751        write(" comprise entre 1 et 30 : ");\r
 752        readln(TailleMax.Absi);\r
 753        writeln;\r
 754     Od;\r
 755  \r
 756     Call CreatMat(mat);\r
 757     Call InitMat(Mat);\r
 758     Call AffichageLaby(Mat);\r
 759  \r
 760     Call CreationChemin(Mat);\r
 761     call SetCursor(25,1);\r
 762     write(" Le labyrinthe cr\82e est sauvegard\82 dans le fichier DONNEES.LAB ... ");\r
 763  \r
 764   END CreationLaby;\r
 765  \r
 766 UNIT Menu : PROCEDURE (output Choix : char);\r
 767  \r
 768 BEGIN\r
 769   call NewPage;\r
 770   call Reverse;\r
 771   call Underscore;\r
 772   call SetCursor(5,32);\r
 773   write(" MENU ");\r
 774   call Normal;\r
 775   call Bold;\r
 776   call SetCursor(9,20);\r
 777   write("1");\r
 778   call Normal;\r
 779   call SetCursor(9,22);\r
 780   write("- Cr\82ation d'un labyrinthe. ");\r
 781   call Bold;\r
 782   call SetCursor(12,20);\r
 783   write("2");\r
 784   call Normal;\r
 785   call SetCursor(12,22);\r
 786   write("- Chargement d'un labyrinthe.");\r
 787   call Bold;\r
 788   call SetCursor(15,20);\r
 789   write("3");\r
 790   call Normal;\r
 791   call SetCursor(15,22);\r
 792   write("- Sortie du programme.");\r
 793   call Bold;\r
 794   call SetCursor(19,30);\r
 795   write("Choix : ");\r
 796   call Normal;\r
 797   call SetCursor(22,20);\r
 798   write("Validez votre choix avec ");\r
 799   call Bold;\r
 800   write(chr(17),chr(217));\r
 801   call SetCursor(19,38);\r
 802   readln(choix);\r
 803   while (ord(Choix) <> 49) AND (ord(Choix) <> 50) AND (ord(Choix) <> 51) do\r
 804     call Bold;\r
 805     call SetCursor(24,10);\r
 806     write("Choix incorrect ");\r
 807     call Normal;\r
 808     call SetCursor(19,38);\r
 809     Readln(Choix);\r
 810   od;\r
 811  \r
 812 END Menu;\r
 813  \r
 814 BEGIN (* Programme principal *)\r
 815  \r
 816   SortieProg:= false;\r
 817   while not SortieProg do\r
 818     call Menu(choix);\r
 819     case ord(choix)\r
 820       when 49 :  Mat := New Matrice;\r
 821                  Entree := New Couple;\r
 822                  TailleMax := New Couple;\r
 823                  call CreationLaby(mat);\r
 824                  call SauveLaby(Entree, TailleMax, Mat, F);\r
 825                  call RechChemin(Mat);\r
 826                  Kill(Mat.A);\r
 827                  Kill(Mat);\r
 828                  kill(entree);\r
 829                  kill(TailleMax);\r
 830  \r
 831       when 50 :  Mat := New Matrice;\r
 832                  Entree := New Couple;\r
 833                  TailleMax := New Couple;\r
 834                  call ChargeLaby(Mat);\r
 835                  call RechChemin(Mat);\r
 836                  Kill(Mat.A);\r
 837                  kill(Mat);\r
 838                  kill(Entree);\r
 839                  kill(TailleMax);\r
 840  \r
 841       when 51 :  SortieProg := True;\r
 842     esac;\r
 843   od;\r
 844   end; (* End iiuwgraph *)\r
 845  \r
 846 END; (* End Programme *)\r