ccanvas

# for example, create a diagonal line of rectangles
#   canvas create rectangle $xo $yo x+$w=:xo y+$h=:yo ... 
#   canvas create rectangle $xo $yo x+$w=:xo y+$h=:yo ... 
# note: the variable name should follow rules for use with $ (see man Tcl)
#       variable name is after the "=" and before first single ":" in the result spec
#       This makes it possible to interpret namespace qualifiers. For example:
#       3i+2c=::vv:m
#       saves result to variable vv in global namespace

package require Tk
package require snit

package provide ccanvas 0.1

snit::widgetadaptor ccanvas {

    variable scale
    # track if -height or -width options have been set
    variable optSet ""

    # a list of all canvas and canvas method options that are lengths
    typevariable lengthOpts {
	-activewidth
	-disabledwidth
	-extent
	-height
	-start
	-width

	-xscrollincrement

	-yscrollincrement
    }










    # a list of all canvas and canvas method options that are lists of lengths
    typevariable lengthListOpts {
	-arrowshape
	-scrollregion
    }

	lmap str $args {
	    set x [cuexpr $selfns $str $context $coords]
	}
    }


    # This entry to ccexpr returns a result in default units (pixels or deg)
    # the result may be saved in a variable too


    # "context" is before coords in the argument list because
    # many options have only one length parameter
    # so there is no coords list, but context is useful in many cases.





    proc cexpr {selfns expr {context 1} {coords ""}} {
	# evaluate an expression containing canvas units
	# evaluate an expression in given context using scale
	# and coords list for references to previously calculated
	# x,y coodinate pairs using x(..) or y(..)
	# when .. is negative index back from current coord
	# magic selfns argument gives access to all snit instancs variables

	}
	return $rr
    }

    
    # This entry to ccexpr returns a result in requested or default units
    # the result may be saved in a variable too
    # it is used by the expr and exprs subcommands

    proc cuexpr {selfns expr context coords} {
	# evaluate an expression containing canvas units
	# evaluate an expression in given context using scale
	# and coords list for references to previously calculated
	# x,y coodinate pairs using x(..) or y(..)
	# when .. is negative index back from current coord

	set context #[expr {[info level] - 1}]
	$hull itemconfigure $id {*}[EvalLengthOpts $selfns $context $args]
    }
	


    proc EvalLengthOpts {selfns context opts} {
	# eval length expressions in an option list
	# pass other options unchanged
	# magic selfns argument gives access to all snit instancs variables
	concat {*}[lmap {opt value} $opts {
	    if {$opt in $lengthOpts} {
		list $opt [cexpr $selfns $value $context]
	    } elseif {$opt in $lengthListOpts} {
		# can't use lmap here because expressions can refer
		# to earlier coord x, y values as coord list is built
		set coords [list]
		foreach x $value {
		    lappend coords [cexpr $selfns $x $context $coords]
		}
		list $opt $coords










	    } else {
		list $opt $value
	    }
	}]
    }

proc row {x y dx dy n def} {
    # draw a row of items generated by the command prefix in def
    # x,y coordinates are appended each time def is executed
    for {set i 0} {$i < $n} {incr i} {
	{*}$def $x $y
	.c exprs "" {$x+$dx=x} {$y+$dy=y}
    }
    # return coordinates of anchor point of last item in row
    list $x $y
}



proc jumper {coords args} {
    # draw wire (typically between holes)

    .c move $id {*}[lrange $args end-1 end]
    return $id
}


proc servoPins {} {
    # for each selected teensy pin location
    # Note serVoPin is effectively a physical pin number (starting at 0)
    #   not teensyduino pin number
    foreach servoPin { 1g 2g  4g 5g  7g 8g  10g 11g} {
	row $servoPin 4g 0g 1g 3 {pin}
    }
}

    package require Img
    catch {photo delete loi}
    image create photo loi -data .c
    loi write $fileName
    image delete loi
}

# draw rockets
# can't get open rocket to export rocket drawing
# kl2 -- draws the rocket

# note many hardware routines update and use a default x coordinate
# (when value is given as -) see [dset]
# this allows items to easily be stacked from left to right

package require Tk
#source ../../src/cdu.tcl
source ~/src/tcl/ccanvas/ccanvas.tcl
#namespace import cdu::cm

namespace eval rdraw {

    variable rd
    set rd(can) .rdraw.c
    
    proc draw {args} {

	    toplevel .rdraw
	}
	ccanvas .rdraw.c -height 50%  -width 80% -scale {60i 20i} -scrollregion {0 -10i 60i 10i}
	pack  .rdraw.c  -side top  -expand yes  -fill both
	
