examples/chin/projet1.log

   1 program projet;\r
   2 var i,j:integer,\r
   3      h,v:char;\r
   4      (* Les variables h et v sont utilis\82es pour comparer le sens des segments*)\r
   5 begin\r
   6 \r
   7 (************************************************************)\r
   8 h:='h';(* Initialisation des variables h et v *)\r
   9 v:='v';\r
  10 pref iiuwgraph block\r
  11 var t,tab:arrayof segment;(* Le tableau tab contient les segments saisis soit \r
  12 au clavier, soit \85 l'aide de la souris ou soit cr\82er al\82atoirement, et le \r
  13 tableau t est le r\82sultat du tri de tab suivant les ordonn\82es (et les abscisses\r
  14 si les ordonn\82es sont \82gales *)\r
  15 \r
  16 (************************************************************)\r
  17 (* Les fonctions de convertion des abscisses et des ordonn\82es\r
  18 en entier(pixel) (xconv_en_entier,yconx_en_entier) ou en r\82el\r
  19 (yconv_en_reel,xconv_en_reel) *)\r
  20 \r
  21 unit xconv_en_entier:function(x:real):integer;\r
  22 begin\r
  23    result:=entier(40+20*x);\r
  24 end xconv_en_entier;\r
  25 \r
  26 unit yconv_en_entier:function(y:real):integer;\r
  27 begin\r
  28    result:=entier(210-20*y);\r
  29 end yconv_en_entier;\r
  30 \r
  31 unit xconv_en_reel:function(x:integer):real;\r
  32 begin\r
  33    result:=(x-40)/20;\r
  34 end xconv_en_reel;\r
  35 \r
  36 unit yconv_en_reel:function(y:integer):real;\r
  37 begin\r
  38    result:=(210-y)/20;\r
  39 end yconv_en_reel;\r
  40 \r
  41 (************************************************************)\r
  42 (* La structure de la classe segment, la procedure saisie utile pour\r
  43 la procedure clavier *)\r
  44 \r
  45 unit segment:class;\r
  46   var sens:char,\r
  47       x1,x2,y1,y2:real;\r
  48   (* La procedure saisie n'est utilis\82e que si les segments sont saisis\r
  49      au clavier *)\r
  50   unit saisie:procedure(input sens:char;inout x1,y1,x2,y2:real);\r
  51   var i,k:integer,j:real,\r
  52       b:boolean;\r
  53   begin\r
  54      if sens=h then\r
  55         call move(40,290);\r
  56         call outstring("entrer la valeur de l'ordonn\82e :   Y= ");\r
  57         i:=inkey;j:=1.0;k:=0;y1:=0.0;b:=false;\r
  58         while i<>13\r
  59         do\r
  60            call hascii(i);\r
  61            call move(350+7*k,290);\r
  62            if i<>46 then\r
  63                 y1:=10*y1+i-48;\r
  64            fi;\r
  65            k:=k+1;\r
  66            if b then j:=j/10.0 fi;\r
  67            if i=46 then b:=true fi;\r
  68            i:=inkey;\r
  69         od;\r
  70         y1:=y1*j;if y1>10.0 then y1:=10.0 fi;\r
  71         call move(40,310);\r
  72         call outstring("entrer la valeur de l'abscisse1 : X1= ");\r
  73         i:=inkey;j:=1.0;k:=0;x1:=0.0;b:=false;\r
  74         while i<>13\r
  75         do\r
  76            call hascii(i);\r
  77            call move(350+7*k,310);\r
  78            if i<>46 then\r
  79                 x1:=10*x1+i-48;\r
  80            fi;\r
  81            k:=k+1;\r
  82            if b then j:=j/10.0 fi;\r
  83            if i=46 then b:=true fi;\r
  84            i:=inkey;\r
  85         od;\r
  86         x1:=x1*j;\r
  87         call move(40,330);\r
  88         call outstring("entrer la valeur de l'abscisse2 : X2= ");\r
  89         i:=inkey;j:=1.0;k:=0;x2:=0.0;b:=false;\r
  90         while i<>13\r
  91         do\r
  92            call hascii(i);\r
  93            call move(350+7*k,330);\r
  94            if i<>46 then\r
  95                 x2:=10*x2+i-48;\r
  96            fi;\r
  97            k:=k+1;\r
  98            if b then j:=j/10.0 fi;\r
  99            if i=46 then b:=true fi;\r
 100            i:=inkey;\r
 101         od;\r
 102         x2:=x2*j;\r
 103         if x1>x2 then\r
 104                 y2:=x1;x1:=x2;x2:=y2;\r
 105         fi;\r
 106         y2:=y1;if x2>28.0 then x2:=28.0 fi;if x1>28.0 then x1:=28 fi;\r
 107         call move(xconv_en_entier(x1),yconv_en_entier(y1));\r
 108         call draw(xconv_en_entier(x2),yconv_en_entier(y2));\r
 109      else\r
 110         if sens=v then\r
 111         call move(40,290);\r
 112         call outstring("entrer la valeur de l'abscisse :   X= ");\r
 113         i:=inkey;j:=1.0;k:=0;x1:=0.0;b:=false;\r
 114         while i<>13\r
 115         do\r
 116            call hascii(i);\r
 117            call move(350+7*k,290);\r
 118            if i<>46 then\r
 119                 x1:=10*x1+i-48;\r
 120            fi;\r
 121            k:=k+1;\r
 122            if b then j:=j/10.0 fi;\r
 123            if i=46 then b:=true fi;\r
 124            i:=inkey;\r
 125         od;\r
 126         x1:=x1*j;if x1>28 then x1:=28 fi;\r
 127         call move(40,310);\r
 128         call outstring("entrer la valeur de l'ordonn\82e1 : Y1= ");\r
 129         i:=inkey;j:=1.0;k:=0;y1:=0.0;b:=false;\r
 130         while i<>13\r
 131         do\r
 132            call hascii(i);\r
 133            call move(350+7*k,310);\r
 134            if i<>46 then\r
 135                 y1:=10*y1+i-48;\r
 136            fi;\r
 137            k:=k+1;\r
 138            if b then j:=j/10.0 fi;\r
 139            if i=46 then b:=true fi;\r
 140            i:=inkey;\r
 141         od;\r
 142         y1:=y1*j;\r
 143         call move(40,330);\r
 144         call outstring("entrer la valeur de l'ordonn\82e2 : Y2= ");\r
 145         i:=inkey;j:=1.0;k:=0;y2:=0.0;b:=false;\r
 146         while i<>13\r
 147         do\r
 148            call hascii(i);\r
 149            call move(350+7*k,330);\r
 150            if i<>46 then\r
 151                 y2:=10*y2+i-48;\r
 152            fi;\r
 153            k:=k+1;\r
 154            if b then j:=j/10.0 fi;\r
 155            if i=46 then b:=true fi;\r
 156            i:=inkey;\r
 157         od;\r
 158         y2:=y2*j;\r
 159         if y1>y2 then\r
 160                 x2:=y1;y1:=y2;y2:=x2;\r
 161         fi;\r
 162         x2:=x1;if y2>10 then y2:=10 fi;if y1>10 then y1:=10 fi;\r
 163         call move(xconv_en_entier(x1),yconv_en_entier(y1));\r
 164         call draw(xconv_en_entier(x2),yconv_en_entier(y2));\r
 165         fi;\r
 166      fi;\r
 167      call move(40,275);\r
 168      call outstring("                                                  ");\r
 169      call move(40,290);\r
 170      call outstring("                                                  ");\r
 171      call move(40,310);\r
 172      call outstring("                                                  ");\r
 173      call move(40,330);\r
 174      call outstring("                                                  ");\r
 175   end saisie;\r
 176 end segment;\r
 177 \r
 178 (*************************************************************)\r
 179 (* La procedure tri, comme son nom l'indique, trie le tableau contenant\r
 180 tous les segments(tab) et met le r\82sultat dans un autre tableau(t) *)\r
 181 \r
 182 unit tri:procedure(tb:arrayof segment;output ta:arrayof segment);\r
 183   var i,j,k,n:integer,t:arrayof integer;\r
 184   begin\r
 185     n:=upper(tb);\r
 186     array t dim(1:n);\r
 187     array ta dim(1:n);\r
 188     for i:=1 to n do t(i):=i od;\r
 189     for i:=1 to n-1 \r
 190     do \r
 191        for j:=i+1 to n\r
 192        do \r
 193           if tb(i).y1>tb(j).y1 then\r
 194                         k:=t(i);       \r
 195                         t(i):=t(j);\r
 196                         t(j):=k;\r
 197           fi;\r
 198           if tb(i).y1=tb(j).y1 then\r
 199                         if tb(i).x1>tb(j).x1 then\r
 200                                         k:=t(i);\r
 201                                         t(i):=t(j);\r
 202                                         t(j):=k;\r
 203           fi;           fi;\r
 204         od;\r
 205     od;\r
 206     for i:=1 to n\r
 207     do\r
 208         ta(i):=new segment;\r
 209         ta(i):=tb(t(i));\r
 210     od;\r
 211     call move(60,295);call color(9);\r
 212     call outstring("Fin du tri.");\r
 213     call move(60,310);call color(5);\r
 214     call outstring("Appuyer sur une touche pour voir ");call color(14);\r
 215     call outstring("les intersections \82ventuelles. ");\r
 216     call move(60,325);call color(15);\r
 217     call outstring("Pour revenir au menu pr\82c\82dent, taper sur une nouvelle touche");\r
 218     j:=inkey;\r
 219 end tri;\r
 220 (*************************************************************)\r
 221 (* Cette procedure est appel\82\82e par la procedure intersection, si les conditions\r
 222 pour une intersection sont r\82alis\82es, pour tracer l'intersection *)\r
 223 \r
 224 unit trace:procedure(c:char,x,y,z:real);\r
 225 begin\r
 226         if c='p' then\r
 227                   call point(xconv_en_entier(x),yconv_en_entier(y));\r
 228         fi;\r
 229         if c=h then\r
 230                 call move(xconv_en_entier(x),yconv_en_entier(y));\r
 231                 call draw(xconv_en_entier(z),yconv_en_entier(y));\r
 232         fi;\r
 233         if c=v then\r
 234                 call move(xconv_en_entier(x),yconv_en_entier(y));\r
 235                 call draw(xconv_en_entier(x),yconv_en_entier(z));\r
 236         fi;\r
 237 end trace;\r
 238 \r
 239 (*************************************************************)\r
 240 (* La procedure parcours a pour but de traiter le tableau tri\82 et si n\82cessaire\r
 241 faire appel \85 une de ses procedures(traitement, intersection) ou classe(arb) pour \r
 242 trouver toutes les intersections existantes *)\r
 243 \r
 244 unit parcours:procedure(tab:arrayof segment);\r
 245   (* La classe arb va servir \85 traiter uniquement les segments verticaux *)\r
 246   unit arb:class;\r
 247         var nb:integer,tv:arrayof segment;\r
 248 \r
 249         unit insertion:procedure(tab:arrayof segment,nb:integer;inout tv:arrayof segment);\r
 250         var i,j:integer;\r
 251         begin\r
 252                 array tv dim(1:nb);j:=0;\r
 253                 for i:=1 to upper(tab)\r
 254                 do;\r
 255                    if tab(i).sens=v then\r
 256                         j:=j+1;\r
 257                         tv(j):=new segment;tv(j).sens:=v;\r
 258                         tv(j).x1:=tab(i).x1;tv(j).y1:=tab(i).y1;\r
 259                         tv(j).x2:=tab(i).x2;tv(j).y2:=tab(i).y2;\r
 260                    fi;\r
 261                 od;\r
 262         end insertion;\r
 263 \r
 264         unit Arb_parcours:procedure(vertical:arrayof segment);\r
 265         begin\r
 266                 for i:=1 to upper(vertical)\r
 267                 do\r
 268                    for j:=i+1 to upper(vertical)\r
 269                    do\r
 270                          call intersection(vertical(i),vertical(j));\r
 271                 od;od;\r
 272         end Arb_parcours;\r
 273 \r
 274   end arb;\r
 275 \r
 276 (* La procedure intersection permet de v\82rifier si les conditions d'intersection\r
 277 entre deux segments sont r\82alis\82es *)\r
 278 \r
 279   unit intersection:procedure(s1,s2:segment);\r
 280   begin\r
 281   call color(14);\r
 282   if s1.sens=s2.sens then\r
 283         if s1.sens=h then\r
 284            if s1.y1=s2.y1 then\r
 285                 if s2.x2<=s1.x2 then\r
 286                         call trace(h,s2.x1,s1.y1,s2.x2);\r
 287                 else\r
 288                         call trace(h,s2.x1,s1.y1,s1.x2);\r
 289            fi;  fi;  \r
 290         else\r
 291            if s1.x1=s2.x1 then     \r
 292                 if s2.y1<=s1.y2 then\r
 293                         if s2.y2<=s1.y2 then\r
 294                          call trace(v,s2.x1,s2.y1,s2.y2);\r
 295                         else\r
 296                          call trace(v,s2.x1,s2.y1,s1.y2);\r
 297         fi; fi; fi;     fi;\r
 298   else\r
 299     if s1.y1>=s2.y1 and s1.y2<=s2.y2 then\r
 300                    call trace('p',s2.x1,s1.y1,0);\r
 301     fi;                 \r
 302   fi;\r
 303   end intersection;\r
 304 \r
 305 (* La procedure traitement parcours le tableau tri\82 et r\82alise un traitement  \r
 306 diff\82rent selon s'il s'agit d'un segment horizontal ou d'un segment vertical *)\r
 307   unit traitement: procedure(tab:arrayof segment);\r
 308   var i,j:integer,b:boolean;\r
 309   var bst:arb;\r
 310   begin\r
 311      bst:=new arb;b:=false;bst.nb:=0;\r
 312      for i:=1 to upper(tab)\r
 313      do\r
 314        if tab(i).sens=h then\r
 315           for j:=1 to upper(tab)\r
 316           do \r
 317             if j<>i then \r
 318                if tab(i).x1<=tab(j).x1 then\r
 319                      if tab(i).x2>=tab(j).x2 or tab(i).x2>=tab(j).x1 then\r
 320                              call intersection(tab(i),tab(j));\r
 321                      fi;\r
 322             fi;fi;\r
 323            od;\r
 324        else\r
 325            bst.nb:=bst.nb+1;b:=true;\r
 326        fi;\r
 327      od;\r
 328      call bst.insertion(tab,bst.nb,bst.tv);\r
 329      if b then call bst.Arb_parcours(bst.tv) fi;\r
 330   end traitement;\r
 331 begin\r
 332         call traitement(tab);\r
 333         i:=inkey;\r
 334 end;\r
 335 (*************************************************************)\r
 336 (* Cette procedure r\82alise le cadre dans lequel les segments,les intersections \r
 337 de segments et le dialogue avec l'utilisateur sont \82cris *)\r
 338 unit graphisme:procedure;\r
 339         begin\r
 340            call cls;\r
 341            call color(10);call move(0,0);\r
 342            call hfill(640);call draw(0,250);\r
 343            call hfill(640);call move(639,0);\r
 344            call draw(639,349);call draw(0,349);\r
 345            call draw(0,250);call color(15);\r
 346            call move(40,10);call draw(40,210);\r
 347            call hfill(599);\r
 348            for i:=1 to 10\r
 349            do \r
 350                 call move(38,210-20*i);\r
 351                 call draw(42,210-20*i);\r
 352                 call move(28,210-i*20);\r
 353                 if (i/10)<1 then\r
 354                         call hascii(48+i);\r
 355                 else\r
 356                         call move(20,210-i*20);\r
 357                         call hascii(48+i/10);\r
 358                         call move(28,210-i*20);\r
 359                         call hascii(i-entier(i/10)*10+48);\r
 360                 fi;\r
 361            od;\r
 362            call move(10,8);call outstring("Y");\r
 363            call move(26,215);call outstring("0");\r
 364            for i:= 1 to 28\r
 365            do \r
 366                 call move(40+i*20,212);\r
 367                 call draw(40+i*20,208);\r
 368                 call move(33+i*20,218);\r
 369                 if (i/10)<1 then\r
 370                         call hascii(48+i);\r
 371                 else\r
 372                         call hascii(48+i/10);\r
 373                         call move(40+i*20,218);\r
 374                         call hascii(i-entier(i/10)*10+48);\r
 375                 fi;\r
 376            od;\r
 377            call move(620,210);call outstring("X");\r
 378 end;\r
 379 \r
 380 (*************************************************************)\r
 381 (* La procedure souris permet la saisie des segments \85 l'aide de la souris *)\r
 382 unit souris:procedure(output tab:arrayof segment);\r
 383 var i,j,n,h1,h2,v1,v2:integer,\r
 384     b:boolean;\r
 385 begin\r
 386       call graphisme;\r
 387       call move(40,260);call color(15);\r
 388       call outstring("Appuyer sur le bouton de gauche pour la premi\8are coordonn\82es");\r
 389       call move(40,280);\r
 390       call outstring("puis sur le bouton de droite pour la seconde coordonn\82es.");\r
 391       call move (40,300);\r
 392       call outstring("Appuyer sur entr\82e pour continuer.");\r
 393       i:=inkey;\r
 394       call move(40,260);call color(15);\r
 395       call outstring("                                                            ");\r
 396       call move(40,280);\r
 397       call outstring("                                                         ");\r
 398       call move (40,300);\r
 399       call outstring("                                    ");\r
 400       pref MOUSE BLOCK\r
 401               unit click:procedure (output x,y,z,t:integer);\r
 402                 var p:integer,l,r,c:boolean;\r
 403               begin\r
 404                 call status(x,y,l,r,c);\r
 405                 do\r
 406                         call getpress(0,x,y,p,l,r,c);\r
 407                         if l then\r
 408                           call move(x,y);x:=inxpos;y:=inypos;call point(x,y);\r
 409                         fi;\r
 410                         if r then exit fi;\r
 411                 od;\r
 412                 call status(z,t,l,r,c);\r
 413                 do\r
 414                         call getpress(1,z,t,p,l,r,c);\r
 415                         if r then\r
 416                           call move(z,t);z:=inxpos;t:=inypos;call point(z,t);\r
 417                           exit;\r
 418                         fi;\r
 419                         if l then exit fi;\r
 420                 od;\r
 421               end click;\r
 422       begin\r
 423       b:=init(i);\r
 424       if b then \r
 425       call showcursor;call setwindow(40,600,10,210);\r
 426       call defcursor(1,12,13);call move(40,260);\r
 427       call outstring("Entrer le nombre de segments(12 au maximum) : ");\r
 428       i:=inkey;call hascii(i);n:=i-48;\r
 429       if i<>13 then \r
 430            i:=inkey;\r
 431            if i<>13 then\r
 432                 call hascii(i);\r
 433                 n:=10*n+i-48;\r
 434       fi;  fi;\r
 435       array tab dim(1:n);\r
 436       for i:=1 to n\r
 437       do\r
 438         tab(i):=new segment;\r
 439         call move(40,280);call color(i);\r
 440         call outstring("Entrer le sens du segment (h/v) : ");\r
 441         j:=inkey;tab(i).sens:=chr(j);call hascii(0);\r
 442         if tab(i).sens=h then\r
 443                 call hascii(72);\r
 444                 call click(tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);\r
 445                 tab(i).x1:=xconv_en_reel(tab(i).x1);\r
 446                 tab(i).x2:=xconv_en_reel(tab(i).x2);\r
 447                 tab(i).y1:=yconv_en_reel(tab(i).y1);\r
 448                 tab(i).y2:=yconv_en_reel(tab(i).y2);\r
 449                 tab(i).y2:=tab(i).y1;\r
 450                 if tab(i).x1>tab(i).x2 then\r
 451                         j:=tab(i).x1;\r
 452                         tab(i).x1:=tab(i).x2;\r
 453                         tab(i).x2:=j;\r
 454                 fi;\r
 455                 call move(xconv_en_entier(tab(i).x1),yconv_en_entier(tab(i).y1));\r
 456                 call draw(xconv_en_entier(tab(i).x2),yconv_en_entier(tab(i).y2));\r
 457         else \r
 458                 call hascii(86);\r
 459                 call click(tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);\r
 460                 tab(i).x1:=xconv_en_reel(tab(i).x1);\r
 461                 tab(i).x2:=xconv_en_reel(tab(i).x2);\r
 462                 tab(i).y1:=yconv_en_reel(tab(i).y1);\r
 463                 tab(i).y2:=yconv_en_reel(tab(i).y2);\r
 464                 tab(i).x2:=tab(i).x1;\r
 465                 if tab(i).y1>tab(i).y2 then\r
 466                         j:=tab(i).y1;\r
 467                         tab(i).y1:=tab(i).y2;\r
 468                         tab(i).y2:=j;\r
 469                 fi;\r
 470                 call move(xconv_en_entier(tab(i).x1),yconv_en_entier(tab(i).y1));\r
 471                 call draw(xconv_en_entier(tab(i).x2),yconv_en_entier(tab(i).y2));\r
 472         fi;\r
 473       od;\r
 474       else\r
 475         call move(100,200);call outstring(" NO M O U S E "); \r
 476       fi;\r
 477       end;\r
 478 end souris;\r
 479 \r
 480 (*************************************************************)\r
 481 (* La procedure clavier est appel\82e si le choix "saisie au clavier" est s\82lectionner". *) \r
 482 \r
 483 unit clavier:procedure(output tab:arrayof segment);\r
 484 var i,j,n:integer;\r
 485 begin\r
 486       call graphisme;call move(40,260);\r
 487       call outstring("Entrer le nombre de segments(12 au maximum) : ");\r
 488       n:=inkey;call hascii(n);n:=n-48;\r
 489       j:=inkey;if j<>13 then \r
 490                   n:=10*n+j-48;\r
 491                   call hascii(j);\r
 492                fi;\r
 493       array tab dim(1:n);\r
 494       for i:=1 to n\r
 495       do\r
 496         tab(i):=new segment;\r
 497         call move(40,275);call color(i);\r
 498         call outstring("Entrer le sens du segment (h/v) : ");\r
 499         j:=inkey;tab(i).sens:=chr(j);call hascii(0);\r
 500         if tab(i).sens=h then\r
 501                 call hascii(72);\r
 502                 call tab(i).saisie(tab(i).sens,tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);\r
 503         else \r
 504                 call hascii(86);\r
 505                 call tab(i).saisie(tab(i).sens,tab(i).x1,tab(i).y1,tab(i).x2,tab(i).y2);\r
 506         fi;\r
 507       od;\r
 508 end clavier;\r
 509 \r
 510 (*************************************************************)\r
 511 (* Menu principal *)\r
 512 unit menu:procedure;\r
 513     var choix:integer;\r
 514     (* Sous-menu du choix num\82ro 2 du menu principal *)\r
 515     unit menu2:procedure;\r
 516     var choix:integer;\r
 517     begin\r
 518         call graphisme;\r
 519         call move(40,260);call outstring(" Choix du mode de saisie :");\r
 520         call move(80,275);call outstring("1- au clavier.");\r
 521         call move(80,290);call outstring("2- avec la souris.");\r
 522         call move(80,305);call outstring("3- retour au menu principal");\r
 523         call move(40,325);call outstring("Votre choix : ");\r
 524         choix:=inkey;call hascii(choix);choix:=choix-48;\r
 525         case choix\r
 526                 when 1 :do\r
 527                           call clavier(tab);\r
 528                           call tri(tab,t);\r
 529                           call parcours(t);\r
 530                           call menu2;\r
 531                           exit;\r
 532                         od;\r
 533                 when 2 : do\r
 534                            call souris(tab);\r
 535                            call tri(tab,t);\r
 536                            call parcours(t);\r
 537                            call menu2;\r
 538                            exit;\r
 539                         od;\r
 540                 when 3 : do\r
 541                            call move(150,325);\r
 542                            call outstring("retour au menu principal");\r
 543                            i:=inkey;\r
 544                            exit;\r
 545                         od;\r
 546                 otherwise call menu2;\r
 547         esac;\r
 548     end menu2;\r
 549     \r
 550     unit choix_alea : procedure(output tab:arrayof segment);\r
 551         var nb_seg,nb_segh,nb_segv,i,j,k:integer,x1,x2,y1,y2:real;\r
 552         begin\r
 553           j:=0;\r
 554           call ranset(1);\r
 555           nb_seg:=2+entier(10*random);\r
 556           array tab dim (1:nb_seg);\r
 557           k:=0;\r
 558           nb_segh:=entier(nb_seg*random);\r
 559           (* nombre de segments horizontaux *)\r
 560           for i:=1 to nb_segh\r
 561           do\r
 562                 y1:=10*random;y2:=y1;j:=j+1;call color(j);\r
 563                 x1:=28*random;x2:=28*random;\r
 564                 tab(j):=new segment;tab(j).sens:=h;\r
 565                 tab(j).x1:=x1;tab(j).x2:=x2;\r
 566                 tab(j).y1:=y1;tab(j).y2:=y2;\r
 567                 if tab(i).x1>tab(i).x2 then \r
 568                         k:=tab(i).x1;tab(i).x1:=tab(i).x2;tab(i).x2:=k;\r
 569                 fi;\r
 570                 if tab(i).y1>tab(i).y2 then \r
 571                         k:=tab(i).y1;tab(i).y1:=tab(i).y2;tab(i).y2:=k;\r
 572                 fi;\r
 573                 call point(xconv_en_entier(tab(i).x1),yconv_en_entier(tab(i).y1));\r
 574                 call draw(xconv_en_entier(tab(i).x2),yconv_en_entier(tab(i).y1));\r
 575           od;\r
 576           nb_segv:=nb_seg-nb_segh;\r
 577           for i:=1 to nb_segv\r
 578           do\r
 579                 x1:=28*random;x2:=x1;j:=j+1;call color(j);\r
 580                 y1:=10*random;y2:=10*random;\r
 581                 tab(j):=new segment;tab(j).sens:=v;\r
 582                 tab(j).x1:=x1;tab(j).x2:=x2;\r
 583                 tab(j).y1:=y1;tab(j).y2:=y2;\r
 584                 if tab(j).x1>tab(j).x2 then \r
 585                         k:=tab(j).x1;tab(j).x1:=tab(j).x2;tab(j).x2:=k;\r
 586                 fi;\r
 587                 if tab(j).y1>tab(j).y2 then \r
 588                         k:=tab(j).y1;tab(j).y1:=tab(j).y2;tab(j).y2:=k;\r
 589                 fi;\r
 590                 call point(xconv_en_entier(tab(j).x1),yconv_en_entier(tab(j).y1));\r
 591                 call draw(xconv_en_entier(tab(j).x1),yconv_en_entier(tab(j).y2));\r
 592           od;\r
 593     end choix_alea;\r
 594 begin\r
 595           call cls;\r
 596           call move(300,0);call color(10);call outstring("MENU");\r
 597           call move(60,60);call color(15);\r
 598           call outstring("1- choix al\82atoire de segments.");\r
 599           call move(60,100);\r
 600           call outstring("2- choix des segments par l'utilisateur.");\r
 601           call move(60,140);call outstring("3- fin du programme.");\r
 602           call move(60,220);call outstring("Votre choix :");\r
 603           choix:=inkey;call hascii(choix);choix:=choix-48;\r
 604           case choix\r
 605         when 1:do \r
 606                 call graphisme;\r
 607                 call choix_alea(tab);\r
 608                 call tri(tab,t);\r
 609                 call parcours(t);\r
 610                 call menu;\r
 611                 exit;\r
 612                od;\r
 613         when 2:do\r
 614                 call menu2;\r
 615                 call menu;exit;\r
 616                od;\r
 617         when 3:do\r
 618                  call cls;\r
 619                  call move(250,50);\r
 620                  call outstring("FIN DU PROGRAMME");\r
 621                  exit;\r
 622                od;\r
 623         otherwise call menu;\r
 624           esac;\r
 625 end menu;\r
 626 \r
 627 (*************************************************************)\r
 628 (* Programme principal *)\r
 629 begin\r
 630 call gron(nocard);\r
 631 call menu;\r
 632 i:=inkey;\r
 633 call groff;\r
 634 end;\r
 635 end projet;\r
 636 \r
 637 \r