#!perl -w #______________________________________________________________________ # Geometric operations # PhilipRBrenan@yahooo.com, 2003. #______________________________________________________________________ my \$VERSION = 1.2; =head1 NAME Geops - draw geometric figures using compass and straight edge only. =head1 DESCRIPTION Geometric constructions using compass and straight-edge only. The right mouse button draws circles. The left mouse button draws straight lines. The center mousewheel zooms in and out. Control-Z to undo. Control-R to redo. Left Doubleclick for more options. Try drawing: One line parallel to another Lines at 30, 60, 90 degrees to another An Isoscelese triangle An equilateral triangle A square A hexagon A pentagon A circle through three non colinear points Try drawing diagrams that demonstrate: The theorem of pythagoras cos(a+b) sin(a+b) Shearing a triangle does not change its area the diagonals of a rhombus meet at 90. Angle doubling in a circle Right triangle in semi-circle Bisection of a circle Given a triangle, draw a circle: - through the triangle's vertices - tangentially touching the sides of the triangle, with the center inside the triangle - tangentially touching the sides of the triangle with the center of the circle outside the triangle, and two sides of the triangle extended into lines. =head1 README Draw geometric figures using compass and straight edge only. =head1 PREREQUISITES C =head1 COREQUISITES =pod OSNAMES any =pod SCRIPT CATEGORIES Educational =cut #______________________________________________________________________ # Packages #______________________________________________________________________ use Tk; use Tk::Balloon; #______________________________________________________________________ # Line manipulation # PhilipRBrenan@yahoo.com, Novosoft Inc., 2003 #______________________________________________________________________ package line; use Carp; #______________________________________________________________________ # Create a line # A line is characterized by the two points through which it passes #______________________________________________________________________ sub new(\$\$\$\$) {my \$l = bless {}; # line my \$sx = shift; # X point 1 my \$sy = shift; # Y point 1 my \$fx = shift; # X point 2 my \$fy = shift; # Y point 2 my \$dx = (\$fx-\$sx); # Delta X my \$dy = (\$fy-\$sy); # Delta Y \$l->{sx} = \$sx; \$l->{sy} = \$sy; \$l->{fx} = \$fx; \$l->{fy} = \$fy; \$l->{dx} = \$dx; \$l->{dy} = \$dy; croak "Bad line defined" if \$dx == 0 and \$dy == 0; return \$l; } #______________________________________________________________________ # Intersect with box - find the points where a line crosses a box #______________________________________________________________________ sub intersectWithBox(\$\$\$\$\$) {my \$l = shift; # line my \$bx1 = shift; # Lower left X of box my \$by1 = shift; # Lower right Y of box my \$bx2 = shift; # Lower left X of box my \$by2 = shift; # Lower right Y of box my (\$sx, \$sy, \$fx, \$fy, \$dx, \$dy) = @\$l{qw(sx sy fx fy dx dy)}; my (\$i, @i); #______________________________________________________________________ # Special cases #______________________________________________________________________ # Points too close return undef if abs(\$dx) <= 1 and abs(\$dy) <= 1; # Vertical line return (\$sx, \$by1, \$sx, \$by2) if abs(\$dx) <= 1; # Horizontal line return (\$bx1, \$sy, \$bx2, \$sy) if abs(\$dy) <= 1; #______________________________________________________________________ # Intersection with each line bounding the box #______________________________________________________________________ # Lower \$i = \$sx-\$dx*(\$sy-\$by1)/\$dy; push @i, (\$i, \$by1) if \$i >= \$bx1 and \$i <= \$bx2; # Upper \$i = \$sx-\$dx*(\$sy-\$by2)/\$dy; push @i, (\$i, \$by2) if \$i >= \$bx1 and \$i <= \$bx2; return @i if scalar(@i) == 4; # Right \$i = \$sy-\$dy*(\$sx-\$bx2)/\$dx; push @i, (\$bx2, \$i) if \$i >= \$by1 and \$i <= \$by2; return @i if scalar(@i) == 4; # Left \$i = \$sy-\$dy*(\$sx-\$bx1)/\$dx; push @i, (\$bx1, \$i) if \$i >= \$by1 and \$i <= \$by2; return @i; } #______________________________________________________________________ # Determinant #______________________________________________________________________ sub determinant(\$\$\$\$) {my (\$x1, \$y1, \$x2, \$y2) = @_; return (\$x1*\$y2 - \$x2*\$y1); } #______________________________________________________________________ # Intersection of two lines #______________________________________________________________________ sub intersection(@) {my (\$p10, \$p11, \$p20, \$p21, \$p30, \$p31, \$p40, \$p41) = @_; my \$n = determinant(\$p30-\$p10, \$p30-\$p40, \$p31-\$p11, \$p31-\$p41); my \$d = determinant(\$p20-\$p10, \$p30-\$p40, \$p21-\$p11, \$p31-\$p41); return undef if abs(\$d) < 1; return (\$p10 + \$n/\$d * (\$p20 - \$p10), \$p11 + \$n/\$d * (\$p21 - \$p11)); } #______________________________________________________________________ # Point on a line closest to a point # P1, P2 line, P3 point #______________________________________________________________________ sub pointOnLineClosestToPoint(@) {my (\$p10, \$p11, \$p20, \$p21, \$p30, \$p31) = @_; my \$p40 = \$p30 + \$p21 - \$p11; # Second point of line through P3 my \$p41 = \$p31 - \$p20 + \$p10; # at right angles to line through P1, P2 return intersection(\$p10, \$p11, \$p20, \$p21, \$p30, \$p31, \$p40, \$p41); } #______________________________________________________________________ # Unit vector along a line #______________________________________________________________________ sub unitVectorAlongLine(@) {my (\$p10, \$p11, \$p20, \$p21) = @_; my (\$x, \$y) = ((\$p10-\$p20), (\$p11-\$p21)); return undef if \$x == 0 and \$y == 0; my \$d = sqrt(\$x*\$x+\$y*\$y); return (\$x/\$d, \$y/\$d); } #______________________________________________________________________ # Package loaded successfully #______________________________________________________________________ 1; #______________________________________________________________________ # Display a dialog for selection of line thickness and dash pattern # PhilipRBrenan@yahooo.com, 2003. #______________________________________________________________________ package lineStyle; sub new(\$@) {my \$m = shift; # Main Window my %p = (-selected=>'green', -unselected=>'white', -flash=>'red', -entered=>'pink', -background=>'white', -line=>'blue', -widths=>[1..5], -dash=>['', qw(. - -. -..)], -height=>20, -width=>40, @_); my @w = (@{\$p{'-widths'}}); my @lineDraw = (5, \$p{'-height'}/2+2, \$p{'-width'}-2, \$p{'-height'}/2+2); my @dash = @{\$p{'-dash'}}; my \$dash = 1; my \$width = 1; my @cdash = (); my @cline = (); my \$row = 1; my \$n = scalar(@w); \$n = scalar(@dash) if scalar(@dash) > \$n; my \$dw = \$m->LabFrame(-label=>'Line types', -labelside=>'acrosstop')->pack(); my \$l1 = \$dw->Label(-text=>'Width')->grid(-column=>1, -row=>\$row); my \$l2 = \$dw->Label(-text=>'Style')->grid(-column=>2, -row=>\$row); ++\$row; # Line width for(my \$i = 0; \$i < \$n; ++\$i) {if (defined(\$w[\$i])) {my \$c; my \$enter = sub(\$\$) {my \$c = shift; my \$i = shift; \$c->configure(-background=>\$p{'-entered'}) unless \$i == \$width; }; my \$leave = sub(\$\$) {my \$c = shift; my \$i = shift; \$c->configure(-background=>\$p{'-unselected'}) unless \$i == \$width; }; my \$press = sub(\$\$) {my \$c = shift; my \$i = shift; \$c->configure(-background=>\$p{'-flash'}); }; my \$release = sub(\$\$) {my \$c = shift; my \$i = shift; \$width = \$i; for(my \$j = 0; \$j < \$n; ++\$j) {\$cline[\$j]->configure(-background=>\$p{'-unselected'}); } \$c->configure(-background=>\$p{'-selected'}); \${\$p{'-widthVar'}} = \$w[\$width] if defined \$p{'-widthVar'}; }; \$cline[\$i] = \$c = \$dw->Canvas(-height=>\$p{'-height'}, -width=>\$p{'-width'}, -background=>\$p{'-background'})->grid(-column=>1, -row=>\$row); \$c->configure(-background=>\$p{'-selected'}) if defined(\$p{'-widthVar'}) and \$w[\$i] == \${\$p{'-widthVar'}}; \$c->createLine(@lineDraw, -fill=>\$p{'-line'}, -width=>\$w[\$i]); \$c->CanvasBind("", [\$release, \$i]); \$c->CanvasBind("", [\$press, \$i]); \$c->CanvasBind("", [\$enter, \$i]); \$c->CanvasBind("", [\$leave, \$i]); } # Line dash style my \$d = \$dash[\$i]; if (defined(\$d)) {my \$c; my \$enter = sub(\$\$) {my \$c = shift; my \$i = shift; \$c->configure(-background=>\$p{'-entered'}) unless \$i == \$dash; }; my \$leave = sub(\$\$) {my \$c = shift; my \$i = shift; unless(\$i == \$dash) {\$c->configure(-background=>\$p{'-unselected'}); } }; my \$press = sub(\$\$) {my \$c = shift; my \$i = shift; \$c->configure(-background=>\$p{'-flash'}); }; my \$release = sub(\$\$) {my \$c = shift; my \$i = shift; \$dash = \$i; for(my \$j = 0; \$j < \$n; ++\$j) {\$cdash[\$j]->configure(-background=>\$p{'-unselected'}); } \$c->configure(-background=>\$p{'-selected'}); \${\$p{'-dashVar'}} = \$dash[\$dash] if defined \$p{'-dashVar'}; }; \$cdash[\$i] = \$c = \$dw->Canvas(-height=>\$p{'-height'}, -width=>\$p{'-width'}, -background=>\$p{'-background'})->grid(-column=>2, -row=>\$row); \$c->configure(-background=>\$p{'-selected'}) if defined(\$p{'-dashVar'}) and \$dash[\$i] eq \${\$p{'-dashVar'}}; \$c->createLine(@lineDraw, -fill=>\$p{'-line'}, -dash=>\$dash[\$i], -width=>\$i); \$c->CanvasBind("", [\$release, \$i]); \$c->CanvasBind("", [\$press, \$i]); \$c->CanvasBind("", [\$enter, \$i]); \$c->CanvasBind("", [\$leave, \$i]); } ++\$row; } return \$dw; } #______________________________________________________________________ # Package loaded successfully #______________________________________________________________________ 1; #______________________________________________________________________ # Get/Set # PhilipRBrenan@yahooo.com, 2003. #______________________________________________________________________ package gs; use Carp; #use Strict; sub new() {return bless {}; } #______________________________________________________________________ # Get - retrieve values of global importance #______________________________________________________________________ sub get(\$@) {my \$g = shift; my @p = @_; return \$g->{\$p[0]} if scalar(@p) == 1; return \$g->{\$p[0]}->{\$p[1]} if scalar(@p) == 2; return \$g->{\$p[0]}->{\$p[1]}->{\$p[2]} if scalar(@p) == 3; die "geo::get: Wrong number of parameters"; } #______________________________________________________________________ # Set - record values of global importance #______________________________________________________________________ sub set(\$@) {my \$g = shift; my @p = @_; return \$g->{\$p[0]} = \$p[1] if scalar(@p) == 2; return \$g->{\$p[0]}->{\$p[1]} = \$p[2] if scalar(@p) == 3; return \$g->{\$p[0]}->{\$p[1]}->{\$p[2]} = \$p[3] if scalar(@p) == 4; die "geo::set: Wrong number of parameters"; } #______________________________________________________________________ # Main #______________________________________________________________________ package main; print << 'END'; GEOPS: PhilipRBrenan@yahoo.com, 2003-2004 Geometric constructions using compass and straight-edge only. The right mouse button draws circles. The left mouse button draws straight lines. The center mousewheel zooms in and out. Control-Z to undo. Control-R to redo. Left Doubleclick for more options. Try drawing: One line parallel to another Lines at 30, 60, 90 degrees to another An Isoscelese triangle An equilateral triangle A square A hexagon A pentagon A circle through three non colinear points Try drawing diagrams that demonstrate: The theorem of pythagoras cos(a+b) sin(a+b) Shearing a triangle does not change its area the diagonals of a rhombus meet at 90. Angle doubling in a circle Right triangle in semi-circle Bisection of a circle Given a triangle, draw a circle: - through the triangle's vertices - tangentially touching the sides of the triangle, with the center inside the triangle - tangentially touching the sides of the triangle with the center of the circle outside the triangle, and two sides of the triangle extended into lines. END #______________________________________________________________________ # Get X, Y coords of mouse. Round to nearest object if we are close #______________________________________________________________________ sub getXYFromEvent(\$) {my \$w = shift; my \$e = \$w->XEvent; my (\$x, \$y) = areWeNearAnything((\$c->canvasx(\$e->x), \$c->canvasy(\$e->y))); return (\$x, \$y, \$e->b); } #______________________________________________________________________ # Button press - record mouse position and start new object #______________________________________________________________________ sub buttonPress(\$) {(\$bx, \$by) = getXYFromEvent(shift()); \$c->createOval(\$bx-\$ps, \$by-\$ps, \$bx+\$ps, \$by+\$ps, -tags=>'startPoint', -fill=>'red'); # Undo / redo capability if (defined(\$objoff) and \$objoff < scalar(@obj)) {my @d = splice @obj, \$objoff; for my \$o(@d) {\$c->delete(\$o->{tag}) if defined \$o->{tag}; } \$objoff = undef; } } #______________________________________________________________________ # Button release - finish new object unless back where we started #______________________________________________________________________ sub buttonRelease(\$) {my (\$x, \$y, \$b) = getXYFromEvent(shift()); \$c->delete('startPoint'); # Finish drawing line if (\$b == 1) {\$c->delete('currentLine'); my \$h = abs(\$y-\$by) < \$pc; \$y = \$by if \$h; my \$v = abs(\$x-\$bx) < \$pc; \$x = \$bx if \$v; unless ((\$x-\$bx)**2+(\$y-\$by)**2 < \$ps*\$ps) {my \$t = \$c->createLine(\$bx, \$by, \$x, \$y, -tags=>[\$drawColor, 'line'], -fill =>\$drawColor, -activefill =>'blue', -disabledfill =>'yellow', -width=>\$drawWidth, -activewidth=>\$drawWidth+1, -disabledwidth=>\$drawWidth, -dash =>\$drawDash); my \$o = {type=>'line', vertical=>\$v, horizontal=>\$h, tag=>\$t}; push @obj, ({type=>'commit'}, \$o); findIntersections(\$o); } } # Finish drawing circle elsif (\$b == 3) {\$c->delete('currentCircle'); my \$r = sqrt((\$x-\$bx)**2+(\$y-\$by)**2); unless (\$r < \$ps) {my \$t1 = \$c->createOval(\$bx-\$r, \$by-\$r, \$bx+\$r, \$by+\$r, -tags=>[\$drawColor, 'circle'], -outline=>\$drawColor, -activeoutline=>'blue', -disabledoutline=>'yellow', -width =>\$drawWidth, -activewidth=>\$drawWidth+1, -disabledwidth=>\$drawWidth, -dash =>\$drawDash); my \$t2 = drawPoint(\$bx, \$by, ["circleCenter\$t1"]); my \$o1 = {type=>'circle', tag=>\$t1}; my \$o2 = {%\$t2, centerOfCircle=>\$t1}; push @obj, ({type=>'commit'}, \$o1, \$o2); findIntersections(\$o1); } } \$c->raise('point'); } #______________________________________________________________________ # Button 1 motion - draw line #______________________________________________________________________ sub button1Motion(\$) {my (\$x, \$y) = getXYFromEvent(shift()); return if configureStartPoint(\$x, \$y); my \$h = abs(\$y-\$by) < \$pc; \$y = \$by if \$h; my \$v = abs(\$x-\$bx) < \$pc; \$x = \$bx if \$v; \$c->delete('currentLine'); my @i = (\$bx, \$by, \$x, \$y); \$c->createLine(@i, -width=>\$drawWidth, -tags=>'currentLine', -fill =>'blue', -width=>\$drawWidth+1); } #______________________________________________________________________ # Button 2 motion - pan #______________________________________________________________________ sub button2Motion(\$) {my (\$x, \$y) = getXYFromEvent(shift()); \$c->move('all', \$x-\$bx, \$y-\$by); \$c->move('startPoint', \$bx-\$x, \$by-\$y); (\$bx, \$by) = (\$x, \$y); } #______________________________________________________________________ # Button 3 motion - draw circle #______________________________________________________________________ sub button3Motion(\$) {my (\$x, \$y) = getXYFromEvent(shift()); return if configureStartPoint(\$x, \$y); my \$r = sqrt((\$x-\$bx)**2+(\$y-\$by)**2); \$c->delete('currentCircle'); \$c->createOval(\$bx-\$r, \$by-\$r, \$bx+\$r, \$by+\$r, -tags=>'currentCircle', -outline=>'blue', -width =>\$drawWidth+1); } #______________________________________________________________________ # Zoom in or out on mouse wheel #______________________________________________________________________ sub mouseWheel(\$) {my \$e = shift; my \$w = \$e->XEvent; my (\$x, \$y, \$d) = (\$w->x, \$w->y, \$w->D); my (\$cx, \$cy) = (\$c->canvasx(\$x), \$c->canvasy(\$y)); my (\$xv1, \$xv2) = \$c->xview; my (\$yv1, \$yv2) = \$c->yview; if (\$d > 0) # Zoom out {\$c->scale('all', \$x, \$y, 4/5, 4/5); my \$fx = \$xv1 - \$cx/5/4/\$g->get(qw(display x)); \$fx = 0 if \$fx < 0; my \$fy = \$yv1 - \$cy/5/4/\$g->get(qw(display y)); \$fy = 0 if \$fy < 0; \$c->xviewMoveto(\$fx); \$c->yviewMoveto(\$fy); } else # Zoom in {\$c->scale('all', \$x, \$y, 5/4, 5/4); my \$fx = \$xv1 + \$cx/\$g->get(qw(display x)); \$fx = 1 if \$fx > 1; my \$fy = \$yv1 + \$cy/\$g->get(qw(display y)); \$fy = 1 if \$fy > 1; \$c->xviewMoveto(\$fx); \$c->yviewMoveto(\$fy); } redrawAllPoints(); } #______________________________________________________________________ # Double Click - show actions dialog #______________________________________________________________________ sub doubleButtonPress1Point(\$\$) {my \$c = shift(); # Canvas press took place on my \$t = shift(); # Tag of point selected my \$lastTag = \$t; # Last tag selected my \$startTag = \$t; # Starting tag my \$cl = \$c->itemcget(\$t, -fill=>); my \$row = 0; # Grid row for next button my %ba = qw(-anchor w -width 8); # Default button attributes my %ga = qw(-sticky w); # Default button attributes my %cb = (); # Hash of check buttons # Dialog main window if (defined(\$mm)) {\$mm->raise(); return; } \$mm = MainWindow->new(); \$mm->title(\$g->get(qw(display title))); \$mm->OnDestroy(sub {\$mm = undef}); #______________________________________________________________________ # Color select #______________________________________________________________________ my \$pm = \$mm->LabFrame(-label=>'Color', -labelside=>'acrosstop') ->grid(-column=>1, -row=>1); \$balloon->attach(\$pm, -msg=>"Choose the color you wish to draw in.\nYou can show or hide selected colors."); my \$showInColor = sub (\$) {my \$r = shift; # Color that changed state my @t = \$c->find(withtag=>'all'); for my \$t(@t) {my \$l = colorFromTag(\$t); my \$s = 'hidden'; \$s = 'normal' if \$showColor->{\$r} == 1; \$c->itemconfigure(\$t, -state=>\$s) if \$l eq \$r; } }; my \$changeColors = sub () {my @t = \$c->find(withtag=>'QED'); for my \$t(@t) {my \$type = \$c->type(\$t); \$c->itemconfigure(\$t, -fill =>\$drawColor) if \$type eq 'line'; \$c->itemconfigure(\$t, -outline=>\$drawColor) if \$type eq 'oval'; \$showColor->{\$drawColor} = 1; &\$showInColor(\$drawColor); } \$cb{\$drawColor}->select(); }; my \$showColors = sub(\$) {my \$l = shift; # Color that changed state &\$showInColor(\$l); }; my \$t1 = \$pm->Label(-text=>'Draw', -anchor=>'w')->grid(-column=>1, -row=>++\$row, -sticky=>'w'); my \$t2 = \$pm->Label(-text=>'Show', -anchor=>'e')->grid(-column=>2, -row=> \$row); for my \$color(@drawColor) {my \$bcolor = \$color; \$bcolor = 'white' if \$color eq 'black'; my \$rb = \$pm->Radiobutton( -text => \$color, -background => \$bcolor, -selectcolor=> \$bcolor, -variable => \\$drawColor, -value => \$color, -anchor => 'w', -command => \$changeColors, )->grid(-column=>1, -row=>++\$row, -sticky=>'we'); my \$cb = \$pm->Checkbutton( # -text => \$color, -background => \$bcolor, -selectcolor=> \$bcolor, -variable => \\$showColor->{\$color}, -anchor => 'center', -command => [\$showColors, \$color], )->grid(-column=>2, -row=>\$row, -sticky=>'we'); \$cb{\$color} = \$cb; \$balloon->attach(\$rb, -msg=>"Draw in \$color."); \$balloon->attach(\$cb, -msg=>"Show or hide \$color."); } #______________________________________________________________________ # Line style select #______________________________________________________________________ my \$lm = \$mm->lineStyle::new(-selected=>'green', -flash=>'red', -entered=>'pink', -unselected=>'white', -background=>'white', -line=>'blue', -widthVar=>\\$drawWidth, -dashVar=>\\$drawDash, -widths=>[1..5], -dash=>['', qw(. - -. -..)], -height=>20, -width=>50) ->grid(-column=>1, -row=>2); #______________________________________________________________________ # Files #______________________________________________________________________ my \$print = sub {my \$f = \$m->getSaveFile(-defaultextension=>'.jpg', #-filetypes=>['JPG files', ['.jpg']], -title=>'Choose a file to write the image to'); \$c->itemconfigure('point', -state=>'hidden'); \$c->postscript(-file=>"zzz.ps"); \$c->itemconfigure('point', -state=>'normal'); my \$cmd = \$gs; \$cmd =~ s/XXX/\$f/; `\$cmd`; \$m->messageBox(-message=>"Image written to \$f", -title=>'Success!', -type=>'OK'); }; my \$new = sub {print "New not implemented yet\n"}; my \$save = sub {print "Save not implemented yet\n"}; my \$fm = \$mm->LabFrame(-label=>'Files', -labelside=>'acrosstop')->grid(-column=>1, -row=>3); my \$pb = \$fm->Button(-text=>'Print', -command=>\$print)->grid(-column=>1, -row=>1); my \$nb = \$fm->Button(-text=>'New', -command=>\$new) ->grid(-column=>2, -row=>1); my \$sb = \$fm->Button(-text=>'Save', -command=>\$save) ->grid(-column=>3, -row=>1); \$balloon->attach(\$pb, -msg=>"Create JPEG"); \$balloon->attach(\$nb, -msg=>"New file to contain data"); \$balloon->attach(\$sb, -msg=>"Save data to file"); } #______________________________________________________________________ # Are we near anything - check how close a point is to known objects # This could be improved by using \$c->bbox #______________________________________________________________________ sub areWeNearAnything(\$\$) {my \$x = shift; # X position my \$y = shift; # Y position my \$n = \$pc; for my \$o(@obj) {if (\$o->{type} eq 'point' and !defined(\$o->{reuse})) {my (\$cx, \$cy) = coordsOfPoint(\$o->{tag}); my \$d = (\$x-\$cx)**2+(\$y-\$cy)**2; # Squared distance to center return (\$cx, \$cy) if \$d < \$n*\$n; # Substitute center of circle } } return (\$x, \$y); } #______________________________________________________________________ # findIntersections - last object added with existing objects #______________________________________________________________________ sub findIntersections(\$) {return unless scalar(@obj) > 0; # No intersections yet my \$a = shift; {my %a = %\$a; next unless \$a{type} eq 'line' or \$a{type} eq 'circle'; for my \$o(@obj) {my %o = %\$o; next unless \$o{type} eq 'line' or \$o{type} eq 'circle'; next unless colorFromTag(\$o{tag}) eq colorFromTag(\$a{tag}); #______________________________________________________________________ # Intersect circle and circle # r,R: Radii of circles. # D: Distance between centers. # d: Half of major axis of chord of intersection # e: Distance to chord from one center # T: Angle of line drawn through centers to horizontal. # t: Half angle subtended by 'd' from center of one circle # sin(a+b) = sin(a)cos(b)+cos(a)sin(b) # sin(a-b) = sin(a)cos(b)-cos(a)sin(b) # cos(a+b) = cos(a)cos(b)-sin(a)sin(b) # cos(a-b) = cos(a)cos(b)+sin(a)sin(b) #______________________________________________________________________ if (\$a{type} eq 'circle' and \$o{type} eq 'circle') {my \$r = radiusOfCircle(\$a); my \$R = radiusOfCircle(\$o); my (\$cx, \$cy) = centerOfCircle(\$a); my (\$Cx, \$Cy) = centerOfCircle(\$o); my \$D = sqrt((\$cx-\$Cx)**2+(\$cy-\$Cy)**2); # Distance between two centers next if \$D > \$R+\$r; # Too far apart to intersect next if \$D < \$ps; # Too close to intersect my \$dd = \$R*\$R - (\$R*\$R-\$r*\$r+\$D*\$D)**2/(4*\$D*\$D); # Half chord width squared my \$d = sqrt(abs(\$dd)); # Half chord width my \$e = sqrt(\$r*\$r - \$dd); # Distance to half chord from center of circle my \$cosT = (\$Cx-\$cx) / \$D; # cos(T) my \$sinT = (\$Cy-\$cy) / \$D; # sin(T) my \$sint = \$d/\$r; my \$cost = \$e/\$r; my \$sinTpt = \$sinT*\$cost+\$cosT*\$sint; my \$cosTpt = \$cosT*\$cost-\$sinT*\$sint; my \$sinTmt = \$sinT*\$cost-\$cosT*\$sint; my \$cosTmt = \$cosT*\$cost+\$sinT*\$sint; my @i = ([\$cx+\$cosTpt*\$r, \$cy+\$sinTpt*\$r], [\$cx+\$cosTmt*\$r, \$cy+\$sinTmt*\$r]); for my \$i(@i) {my (\$x, \$y) = @\$i; my \$t = drawPoint(\$x, \$y, ["intersectCircle\$a{tag}Circle\$o{tag}"]); push @obj, {%\$t, intersectCircles=>[\$a, \$o]}; } } #______________________________________________________________________ # Intersect line and line #______________________________________________________________________ if (\$a{type} eq 'line' and \$o{type} eq 'line') {my @a = coordsOfLine(\$a); my @o = coordsOfLine(\$o); my (\$x, \$y) = line::intersection(@a, @o); next unless defined \$x; my \$t = drawPoint(\$x, \$y, ["intersectLine\$a{tag}Line\$o{tag}"]); push @obj, {%\$t, intersectLines=>[\$a, \$o]}; } #______________________________________________________________________ # Intersect line and circle # Find the point on the line closest to the center of the circle. # This point is midway between the two intersection points. #______________________________________________________________________ if ((\$a{type} eq 'line' and \$o{type} eq 'circle') or (\$o{type} eq 'line' and \$a{type} eq 'circle')) {my %l = %a; %l = %o if \$o{type} eq 'line'; my %c = %o; %c = %a if \$a{type} eq 'circle'; my @l = coordsOfLine(\%l); my @c = centerOfCircle(\%c); my \$r = radiusOfCircle(\%c); my (\$X, \$Y) = line::pointOnLineClosestToPoint(@l, @c); next unless defined \$X; my \$dd = (\$c[0]-\$X)**2+(\$c[1]-\$Y)**2; # Distance squared from midway to center next if sqrt(\$dd) > \$r; # Check actually intersects circle my \$d = sqrt(\$r**2-\$dd); # Distance from midway to circumference my (\$ux, \$uy) = line::unitVectorAlongLine(@l); my \$t1 = drawPoint(\$X + \$d * \$ux, \$Y + \$d * \$uy, ["intersectLine\$l{tag}Circle\$c{tag}"]); push @obj, {%\$t1, intersectLineCircle=>[\%l, \%c]}; my \$t2 = drawPoint(\$X - \$d * \$ux, \$Y - \$d * \$uy, ["intersectLine\$l{tag}Circle\$c{tag}"]); push @obj, {%\$t2, intersectLineCircle=>[\%l, \%c]}; } } } } #______________________________________________________________________ # Redraw all points to correct size #______________________________________________________________________ sub redrawAllPoints() {for my \$p(@obj) {my %p = %\$p; next unless \$p{type} eq 'point' and !defined \$p{reuse}; my @i = \$c->coords(\$p{tag}); my (\$x, \$y) = coordsOfPoint(\$p{tag}); \$c->coords(\$p{tag}, \$x-\$ps, \$y-\$ps, \$x+\$ps, \$y+\$ps); } } #______________________________________________________________________ # Draw point unless very close to an existing point #______________________________________________________________________ sub drawPoint(\$\$) {my \$x = shift; # X coord my \$y = shift; # Y coord my \$t = shift; # Array of tags my @n = \$c->find(overlapping=>\$x-\$ps, \$y-\$ps, \$x+\$ps, \$y+\$ps); for my \$n(@n) {my @t = \$c->gettags(\$n); my %t; for my \$t(@t) {\$t{\$t} = 1}; if (\$t{point} and \$t{\$drawColor}) {my (\$cx, \$cy) = coordsOfPoint(\$n); my \$d = (\$cx-\$x)**2+(\$cy-\$y)**2; return {type=>'point', reuse=>\$n} if \$d < \$near; } } my \$p = \$c->createOval(\$x-\$ps, \$y-\$ps, \$x+\$ps, \$y+\$ps, -tags=>['point', \$drawColor, @\$t], -outline=>\$drawColor, -fill=>'white', -activefill=>'green', -disabledfill=>'yellow'); \$c->bind(\$p, "", [\&doubleButtonPress1Point, \$p]); return {type=>'point', tag=>\$p}; } #______________________________________________________________________ # Configure start point #______________________________________________________________________ sub configureStartPoint(\$\$) {my (\$x, \$y) = @_; if ((\$x-\$bx)**2+(\$y-\$by)**2 < \$ps*\$ps) {\$c->itemconfigure('startPoint', -fill=>'red'); return 1; } else {\$c ->itemconfigure('startPoint', -fill=>'green'); return 0; } } #______________________________________________________________________ # Coords of line from tag #______________________________________________________________________ sub coordsOfLine(\$) {my \$l = shift; # Line return \$c->coords(\$l->{tag}); } #______________________________________________________________________ # Radius of circle from tag #______________________________________________________________________ sub radiusOfCircle(\$) {my \$C = shift; # Circle my (\$x1, \$y1, \$x2, \$y2) = \$c->coords(\$C->{tag}); return abs(\$x2 - \$x1) / 2; } #______________________________________________________________________ # Center of circle from tag #______________________________________________________________________ sub centerOfCircle(\$) {my \$C = shift; # Circle my (\$x1, \$y1, \$x2, \$y2) = \$c->coords(\$C->{tag}); return ((\$x1+\$x2)/2, (\$y1+\$y2)/2); } #______________________________________________________________________ # Coord of point from tag #______________________________________________________________________ sub coordsOfPoint(\$) {my \$p = shift; # Tag of point my (\$x1, \$y1, \$x2, \$y2) = \$c->coords(\$p); unless (\$x1) {print "p=\$p\n"; dd(); } return ((\$x1+\$x2)/2, (\$y1+\$y2)/2); } #______________________________________________________________________ # Color of object from tag #______________________________________________________________________ sub colorFromTag(\$) {my \$t = shift; # Tag my \$type = \$c->type(\$t); my \$cl; \$cl = \$c->itemcget(\$t, -fill=>) if \$type eq 'line'; \$cl = \$c->itemcget(\$t, -outline=>) if \$type eq 'oval'; return \$cl; } #______________________________________________________________________ # Dump all objects #______________________________________________________________________ sub dd(\$) {my \$l = shift; # Title print "\n"; print "\$l\n" if \$l; my @t = \$c->find(withtag=>'all'); for my \$t(@t) {my @v = \$c->gettags(\$t); if (@v) {my @co = \$c->coords(\$t); print "\$t:", join(' ', @v), "\n coords:", join(' ', @co), "\n"; } } } #______________________________________________________________________ # Undo #______________________________________________________________________ sub undo() {\$objoff = scalar(@obj) unless defined(\$objoff); \$objoff-- if \$objoff > 0; for(;\$objoff >= 0; --\$objoff) {return if \$objoff < 0; my %o = %{\$obj[\$objoff]}; my \$t = ''; \$t = \$o{tag} if defined(\$o{tag}); if (\$o{type} eq 'commit') {return; } \$c->itemconfigure(\$o{tag}, -state=>'disabled'); } } #______________________________________________________________________ # Redo #______________________________________________________________________ sub redo() {return unless defined(\$objoff); \$objoff++ if \$objoff < scalar(@obj); for(;\$objoff < scalar(@obj);++\$objoff) {my %o = %{\$obj[\$objoff]}; my \$t = ''; \$t = \$o{tag} if defined(\$o{tag}); if (\$o{type} eq 'commit') {return; } \$c->itemconfigure(\$o{tag}, -state=>'normal'); } } #______________________________________________________________________ # Main #______________________________________________________________________ \$g = gs::new(); \$g->set qw(display title Geops); # X size of display \$g->set qw(display x 1000); # X size of display \$g->set qw(display y 1000); # Y size of display \$g->set qw(display near 0.001); # Near enough to be considered the same \$g->set qw(user point size 5); # Point representation size \$g->set qw(user point capture 10); # Point representation size #______________________________________________________________________ # Create display #______________________________________________________________________ \$m = MainWindow->new(); \$m->title(\$g->get(qw(display title))); \$g->set(qw(display main), \$m); \$m->OnDestroy(sub {\$mm->destroy() if defined(\$mm)}); \$c = \$m->Canvas( -background => 'white', -width => \$g->get(qw(display x)), -height => \$g->get(qw(display y)), -cursor=>'crosshair'); \$g->set(qw(display canvas), \$c); \$c->pack(-expand=>1, -fill=>'both'); \$balloon = \$m->Balloon(); # Help balloon #______________________________________________________________________ # Data #______________________________________________________________________ \$ps = \$g->get qw(user point size); # Point size \$pc = \$g->get qw(user point capture); # Point capture size \$near = \$g->get qw(display near); # Near enough to be the same \$bx = undef; # Button down X \$by = undef; # Button down Y @obj = (); # List of objects @drawColor = qw/DarkRed Red DeepPink Magenta OrangeRed Orange Gold Yellow Cyan Green DarkGreen Purple Blue DarkBlue Black/; \$drawColor = 'Black'; # Current color \$drawWidth = 3; # Current drawing width \$drawDash = ''; # Dash scheme \$showColor->{\$drawColor} = 1; # Activate current color \$gs = '/gs/"gs8.11"/bin/gswin32c.exe -sDEVICE=jpeg -SOutputFile=XXX -dBATCH -dNOPAUSE zzz.ps'; #______________________________________________________________________ # Bindings #______________________________________________________________________ \$c->CanvasBind("", \&buttonPress); \$c->CanvasBind("", \&buttonRelease); \$c->CanvasBind("", \&button1Motion); \$c->CanvasBind("", \&button2Motion); \$c->CanvasBind("", \&button3Motion); \$c->CanvasBind('all', "", \&mouseWheel); \$m->bind("", \&undo); \$m->bind("", \&redo); \$m->bind("", \&doubleButtonPress1Point); #______________________________________________________________________ # Display #______________________________________________________________________ MainLoop;