	set x 0
	foreach re $args {
	    puts $re
	    {*}[linsert  $re  1  .rdraw.c]
	}
    }


    proc eps {fileName} {
	# write image to a .eps file

	btc98o 3.888i
	btc139i 5.19i
	btc139o 5.338i
	btc152i 5.835i
	btc152o 5.976i
    }

    puts [llength [array get dim]]
    

    proc move {xdisp} {
	# move default position by given displacement along rocket length
	variable rd
	set rd(x) [$rd(can) expr $rd(x)+$xdisp=i]
    }


    proc moveTag {tag dx dy} {
	# move taged items by given 2D displacement
	variable rd
	$rd(can) move $tag $dx $dy
    }



    proc grid {x len width dx dy  args} {
	# draw a grid of lines
	variable rd
	set c $rd(can)
	
	dset x $x

	set x1 [$c expr $x+$len]
	set yo [$c expr $width/2+$dy]
	set y1 [$c expr -$yo]
	while {$yo >= $y1} {
	    $rd(can) create line $x $yo-$dy=yo  $x1 y  \
		-width 1  -fill lightgray  {*}$args
	}
	set x [.c expr $x-$dx]
	set yo [.c expr -$y1]
	while {$x <= $x1} {
	    $rd(can) create line $x+$dx=x $yo  x $y1  \
		-width 1  -fill lightgray  {*}$args
	}
    }
	

    # routines to draw hardware
    # most allow a default x coordinate (-) to position new item after last one

    proc washer3/8-2 {x args} {
	washer $x 2i 7i/16 1i/16 {*}$args
    }


    # !!! unused
    proc fill {x do L args} {
	# generalized body filling
	# rounded rectangle
	variable rd
	set c $rd(can)
	
	set lopts [lineOpts {*}$args]

	$c create arc $xc -$y0  $xa -$y2  \
	    -type arc  -start 0  -extent 90  -width 3  {*}$args
	$c create arc $xc $y0  $xa $y2  \
	    -type arc  -start 270  -extent 90  -width 3  {*}$args
	$c create line $xc $y1  $xc -$y1  -width 3  {*}$lopts
	$c create line $x1 $y1  $xb -$y1  -width 3  {*}$lopts
	$c create line $x1 $y1  $xb -$y1  -width 3  {*}$lopts
	$c expr $x+$L=i
    }


    proc elipticalNose {do L args} {
	variable rd
	set c $rd(can)
	dset x $L

	dset x $x

	# flange
	set t [$c expr $fthick/2]
	$c create line $x-$t=xx $fod/2=y  x -y  \
	    -width $fthick  -fill gray  {*}$args
	# body
	puts tnut
	puts [$c create line  $x $tid/2+$t=r  $x+$Len=xx y  \
		  -width $fthick  -fill gray  {*}$args]
	puts [$c create line $x -$r  $xx y  \
		  -width $fthick  -fill gray  {*}$args]
	# leave reference point alone
	#dset x $xx
    }


    proc tnut3/8> {x args} {
	tnut> $x 1i 1i/16 7i/16 1i/2 {*}$args

	# eye (extent angle chosen to almost close the eye)
	$c create arc $x1 -$r  $x1+$eyed=x2 -y  -style arc  -width $rodd  \
	    -start 225  -extent 305  -outline gray {*}$args

	# join curve and eye (with fat line at 45 deg)
	set dd [$c expr $r/sqrt(2)]
	puts [$c create line  $xx+$dd-1  $r-$dd-1  $x1+$r-$dd+1  $dd+1  \
		  -width $rodd  -fill gray  {*}$args]
	
	dset x $x2
    }


    proc <eyeBolt3/8-6 {x args} {
	<eyeBolt $x 3i/8 6i 11i/8 {*}$args

	btc54 $nref 0.5i
	set tref [dget x]
	cr - $dim(btc54o) 7i/16 0.5i
	set wref [dget x]
	btc54 - 5i
	
	#<eyeBolt $nref 3i/8 6i 1i
	puts eyebolt
	<eyeBolt3/8-6 $nref 
	#tnut> $tref 1i 1i/16 3i/8 7i/16
	tnut3/8> $tref
	#nut $wref 0.625i 3i/8 0.25i
	nut3/8 $wref
	washer3/8-2 -
	# weight (actually a stack of washers)
	re - 1.5i 7i/16 1.75i -fill gray -outline black
	#nut - 0.625i 3i/8 0.25i
	nut3/8 -
	puts eyebolt-done
	# return location of back of front section body tube
	return $bref
    }   
}


