examples/geometri/mariusz4.log

   1 program pierwiastek;\r
   2 begin\r
   3 pref IIUWgraph block\r
   4 const\r
   5    aspekt=1.33333333333,\r
   6    Pi=3.1415926536,\r
   7    jednostka=25;\r
   8 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
   9  unit WaitMoment:procedure;\r
  10  var r:integer;\r
  11    begin\r
  12      call move(290,320);\r
  13      call outstring("Press any key!");\r
  14      while r = 0 do\r
  15        r:=inkey\r
  16      od;\r
  17      call move(290,320);\r
  18      call outstring("       *      ");\r
  19  end WaitMoment;\r
  20 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
  21 unit punkt:class(x,y:real);\r
  22   unit plot:procedure;\r
  23   begin\r
  24     call move(round(x*aspekt)-3,round(y));\r
  25     call draw(round(x*aspekt)+3,round(y));\r
  26     call move(round(x*aspekt),round(y)-2);\r
  27     call draw(round(x*aspekt),round(y)+3);\r
  28   end plot;\r
  29 end punkt;\r
  30 \r
  31 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
  32 \r
  33 unit okrag :class (S:punkt;r:real);\r
  34   unit cirb:procedure(alfa,beta:real);\r
  35   var gamma,x,y:real;\r
  36   begin\r
  37     if alfa<beta then\r
  38           gamma:=alfa\r
  39     else  gamma:=beta;\r
  40           beta:=alfa\r
  41     fi;\r
  42     x:=round(aspekt*(S.x+(r*cos(gamma))));\r
  43     y:=round(S.y+(r*sin(gamma)));\r
  44     call move(x,y);\r
  45     while gamma<=beta do\r
  46       x:=round(aspekt*(S.x+(r*cos(gamma))));\r
  47       y:=round(S.y+(r*sin(gamma)));\r
  48       call draw(x,y);\r
  49       gamma:=gamma+0.01\r
  50     od\r
  51   end cirb;\r
  52   unit rys:procedure(A:punkt);\r
  53   var alfa,pom:real;\r
  54   begin\r
  55   pom:=(A.y-S.y)/(A.x-S.x);\r
  56   alfa:=atan(pom);\r
  57   if A.x-S.x<0 then\r
  58        alfa:=Pi+alfa\r
  59   fi;\r
  60   call cirb(alfa-0.3,alfa+0.3);\r
  61   end rys;\r
  62 end okrag;\r
  63 \r
  64 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
  65 \r
  66 unit odcinek:class(A,B:punkt);\r
  67 begin\r
  68 call move(round(A.x*aspekt),round(A.y));\r
  69 call draw(round(B.x*aspekt),round(B.y))\r
  70 end odcinek;\r
  71 \r
  72 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
  73 \r
  74 unit odleglosc:function(A,B:punkt):real;\r
  75 begin\r
  76   result:=sqrt((B.x-A.x)*(B.x-A.x)+(B.y-A.y)*(B.y-A.y))\r
  77 end odleglosc;\r
  78 \r
  79 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
  80 \r
  81 unit srodek_odcinka:function(GH:odcinek):punkt;\r
  82     var\r
  83      o2,o3:okrag,\r
  84      C,D:punkt,\r
  85      CD:odcinek;\r
  86 begin\r
  87    o2:=new okrag(GH.A,odleglosc(GH.A,GH.B));\r
  88    o3:=new okrag(GH.B,odleglosc(GH.A,GH.B));\r
  89    call okrag_okrag(o2,o3,C,D);\r
  90    call WaitMoment;\r
  91    CD:=new odcinek(C,D);\r
  92    result:=odcinek_odcinek(GH,CD)\r
  93 end srodek_odcinka;\r
  94 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
  95 \r
  96 unit okrag_okrag:procedure(o2,o1:okrag;output G,H:punkt);\r
  97 var\r
  98    ax2,ay2,cx2,cy2,r12,r22:real,\r
  99    A,B:punkt,\r
 100    AB:odcinek;\r
 101 begin\r
 102    ax2:=o1.S.x * o1.S.x;\r
 103    ay2:=o1.S.y * o1.S.y;\r
 104    cx2:=o2.S.x * o2.S.x;\r
 105    cy2:=o2.S.y * o2.S.y;\r
 106    r12:=o1.r * o1.r;\r
 107    r22:=o2.r * o2.r;\r
 108   A:=new punkt(0,(r12-r22-ay2-ax2+cx2+cy2)/(2*(o2.S.y-o1.s.y)));\r
 109 B:=new punkt(1,(r12-r22-ay2-ax2+cx2+cy2+2*o1.s.x-2*o2.s.x)/(2*(o2.S.y-o1.s.y)));\r
 110   AB:=new odcinek(A,B);\r
 111   call okrag_odcinek(o1,AB,G,H);\r
 112   call o1.rys(G);\r
 113   call o2.rys(G);\r
 114   call G.plot;\r
 115   call outstring("G");\r
 116   call o1.rys(H);\r
 117   call o2.rys(H);\r
 118   call H.plot;\r
 119   call outstring("H");\r
 120 end okrag_okrag;\r
 121 \r
 122 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
 123 \r
 124 unit okrag_odcinek:procedure(o:okrag;p:odcinek;output G,H:punkt);\r
 125 var\r
 126    a,b,c,x,y,delta,m:real;\r
 127 begin\r
 128 \r
 129    m:=(p.B.y - p.A.y) / (p.B.x - p.A.x);\r
 130    a:=(m * m) + 1;\r
 131    b:=(-2) * ((m * m * p.A.x) - (m * p.A.y)+(o.s.x)+(m*o.s.y));\r
 132    c:=m * p.A.x *(m * p.A.x - 2 * p.A.y) + (p.A.y * p.A.y) - (o.r * o.r);\r
 133    c:=c+(o.s.x*o.s.x)+(o.s.y*o.s.y)-(2*p.a.y*o.s.y);\r
 134    c:=c+(2*m*p.a.x*o.s.y);\r
 135    delta :=b * b -(4 * a * c);\r
 136    if delta < 0 then\r
 137                 G:=none;\r
 138                 H:=none;\r
 139    else\r
 140       if delta = 0 then\r
 141                    x:= -b / (2 * a);\r
 142                    y:= m *(x - p.A.x) + p.A.y;\r
 143                    G:=new punkt(x ,y);\r
 144       else       delta:=sqrt(delta);\r
 145                  x:= (-b - delta) / (2 * a);\r
 146                  y:= m *(x - p.A.x) + p.A.y;\r
 147                  G:=new punkt(x ,y);\r
 148                  x:= (-b + delta) / (2 * a);\r
 149                  y:= m *(x - p.A.x) + p.A.y;\r
 150                  H:=new punkt(x ,y);\r
 151       fi\r
 152    fi\r
 153 end okrag_odcinek;\r
 154 \r
 155 \r
 156 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
 157 \r
 158 unit  punkt_odlegly:function(AB:odcinek;odl:integer):punkt;\r
 159 (*   Funkcja zwraca punkt odlegly w poziomie o odl lezacy na prostej AB.   *)\r
 160 var\r
 161   G,H:punkt,\r
 162   o:okrag;\r
 163 begin\r
 164   o:=new okrag(AB.B,odl*jednostka);\r
 165   call okrag_odcinek(o,AB,G,H);\r
 166   if odleglosc(AB.A,G)<odleglosc(AB.A,H) then\r
 167     result:=H\r
 168   else\r
 169     result:=G\r
 170   fi\r
 171 end punkt_odlegly;\r
 172 \r
 173 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
 174 \r
 175 unit odcinek_odcinek:function(AB,CD:odcinek):punkt;\r
 176 var\r
 177    m1,m2,x,y:real;\r
 178 begin\r
 179    m1:=(AB.B.y-AB.A.y)/(AB.B.x-AB.A.x);\r
 180    m2:=(CD.B.y-CD.A.y)/(CD.B.x-CD.A.x);\r
 181    x:=(m1*AB.A.x-AB.A.y-m2*CD.A.x+CD.A.y)/(m1-m2);\r
 182    y:=m1*(x-AB.A.x)+AB.A.y;\r
 183    result:=new punkt(x,y)\r
 184 end odcinek_odcinek;\r
 185 \r
 186 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
 187 \r
 188 unit prostopadla:function(AC:odcinek;B:punkt):odcinek;\r
 189 var\r
 190   o1,o2,o3:okrag,\r
 191   G,H,K,L:punkt;\r
 192 begin\r
 193 o1:=new okrag(B,odleglosc(B,AC.B));\r
 194 call okrag_odcinek(o1,AC,G,H);\r
 195 o2:=new okrag(G,2*odleglosc(B,AC.B));\r
 196 o3:=new okrag(H,2*odleglosc(B,AC.B));\r
 197 call okrag_okrag(o2,o3,K,L);\r
 198 result:=new odcinek (K,L)\r
 199 end prostopadla;\r
 200 \r
 201 (*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%*)\r
 202 \r
 203 \r
 204 \r
 205 var\r
 206    A,B,C,D,E,F,G:punkt,\r
 207    o1:okrag,\r
 208    AC,AB,BE,BF:odcinek,\r
 209    wynik:real;\r
 210 begin\r
 211 \r
 212    call gron(0);\r
 213    A:=new punkt(200,100);\r
 214    call A.plot;\r
 215    call outstring ("A");\r
 216    call move (100,300);\r
 217    call outstring("Choose second point and press <END>.");\r
 218    call track(303,202);\r
 219    B:=new punkt(inxpos*(1/aspekt),inypos);\r
 220    call B.plot;\r
 221    call outstring ("B");\r
 222    call move (100,300);\r
 223    call outstring("                                    ");\r
 224    AB:=new odcinek(A,B);\r
 225    C:=punkt_odlegly(AB,1);\r
 226    call C.plot;\r
 227    call outstring ("C");\r
 228    AC:=new odcinek(A,C);\r
 229    call WaitMoment;\r
 230    D:=srodek_odcinka(AC);\r
 231    call D.plot;\r
 232    call outstring("D");\r
 233    call WaitMoment;\r
 234    o1:=new okrag(D,odleglosc(D,C));\r
 235    call cirb(round(D.x*aspekt),round(d.y),round(odleglosc(D,C)*aspekt),1,1,1,0,1,1);\r
 236    BE:=prostopadla(AC,B);\r
 237    call WaitMoment;\r
 238    call okrag_odcinek(o1,BE,F,G);\r
 239    wynik:=odleglosc(B,F);\r
 240    call F.plot;\r
 241    call outstring("F");\r
 242    BF:=new odcinek(B,F);\r
 243    call move(100,310);\r
 244    call outstring("Dlugosc odcinka BF wynosi pierwiastek z dlugosci odcinka AB.");\r
 245    call WaitMoment;\r
 246    call groff\r
 247  end\r
 248 end.\r
 249 \1a