examples/geometri/odcinki.log

   1 program Seg;\r
   2 begin;\r
   3 pref IIUWGRAPH block;\r
   4 \r
   5 unit Welcome : Ansi procedure ;\r
   6 const X = 100 ,\r
   7       Y = 80 ,\r
   8       Height = 150 ,\r
   9       Width  = 80 ,\r
  10       Room   = 20;\r
  11 \r
  12 var P : point ,\r
  13     i : integer ;\r
  14           \r
  15   unit DrawO : procedure( P : Point );\r
  16   begin\r
  17     call Move( P.X,P.Y );\r
  18     call Draw( P.X + Width , P.Y );\r
  19     call Draw( P.X + Width , P.Y + Height );\r
  20     call Draw( P.X , P.Y + Height );\r
  21     call Draw( P.X , P.Y );\r
  22   end;\r
  23   \r
  24   unit DrawD : procedure( P : Point );\r
  25   begin\r
  26     call DrawO( P );\r
  27     call Move( P.X + 2,P.Y );\r
  28     call Draw( P.X + 2 ,P.Y + Height );\r
  29   end;\r
  30   \r
  31   unit DrawC : procedure( P : point );\r
  32   begin\r
  33     call Move( P.X + Width ,P.Y );\r
  34     call Draw( P.X, P.Y );\r
  35     call Draw( P.X , P.Y + Height );\r
  36     call Draw( P.X + Width  , P.Y + Height );       \r
  37   end;\r
  38   \r
  39   unit  DrawI : procedure( P : point );\r
  40   begin\r
  41     call Move( P.X,P.Y );\r
  42     call Draw( P.X + 2, P.Y );\r
  43     call Draw( P.X + 2, P.Y + Height  );\r
  44     call Draw( P.X,P.Y + Height );\r
  45     call Draw( P.X, P.Y );\r
  46   end;\r
  47   \r
  48   unit  DrawN : procedure( P : point );\r
  49   begin \r
  50     call Move( P.X , P.Y + Height );\r
  51     call Draw( P.X , P.Y );\r
  52     call Draw( P.X + Width , P.Y + Height );\r
  53     call Draw( P.X + Width , P.Y );\r
  54   end DrawN ;\r
  55   \r
  56   unit DrawK : procedure( P : point );\r
  57   begin\r
  58     call Move( P.X , P.Y );\r
  59     call Draw( P.X, P.Y + Height );\r
  60     call Move( P.X + Width , P.Y  );\r
  61     call Draw( P.X , P.Y  + Height div 2 );\r
  62     call Draw( P.X + Width , P.Y + Height );\r
  63   end;\r
  64 \r
  65   begin\r
  66     call Gron( 1 );\r
  67     P := new point ( X,Y );      \r
  68     call DrawO( P );    \r
  69     P.X := P.X + Width + Room;\r
  70     call DrawD( P );\r
  71     P.X := P.X + Width + Room ;\r
  72     call DrawC( P );\r
  73     P.X := P.X + Width + Room ;\r
  74     call DrawI( P );\r
  75     P.X := P.X + Room;\r
  76     call DrawN( P );\r
  77     P.X := P.X + Width + Room ;\r
  78     call DrawK( P );\r
  79     P.X := P.X + Width + Room ;\r
  80     call DrawI( P );\r
  81     P.Y := 300 ;\r
  82     P.X := 20;\r
  83     call MyWrite( P, "Copyright by Anna Wosinska " );\r
  84     i := inchar ;\r
  85     if i = Hlp then call Help ; fi ;\r
  86     call Groff;\r
  87   end Welcome;\r
  88     \r
  89     \r
  90       \r
  91       \r
  92 unit Point : class ( X, Y : integer);\r
  93 end Point;\r
  94 \r
  95 unit Interval : class( x1, x2 : integer );\r
  96   \r
  97   unit Assign : procedure( y1,y2 : integer );\r
  98 \r
  99   begin\r
 100     if y1 > y2 then call Swap( y1,y2 ); fi; \r
 101     x1 := y1;\r
 102     x2 := y2;\r
 103   end Assign;    \r
 104 \r
 105 begin\r
 106     if x1 > x2 then call Swap ( x1,x2 ); fi;      \r
 107 end Interval;    \r
 108 \r
 109 unit Swap : procedure( inout y1,y2 : integer );\r
 110   var x : integer;\r
 111 begin\r
 112   x := y1;\r
 113   y1 := y2;\r
 114   y2 := x;\r
 115 end Swap;  \r
 116 \r
 117   unit Elem : class( Info : integer );\r
 118   var   next : Elem;\r
 119   end Elem ;\r
 120   \r
 121 unit IncidList : class( Key : integer );\r
 122   var   Head : Elem;\r
 123     \r
 124   unit Into : procedure( i : integer );\r
 125   var Aux : Elem;\r
 126   \r
 127   begin\r
 128     if Head = none then\r
 129       Head := new Elem( i );\r
 130     else  \r
 131       Aux := new Elem( i );\r
 132       Aux.next := Head.next ;\r
 133       Head.next := Aux;\r
 134     fi;  \r
 135   end Into;\r
 136     \r
 137   unit KillList : procedure ;\r
 138   \r
 139     unit KL : procedure( inout u : Elem );\r
 140     begin\r
 141       if u <> none then\r
 142         if u.next = none then\r
 143           kill ( u );\r
 144         else \r
 145          call KL( u.next );    \r
 146         fi;  \r
 147       fi;  \r
 148     end KL;\r
 149     \r
 150   begin  \r
 151     call KL( Head );\r
 152   end KillList ;\r
 153   \r
 154 end IncidList;\r
 155 \r
 156 unit Node : class( Key, Info : integer );\r
 157 var l, r : node ;\r
 158 end Node ;\r
 159 \r
 160 unit BST : class ;\r
 161 close Delete, Insert ;\r
 162 \r
 163   var root : node;\r
 164 \r
 165 (* Nodes in this BST are sorted according to their Key value( k ) *)\r
 166 \r
 167   unit Insert : procedure( k,i : integer );\r
 168       \r
 169     unit Ins : procedure( inout u : node );\r
 170     begin\r
 171       if u <> none then\r
 172         if k <= u.Key then call Ins( u.l );\r
 173         else call Ins( u.r );\r
 174         fi;\r
 175       else\r
 176         u := new node( k, i );\r
 177       fi;\r
 178     end Ins;\r
 179     \r
 180   begin (* Insert *)\r
 181     call Ins( root );\r
 182   end Insert;\r
 183   \r
 184   unit Build : procedure(  P : integer);\r
 185   var i : integer;\r
 186   \r
 187   begin\r
 188     for i := 1 to Act do\r
 189       if Tree( P,i ) = 0  then exit ; \r
 190       else\r
 191         if not Lines( Tree( P,i) ).Vertical then\r
 192           call Insert( Lines( Tree( P,i )).Pe.X , Tree( P,i ));\r
 193           call Insert( Lines( Tree( P,i )).Pb.X , Tree( P,i ));\r
 194         \r
 195         else\r
 196           (* Lines( Tree( P,i )).Vertical *)\r
 197           if Min( Lines( Tree( P,i )).Pb.Y , Lines( Tree( P,i )).Pe.Y ) = P \r
 198           then\r
 199             call Insert( Lines( Tree( P,i )).Pb.X , Tree( P,i ));\r
 200           fi;  \r
 201         fi;  \r
 202       fi;\r
 203     od;\r
 204   end Build;\r
 205   \r
 206 \r
 207   unit Update : procedure( P : integer ) ;\r
 208   var i : integer ;\r
 209     \r
 210   begin\r
 211     for i := 1 to Act do\r
 212       if Tree( P,i ) = 0 then exit ; fi;\r
 213       \r
 214       if Lines( Tree( P,i )).Vertical then\r
 215         if Max( Lines( Tree( P,i )).Pb.Y , Lines( Tree( P,i )).Pe.Y ) = P \r
 216         then\r
 217           call Delete( Lines( Tree( P,i )).Pb.X , Tree( P,i ) ) ;\r
 218         fi;\r
 219         \r
 220       else \r
 221         call Delete( Lines( Tree( P,i )).Pb.X , Tree( P,i ) );\r
 222         call Delete( Lines( Tree( P,i )).Pe.X , Tree( P,i ) );    \r
 223      fi;\r
 224    od;\r
 225  end Update ;         \r
 226       \r
 227   \r
 228  unit Delete : procedure( k,i : integer );\r
 229   \r
 230    unit Del : procedure( inout u : node );\r
 231    var Q : node ;\r
 232       \r
 233      unit DelMax : procedure( inout v : node );\r
 234      begin\r
 235        if v.r <> none then call DelMax( v.r );\r
 236        else\r
 237          (* v.r = none *)\r
 238          Q.Key := v.Key;\r
 239          Q.Info := v.Info ;\r
 240          Q := v ;\r
 241          v := v.l ;\r
 242        fi;\r
 243      end;     \r
 244       \r
 245    begin\r
 246      if u <> none then\r
 247        if k < u.key then call Del ( u.l );\r
 248        else\r
 249          if k > u.key then call Del( u.r );\r
 250          else\r
 251            if i <> u.info then call Del( u.l );\r
 252            else\r
 253            (* k = u.key  *)\r
 254            (* i = u.info *)      \r
 255              Q := u;\r
 256              if u.r = none then u := u.l ;\r
 257              else\r
 258              (* u.r <> none *)\r
 259                if u.l = none then u := u.r ;\r
 260                else\r
 261                (* u.r <> none *)\r
 262                (* u.l <> none *)\r
 263                  call DelMax( Q.l );\r
 264                  kill(Q);\r
 265                (* Q = maximal in left subtree of u *)\r
 266                fi;\r
 267              fi;\r
 268            fi;       \r
 269          fi;\r
 270        fi;    \r
 271      fi;\r
 272    end Del;\r
 273         \r
 274     begin\r
 275       call Del ( root );\r
 276     end Delete ;      \r
 277 \r
 278   unit Range : procedure ( x1, x2, Index : integer );\r
 279   \r
 280     unit Ran : procedure( v : node );\r
 281       var tx1, tx2 : boolean;\r
 282       \r
 283     begin\r
 284       if v <> none then\r
 285         if x1 > x2 then call Swap( x1,x2 ); fi ;\r
 286         tx1 := v.Key >= x1;\r
 287         tx2 := v.Key <= x2;\r
 288         \r
 289 (*         x1 < v.key < x2 *)\r
 290         if v.info = 0 then\r
 291           call Groff;\r
 292           writeln("v.info = 0 ");\r
 293           call Endrun  ;\r
 294         fi;\r
 295            \r
 296         if tx2 and tx1 then call Information( Index ).Into( v.info ) ;fi;\r
 297         \r
 298         if tx2 then call Ran( v.r ); fi;\r
 299       fi;  \r
 300     end Ran;\r
 301     \r
 302   begin (* Range *);\r
 303     call Ran( root );\r
 304   end Range;\r
 305 \r
 306 \r
 307            \r
 308 end BST;\r
 309 \r
 310 \r
 311 unit Murderer : procedure( T : BST );\r
 312 \r
 313   unit Killer : procedure( u : Node ); \r
 314   begin\r
 315     if u <> none then\r
 316       if u.l <> none then\r
 317         call Killer( u.l );fi;\r
 318       if u.r <> none then \r
 319         call Killer( u.r ); fi;\r
 320       kill( u );\r
 321     fi;\r
 322   end Killer;       \r
 323       \r
 324   begin\r
 325     if T <> none then \r
 326       call Killer( T.Root );\r
 327     fi; \r
 328 end Murderer;\r
 329 \r
 330 unit BuildTree : procedure;\r
 331 \r
 332   var j,i : integer; \r
 333                   \r
 334 begin\r
 335   array Tree dim ( MinY : MaxY );\r
 336   for i := MinY to MaxY do\r
 337     array Tree( i ) dim ( 1 : Act + 1 );\r
 338   od   ;\r
 339   \r
 340   for i := 1 to  Act do\r
 341     j := 1;\r
 342     while Tree( Lines( i ).Pb.Y,j ) <> 0 do j := j + 1 ; od;\r
 343     \r
 344     Tree( Lines( i ).Pb.Y, j ) := i ;\r
 345     \r
 346     if Lines( i ).Vertical  then \r
 347       j := 1;\r
 348       while Tree( Lines( i ).Pe.Y,j ) <> 0 do j := j + 1; od;\r
 349       Tree( Lines( i ).Pe.Y, j ) := i ;\r
 350     fi;\r
 351   od;\r
 352 end BuildTree ;       \r
 353 \r
 354 unit Scan : procedure ;\r
 355 var XTree : BST,\r
 356       Aux : Elem,\r
 357       k,l : integer ;\r
 358 begin\r
 359   Xtree := new BST ;\r
 360   for k := MinY to  MaxY do\r
 361     if Tree( k,1 ) <> 0 then  \r
 362       call BegScanLine( k )    ;\r
 363       call XTree.Build( k ); \r
 364       for l := 1 to Act do\r
 365         if Tree( k,l ) = 0 then exit ; fi;\r
 366         call XTree.Range( Lines( Tree( k,l)).Pb.X, Lines( Tree( k,l)).Pe.X ,\r
 367                           Tree( k,l ) );\r
 368 \r
 369         Aux := Information( Tree( k,l )).Head;\r
 370        block\r
 371       \r
 372 handlers\r
 373   when conerror : call groff ;\r
 374                   writeln("k = ", k) ;\r
 375                   writeln("l = ", l) ;\r
 376                   if k < lower(Tree) orif k > upper(Tree)\r
 377                   orif l < lower(Tree(k)) orif l > upper(Tree(k)) then\r
 378                     writeln(" Excessed bounds of Tree    ") ;\r
 379                   else\r
 380                     writeln("Tree(k,l) = ", Tree(k,l));\r
 381                     writeln("Aux.Info = ", Aux.Info) ;\r
 382                     if Tree(k,l) < lower(Lines) \r
 383                     orif Tree(k,l) > upper(Lines) \r
 384                     orif Aux.Info < lower(Lines)\r
 385                     orif Aux.Info > upper(Lines) then\r
 386                       writeln("Excessed bounds of Lines, which are (", \r
 387                               lower(Lines), ":", upper(Lines), ")") ;\r
 388                     fi ;\r
 389                   fi ;\r
 390                   call endrun ;\r
 391   end handlers ;                  \r
 392   begin        \r
 393         while Aux <> none  do\r
 394           call CrossPoint( Lines( Tree( k,l )),Lines( Aux.Info ));\r
 395           Aux := Aux.next;\r
 396         od;                            \r
 397    end ;\r
 398       od;\r
 399 \r
 400       call Xtree.Update( k );\r
 401 (*      call kill ( Tree( k )); *)\r
 402       call EndScanLine( k ) ;\r
 403     fi;\r
 404   od;\r
 405   call Murderer( XTree );\r
 406 end Scan ;    \r
 407 \r
 408 unit ANSI : class;\r
 409  \r
 410  \r
 411   unit Inchar : IIUWgraph function : integer ;\r
 412       (*podaj nr znaku przeslanego z klawiatury *)\r
 413     var i : integer;\r
 414   begin\r
 415     do\r
 416       i := inkey;\r
 417       if i <> 0 then exit fi;\r
 418     od;\r
 419     result := i;\r
 420   end inchar;\r
 421  \r
 422 \r
 423 end Ansi;\r
 424 \r
 425 unit MyWrite : procedure( Pos : Point, Word : string );\r
 426 var i : integer,\r
 427     A : arrayof char;\r
 428  \r
 429 begin;\r
 430   A := unpack( Word );\r
 431   call Move( Pos.X, Pos.Y );\r
 432   for i := lower( A ) to upper( A ) do\r
 433     call HASCII( 0 );\r
 434     call HASCII( ord( A( i )));\r
 435   od;\r
 436   kill ( A ); \r
 437 end MyWrite;\r
 438 \r
 439 unit Erase : procedure( Line : integer );\r
 440 var Aux : Point;\r
 441 \r
 442 begin\r
 443   Aux := new Point( Left + M, Line );\r
 444   call Mywrite(Aux,\r
 445      "                                                                    ");\r
 446   kill ( Aux );\r
 447 end Erase;                                                      \r
 448 \r
 449 unit Frame : procedure( P1, P2 : point );\r
 450 begin\r
 451   call Move ( P1.X, P1.Y );\r
 452   call Draw ( P1.X, P2.Y );\r
 453   call Draw ( P2.X, P2.Y );\r
 454   call Draw ( P2.X, P1.Y );\r
 455   call Draw ( P1.X, P1.Y );\r
 456 end Frame;\r
 457 \r
 458 unit SysDraw : procedure;\r
 459 \r
 460   unit GradVert : procedure( P : Point, Number : integer  );\r
 461   var i,j : integer;\r
 462   \r
 463   begin\r
 464     call Move( P.X - M, P.Y );\r
 465     call Draw( P.X + M, P.Y );\r
 466      if Number < 10 then \r
 467       call Move( P.X - 2 * M - LetDim  , P.Y - LetDim div 2 );\r
 468       call HASCII( 0 );\r
 469       call HASCII( Number + 48 );\r
 470     else \r
 471       i := Number div 10; \r
 472       j := Number - i * 10; \r
 473       call Move( P.X - 2 * M - 2 * LetDim  , P.Y - LetDim div 2 );  \r
 474       call HASCII( 0 ); \r
 475       call Hascii( i + 48 ); \r
 476       call Move( P.X - 2 * M - LetDim  , P.Y - LetDim div 2 );   \r
 477       call Hascii( 0 ); \r
 478       call Hascii( j + 48 ); \r
 479     fi;\r
 480   end GradVert;\r
 481   \r
 482   unit GradHor : procedure( P : Point , Number : integer );\r
 483   var i,j : integer;\r
 484   \r
 485   begin\r
 486     call Move( P.X, P.Y - M );\r
 487     call Draw( P.X, P.Y + M );\r
 488     if Number < 10 then\r
 489       call Move( P.X - LetDim div 2, P.Y + 4 * M );\r
 490       call HASCII( 0 );\r
 491       call HASCII( Number + 48 );\r
 492     else\r
 493       i := Number div 10;\r
 494       j := Number - i * 10;\r
 495       call Move( P.X - LetDim div 2  , P.Y + 4 * M  );  \r
 496       call HASCII( 0 );\r
 497       call Hascii( i + 48 );\r
 498       call Hascii( 0 );\r
 499       call Hascii( j + 48 );\r
 500     fi;               \r
 501   end GradHor;\r
 502 \r
 503   unit ArVert : procedure( X, Y : integer);\r
 504   begin\r
 505     call Move( X - 2 * M, Y + 2 * M );\r
 506     call Draw( X, Y );\r
 507     call Draw( X + 2 * M, Y + 2 * M );\r
 508   end ArVert;\r
 509   \r
 510   unit ArHor : procedure( X,Y : integer );\r
 511   begin\r
 512     call Move( X - 2 * M, Y - 2 * M );\r
 513     call Draw( X, Y );\r
 514     call Draw( X - 2 * M, Y + 2 * M );\r
 515   end ArHor;\r
 516   \r
 517 var i : integer,\r
 518     P : Point;    \r
 519              \r
 520 begin\r
 521   call Move( LeftMargin,UpMargin );\r
 522   call Draw( LeftMargin, DimY - DownMargin );\r
 523   call Draw( DimX - RightMargin, DimY - DownMargin );\r
 524   call ArVert( LeftMargin, UpMargin );\r
 525   call ArHor( DimX - RightMargin, DimY - DownMargin ); \r
 526   \r
 527 call Move( LeftMargin - 2 * M - 2 * LetDim, DimY - DownMargin - LetDim div 2);\r
 528   call Hascii( 0 );\r
 529   call Hascii( 48 );\r
 530   call Hascii( 48 );\r
 531   \r
 532   P := new Point( LeftMargin, DimY - DownMargin );\r
 533   for i := MinX + 1 to MaxX  do\r
 534     P.X := P.X + Sc;\r
 535     call GradHor( P , i );     \r
 536   od;\r
 537   kill ( P );  \r
 538   \r
 539   P := new Point ( LeftMargin, DimY - DownMargin ); \r
 540   for i := MinY + 1 to MaxY  do\r
 541     P.Y := P.Y - Sc;\r
 542     call GradVert( P , i );\r
 543   od;  \r
 544   kill ( P );\r
 545 end SysDraw;\r
 546 \r
 547 unit Segment : class( pb , pe : Point, Vert : boolean );\r
 548 hidden Vert;\r
 549 \r
 550   unit Vertical : function : boolean;\r
 551   begin\r
 552     result := Vert ;\r
 553   end Vertical;\r
 554 \r
 555      \r
 556 end Segment;\r
 557 \r
 558 unit SegKill : procedure( inout S : Segment );\r
 559 begin\r
 560   kill ( S.Pb );\r
 561   kill ( S.Pe );\r
 562   kill ( S );\r
 563 end SegKill   ;\r
 564 \r
 565 unit GenSeg : function : Segment ;\r
 566 \r
 567 var   X1, Y1, X2, Y2  : integer;  \r
 568           \r
 569 begin\r
 570   if Random < 0.5 then \r
 571   (* Generates horizontal segment *)\r
 572     do\r
 573       X1 := Random * MaxX ;\r
 574       Y1 := Random * MaxY ;\r
 575       X2 := Random * MaxX ;\r
 576       Y2 := Y1;\r
 577       if X1 <> X2 and Y2 > MinX  then exit ; fi;\r
 578     od;\r
 579     result := new Segment( new Point( X1 ,Y1 ), new Point( X2,Y2 ),false);  \r
 580   else\r
 581     (* Generates vertical segment *)  \r
 582     do\r
 583       X1 := Random * MaxX ;\r
 584       Y1 := Random * MaxY ;\r
 585       X2 := X1;\r
 586       Y2 := Random * MaxY ;\r
 587       if Y1 <> Y2 and X2 > MinX then exit; fi;\r
 588     od; \r
 589     result := new Segment( new Point( X1 ,Y1 ), new Point( X2,Y2 ),true);\r
 590   fi;\r
 591 \r
 592 end GenSeg;\r
 593 \r
 594 unit SegDraw : procedure( S : Segment );\r
 595 \r
 596 begin;\r
 597   if S.Vertical then\r
 598     call Move( LeftMargin + Sc*S.Pb.X + M, DimY - ( Sc*S.Pb.Y + DownMargin));\r
 599     call Draw( LeftMargin + Sc*S.Pb.X - M, DimY - ( Sc*S.Pb.Y + DownMargin));  \r
 600     call Move( LeftMargin + Sc*S.Pb.X, DimY - ( Sc*S.Pb.Y + DownMargin));\r
 601     call Draw( LeftMargin + Sc*S.Pe.X, DimY - ( Sc*S.Pe.Y + DownMargin));\r
 602     call Move( LeftMargin + Sc*S.Pe.X + M, DimY - ( Sc*S.Pe.Y + DownMargin));    \r
 603     call Draw( LeftMargin + Sc*S.Pe.X - M, DimY - ( Sc*S.Pe.Y + DownMargin));\r
 604   else\r
 605     call Move( LeftMargin + Sc*S.Pb.X , DimY - ( Sc*S.Pb.Y + DownMargin) + M );\r
 606     call Draw( LeftMargin + Sc*S.Pb.X , DimY - ( Sc*S.Pb.Y + DownMargin) - M);  \r
 607     call Move( LeftMargin + Sc*S.Pb.X, DimY - ( Sc*S.Pb.Y + DownMargin));\r
 608     call Draw( LeftMargin + Sc*S.Pe.X, DimY - ( Sc*S.Pe.Y + DownMargin));\r
 609     call Move( LeftMargin + Sc*S.Pe.X , DimY - ( Sc*S.Pe.Y + DownMargin) + M);\r
 610     call Draw( LeftMargin + Sc*S.Pe.X , DimY - ( Sc*S.Pe.Y + DownMargin) - M);    \r
 611   fi;\r
 612 end SegDraw;\r
 613 \r
 614 unit KeyServer : Ansi procedure;\r
 615 var PrevChar , i : integer;\r
 616 \r
 617 begin\r
 618   while not  Over  do\r
 619     i := inchar;\r
 620       case i  \r
 621         when Esc    : call Escape;\r
 622         when NSys   : Over := true;\r
 623         when Hlp    : call Help;      \r
 624         when NewSeg  : if PrevChar <> NewSeg then call ClearWindow; fi;\r
 625                         Act := Act + 1;\r
 626                         Lines( Act ) := GenSeg;\r
 627                         call SegEdit( Act );\r
 628                         call SegDraw( Lines( Act ));                \r
 629                     \r
 630         when Termin : exit;\r
 631       \r
 632         when Enter :  call ClearWindow; \r
 633                       call SegRead;\r
 634                     \r
 635         otherwise;\r
 636       esac;\r
 637       PrevChar := i;\r
 638   od;  \r
 639   call ClearWindow ;\r
 640 end KeyServer ;\r
 641 \r
 642 unit Pause : procedure( T : integer );\r
 643 var i : integer;\r
 644 begin\r
 645   for i := 1 to T do; od;\r
 646 end Pause ;  \r
 647    \r
 648 \r
 649 unit Help : Ansi procedure;\r
 650 var   i : integer ,\r
 651     Aux : Point ;\r
 652 begin;\r
 653   Aux := new Point( LeftMargin + Distance, DimY - Window + 2 * M )  ;\r
 654   call Clearwindow ;\r
 655 call MyWrite\r
 656   ( Aux," Esc - terminates program,      Del - new system of coordinates ");\r
 657   Aux.Y := Aux.Y + LetDim + M ;\r
 658 call Mywrite( Aux," Enter - generates new segment, End  - scanning             ");\r
 659   Aux.Y := Aux.Y + LetDim + M ;\r
 660 call MyWrite( Aux," Space - you enter new segment                           ");\r
 661   kill ( Aux ) ;\r
 662   i := inchar ;\r
 663   call ClearWindow ;\r
 664 end Help;\r
 665 \r
 666 unit SegRead : procedure;\r
 667 \r
 668 \r
 669   unit ReadInteger : ANSI function : integer;\r
 670 \r
 671   \r
 672   var  X,Y,i, OrdN, j : integer,\r
 673                Number : arrayof integer;\r
 674 (* i - liczba wprowadzonych znakow  *)\r
 675   begin\r
 676     array Number dim( 1 : NumbLenght );\r
 677     i:= 0 ;\r
 678     X := InXPos;\r
 679     Y := InYPos;\r
 680     do\r
 681       OrdN:=inchar;\r
 682       if i = NumbLenght or (OrdN < 48 and OrdN > 57) then exit fi;\r
 683 \r
 684       case OrdN\r
 685         when 48    :i:=i+1;\r
 686                     Number(i):=0;\r
 687         when 49    :i:=i+1;\r
 688                     Number(i):=1;\r
 689         when 50    :i:=i+1;\r
 690                     Number(i):=2;\r
 691         when 51    :i:=i+1;\r
 692                     Number(i):=3;\r
 693         when 52    :i:=i+1;\r
 694                     Number(i):=4;\r
 695         when 53    :i:=i+1;\r
 696                     Number(i):=5;\r
 697         when 54    :i:=i+1;\r
 698                     Number(i):=6;\r
 699         when 55    :i:=i+1;\r
 700                     Number(i):=7;\r
 701         when 56    :i:=i+1;\r
 702                     Number(i):=8;\r
 703         when 57    :i:=i+1;\r
 704                     Number(i):=9;\r
 705         when  8    :if i>0 then\r
 706                       Number( i ) := 0;\r
 707                       i := i - 1;\r
 708                     fi;\r
 709         when 13    :if i > 0 then exit fi ;\r
 710 \r
 711       esac;\r
 712        \r
 713       if Number( 1 ) <> 0 then\r
 714         call Move( X,Y );\r
 715         call hascii( 0 );\r
 716         call hascii(48+Number( 1 ));\r
 717         call hascii( 0 );\r
 718 \r
 719       fi;\r
 720       \r
 721       if i = 2 then\r
 722         call Move( X + LetDim, Y  ); \r
 723         call hascii( 0 );\r
 724         call hascii( 48 + Number( 2 ));   \r
 725         call hascii( 0 );\r
 726       fi;  \r
 727    od;\r
 728    \r
 729    if Number( 1 ) = 0 and Number( 2 ) = 0 then\r
 730      call Move( X,Y );\r
 731      call hascii( 0 );\r
 732      call hascii( 48 );\r
 733      call hascii( 0 );          \r
 734    fi;  \r
 735    \r
 736    if i = 1 then result := Number( 1 );\r
 737    else\r
 738      result := 10 * Number( 1 ) + Number ( 2 );\r
 739    fi;\r
 740    kill( Number );\r
 741   end ReadInteger;\r
 742   \r
 743 const StrLenght = 26;\r
 744    \r
 745 var            Aux : Point,\r
 746     X1, X2, Y1, Y2 : integer;\r
 747     \r
 748 begin\r
 749   Aux := new Point( LeftMargin + Distance, DimY - Window + 2 * M )  ;\r
 750   call MyWrite( Aux," ENTER NEW SEGMENT : X1 = " );\r
 751   X1 := ReadInteger;\r
 752   Aux.X := Aux.X + StrLenght * LetDim + NumbLenght * LetDim; \r
 753   call MyWrite( Aux ," Y1 = " );\r
 754   Y1 := ReadInteger;\r
 755   \r
 756   Aux.X := Aux.X - (NumbLenght + 6) * LetDim;\r
 757   Aux.Y := Aux.Y + M + LetDim;\r
 758   call MyWrite( Aux, " X2 = " );\r
 759   X2 := ReadInteger;      \r
 760   Aux.X := Aux.X + (NumbLenght + 6 ) * LetDim ;\r
 761   call Mywrite( Aux, " Y2 = " );\r
 762   Y2 := ReadInteger;\r
 763   Aux.X := Aux.X - StrLenght * LetDim - NumbLenght * LetDim; \r
 764   Aux.Y := Aux.Y + M + LetDim;\r
 765   if ( X1 <> X2 ) and ( Y1 <> Y2 ) then \r
 766     call MyWrite( Aux," THIS SEGMENT IS NEITHER HORIZONTAL NOR VERTICAL ! ");\r
 767   else\r
 768     if X1 < MaxX and X2 < MaxX and Y1 < MaxY and Y2 < MaxY then\r
 769       Act := Act + 1;\r
 770       if X1 = X2 then\r
 771         Lines( Act ) := new Segment( new Point( X1,Y1 ),\r
 772                                      new Point( X2,Y2 ), true );\r
 773       else\r
 774         Lines( Act ) := new Segment( new Point( X1,Y1 ),\r
 775                                      new Point( X2,Y2 ), false );\r
 776       fi;\r
 777       call SegDraw( Lines( Act ));\r
 778     else\r
 779       call MyWrite( Aux," THE SEGMENT IS TOO BIG ! " );\r
 780     fi;\r
 781   fi;\r
 782   kill ( Aux );\r
 783 end SegRead;\r
 784 \r
 785 unit WriteInteger : procedure( Number : integer );\r
 786 begin\r
 787   if Number < 10 then\r
 788     call HASCII( 0 );\r
 789     call HASCII( Number + 48 );\r
 790     call Hascii( 0 );\r
 791   else\r
 792     i := Number div 10;\r
 793     j := Number - i * 10;\r
 794     call HASCII( 0 );\r
 795     call Hascii( i + 48 );\r
 796     call Hascii( 0 );\r
 797     call Hascii( j + 48 );\r
 798   fi;               \r
 799 end WriteInteger;\r
 800   \r
 801 unit SegEdit : procedure( Cur : integer );\r
 802 \r
 803 \r
 804 const StrLenght = 24;\r
 805 \r
 806 var  Aux : Point;\r
 807 \r
 808 begin;\r
 809   Aux := new Point( LeftMargin + Distance, DimY - Window + 2 * M );  \r
 810   call MyWrite( Aux," CURRENT SEGMENT :  ");\r
 811   call WriteInteger( Act );\r
 812     \r
 813   Aux.Y := Aux.Y + M + LetDim ;\r
 814   call Mywrite( Aux,"           BEGIN : X1 = ");\r
 815   call WriteInteger( Lines( Cur ).Pb.X );\r
 816   Aux.X := Aux.X + StrLenght * LetDim + NumbLenght * LetDim ;\r
 817   call MyWrite( Aux," Y1 = ");\r
 818   call WriteInteger( Lines( Cur ).Pb.Y );\r
 819   \r
 820   Aux.X := Aux.X - StrLenght * LetDim - NumbLenght * LetDim ;\r
 821   Aux.Y := Aux.Y + M + LetDim ;   \r
 822   call Mywrite( Aux,"             END : X2 = ");\r
 823   call WriteInteger( Lines( Cur ).Pe.X );\r
 824   Aux.X := Aux.X + StrLenght * LetDim + NumbLenght * LetDim ;\r
 825   call MyWrite( Aux," Y2 = ");\r
 826   call WriteInteger( Lines( Cur ).Pe.Y );\r
 827   kill ( Aux );\r
 828 end SegEdit;\r
 829 \r
 830 unit ClearWindow : procedure ;\r
 831 var \r
 832       Line, i : integer;\r
 833       \r
 834 begin\r
 835   for i := 0 to (( Window - Down ) div LetDim) - 1 do\r
 836     call Erase( DimY - Window + i * LetDim + M );\r
 837   od;\r
 838 end ClearWindow ;    \r
 839 \r
 840 unit Escape : procedure;\r
 841 begin;\r
 842   Over := true;\r
 843   Continue := false;\r
 844 end Escape;\r
 845 \r
 846 \r
 847 \r
 848 unit CrossPoint : procedure ( S1, S2 : segment ) ;\r
 849 var X1,X2,X3,X4,Y1,Y2,Y3,Y4 : integer ;\r
 850 \r
 851 begin\r
 852   if S1.Vertical then\r
 853     if not S2.Vertical then\r
 854      (* S1 is vertical and S2 is horizontal *)\r
 855       call Mark( S1.pe.X, S2.pe.Y); \r
 856     else\r
 857       (* both S1 and S2 are vertical *)\r
 858       Y1 := min( S1.pb.Y, S1.pe.Y );\r
 859       Y2 := max( S1.pb.Y, S1.pe.Y );\r
 860       Y3 := min( S2.pb.Y, S2.pe.Y );\r
 861       Y4 := max( S2.pb.Y, S2.pe.Y );\r
 862       if not( Y1 = Y3 and Y2 = Y4 ) then \r
 863         if Y2 > Y4 then\r
 864           if Y1 > Y3 then\r
 865             call Mark( S1.pb.X, Y4 );\r
 866             call Mark( S1.pb.X, Y1 );\r
 867           else\r
 868             call Mark( S1.pb.X, Y4 );\r
 869             call Mark( S1.pb.X, Y3 );  \r
 870           fi;  \r
 871         else\r
 872           if Y1 > Y3 then\r
 873             call Mark( S1.pb.X, Y2 );\r
 874             call Mark( S1.pb.X, Y1);\r
 875           else\r
 876             call Mark( S1.pb.X, Y2 );  \r
 877             call Mark( S1.pb.X, Y3);\r
 878           fi;  \r
 879         fi;    \r
 880       fi;\r
 881     fi;  \r
 882   else\r
 883       if S2.Vertical then\r
 884       (* S1 is horizontal and S2 is vertical *)\r
 885         call Mark( S2.Pb.X, S1.Pb.Y);\r
 886       else\r
 887         (* both are horizontal *) \r
 888         X1 := min( S1.pb.X, S1.pe.X );\r
 889         X2 := max( S1.pb.X, S1.pe.X );\r
 890         X3 := min( S2.pb.X, S2.pe.X );\r
 891         X4 := max( S2.pb.X, S2.pe.X );\r
 892         if not( X1 = X3 and X2 = X4 ) then\r
 893           if X2 > X4 then\r
 894             if X3 > X1 then\r
 895               call Mark( X4, S1.pb.Y);\r
 896               call Mark( X3, S1.pb.Y);        \r
 897             else\r
 898               call Mark( X1, S1.pb.Y);\r
 899               call Mark( X4, S1.pb.Y);\r
 900             fi;  \r
 901           else\r
 902             if X3 > X1 then\r
 903               call Mark( X3, S1.pb.Y);\r
 904               call Mark( X2, S1.pb.Y);        \r
 905             else\r
 906               call Mark( X1, S1.pb.Y);  \r
 907               call Mark( X2, S1.pb.Y);\r
 908             fi;  \r
 909          fi;   \r
 910       fi;        \r
 911     fi;\r
 912   fi;\r
 913 end CrossPoint ;      \r
 914 \r
 915 unit Mark : procedure( input X,Y : integer );\r
 916 \r
 917 begin\r
 918   if X >= 0 and Y >= 0 then\r
 919     x := X * Sc + LeftMargin ;\r
 920     y := DimY - ( DownMargin + Y * Sc ) ; \r
 921     call cirb( x,y,R,1,1,1,0,1,1 );\r
 922   fi;  \r
 923 end Mark;  \r
 924 \r
 925 unit Min : function( x,y : integer ): integer ;\r
 926 begin\r
 927   if x < y then result := x ;\r
 928   else result := y; fi;\r
 929 end Min ;  \r
 930 \r
 931 unit Max: function( x,y : integer ) : integer ;\r
 932 begin\r
 933   if x < y then result := y ;\r
 934   else result := x; fi;\r
 935 end Max ;\r
 936 \r
 937 var         Aux : Point,   \r
 938       LongHLine : arrayof integer ;\r
 939       \r
 940 unit  BegScanLine : procedure( y : integer );\r
 941 \r
 942 begin\r
 943   call Move( LeftMargin , DimY - DownMargin - y * Sc );\r
 944   LongHLine:= GetMap( DimX - RightMargin, DimY - DownMargin - y * Sc) ;\r
 945   call Move( LeftMargin, DimY - DownMargin - y * Sc);\r
 946   call Draw(  DimX - RightMargin, DimY - DownMargin - y * Sc) ;\r
 947   Aux := new Point( LeftMargin + Distance, DimY - Window + 2 * M )  ;\r
 948   call MyWrite( Aux," SCANNING ... : ");\r
 949   call WriteInteger( y );\r
 950 end BegScanLine ;   \r
 951 \r
 952 \r
 953 unit  EndScanLine : procedure( y : integer );\r
 954 \r
 955 begin\r
 956   call Move( LeftMargin, DimY - DownMargin - y * Sc);\r
 957   call PutMap( LongHLine );\r
 958   kill ( LongHLine );\r
 959   call Erase( Aux.Y );\r
 960   kill ( Aux );\r
 961 end EndScanLine;\r
 962   \r
 963 \r
 964 \r
 965            \r
 966 const\r
 967            NumbLenght = 2,\r
 968                 DimX  = 619,\r
 969                 DimY  = 348,\r
 970                    M  = 2,  \r
 971                    R  = 3,\r
 972               LetDim  = 8,\r
 973             Distance  = 20,     \r
 974               Window  = 40,\r
 975                 Left  = 0,\r
 976                Right  = 0, \r
 977                   Up  = 0,\r
 978                 Down  = 2,    \r
 979           LeftMargin  = 25,\r
 980           RightMargin = 10,\r
 981           UpMargin    = 10,\r
 982           DownMargin  = 60,\r
 983           Sc          = 20,\r
 984           MaxX        = 29,\r
 985           MinX        = 0,\r
 986           MaxY        = 14,\r
 987           MinY        = 0,\r
 988           Esc         = 27, (* Escape *)\r
 989           Hlp         = - 59,  (* F1     *)\r
 990           NSys        = - 83,(* Del      *)\r
 991           Enter       = 13, (* enter  *)\r
 992           Termin      = - 79,(* End      *)\r
 993           NewSeg      = 32, (* space bar *)\r
 994           Numb        = 100;          \r
 995 \r
 996 \r
 997 var        Tree   : arrayof arrayof integer ,\r
 998         Act, j, i : integer,\r
 999     Continue,Over : boolean,\r