proc kl2rear {bref} {

	#motor tube front support
	cr $bkref $dim(btc98i)-0.01i $dim(btc98i)-0.5i 0.5i
	set mtref [dget x]
	cr - $dim(btc98i)-0.01i $dim(bt38o) 0.75i
	set unref [dget x]
	cr - $dim(btc98i)-0.01i  $dim(btc98i)-0.124i 0.5i
	# recovery anchor
	puts ubolt
	<ubolt $mtref-1i/16 2.5i 1i/4 2i 5i/16 1.5i
	tnut5/16> $mtref  -tags leg1
	tnut5/16> $mtref  -tags leg2
	# washer and double nut (actually nut, and drilled and wired castellated nut)
	washer $unref 0.75i 3i/8 1i/16  -tag leg1
	nut5/16  -  -tag leg1
	nut5/16  -  -tag leg1
	washer $unref 0.75i 3i/8 1i/16  -tag leg2
	nut5/16 -  -tag leg2
	nut5/16 -  -tag leg2
	# vertical displacement from center line to center of ubolt rods
	set udisp [$c expr (2.5i+9i/32)/2] 
	moveTag leg1 0 $udisp
	moveTag leg2 0 -$udisp
	puts "ubolt-done  $udisp [$c expr -$udisp]"

	# motor case
	bt38 $mtref 25.125i
	aeroPackRetainerBody - -tags retainer
	pro38c -  6 -tags case
	pro38r - -tags retainer
	aeroPackRetainerCap - -tags retainer

}


proc afterCrash {} {
    variable rdraw::rd
    $rd(can) move case 2.25i 0
}

# servo switch layout
#
# Layout of servo switch/mixer on a protoboard.
# Most coordinates for larger items (busses, jumpers and etc)
# are on 0.1i grid.
# The grid origin (0,0) is centered between the leftmost pins of the teensy.
#
# draw -- draws the board layout

package require ccanvas

destroy .c

ccanvas .c -height 50% -width 30% -scale {2.7i 2.2i} \
    -scrollregion {-.5i -1i 2.2i 1.2i}

pack .c  -side top  -fill both  -expand yes

# draw background color rectangle to give dark background on postscript file
.c create rectangle [.c cget -scrollregion] -fill darkslategray

# define convenient unit (g for grid) for drawing on a 0.1 inch grid
.c addLengthUnit g 0.1i


proc row {x y dx dy n def} {
    # draw a row of items generated by the command prefix in def
    # x,y coordinates are appended each time def is executed
    for {set i 0} {$i < $n} {incr i} {
	{*}$def $x $y
	.c exprs "" {$x+$dx=x} {$y+$dy=y}
    }
    # return coordinates of anchor point of last item in row
    list $x $y
}



proc jumper {coords args} {
    # draw wire (typically between holes)
    # coords must be a list
    .c create line  $coords  -width 0.2g  -fill cyan  \
	-capstyle round  -joinstyle round  {*}$args
}



# draw prototype board busses

proc hole {args} {
    # draw a 0.03i diameter hole centered at last two args x,y
    # other args are canvas item options
    set d 0.03i
    .c create oval [lindex $args end-1]-$d/2  \
	[lindex $args end]-$d/2  \
	x+$d  y+$d  \
	-fill darkslategray  -tags hole  {*}[lrange $args 0 end-2]
}


proc bus {xo yo dx dy args} {
    # draw a bus bar
    # lengths dx and dy must not be negative
    # busses go right or down from xo,yo
    .c create line  $xo  $yo  \
	x+max(0,$dx)=xx  y+max(0,$dy)=yy  \
	-width 0.5g  -capstyle projecting  -fill gray {*}$args
    # return coordinates of last grid point in bus
    list $xx $yy
}


proc text {x y txt args} {
    # draw text at given coordinates
    # default to white and west anchor
    .c create text  $x $y  -text $txt  -fill white  -anchor w  {*}$args
}

    
proc pwrBusses {} {
    # draw busses with labels 0.05i off right end
    text {*}[.c exprs [bus -5g -2g 24g 0g] x+0.5g y] "+5V" -anchor w
    row -5g -2g 1g 0g 25 {hole}

    bus -5g -1g 24g 0g
    row -5g -1g 1g 0g 25 {hole}

    text {*}[.c exprs [bus -5g 5g 24g 0g] x+0.5g y] "SERVO+" -anchor w
    row -5g 5g 1g 0g 25 {hole}

    text {*}[.c exprs [bus -5g 6g 24g 0g] x+0.5g y] "GND" -anchor w
    row -5g 6g 1g 0g 25 {hole}
}


proc pinBus {n x y} {
    # given first pin center coordinate (x y)
    # and number of pins to draw downward
    # pins are on a 0.1 inch grid
    bus $x $y 0g ($n-1)*1g
    row $x $y 0g 1g $n {hole}
}


