Version 6 of Toy car workshop

if 0 {Richard Suchenwirth 2004-08-25 - Users of Toy cars may appreciate this little utility - it makes designing new cars easier (one might even call it poor man's CAD :-). The Canvas items can be edited in the text widget at bottom. Click the "?" button to see how it looks, on the canvas above. Moving the cursor in the canvas shows the x/y coordinates in the window title. Clicking in the canvas inserts the x/y coordinates into the text widget, at insert position, so you can sketch out a polygon. The "<->" mirrors the car in x direction, so you can check how it looks "on the other side". The "C" button clears both canvas and text.

When satisfied, just copy & paste into an editor that holds your car pool... The example shows a steamroller which sure looks a bit funny, cruising on the highway :) }

 proc render'car {text canvas} {
    $canvas delete all
    $canvas create line -200 0 200 0 -fill lightgrey
    $canvas create line 0 -100 0 100 -fill lightgrey
    foreach line [split [$text get 1.0 end] \n] {
        if {[string trim $line] eq ""} continue
        eval $canvas create $line -tag t
    }
 }
 proc center {w tag} {
    foreach {x0 y0 x1 y1} [$w bbox $tag] break
    list [expr {($x0+$x1)/2.}] [expr {($y0+$y1)/2.}]
 }
 proc int x {expr int($x)}

 pack [canvas .c -height 100] -fill x -expand 1
 .c config -scrollregion {-100 -70 200 30}
 bind .c <Motion> {wm title . [int [%W canvasx %x]],[int [%W canvasy %y]]}
 bind .c <1> {.t insert insert " [int [%W canvasx %x]] [int [%W canvasy %y]]"}
 pack [frame .f -relief sunken -borderwidth 1] -anchor w -fill x
 button .f.? -text ? -width 5 -command {render'car .t .c}
 button .f.<-> -text <-> -width 5 -command {eval .c scale t [center .c t] -1 1}
 button .f.c -text C -width 5 -command {.t delete 1.0 end; .c delete all}
 eval pack [winfo children .f] -side left
 pack [text .t -height 16] -fill both -expand 1
 focus .t
 .t insert end \
 "oval  0 -30 30 0 -fill brown -width 2
 line  15 -15 15 -35 -width 3
 poly  10 -35 30 -35 39 -15 110 -15 110  -45 10 -45 -fill orange -outline red
 text  50 -37 -text ACME
 oval  65 -40 105 0 -fill brown -width 2
 oval  84 -21 86 -19 -outline black 
 line  71 -60 71 -44 
 line 102 -60 102 -44
 rect 67 -65 107 -60 -fill brown
 oval 82 -55 91 -46 -fill bisque"

#-- Little development/debugging helpers

 bind . <Escape> {exec wish $argv0 &; exit}
 bind . <F1> {console show}

if 0 {

LES: I can't believe you came up with that! LOL! (this comment will self-destruct in 24 hours)

Brian Theado: Nice. Another, more interactive option would be to use Tkpaint. Its file format consists partially of canvas create statements which could probably be pasted into the "car pool" with little or no modification. }

Arts and crafts of Tcl-Tk programming