drawing

Abstract : Used by both the Tcl code and the PP Group's C++ code to
           create objects and display them.

Comments : The names of the calls in here are the exact ones called in the
           C++. First the object structure is created, then it is displayed.


proc tclCEdge {SourceX SourceY DestX DestY} {
    set midx [expr ((($DestX - $SourceX) / 2 ) + $SourceX)]
    set midy [expr ((($DestY - $SourceY) / 2 ) + $SourceY)]
    puts "$SourceX $SourceY $DestX $DestY $midx $midy"
    set first [.area create line $SourceX $SourceY $midx $midy \
	    -arrow last -tags {arrow edge cedge} ]
    set second [.area create line $midx $midy $DestX $DestY \
	    -tags {finish edge cedge} ]
}

proc tclAEdge {SourceX SourceY DestX DestY} {
    set space 3
    set midx [expr ((($DestX - $SourceX) / 2 ) + $SourceX)]
    set midy [expr ((($DestY - $SourceY) / 2 ) + $SourceY)]
    if {[expr ($DestX - $SourceX)] != 0} {
	set slope [expr abs((($DestY - $SourceY) * 100) / ($DestX - $SourceX))]
	puts "$slope"
	if {[expr $slope] >= 100} {
	    set xspace $space
	    set yspace 0
	} else {
	    set xspace 0
	    set yspace $space
	}
    } else {
	set xspace 0
	set yspace $space
    }

#puts "$SourceX $SourceY $DestX $DestY $midx $midy"

    set first [.area create line [expr $SourceX - $xspace] \
	    [expr $SourceY - $yspace] [expr $midx - $xspace] \
	    [expr $midy - $yspace] \
            -arrow last -tags {arrow edge aedge} ]
    set second [.area create line [expr $midx - $xspace] \
	    [expr $midy - $yspace] [expr $DestX - $xspace] \
	    [expr $DestY - $yspace] \
            -tags {finish edge aedge} ]
    set first [.area create line [expr $SourceX + $xspace] \
            [expr $SourceY + $yspace] [expr $midx + $xspace] \
            [expr $midy + $yspace] \
            -arrow last -tags {arrow edge aedge} ]
    set second [.area create line [expr $midx + $xspace] \
            [expr $midy + $yspace] [expr $DestX + $xspace] \
            [expr $DestY + $yspace] \
            -tags {finish edge aedge} ]

}

proc tclCVert {labelName labelX labelY ShapeX ShapeY} {
global INCLUDE

    set new [.area create bitmap [expr $ShapeX] [expr $ShapeY] \
	    -bitmap "@$INCLUDE/constr.xbm" -tags {node connode}]
    set newlabel [.area create text [expr $labelX] [expr $labelY] \
	    -text $labelName -tags {label conlabel}]

}

proc tclAVert {labelName labelX labelY ShapeX ShapeY} {
global INCLUDE

    set new [.area create bitmap [expr $ShapeX] [expr $ShapeY] \
            -bitmap "@$INCLUDE/alter.xbm" -tags {node altnode}]
    set newlabel [.area create text [expr $labelX] [expr $labelY] \
            -text $labelName -tags {label altlabel}]

}