- define points and lines and circles as individual objects
- allow their manipulation via simple computations and operations

# draw_geometry.tcl -- # Draw and manipulate (plane) geometrical objects. Well, it is # merely an illustration of what I mean by "geometrical drawing app" # # PixelPoint -- # Compute pixel coordinates # Arguments: # x X-coordinate/point # y Y-coordinate/point # type Type of object # Result: # List of pixel coordinates # proc PixelPoint {x {y {}} {type {}}} { if { $y == {} } { set px [lindex $x 1] set py [lindex $x 2] return [list [expr {$px*100+200}] [expr {-$py*100+200}]] } if { $type == "oval" } { return [list [expr {$x*100+200-2}] [expr {-$y*100+200-2}] \ [expr {$x*100+200+2}] [expr {-$y*100+200+2}]] } } # point -- # Create (and draw) a point at given coordinates # Arguments: # x X-coordinate # y Y-coordinate # Result: # A point at the given coordinates # proc point {x y} { .c create oval [PixelPoint $x $y oval] -fill black return [list POINT $x $y] } # line -- # Create (and draw) a line through two points # Arguments: # point1 First point # point2 Second point # Result: # A line through the two points # proc line {point1 point2} { .c create line [concat [PixelPoint $point1] [PixelPoint $point2]] -fill black return [list LINE $point1 $point2] } # circle -- # Create (and draw) a circle at given coordinates # Arguments: # point Centre of the circle # rad Radius # Result: # A circle at the given centre and given radius # proc circle {point rad} { set x [lindex $point 1] set y [lindex $point 2] set p1 [list POINT [expr {$x+$rad}] [expr {$y+$rad}]] set p2 [list POINT [expr {$x-$rad}] [expr {$y-$rad}]] .c create oval [concat [PixelPoint $p1] [PixelPoint $p2]] -outline black return [list CIRCLE $point $rad] } # distance -- # Compute the distance between two objects # Arguments: # obj1 Point, line, ... # obj2 Point, line, ... # Result: # Distance between the given objects (now: only points) # proc distance {obj1 obj2} { if { [lindex $obj1 0] == "POINT" } { set px1 [lindex $obj1 1] set py1 [lindex $obj1 2] if { [lindex $obj2 0] == "POINT" } { set px2 [lindex $obj2 1] set py2 [lindex $obj2 2] return [expr {hypot($px2-$px1,$py2-$py1)}] } else { error "Types unsupported" } } else { error "Types unsupported" } } # inprod -- # Compute the inproduct of two vectors # Arguments: # vect1 First vector # vect2 Second vector # Result: # Inproduct # proc inprod {vect1 vect2} { set vx1 [lindex $vect1 1] set vy1 [lindex $vect1 2] set vx2 [lindex $vect2 1] set vy2 [lindex $vect2 2] return [expr {$vx1*$vx2+$vy1*$vy2}] } # pointonline -- # Compute the coordinates of a point on a line # Arguments: # line Line in question # lambda Parameter value # Result: # Point on the line # proc pointonline {line lambda} { set v [vectorfromline $line] set vx [lindex $v 1] set vy [lindex $v 2] set px [lindex $line 1 1] set py [lindex $line 1 2] set x [expr {$px+$lambda*$vx}] set y [expr {$py+$lambda*$vy}] return [point $x $y] ;# Make it visible } # vectorfromline -- # Compute the directional vector of a line # Arguments: # line Line in question # Result: # Vector in the direction of the line # proc vectorfromline {line} { set px1 [lindex $line 1 1] set py1 [lindex $line 1 2] set px2 [lindex $line 2 1] set py2 [lindex $line 2 2] set vx [expr {$px2-$px1}] set vy [expr {$py2-$py1}] return [list VECTOR $vx $vy] } # diffvector -- # Compute the vector from one point to the next # Arguments: # point1 First point # point2 Second point # Result: # Vector # proc diffvector {point1 point2} { set px1 [lindex $point1 1] set py1 [lindex $point1 2] set px2 [lindex $point2 1] set py2 [lindex $point2 2] set vx [expr {$px2-$px1}] set vy [expr {$py2-$py1}] return [list VECTOR $vx $vy] } # normal -- # Compute the normal vector to another vector or a line # Arguments: # obj Directed object # Result: # Vector normal to the direction of the object # proc normal {obj} { if { [lindex $obj 0] == "LINE" } { set obj [vectorfromline $obj] } set vy [expr {-[lindex $obj 1]}] set vx [lindex $obj 2] set len [expr {hypot($vx,$vy)}] return [list VECTOR [expr {$vx/$len}] [expr {$vy/$len}]] } # intersect -- # Compute the intersection between two objects # Arguments: # obj1 line, circle, ... # obj2 line, circle, ... # Result: # One point or a collection of points (now: only lines) # proc intersect {obj1 obj2} { if { [lindex $obj1 0] == "LINE" } { # # Construct the equation for the line obj1 # set n1 [normal $obj1] set p1 [lindex $obj1 1] if { [lindex $obj2 0] == "LINE" } { # # Get the parametrisation of the line obj2 # set v2 [vectorfromline $obj2] set p2 [lindex $obj2 1] set lambda [expr {[inprod [diffvector $p2 $p1] $n1]/ \ [inprod $v2 $n1]}] return [pointonline $obj2 $lambda] } else { error "Types unsupported" } } else { error "Types unsupported" } } # # Create the standard canvas # pack [canvas .c -width 400 -height 400 -bg white] # # Simple illustration: # Define two lines, get their intersection and draw a circle with that # point as the centre. # set P1 [point 0 0] set P2 [point 1 1] set P3 [point 1 0.5] set P4 [point 0.1 0.5] set L1 [line $P1 $P2] set L2 [line $P3 $P4] set P5 [intersect $L1 $L2] puts $P5 set r [distance $P2 $P1] set C [circle $P5 $r]

Lars H, 13 Jan 2005: One of the more advanced programs for this style of drawing is John Hobby's MetaPost [1], which is just fantastic for some types of diagrams!One of its (language-wise) more interesting feature is the built-in automatic linear equation system solver, using which the above calculation of P5 from P1 through P4 could be written as

if 0 { P5 = whatever[P1,P2] = whatever[P3,P4]; }(The first equation states that P5 is some point on the line through P1 and P2, the second equation that it is also some point on the line through P3 and P4.) The way it works is that variables are unknowns until enough equations have been given to determine their value, at which point they without further ado get set to that value. None of which has anything to do with Tcl ...... although if someone would go through the trouble of implementing the algorithm in Tcl, then I bet it would be a really fun addition to tcllib.AK: Historical information: MetaPost is a direct descendant of MetaFont by Donald E. Knuth. The frontend is basically the same AFAIK, but the backend was changed from Knuth's raster format to PostScript. MetaFont is used to generate raster fonts for TeX from character specifications. The best-known fonts specified in MetaFont is Knuth's series of "Computer Modern" fonts.

AM (28 January 2005) Here is another experiment: Drawing diagrams

See also Geometry