examples/geometri/cub.log

   1 PROGRAM Infographie;\r
   2 \r
   3 (* Auteurs: Peyrard Fabrice & Pianelo Patrice *)\r
   4 \r
   5 BEGIN\r
   6   Pref Mouse Block\r
   7   VAR\r
   8     h,v,p,lg,b,vitd,vith : Integer,\r
   9     l,r,z : Boolean,\r
  10     cour,debut: Cub;\r
  11  \r
  12 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
  13 (*º/////////////////////// CUB \\\\\\\\\\\\\\\\\\\\\\ º*)\r
  14 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
  15  \r
  16 Unit Cub : Class;\r
  17 Var\r
  18   x,y : Real,\r
  19   suiv : Cub;\r
  20  \r
  21 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
  22 (*º/////////////////////// DROITE \\\\\\\\\\\\\\\\\\\\º*)\r
  23 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
  24  \r
  25 Unit Droite : Coroutine;\r
  26 Var\r
  27   dif,dif1,b : Integer;\r
  28 Begin\r
  29   Return;\r
  30   Do\r
  31     dif1 := 640;\r
  32     cour := debut;\r
  33     Do\r
  34       b := Calcul_b (cour.x,cour.y);\r
  35       dif := (b - y) - (x+lg+lg Div 3);\r
  36       If ((dif < dif1) AND (dif > 0)) Then\r
  37         dif1 := dif;\r
  38       Fi;\r
  39       If (cour.suiv = NONE) Then\r
  40         Exit;\r
  41       Else\r
  42         cour := cour.suiv;\r
  43       Fi;\r
  44     Od;\r
  45     Call Cube (x,y,0);\r
  46     If (dif1 < vith) Then\r
  47       x := x + dif1;\r
  48     Else\r
  49       x := x + vith;\r
  50     Fi;\r
  51     Call Cube (x,y,15);\r
  52     Call Setwindow (x,x+(lg+lg Div 3),y,y+lg);\r
  53     Detach;\r
  54   Od;\r
  55 End Droite;\r
  56  \r
  57 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
  58 (*º/////////////////////// GAUCHE \\\\\\\\\\\\\\\\\\\\º*)\r
  59 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
  60  \r
  61 Unit Gauche: Coroutine;\r
  62 Var\r
  63   dif,dif1,b : Integer;\r
  64 Begin\r
  65   Return;\r
  66   Do\r
  67     dif1 := 640;\r
  68     cour := debut;\r
  69     Do\r
  70       b := Calcul_b (cour.x+lg+lg Div 3,cour.y);\r
  71       dif := x-(b - y);\r
  72       If ((dif < dif1) AND (dif > 0)) Then\r
  73         dif1 := dif;\r
  74       Fi;\r
  75       If (cour.suiv = NONE) Then\r
  76         Exit;\r
  77       Else\r
  78         cour := cour.suiv;\r
  79       Fi;\r
  80     Od;\r
  81     Call Cube (x,y,0);\r
  82     If (dif1 < vith) Then\r
  83       x := x - dif1;\r
  84     Else\r
  85       x := x - vith;\r
  86     Fi;\r
  87     Call Cube (x,y,15);\r
  88     Call Setwindow (x,x+(lg+lg Div 3),y,y+lg);\r
  89     Detach;\r
  90   Od;\r
  91 End Gauche;\r
  92  \r
  93 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
  94 (*º/////////////////////// HAUT \\\\\\\\\\\\\\\\\\\\\\º*)\r
  95 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
  96  \r
  97 Unit Haut: Coroutine;\r
  98 Var\r
  99   dif,dif1: Integer;\r
 100 Begin\r
 101   Return;\r
 102   Do\r
 103     dif1 := 640;\r
 104     cour := debut;\r
 105     Do\r
 106       dif := y-(lg Div 2) - cour.y;\r
 107       If ((dif < dif1) AND (dif > 0)) Then\r
 108         dif1 := dif;\r
 109       Fi;\r
 110       If (cour.suiv = NONE) Then\r
 111         Exit;\r
 112       Else\r
 113         cour := cour.suiv;\r
 114       Fi;\r
 115     Od;\r
 116     Call Cube (x,y,0);\r
 117     If (dif1 < vitd) Then\r
 118       y := y - dif1;\r
 119       x := x + dif1;\r
 120     Else\r
 121       y := y - vitd;\r
 122       x := x + vitd;\r
 123     Fi;\r
 124     Call Cube (x,y,15);\r
 125     Call Setwindow (x,x+(lg+lg Div 3),y,y+lg);\r
 126     Detach;\r
 127   Od;\r
 128 End Haut;\r
 129  \r
 130 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 131 (*º//////////////////////// BAS \\\\\\\\\\\\\\\\\\\\\\º*)\r
 132 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 133  \r
 134 Unit Bas: Coroutine;\r
 135 Var\r
 136   dif,dif1: Integer;\r
 137 Begin\r
 138   Return;\r
 139   Do\r
 140     dif1 := 640;\r
 141     cour := debut;\r
 142     Do\r
 143       dif := cour.y-(lg Div 2) - y;\r
 144       If ((dif < dif1) AND (dif > 0)) Then\r
 145         dif1 := dif;\r
 146       Fi;\r
 147       If (cour.suiv = NONE) Then\r
 148         Exit;\r
 149       Else\r
 150         cour := cour.suiv;\r
 151       Fi;\r
 152     Od;\r
 153     Call Cube (x,y,0);\r
 154     If (dif1 < vitd) Then\r
 155       y := y + dif1;\r
 156       x := x - dif1;\r
 157     Else\r
 158       y := y + vitd;\r
 159       x := x - vitd;\r
 160     Fi;\r
 161     Call Cube (x,y,15);\r
 162     Call Setwindow (x,x+(lg+lg Div 3),y,y+lg);\r
 163     Detach;\r
 164   Od;\r
 165 End Bas;\r
 166  \r
 167 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 168 (*º/////////////////////// CUBE \\\\\\\\\\\\\\\\\\\\\ º*)\r
 169 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 170  \r
 171 Unit Cube: IIUWGraph Procedure (x,y,c : Integer);\r
 172 Begin\r
 173   Call Color (c);\r
 174   Call Move (x,y);\r
 175   Call Draw (x + lg + lg Div 3,y);\r
 176   Call Draw (x + lg + lg Div 2 + lg Div 3,y - lg Div 2);\r
 177   Call Draw (x + lg Div 2,y - lg Div 2);\r
 178   Call Draw (x,y);\r
 179   Call Draw (x,y + lg);\r
 180   Call Draw (x + lg + lg Div 3,y + lg);\r
 181   Call Draw (x + lg + lg Div 3,y);\r
 182   Call Move (x + lg + lg Div 3,y + lg);\r
 183   Call Draw (x + lg + lg Div 2 + lg Div 3,y + lg Div 2);\r
 184   Call Draw (x + lg + lg Div 2 + lg Div 3,y - lg Div 2);\r
 185 End Cube;\r
 186  \r
 187 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 188 (*º/////////////////////// NOIR \\\\\\\\\\\\\\\\\\\\\ º*)\r
 189 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 190  \r
 191 Unit Noir: IIUWGraph Procedure (x,y,c : Integer);\r
 192 Var\r
 193   i : Integer;\r
 194 Begin\r
 195   Call Color (c);\r
 196   For i:= x + 1 To x + (lg+lg Div 3) - 1 Do\r
 197     Call Move (i,y+1);\r
 198     Call Draw (i,y+lg-1);\r
 199   Od;\r
 200   For i := y To y + lg-2 Do\r
 201     Call Move (x+(lg+lg Div 3)+1,i);\r
 202     Call Draw (x+(lg+lg Div 2+lg Div 3)-1,i-(lg Div 2)+2);\r
 203   Od;\r
 204   For i:= x + 2 To x + (lg+lg Div 3) Do\r
 205     Call Move (i,y-1);\r
 206     Call Draw (i+(lg Div 2)-2,y-(lg Div 2)+1);\r
 207   Od;\r
 208 End Noir;\r
 209  \r
 210 Unit Calcul_b: Function (vx,vy:Integer):Integer;\r
 211 Begin\r
 212   result := vx + vy;\r
 213 End Calcul_b;\r
 214  \r
 215 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 216 (*º////////////////////// DEPLACE \\\\\\\\\\\\\\\\\\\ º*)\r
 217 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 218  \r
 219 UNIT Deplace: IIUWGraph Procedure;\r
 220 Var\r
 221   i : Integer,\r
 222   err : Boolean,\r
 223   Ba : Bas,\r
 224   Ha : Haut,\r
 225   Ga : Gauche,\r
 226   Dr : Droite,\r
 227   c1 : Cub;\r
 228 Begin\r
 229   Ba := New Bas;\r
 230   Ha := New Haut;\r
 231   Ga := New Gauche;\r
 232   Dr := New Droite;\r
 233  \r
 234   Call Setposition (x+(4*lg) Div 6,y+lg Div 2);\r
 235   Call Hidecursor;\r
 236   Do\r
 237     i := Inkey;\r
 238     Call Status (h,v,l,r,z);\r
 239  \r
 240 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 241 (*º/////////////////////// DROITE \\\\\\\\\\\\\\\\\\\\º*)\r
 242 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 243  \r
 244     If ((i = -77) OR (h>=x+(lg+lg Div 3))) Then\r
 245       If (x+lg+lg Div 3 < 595-vith) Then\r
 246         err := False;\r
 247         cour := debut;\r
 248         Do\r
 249           b := Calcul_b (cour.x,cour.y);\r
 250           If (y = -(x+lg+lg Div 3) + b) Then\r
 251             If ((y-lg Div 2 < cour.y) AND (y > cour.y-lg Div 2)) Then\r
 252               err := True;\r
 253               Exit;\r
 254             Fi;\r
 255           Fi;\r
 256           If (cour.suiv = NONE) Then\r
 257             Exit;\r
 258           Else\r
 259             cour := cour.suiv;\r
 260           Fi;\r
 261         Od;\r
 262         If Not err Then\r
 263           Attach (Dr);\r
 264         Fi;\r
 265         cour := debut;\r
 266         Do\r
 267           Call Cube (cour.x,cour.y,2);\r
 268           If (cour.suiv = NONE) Then\r
 269             Exit;\r
 270           Else\r
 271             cour := cour.suiv;\r
 272           Fi;\r
 273         Od;\r
 274       Fi;\r
 275     Fi;\r
 276  \r
 277 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 278 (*º/////////////////////// GAUCHE \\\\\\\\\\\\\\\\\\\\º*)\r
 279 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 280  \r
 281     If ((i = -75) OR (h<=x)) Then\r
 282       If (x > vith) Then\r
 283         err := False;\r
 284         cour := debut;\r
 285         Do\r
 286           b := Calcul_b (cour.x+lg+lg Div 3,cour.y);\r
 287           If (y = -x+b) Then\r
 288             If ((y-lg Div 2 < cour.y) AND (y > cour.y-lg Div 2)) Then\r
 289               err := True;\r
 290               Exit;\r
 291             Fi;\r
 292           Fi;\r
 293           If (cour.suiv = NONE) Then\r
 294             Exit;\r
 295           Else\r
 296             cour := cour.suiv;\r
 297           Fi;\r
 298         Od;\r
 299         If Not err Then\r
 300           Attach (Ga);\r
 301         Fi;\r
 302         cour := debut;\r
 303         Do\r
 304           Call Cube (cour.x,cour.y,2);\r
 305           If (cour.suiv = NONE) Then\r
 306             Exit;\r
 307           Else\r
 308             cour := cour.suiv;\r
 309           Fi;\r
 310         Od;\r
 311       Fi;\r
 312     Fi;\r
 313  \r
 314 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 315 (*º//////////////////////// BAS \\\\\\\\\\\\\\\\\\\\\\º*)\r
 316 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 317  \r
 318     If ((i = -80) OR (v>=y+lg)) Then\r
 319       If (y+lg < 300-vitd) AND (x > vith) Then\r
 320         err := False;\r
 321         cour := debut;\r
 322         Do\r
 323           If (y = cour.y-(lg Div 2)) Then\r
 324             If ((x <= cour.x+(lg+lg Div 2+lg Div 3)) AND\r
 325                (x >= cour.x-(lg Div 2+lg Div 3))) Then\r
 326               err := True;\r
 327               Exit;\r
 328             Fi;\r
 329           Fi;\r
 330           If (cour.suiv = NONE) Then\r
 331             Exit;\r
 332           Else\r
 333             cour := cour.suiv;\r
 334           Fi;\r
 335         Od;\r
 336         If Not err Then\r
 337           Attach (Ba);\r
 338         Fi;\r
 339         cour := debut;\r
 340         Do\r
 341           Call Cube (cour.x,cour.y,2);\r
 342           If (cour.suiv = NONE) Then\r
 343             Exit;\r
 344           Else\r
 345             cour := cour.suiv;\r
 346           Fi;\r
 347         Od;\r
 348       Fi;\r
 349     Fi;\r
 350  \r
 351 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 352 (*º/////////////////////// HAUT \\\\\\\\\\\\\\\\\\\\\\º*)\r
 353 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 354  \r
 355     If ((i = -72) OR  (v<=y)) Then\r
 356       If (y-lg Div 2 > vitd) AND (x+lg+lg Div 3 < 595-vith) Then\r
 357         err := False;\r
 358         cour := debut;\r
 359         Do\r
 360           If (y-(lg Div 2) = cour.y) Then\r
 361             If ((x+(lg + lg Div 2 + lg Div 3) >= cour.x) AND\r
 362                (x+(lg Div 2) <= cour.x+(lg + lg Div 3))) Then\r
 363               err := True;\r
 364               Exit;\r
 365             FI;\r
 366           Fi;\r
 367           If (cour.suiv = NONE) Then\r
 368             Exit;\r
 369           Else\r
 370             cour := cour.suiv;\r
 371           Fi;\r
 372         Od;\r
 373         If Not err Then\r
 374           Attach (Ha);\r
 375         Fi;\r
 376         cour := debut;\r
 377         Do\r
 378           Call Cube (cour.x,cour.y,2);\r
 379           If (cour.suiv = NONE) Then\r
 380             Exit;\r
 381           Else\r
 382             cour := cour.suiv;\r
 383           Fi;\r
 384         Od;\r
 385       Fi;\r
 386     Fi;\r
 387  \r
 388 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 389 (*º///////////////////// VALIDATION \\\\\\\\\\\\\\\\\\º*)\r
 390 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 391  \r
 392     If ((i = 27) OR l) Then\r
 393       cour := debut;\r
 394       C1 := new Cub;\r
 395       C1.x := x;\r
 396       C1.y := y;\r
 397       Do\r
 398         b := Calcul_b (debut.x+lg+lg Div 3,debut.y);\r
 399         If ((y-lg Div 2) < debut.y) AND (x < (b-y))\r
 400            OR ((y) < (debut.y-lg Div 2) AND (x >= (b-y))) Then\r
 401           C1.suiv := debut;\r
 402           debut := C1;\r
 403           Exit;\r
 404         Fi;\r
 405         If (cour.suiv = NONE)  Then\r
 406           cour.suiv := C1;\r
 407           C1.suiv := NONE;\r
 408           Exit;\r
 409         Fi;\r
 410         b := Calcul_b (cour.suiv.x+lg+lg Div 3,cour.suiv.y);\r
 411         If ((y-lg Div 2) < cour.suiv.y) AND (x < (b-y))\r
 412            OR ((y) < (cour.suiv.y-lg Div 2) AND (x >= (b-y))) Then\r
 413           C1.suiv := cour.suiv;\r
 414           cour.suiv := C1;\r
 415           Exit;\r
 416         Fi;\r
 417         cour := cour.suiv;\r
 418       Od;\r
 419       cour := debut;\r
 420       Do\r
 421         Call Cube (cour.x,cour.y,2);\r
 422         Call Noir (cour.x,cour.y,0);\r
 423         If (cour.suiv = NONE) Then\r
 424           Exit;\r
 425         Else\r
 426           cour := cour.suiv;\r
 427         Fi;\r
 428       Od;\r
 429       Exit;\r
 430     Fi;\r
 431   Od;\r
 432   Kill (Ba);\r
 433   Kill (Ha);\r
 434   Kill (Ga);\r
 435   Kill (Dr);\r
 436 End Deplace;\r
 437  \r
 438 End Cub;\r
 439  \r
 440 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 441 (*º///////////////////// RECTANGLE \\\\\\\\\\\\\\\\\\\º*)\r
 442 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 443  \r
 444 Unit Rectangle: IIUWGraph Procedure (x1,y1,x2,y2,c : Integer);\r
 445 Begin\r
 446   Call Color (c);\r
 447   Call Move (x1,y1);\r
 448   Call Draw (x2,y1);\r
 449   Call Draw (x2,y2);\r
 450   Call Draw (x1,y2);\r
 451   Call Draw (x1,y1);\r
 452   Call Move (x1+1,y1+1);\r
 453   Call Draw (x2-1,y1+1);\r
 454   Call Draw (x2-1,y2-1);\r
 455   Call Draw (x1+1,y2-1);\r
 456   Call Draw (x1+1,y1+1);\r
 457 End Rectangle;\r
 458  \r
 459 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 460 (*º////////////////////// EFFACE \\\\\\\\\\\\\\\\\\\\\º*)\r
 461 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 462  \r
 463 Unit Efface: IIUWGraph Procedure (x1,y1,x2,y2,c : Integer);\r
 464 Var\r
 465   i : Integer;\r
 466 Begin\r
 467   Call Color (c);\r
 468   For i:=y1 To y2 Do\r
 469     Call Move (x1,i);\r
 470     Call Draw (x2,i);\r
 471   Od;\r
 472 End Efface;\r
 473  \r
 474 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 475 (*º////////////////////// TEXTE \\\\\\\\\\\\\\\\\\\\\\º*)\r
 476 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 477  \r
 478 Unit Texte: IIUWGraph Procedure (x,y : Integer,ch:String);\r
 479 Begin\r
 480   Call Color (9);\r
 481   Call Move (x,y);\r
 482   Call Outstring (ch);\r
 483 End Texte;\r
 484  \r
 485 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 486 (*º///////////////////// OPTIONS \\\\\\\\\\\\\\\\\\\\\º*)\r
 487 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 488  \r
 489 Unit Options: IIUWGraph Procedure;\r
 490 Var\r
 491   cc: Cub,\r
 492   i: Integer;\r
 493 Begin\r
 494   lg := 30;\r
 495   cc := New Cub;\r
 496   Call cc.Cube (290,50,15);\r
 497   Call cc.Noir (290,50,1);\r
 498   Call cc.Cube (235,40,15);\r
 499   Call cc.Noir (235,40,2);\r
 500   Call cc.Cube (360,35,15);\r
 501   Call cc.Noir (360,35,3);\r
 502   Call cc.Cube (200,70,15);\r
 503   Call cc.Noir (200,70,4);\r
 504   Call cc.Cube (260,80,15);\r
 505   Call cc.Noir (260,80,5);\r
 506   Call cc.Cube (320,75,15);\r
 507   Call cc.Noir (320,75,6);\r
 508   Call Color (2);\r
 509   Call Move (260,135);\r
 510   Call Outstring ("OPTIONS");\r
 511   Call Color (15);\r
 512   Call Move (100,150);\r
 513   Call Outstring ("Vitesse");\r
 514   Call Move (410,150);\r
 515   Call Outstring ("Taille");\r
 516   Call Rectangle (150,170,165,185,9);\r
 517   Call Rectangle (150,200,165,215,9);\r
 518   Call Rectangle (150,230,165,245,9);\r
 519   Call Color (15);\r
 520   Call Move (180,178);\r
 521   Call Outstring ("Lent");\r
 522   Call Move (180,208);\r
 523   Call Outstring ("Moyen");\r
 524   Call Move (180,238);\r
 525   Call Outstring ("Rapide");\r
 526   Call Rectangle (450,170,465,185,9);\r
 527   Call Rectangle (450,200,465,215,9);\r
 528   Call Rectangle (450,230,465,245,9);\r
 529   Call Color (15);\r
 530   Call Move (480,178);\r
 531   Call Outstring ("Petit");\r
 532   Call Move (480,208);\r
 533   Call Outstring ("Moyen");\r
 534   Call Move (480,238);\r
 535   Call Outstring ("Gros");\r
 536   Call Rectangle (250,300,350,330,14);\r
 537   Call Texte (265,310,"Continuer");\r
 538   Call Efface (152,202,163,213,7);\r
 539   Call Efface (452,202,463,213,7);\r
 540   lg := 60;\r
 541   vitd := 4;\r
 542   vith := 6;\r
 543   z := Init (i);\r
 544   Call Setwindow (0,630,0,330);\r
 545   Call Showcursor;\r
 546   Do\r
 547     Call Status (h,v,l,r,z);\r
 548     If (l) Then\r
 549       Call Hidecursor;\r
 550       If ((h >= 250) AND (h <= 350)) AND ((v >= 300) AND (v <= 330)) Then\r
 551         Exit;\r
 552       Fi;\r
 553       If ((h >= 150) AND (h <= 165)) AND ((v >= 170) AND (v <= 185)) Then\r
 554         Case (vitd)\r
 555           When 2:  Call Efface (152,172,163,183,0);\r
 556           When 4:  Call Efface (152,202,163,213,0);\r
 557           When 10: Call Efface (152,232,163,243,0);\r
 558         Esac;\r
 559         Call Efface (152,172,163,183,7);\r
 560         vitd := 2;\r
 561         vith := 4;\r
 562       Fi;\r
 563       If ((h >= 150) AND (h <= 165)) AND ((v >= 200) AND (v <= 215)) Then\r
 564         Case (vitd)\r
 565           When 2:  Call Efface (152,172,163,183,0);\r
 566           When 4:  Call Efface (152,202,163,213,0);\r
 567           When 10: Call Efface (152,232,163,243,0);\r
 568         Esac;\r
 569         Call Efface (152,202,163,213,7);\r
 570         vitd := 4;\r
 571         vith := 6;\r
 572       Fi;\r
 573       If ((h >= 150) AND (h <= 165)) AND ((v >= 230) AND (v <= 245)) Then\r
 574         Case (vitd)\r
 575           When 2:  Call Efface (152,172,163,183,0);\r
 576           When 4:  Call Efface (152,202,163,213,0);\r
 577           When 10: Call Efface (152,232,163,243,0);\r
 578         Esac;\r
 579         Call Efface (152,232,163,243,7);\r
 580         vitd := 10;\r
 581         vith := 12;\r
 582       Fi;\r
 583       If ((h >= 450) AND (h <= 465)) AND ((v >= 170) AND (v <= 185)) Then\r
 584         Case (lg)\r
 585           When 30: Call Efface (452,172,463,183,0);\r
 586           When 60: Call Efface (452,202,463,213,0);\r
 587           When 80: Call Efface (452,232,463,243,0);\r
 588         Esac;\r
 589         Call Efface (452,172,463,183,7);\r
 590         lg := 30;\r
 591       Fi;\r
 592       If ((h >= 450) AND (h <= 465)) AND ((v >= 200) AND (v <= 215)) Then\r
 593         Case (lg)\r
 594           When 30: Call Efface (452,172,463,183,0);\r
 595           When 60: Call Efface (452,202,463,213,0);\r
 596           When 80: Call Efface (452,232,463,243,0);\r
 597         Esac;\r
 598         Call Efface (452,202,463,213,7);\r
 599         lg := 60;\r
 600       Fi;\r
 601       If ((h >= 450) AND (h <= 465)) AND ((v >= 230) AND (v <= 245)) Then\r
 602         Case (lg)\r
 603           When 30: Call Efface (452,172,463,183,0);\r
 604           When 60: Call Efface (452,202,463,213,0);\r
 605           When 80: Call Efface (452,232,463,243,0);\r
 606         Esac;\r
 607         Call Efface (452,232,463,243,7);\r
 608         lg := 80\r
 609       Fi;\r
 610       Call Showcursor;\r
 611     Fi;\r
 612   Od;\r
 613   Call Efface (0,0,640,350,0);\r
 614   Kill (cc);\r
 615 End Options;\r
 616  \r
 617  \r
 618 (*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*)\r
 619 (*º/////////////// PROGRAMME PRINCIPAL \\\\\\\\\\\\\\\º*)\r
 620 (*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼*)\r
 621  \r
 622 BEGIN\r
 623   Pref IIUWGraph Block\r
 624   VAR\r
 625     i,j,nb : Integer,\r
 626     C : Cub;\r
 627   Begin\r
 628     nb := 13;\r
 629     z := Init (j);\r
 630     Call Gron (nocard);\r
 631     Call Border (5);\r
 632     Call Options;\r
 633     Call Color (3);\r
 634     Call Move (0,300);\r
 635     Call Draw (605,300);\r
 636     Call Draw (605,310);\r
 637     Call Draw (0,310);\r
 638     Call Move (605,300);\r
 639     Call Draw (638,267);\r
 640     Call Move (605,310);\r
 641     Call Draw (638,277);\r
 642     Call Move (0,320);\r
 643     Call Color (15);\r
 644     C := New Cub;\r
 645     C.x := 200;\r
 646     C.y := 150;\r
 647     Call C.Cube (C.x,C.y,2);\r
 648     debut := C;\r
 649     For i:=1 to nb Do\r
 650       Call Rectangle (520,315,600,345,14);\r
 651       Call Texte (535,325,"Quitter");\r
 652       Call Rectangle (420,315,500,345,14);\r
 653       Call Texte (435,325,"Suivant");\r
 654       z := Init (j);\r
 655       Call Setwindow (0,630,0,330);\r
 656       Call Showcursor;\r
 657       Do\r
 658         Call Status (h,v,l,r,z);\r
 659         If (l) Then\r
 660           If ((h >= 520) AND (h <= 600)) AND\r
 661              ((v >= 315) AND (v <= 345)) Then\r
 662             Call Hidecursor;\r
 663             Call Efface (520,315,600,345,0);\r
 664             Call Efface (420,315,500,345,0);\r
 665             Exit\r
 666             Exit;\r
 667           Fi;\r
 668           If ((h >= 420) AND (h <= 500)) AND\r
 669              ((v >= 315) AND (v <= 345)) Then\r
 670             Exit;\r
 671           Fi;\r
 672         Fi;\r
 673       Od;\r
 674       Call Hidecursor;\r
 675       Call Efface (520,315,600,345,0);\r
 676       Call Efface (420,315,500,345,0);\r
 677       Call Color (15);\r
 678       Call Move (10,320);\r
 679       Call Outstring ("D\82placez le cube, et fixez");\r
 680       Call Outstring (" le en cliquant sur le bouton de GAUCHE.");\r
 681       C := New Cub;\r
 682       C.x := 595-lg-lg Div 3;\r
 683       C.y := 290-lg;\r
 684       Call C.Cube (C.x,C.y,15);\r
 685       z := Init (j);\r
 686       Call C.Deplace;\r
 687       Call Move (10,320);\r
 688       Call Outstring ("                          ");\r
 689       Call Outstring ("                                        ");\r
 690     Od;\r
 691     Call Move (0,320);\r
 692     Call Color (15);\r
 693     Call Outstring ("Cliquez sur le bouton de DROITE");\r
 694     Call Outstring (" pour obtenir une figure en couleurs.   ");\r
 695     Do\r
 696       Call Status (h,v,l,r,z);\r
 697       If (r) Then\r
 698         i := 1;\r
 699         cour := debut;\r
 700         Do\r
 701           Call C.Cube (cour.x,cour.y,15);\r
 702           Call C.Noir (cour.x,cour.y,i);\r
 703           If (cour.suiv = NONE) Then\r
 704             Exit;\r
 705           Else\r
 706             cour := cour.suiv;\r
 707           Fi;\r
 708             i := i + 1;\r
 709         Od;\r
 710         Exit;\r
 711       Fi;\r
 712     Od;\r
 713     Call Move (0,320);\r
 714     Call Color (15);\r
 715     Call Outstring ("Cliquez sur le bouton de GAUCHE");\r
 716     Call Outstring (" pour sortir ...                        ");\r
 717     Do\r
 718       Call Status (h,v,l,r,z);\r
 719       If (l) Then\r
 720         Exit;\r
 721       Fi;\r
 722     Od;\r
 723     Call Groff;\r
 724   End;\r
 725 End;\r
 726 END Infographie.\r
 727  \r