1000       Information : arrayof IncidList,\r
1001             Lines : arrayof segment;\r
1002             \r
1003 begin (* Seg *);\r
1004   call Welcome ;\r
1005   Continue := true;\r
1006   while Continue do\r
1007     Act := 0;\r
1008     Over := false;\r
1009     call Gron( 1 );\r
1010     call Frame( new Point( Left, Up ),\r
1011                 new Point( DimX - Right, DimY - Window - M ));\r
1012     call Frame( new Point( Left, DimY - Window ),\r
1013                 new Point( DimX - Right, DimY - Down )); \r
1014     call SysDraw;\r
1015     array Lines dim( 1 : Numb );\r
1016     call KeyServer;\r
1017     if not Over and Act > 0 then\r
1018       call BuildTree;\r
1019       array Information dim ( 1 :  Act );\r
1020       for i := 1 to Act do\r
1021         Information( i ) := new IncidList( i );\r
1022       od;   \r
1023       call Scan;\r
1024       write( chr( 7 ));\r
1025       do\r
1026         i := inkey;\r
1027         if i <> 0 then exit; fi;\r
1028       od;  \r
1029       call Groff;\r
1030       if i = Esc then exit ; fi ;\r
1031     \r
1032       for i := 1 to  Act  do\r
1033         if Information( i ) <> none then\r
1034           call Information( i ). KillList;\r
1035         fi;  \r
1036       od;\r
1037       kill ( Information );\r
1038       for i:=1 to Act do\r
1039         call SegKill( Lines( i ));   \r
1040       od;\r
1041       kill ( Lines );  \r
1042       for i := MinY to MaxY do kill ( Tree( i )); od;\r
1043       kill ( Tree );\r
1044     fi;  \r
1045   od;    \r
1046   call Groff ;  \r
1047 end  ;\r
1048 end;\r
1049 \1a