examples/geometri/inwers.log

   1 program geo;\r
   2 (*****************************************************************************)\r
   3 (*  BOGDAN WIERCZYNSKI 1989-06                                               *)\r
   4 (*                                                                           *)\r
   5 (*               I   N   W   E   R   S   J   A                               *)\r
   6 (* Program ten dokonuje inwersji przy uzyciu tylko cyrkla (okregi).          *)\r
   7 (*****************************************************************************)\r
   8  \r
   9  \r
  10   unit grafika:iiuwgraph class;\r
  11  \r
  12   const poczY=310,(* Rzedna piksela odpowiadajacemu poczatkowi ukladu na\r
  13                      ekranie *)\r
  14         poczX=20,(* Odcieta piksela odpowiadajacemu poczatkowi ukladu na\r
  15                      ekranie *)\r
  16         skala=18,(* Liczba pikseli na jednostke w pionie *)\r
  17         wysekranu=320,\r
  18         aspekt=1.334,\r
  19         szerekranu=620;\r
  20  \r
  21   var     liczba:arrayof string;\r
  22  \r
  23      unit inchar :function : integer;\r
  24      (*podaj nr znaku przeslanego z klawiatury *)\r
  25      var i : integer;\r
  26      begin\r
  27           do\r
  28             i := inkey;\r
  29             if i <> 0 then exit fi;\r
  30           od;\r
  31       result := i;\r
  32      end inchar;\r
  33  \r
  34  \r
  35      unit ryspunkt:procedure(x,y:real);\r
  36      (* Procedura rysuje punkt jako krzyzyk *)\r
  37      var x1,y1:integer;\r
  38      begin\r
  39         call color(14);\r
  40         y1:=entier(poczY-y*skala);\r
  41         x1:=entier(x*skala*aspekt+poczX);\r
  42         call move(x1,y1+3);\r
  43         call draw(x1,y1-3);\r
  44         call move(x1-4,y1);\r
  45         call draw(x1+4,y1);\r
  46      end ryspunkt;\r
  47  \r
  48      unit rys_ukl_wsp:procedure;\r
  49      (* Rysowanie ukladu wspolrzednych na ekranie oraz skali na osi OX i OY *)\r
  50      var i,y,x:integer;\r
  51      begin\r
  52          call color(14);\r
  53          call move(poczX,poczY);\r
  54          call hfill(szerekranu);\r
  55          call draw(poczX,0);\r
  56          i:=1;\r
  57          x:=0;\r
  58          y:=skala;\r
  59          while y>= skala do\r
  60              y:=poczY - i*skala;\r
  61              if y >= 4 then\r
  62                 call move(0,y-4)\r
  63              else\r
  64                  call move(0,y);\r
  65              fi;\r
  66              call outstring(liczba(i));\r
  67              call move(poczX-2,y);\r
  68              call draw(poczX,y);\r
  69              i:=i+1;\r
  70          od;\r
  71          i:=1;\r
  72          while x<=(szerekranu-skala*aspekt) do\r
  73              x:=poczX+i*skala*aspekt;\r
  74              if x <= (szerekranu-5) then\r
  75                  call move(x-9,poczY+5);\r
  76              else\r
  77                  call move(x-13,poczY+5);\r
  78              fi;\r
  79              call outstring(liczba(i));\r
  80              call move(x,poczY);\r
  81              call draw(x,poczY+3);\r
  82              i :=i+1;\r
  83          od;\r
  84      end rys_ukl_wsp;\r
  85  \r
  86  \r
  87      unit rysokrag:procedure(x,y,promien:real);\r
  88      (* Rysowanie okregu na ekranie w ten sposob aby nie przecinal osi        *)\r
  89      (* ukladu wspolrzednych, jesli okrag nie miesci sie na ekranie to        *)\r
  90      (* rysowany jest tylko wycinek                                           *)\r
  91      const  srodek=0,\r
  92             prawo=1,\r
  93             lewo=2,\r
  94             gora=4,\r
  95             dol=7,\r
  96             goraprawo=5,\r
  97             goralewo=6,\r
  98             dolprawo=8,\r
  99             dollewo=9,\r
 100             goradol=11,\r
 101             goraprawodol=12,\r
 102             goralewodol=13,\r
 103             pi=3.1415926536;\r
 104      var x1,x2,y1,y2,a,b,r,katpocz,katkon:real,\r
 105          polozenie:integer;\r
 106      begin\r
 107           call color(11);\r
 108           a:=x;\r
 109           b:=y;\r
 110           r:=promien;\r
 111           polozenie:=srodek;\r
 112           katpocz,katkon:=0;\r
 113           if (a+r)>29 then polozenie:=prawo fi;\r
 114           if (a-r)<0 then polozenie:=polozenie+lewo fi;\r
 115           if (b+r)>18 then polozenie:=polozenie+gora fi;\r
 116           if (b-r)<0 then polozenie:=polozenie+dol fi;\r
 117           case polozenie\r
 118                when gora:x1:=sqrt(r*r-(18-b)*(18-b));\r
 119                          katpocz:=pi-atan((18-b)/x1);\r
 120                          katkon:=atan((18-b)/x1);\r
 121                when dol: x1:=sqrt(r*r-b*b);\r
 122                          katpocz:=2*pi-atan(b/x1);\r
 123                          katkon:=pi+atan(b/x1);\r
 124                when prawo:y1:=sqrt(r*r-(29-a)*(29-a));\r
 125                           katpocz:=atan(y1/(29-a));\r
 126                           katkon:=2*pi-atan(y1/(29-a));\r
 127                when lewo: y1:=sqrt(r*r-a*a);\r
 128                           katpocz:=pi+atan(y1/a);\r
 129                           katkon:=pi-atan(y1/a);\r
 130                when goraprawo:x1:=sqrt(r*r-(18-b)*(18-b));\r
 131                               y1:=sqrt(r*r-(29-b)*(29-b));\r
 132                               katpocz:=0.5*pi+atan(x1/(18-b));\r
 133                               katkon:=2*pi-atan(y1/(29-a));\r
 134                when goralewo:x1:=sqrt(r*r-(18-b)*(18-b));\r
 135                              y1:=sqrt(r*r-a*a);\r
 136                              katpocz:=pi+atan(y1/a);\r
 137                              katkon:=atan((18-b)/x1);\r
 138                otherwise\r
 139                   case polozenie\r
 140                        when dolprawo:y1:=sqrt(r*r-(29-a)*(29-a));\r
 141                                      x1:=sqrt(r*r-b*b);\r
 142                                      katpocz:=atan(y1/(29-a));\r
 143                                      katkon:=pi+atan(b/x1);\r
 144                        when dollewo: x1:=sqrt(r*r-b*b);\r
 145                                      y1:=sqrt(r*r-a*a);\r
 146                                      katpocz:=2*pi-atan(b/x1);\r
 147                                      katkon:=pi-atan(y1/a);\r
 148                        when goradol: x1:=sqrt(r*r-(18-b)*(18-b));\r
 149                                      x2:=sqrt(r*r-b*b);\r
 150                                      katpocz:=pi-atan((18-b)/x1);\r
 151                                      katkon:=pi+atan(b/x2);\r
 152                                      call cirb(entier(a*skala*aspekt+poczX),\r
 153                                                entier(poczY-b*skala),\r
 154                                                entier(r*skala*aspekt),\r
 155                                                katpocz,katkon,1,0,1,1);\r
 156                                      x1:=a+sqrt(r*r-(18-b)*(18-b));\r
 157                                      x2:=a+sqrt(r*r-b*b);\r
 158                                      katpocz:=2*pi-atan(b/(x2-a));\r
 159                                      katkon:=atan((18-b)/(x1-a));\r
 160                        when goraprawodol:x1:=sqrt(r*r-(18-b)*(18-b));\r
 161                                          x2:=sqrt(r*r-b*b);\r
 162                                          katpocz:=pi-atan((18-b)/x1);\r
 163                                          katkon:=pi+atan(b/x2);\r
 164                        when goralewodol:x1:=sqrt(r*r-(18-b)*(18-b));\r
 165                                         x2:=sqrt(r*r-b*b);\r
 166                                         katpocz:=2*pi-atan(b/x2);\r
 167                                         katkon:=atan((18-b)/x1);\r
 168                   esac;\r
 169            esac;\r
 170  \r
 171           call cirb(entier(a*skala*aspekt+poczX),entier(poczY-b*skala),\r
 172                     entier(r*skala*aspekt),katpocz,katkon,11,0,1,1);\r
 173      end rysokrag;\r
 174  \r
 175  \r
 176  \r
 177  \r
 178  \r
 179   begin\r
 180     array liczba dim(1:29);\r
 181     liczba(1):=" 1";\r
 182     liczba(2):=" 2";\r
 183     liczba(3):=" 3";\r
 184     liczba(4):=" 4";\r
 185     liczba(5):=" 5";\r
 186     liczba(6):=" 6";\r
 187     liczba(7):=" 7";\r
 188     liczba(8):=" 8";\r
 189     liczba(9):=" 9";\r
 190     liczba(10):="10";\r
 191     liczba(11):="11";\r
 192     liczba(12):="12";\r
 193     liczba(13):="13";\r
 194     liczba(14):="14";\r
 195     liczba(15):="15";\r
 196     liczba(16):="16";\r
 197     liczba(17):="17";\r
 198     liczba(18):="18";\r
 199     liczba(19):="19";\r
 200     liczba(20):="20";\r
 201     liczba(21):="21";\r
 202     liczba(22):="22";\r
 203     liczba(23):="23";\r
 204     liczba(24):="24";\r
 205     liczba(25):="25";\r
 206     liczba(26):="26";\r
 207     liczba(27):="27";\r
 208     liczba(28):="28";\r
 209     liczba(29):="29";\r
 210  \r
 211   end grafika;\r
 212  \r
 213  \r
 214  \r
 215   unit geometria:grafika class;\r
 216  \r
 217  \r
 218     unit punkt:class(x,y:real);\r
 219     begin\r
 220       call ryspunkt(x,y);\r
 221     end punkt;\r
 222  \r
 223     unit okrag:class(srodek:punkt;promien:real);\r
 224     var i:integer;\r
 225     begin\r
 226          call rysokrag(srodek.x,srodek.y,promien);\r
 227          i := inchar ; (*** czekaj nich popatrze ***)\r
 228     end okrag;\r
 229  \r
 230  \r
 231  \r
 232     unit odleglosc:function(a,b:punkt):real;\r
 233     var a1,a2:real;\r
 234     begin\r
 235       a1:=b.x-a.x;\r
 236       a2:=b.y-a.y;\r
 237       result:=sqrt((a1*a1)+(a2*a2));\r
 238     end odleglosc;\r
 239  \r
 240  \r
 241     unit dalszy:function(od_punktu,P1,P2:punkt):punkt;\r
 242     begin\r
 243          if odleglosc(od_punktu,P1) > odleglosc(od_punktu,P2) then\r
 244             result:=P1\r
 245          else\r
 246             result:=P2\r
 247          fi;\r
 248     end dalszy;\r
 249  \r
 250   unit przeciecieokr:procedure(k1,k2:okrag;output Apunkt,Bpunkt:punkt);\r
 251       (* Procedura ta oblicza wspolrzedne punktow przeciecia sie\r
 252          dwoch okregow k1, k2 rozwiazujac uklad dwoch rownan\r
 253          kwadratowych opisujacych okregi k1 i k2 .I tak\r
 254          k1 - srodek (a,b) ,promien r\r
 255          k2 - srodek (c,d) ,promien R                             *)\r
 256   var f,aa,bb,cc,sqrdel,delta,\r
 257         a,b,c,d,e,r2,r1,c_a,r1_2,r1_2_r2_2:real;\r
 258   var   x1,x2,y1,y2:real;\r
 259     begin\r
 260       a:=k1.srodek.x;\r
 261       b:=k1.srodek.y;\r
 262       c:=k2.srodek.x;\r
 263       d:=k2.srodek.y;\r
 264       r1:=k1.promien;\r
 265       r2:=k2.promien;\r
 266       r1_2:=r1*r1;\r
 267       r1_2_r2_2:=r1_2-(r2*r2);\r
 268       if a=c then\r
 269          y1:=r1_2_r2_2/(2*(d-b))+(d+b)/2;\r
 270          y2:=y1;\r
 271          sqrdel:=sqrt(r1_2-(y1-b)*(y1-b));\r
 272          x1:=a-sqrdel;\r
 273          x2:=a+sqrdel;\r
 274       else\r
 275         if b=d then\r
 276                x1:=r1_2_r2_2/(2*(c-a))+(c+a)/2;\r
 277                x2:=x1;\r
 278                sqrdel:=sqrt(r1_2-(x1-a)*(x1-a));\r
 279                y1:=b-sqrdel;\r
 280                y2:=b+sqrdel\r
 281         else\r
 282               c_a:=c-a;\r
 283               e:=(c+a)/2+(r1_2_r2_2-b*b+d*d)/(2*c_a);\r
 284               f:=(b-d)/c_a;\r
 285               aa:=(f*f)+1;\r
 286               bb:=2*(f*(e-a)-b);\r
 287               cc:=(e*e)-(2*e*a)+(a*a)+(b*b)-(r1*r1);\r
 288               delta:=(bb*bb)-(4*aa*cc);\r
 289               y1:=((-bb)-sqrt(delta))/(2*aa);\r
 290               y2:=((-bb)+sqrt(delta))/(2*aa);\r
 291               x1:=e+f*y1;\r
 292               x2:=e+f*y2;\r
 293         fi;\r
 294       fi;\r
 295       Apunkt:=new punkt(x1,y1);\r
 296       Bpunkt:=new punkt(x2,y2);\r
 297 end przeciecieokr;\r
 298  \r
 299  \r
 300     unit wydluz2x:function(P,K:punkt):punkt;\r
 301     var P1,P2,P3,P4,P5:punkt,\r
 302         KP,PK:okrag;\r
 303     begin\r
 304          KP:=new okrag(K,odleglosc(K,P));\r
 305          PK:=new okrag(P,KP.promien);\r
 306          call przeciecieokr(KP,PK,P1,P2);\r
 307          kill(P2);\r
 308          kill(PK);\r
 309          PK:=new okrag(P1,KP.promien);\r
 310          call przeciecieokr(KP,PK,P2,P3);\r
 311          P4:=copy(dalszy(P,P2,P3));\r
 312          kill(P3);\r
 313          kill(P2);\r
 314          kill(PK);\r
 315          PK:=new okrag(P4,KP.promien);\r
 316          call przeciecieokr(KP,PK,P3,P4);\r
 317          P5:=copy(dalszy(P1,P3,P4));\r
 318          kill(P4);\r
 319          kill(P3);\r
 320          kill(P1);\r
 321          kill(P2);\r
 322          result:=P5;\r
 323          kill(KP);\r
 324          kill(PK);\r
 325     end wydluz2x;\r
 326  \r
 327  \r
 328  \r
 329   begin\r
 330   end geometria;\r
 331  \r
 332 begin\r
 333  \r
 334 pref geometria block\r
 335 const ek_rob=0,\r
 336       cls_ek=1,\r
 337       exit_con=2,\r
 338       inwer=3,\r
 339       enter=13,\r
 340       st_w_dol=-80,\r
 341       st_w_gore=-72,\r
 342       esc=27;\r
 343  \r
 344  \r
 345 unit inwersja:geometria procedure(x,y:real);\r
 346   var P,P1,P2,P3,P4:punkt,\r
 347       i,odl:integer,\r
 348       KPS,KP1,KP2:okrag;\r
 349   begin\r
 350        call color(14);\r
 351        if (S.x=/=x) or (S.y=/=y) then\r
 352           odl:=0;\r
 353           P:=new punkt(x,y); (* PUNKT KTORY MA BYC PRZEKSZTALCONY *)\r
 354           call outstring("P");\r
 355           if odleglosc(P,S)<= (KS.promien/2) then\r
 356           (* NALEZY PRZESUNAC P POZA OKRAG INWERSJI DOKONAC INWERSJI I *)\r
 357           (*  PRZESUNAC TYLE SAMO RAZY CO POPRZEDNIO                   *)\r
 358              P1:=copy(P);\r
 359              P2:=copy(S);\r
 360              while odleglosc(P1,S)<=KS.promien do\r
 361                    P3:=wydluz2x(P2,P1);\r
 362                    kill( P2);\r
 363                    P2:=P1;\r
 364                    P1:=P3;\r
 365                    odl:=odl+1;\r
 366              od;\r
 367              kill( P2);\r
 368              kill( P);\r
 369              P:=P1;\r
 370              P1:=none;\r
 371              P3:=none;\r
 372              call ryspunkt(P.x,P.y);\r
 373              call outstring("P1'");\r
 374           fi;\r
 375           KPS:=new okrag(P,odleglosc(P,S));\r
 376           call przeciecieokr(KPS,KS,P1,P2);\r
 377           kill( KPS);\r
 378           kill( P);\r
 379           KP1:=new okrag(P1,KS.promien);\r
 380           KP2:=new okrag(P2,KS.promien);\r
 381           call przeciecieokr(KP1,KP2,P3,P4);\r
 382           kill( P1);\r
 383           kill( P2);\r
 384           kill( KP1);\r
 385           kill( KP2);\r
 386           P:=copy(dalszy(S,P3,P4));\r
 387           call ryspunkt(P.x,P.y);\r
 388           if odl>0 then\r
 389              call outstring("P2'")\r
 390           else\r
 391              call outstring("P'")\r
 392           fi;\r
 393           kill( P3);\r
 394           kill( P4);\r
 395           P1:=copy(S);\r
 396           for i:=1 to odl do\r
 397             P3:=wydluz2x(P1,P);\r
 398             kill( P1);\r
 399             P1:=P;\r
 400             P:=P3;\r
 401           od;\r
 402           call ryspunkt(P.x,P.y);\r
 403           call outstring("P' ");\r
 404           kill(P);\r
 405           kill(P1);\r
 406        fi;\r
 407   end inwersja;\r
 408  \r
 409  \r
 410 unit strzalka:procedure(x,y:integer);\r
 411 begin\r
 412   call cirb(x,y,29,2.9,3.3,0,1,1,1);\r
 413 end strzalka;\r
 414  \r
 415  \r
 416 unit rys_menu:procedure;\r
 417 begin\r
 418      call color(14);\r
 419      call move(519,0);\r
 420      call hfill(619);\r
 421      call draw(519,25);\r
 422      call hfill(619);\r
 423      call draw(519,50);\r
 424      call hfill(619);\r
 425      call draw(519,75);\r
 426      call hfill(619);\r
 427      call draw(519,100);\r
 428      call draw(619,100);\r
 429      call draw(619,0);\r
 430      call move(533,5);\r
 431      call outstring("SHAW AUX");\r
 432      call move(533,30);\r
 433      call outstring("CLEAR AUX");\r
 434      call move(533,55);\r
 435      call outstring("END");\r
 436      call move(533,80);\r
 437      call outstring("INVERSION");\r
 438 end rys_menu;\r
 439  \r
 440  \r
 441 unit czyt_licz:function:real;\r
 442 const kropka=46;\r
 443 var   ulamek:bool,\r
 444       wykladnik,res:real,\r
 445       lzn,(*liczba wczytanych znakow *)\r
 446       znak:integer;(*kod wczytanego znaku*)\r
 447 begin\r
 448      ulamek:=false;\r
 449      wykladnik:=1;\r
 450      result:=0;\r
 451      do\r
 452        znak:=inchar;\r
 453        case znak\r
 454             when kropka: ulamek:=true;\r
 455                          wykladnik:=1;\r
 456                          lzn:=lzn+1;\r
 457                          call hascii(znak);\r
 458             when enter:  exit;\r
 459             otherwise    lzn:=lzn+1;\r
 460                          if lzn <= 5 then\r
 461                             if ulamek then\r
 462                                wykladnik:=wykladnik/10;\r
 463                                result:=result+(znak-ord('0'))*wykladnik;\r
 464                             else\r
 465                                 result:=result*wykladnik+(znak-ord('0'));\r
 466                                 wykladnik:=wykladnik*10;\r
 467                             fi;\r
 468                             call hascii(znak);\r
 469                          else\r
 470                              exit\r
 471                          fi;\r
 472        esac;\r
 473      od;\r
 474 end czyt_licz;\r
 475  \r
 476  \r
 477 var i,stan,znak:integer,\r
 478     S:punkt,\r
 479     KS:okrag,\r
 480     wsp_strz:arrayof arrayof integer,\r
 481     x,y:real;\r
 482 begin\r
 483  \r
 484  array wsp_strz dim(0:5);\r
 485  for i:=0 to 5 do\r
 486      array wsp_strz(i) dim(1:2);\r
 487  od;\r
 488  for i:=0 to 5 do\r
 489      wsp_strz(i,1):=515;\r
 490  od;\r
 491  wsp_strz(0,2):=15;\r
 492  wsp_strz(1,2):=40;\r
 493  wsp_strz(2,2):=65;\r
 494  wsp_strz(3,2):=90;\r
 495  wsp_strz(4,2):=120;\r
 496  wsp_strz(5,2):=140;\r
 497  stan:=0;\r
 498  call gron(0);         (* 0 - STRONA ROBOCZA  *)\r
 499  call rys_ukl_wsp;\r
 500  \r
 501  (******* RYSUJ OKRAG INWERSJI ***********)\r
 502  \r
 503  call color(2);\r
 504  S:=new punkt(11.5,9.5);\r
 505  call outstring(" S");\r
 506  KS:=new okrag(S,4);\r
 507  kill(S);\r
 508  kill(KS);\r
 509  call hpage(1,1,0);   (* 1 - STRONA Z MENU   *)\r
 510  call cls;\r
 511  call rys_ukl_wsp;\r
 512  \r
 513  (******* RYSUJ OKRAG INWERSJI ***********)\r
 514  call color(14);\r
 515       S:=new punkt(11.5,9.5);\r
 516       call outstring(" S");\r
 517       KS:=new okrag(S,4);\r
 518       call rys_menu;\r
 519       call strzalka(wsp_strz(stan,1),wsp_strz(stan,2));\r
 520  do\r
 521    znak:=inchar;\r
 522    case znak\r
 523        when st_w_dol: call color(0); (**** 0 - kolor tla  *****)\r
 524                   call strzalka(wsp_strz(stan,1),wsp_strz(stan,2));\r
 525                   stan:=(stan+1) mod 4;\r
 526                   call color(14); (**** 14 - kolor znaku *****)\r
 527                   call strzalka(wsp_strz(stan,1),wsp_strz(stan,2));\r
 528         when st_w_gore:call color(0); (**** 0 - kolor tla  *****)\r
 529                   call strzalka(wsp_strz(stan,1),wsp_strz(stan,2));\r
 530                   stan:=(stan+3) mod 4;\r
 531                   call color(14); (**** 1 - kolor znaku *****)\r
 532                   call strzalka(wsp_strz(stan,1),wsp_strz(stan,2));\r
 533        when enter: case stan\r
 534                      when  ek_rob: call hpage(0,1,0);\r
 535                                    znak:=inchar;\r
 536                                    call hpage(1,1,0);\r
 537  \r
 538                      when  cls_ek: call hpage(0,1,0);\r
 539                                call cls;\r
 540                                call rys_ukl_wsp;\r
 541                                call rysokrag(S.x,S.y,KS.promien);\r
 542                                call ryspunkt(S.x,S.y);\r
 543                                call outstring(" S");\r
 544                                call hpage(1,1,0);\r
 545  \r
 546                      when  exit_con: exit;\r
 547  \r
 548                      when  inwer: call move(519,115);\r
 549                                   call outstring("X=");\r
 550                                   call move(540,112);\r
 551                                   call draw(590,112);\r
 552                                   call move(540,112);\r
 553                                   call draw(540,125);\r
 554                                   call draw(590,125);\r
 555                                   call draw(590,112);\r
 556                                   call move(546,115);\r
 557                                    (*wczytnie x*)\r
 558                                   x:=czyt_licz;\r
 559                                   call move(519,145);\r
 560                                   call outstring("Y=");\r
 561                                   call move(540,142);\r
 562                                   call draw(590,142);\r
 563                                   call move(540,142);\r
 564                                   call draw(540,155);\r
 565                                   call draw(590,155);\r
 566                                   call draw(590,142);\r
 567                                   call move(546,145);\r
 568                                    (*wczytnie y*)\r
 569                                   y:=czyt_licz;\r
 570                                   call color(0);\r
 571                                   for i:=112 to 155 do\r
 572                                       call move(515,i);\r
 573                                       call draw(595,i);\r
 574                                   od;\r
 575                                   call color(11);\r
 576                                   call hpage(0,1,0);\r
 577                                   if (x>0) andif (y>0) andif (x<29) andif (y<18)\r
 578                                    then\r
 579                                     call inwersja(x,y);\r
 580                                     znak:=inchar;\r
 581                                     call hpage(1,1,0);\r
 582                                    else\r
 583                                     call move(360,180);\r
 584  \r
 585                                     call outstring(" bad data  ");\r
 586                                     call move(360,200);\r
 587                                     call outstring("  press ESC ");\r
 588                                     do\r
 589                                       znak:=inchar;\r
 590                                       if znak=Esc then exit fi;\r
 591                                     od;\r
 592                                     call cls;\r
 593                                     call rys_ukl_wsp;\r
 594                                     call rysokrag(S.x,S.y,KS.promien);\r
 595                                     call ryspunkt(S.x,S.y);\r
 596                                     call outstring(" S");\r
 597                                     call hpage(1,1,0);\r
 598                                   fi;\r
 599                   esac;\r
 600           esac;\r
 601       od;\r
 602       call groff;\r
 603   end;\r
 604 end geo\r