Drawing geometrical objects

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:

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

Okay, nothing grant (yet). But it was a one-hour job to get it up and running from scratch :)

AK: Heh, I did some of my logos in POVray, just because it was possible to specify stuff geometrically instead of drawing by hand. So yes, I also prefer to specify diagrams in text. I guess I can work directly with coordinates, but having higher level help will be cherished.


 # 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