proc pinBusses {} {
    # actually draws rows of pin busses
    row -5g 7g 1g 0g 25 {pinBus 5}
    row -5g 0g 1g 0g 25 {pinBus 5}
    row -5g -7g 1g 0g 25 {pinBus 5}
}


# components


proc circle {x y d args} {
    # draw circle of diameter d centered at x y
    .c create oval $x-$d/2  $y-$d/2   x+$d y+$d  \
	-fill red  -tags comp  {*}$args
}



# MCP-1702 voltage regulator
# ground pin to left
# Vin centered (at x y)
# Vout to right
proc voltReg {x y args} {
    # radius of circular half
    set R 1g
    # height of square half
    set h 0.6g
    .c create arc $x-$R $y-$R  $x+$R $y+$R  \
	-start 0  -extent 180  -style arc  -outline red  -tags {mcp1702 vr}  \
	{*}$args
    .c create line $x-$R $y  x y+$h  x+2*$R y  x $y  \
	-fill red  -tags {mcp1702 vr}  {*}$args
}


# teensy tie points

proc pinHole {args} {
    # one plated through hole
    # x, y are last two arguments
    set id [.c create oval -0.025i x() -x -y \
		-width 0.005i  -outline yellow  -tags pinHole \
		{*}[lrange $args 0 end-2]]
    .c move $id {*}[lrange $args end-1 end]
    return $id
}


proc t4.0 {} {
    # draw teensy 4.0
    .c create rectangle -0.075i -0.125i x+0.375i y+0.25i -outline white
    .c create rectangle -0.05i -0.35i x+1.4i y+0.7i -outline white
    .c create text 0.05i 0  -text "USB"  -anchor c  -fill white
    .c create text 0.65i 0  -text "TEENSY 4.0"  -anchor c  -fill white
    row 0g -3g  1g 0g  14  {pinHole -tags pinHole}
    .c dup pinHole -addtags morePins
    .c move morePins 0 6g
    .c dtag morePins
}


proc pin {args} {
    # draw 0.025 inch square pin
    # default to red and taged pin
    # coords are last two arguments, the others are options for the pin
    set id [.c create rectangle -0.0125i x() -x -y -fill red -tags pin \
		{*}[lrange $args 0 end-2]]
    .c move $id {*}[lrange $args end-1 end]
    return $id
}


proc servoPins {} {
    # for each selected teensy pin location
    # Note serVoPin is effectively a physical pin number (starting at 0)
    #   not teensyduino pin number
    foreach servoPin { 1g 2g  4g 5g  7g 8g  10g 11g} {
	row $servoPin 4g 0g 1g 3 {pin}
    }
}



proc draw {} {
    pwrBusses
    pinBusses
    t4.0
    servoPins
    voltReg 15g 2g -width 0.01i
    jumper {-1g -2g  -1g -4g  0g -4g}
    jumper {0g 4g  0g 6g}
    jumper {14g 4g  14g 6g}

    # diode
    circle 15g 4g 1g -fill red
    jumper {15g 4g 15g 5g}

    # Cin
    circle 14.5g 0g 1.5g  -fill orange
    
    jumper {16g 0g  16g -2g}

    # Cout
    jumper {16g 6g 16g 4g}
    circle 16g 5g 1.5g  -fill orange

    # light sensor input
    # resistor
    circle 3g -4g 1g  -fill brown
    jumper {2g -4g 3g -4g}
    jumper {1g -4g  1g -9g}  -fill pink
    jumper {3g -5g  3g -9g}  -fill pink

    # labels
    text 2g -9g  "LIGHT SENSOR"  -anchor s  -fill white
    text 2g -7.25g  "+3.3V"  -anchor s  -fill white

    text 1g 7g  "GPS L"  -anchor e -angle 90 -fill white
    text 2g 7g  "GPS R" -anchor e -angle 90 -fill white
    text 4g 7g  "RADIO L" -anchor e -angle 90 -fill white
    text 5g 7g  "RADIO R" -anchor e -angle 90 -fill white
    text 7g 7g  "FLAPS" -anchor e -angle 90 -fill white
    text 8g 7g  "GPS SEL" -anchor e -angle 90 -fill white
    text 10g 7g  "LEFT OUT" -anchor e -angle 90 -fill white
    text 11g 7g  "RIGHT OUT" -anchor e -angle 90 -fill white
}


proc ps {{fileName layout.ps}} {
    # generate postscript file image in lower left corner of page
    # scaled to be 7 inches wide
    .c postscript -file $fileName  -pageanchor sw  -pagex 0 -pagey 0 \
	-pagewidth 7i
}


proc png {{fileName layout.png}} {
    # write layout to a .png file
    # less font sillyness than for .ps files
    package require Img
    catch {photo delete loi}
    image create photo loi -data .c
    loi write $fileName
    image delete loi
}