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 :) }

 # See also: Toy cars - https://wiki.tcl-lang.org/12266

  proc Help {} {
    set msg "Buttons:\n"
    append msg "!   - Redraw\n"
    append msg "<-> - Mirror\n"
    append msg "C   - Clear text and image\n\n"
    append msg "Click to insert mouse-coordinates into text-area.\n\n"
    append msg "Drawing commands:\n"
    append msg "line x1 y1  x2 y2 -width xx\n"
    append msg "rect x1 x2  y1 y2 -fill xxx\n"
    append msg "poly x1 y1  x2 y2 -fill xxx -outline xxx\n";
    append msg "text x y -text xxxx.\n"
    append msg "oval x1 y1  x2 y2 -width xx -fill xxx -outline xxx\n"
    tk_messageBox -title "Toycar-Workshop" -message $msg
  }

  proc Demo1 {} {  ;# Demo-Toycar: Steamroller
    .t insert end "\
    oval  0 -30 30 0 -fill red -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 red -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\n"
    render'car .t .c
  }

  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
        if {[string first "#" $line] == 0} 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}
  button .f.d   -text Demo -width 5 -command {Demo1}
  button .f.?   -text ?    -width 5 -command {Help} 

  eval pack [winfo children .f] -side left
  pack configure .f.d .f.?      -side right
  pack [text .t -height 16] -fill both -expand 1
  focus .t
  Demo1    ;# Demo-Toycar, so the "app" doesn't look so empty

#-- Little development/debugging helpers

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

if 0 { 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.

HJG Added some help, and a button to get a fresh copy of the demo. Also, you can now comment-out a drawing-command with a "#" as the first character in the line.

RS The help text is a good idea. Note however that multi-line strings can be done easier in Tcl (easier to read and maintain):

    set msg "Buttons:
    !   - Redraw
    <-> - Mirror
    C   - Clear text and image
 Click to insert mouse-coordinates into text-area.

 Drawing commands:
    line x1 y1  x2 y2 -width xx
    rect x1 x2  y1 y2 -fill xxx
    poly x1 y1  x2 y2 -fill xxx -outline xxx
    text x y -text xxxx.
    oval x1 y1  x2 y2 -width xx -fill xxx -outline xxx
    "

}