Arjen Markus (12 january 2005) From time to time I need to draw a diagram, preferably using some electronic medium, because then it can be incorporated in a document. I thoroughly dislike most drawing programs, as I am distracted by them: I want to make a horizontal line exactly horizontal, or the box should be shifted half a centimeter. In short: I spent too much time worrying about the layout, rather than the contents.
So, drawing via plot commands is much more to my liking: I can sketch the diagram on paper, using a pencil, figure out the coordinates and type the commands into a small file. Then inspect the result visually and fiddle a bit. Done.
Except that determining the coordinates can be nasty.
Here is a simple script that illustrates a way out:
Okay, nothing grant (yet). But it was a one-hour job to get it up and running from scratch :)
# 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]]