obj method canvaseditor buildMenu {} {
variable level
set canvas [my canvas]
destroy $canvas.context
menu $canvas.context
#
# Selection
#
$canvas.context add cascade -label select\
-menu [menu $canvas.context.sel -tearoff no]
#
$canvas.context.sel add command -label Info\
-command "$self buildInfoWindow"
$canvas.context.sel add separator
$canvas.context.sel add cascade -label Select\
-menu [menu $canvas.context.sel.select -tearoff no]
#
$canvas.context.sel.select add command -label Enclosed\
-command "$self createSelRect enclosed"
$canvas.context.sel.select add command -label Overlapping\
-command "$self createSelRect overlapping"
$canvas.context.sel.select add command -label Toggle -command [list apply {
self {
$self select {*}[$self elements]
}
} $self]
$canvas.context.sel.select add command -label Connected -command [list apply {
self {
set chain {}
foreach obj [$self selected] {
if {[$obj isa line]} then {
$self select $obj
if {$obj ni $chain} then {
lappend chain {*}[$obj chainedList]
}
}
}
if {$chain ne {}} then {
$self select {*}$chain
}
}
} $self]
$canvas.context.sel.select add command -label None\
-command "$self select"
$canvas.context.sel add separator
#
# Move
#
$canvas.context.sel add cascade -label Move\
-menu [menu $canvas.context.sel.move -tearoff no]
#
$canvas.context.sel.move add command -label Free\
-command "$self moveMode both"
$canvas.context.sel.move add command -label Horizontal\
-command "$self moveMode horizontal"
$canvas.context.sel.move add command -label Vertical\
-command "$self moveMode vertical"
#
# Scale
#
$canvas.context.sel add cascade -label Scale\
-menu [menu $canvas.context.sel.scale -tearoff no]
#
$canvas.context.sel.scale add command -label Free\
-command "$self scaleMode both"
$canvas.context.sel.scale add command -label Proportional\
-command "$self scaleMode proportional"
$canvas.context.sel.scale add command -label Horizontal\
-command "$self scaleMode horizontal"
$canvas.context.sel.scale add command -label Vertical\
-command "$self scaleMode vertical"
#
# Rotate
#
$canvas.context.sel add cascade -label Rotate\
-menu [menu $canvas.context.sel.rotate -tearoff no]
$canvas.context.sel.rotate add command -label Periphery\
-command "$self rotateMode"
$canvas.context.sel.rotate add command -label Scaling\
-command "$self rotateMode yes"
#
# Shear
#
$canvas.context.sel add cascade -label Shear\
-menu [menu $canvas.context.sel.shear -tearoff no]
#
$canvas.context.sel.shear add cascade -label Horizontal\
-menu [menu $canvas.context.sel.shear.h -tearoff no]
#
$canvas.context.sel.shear.h add command -label Free\
-command "$self shearHmode scaling"
$canvas.context.sel.shear.h add command -label Parallel\
-command "$self shearHmode parallel"
#
$canvas.context.sel.shear add cascade -label Vertical\
-menu [menu $canvas.context.sel.shear.v -tearoff no]
#
$canvas.context.sel.shear.v add command -label Free\
-command "$self shearVmode scaling"
$canvas.context.sel.shear.v add command -label Parallel\
-command "$self shearVmode parallel"
#
$canvas.context.sel.shear add cascade -label Diagonal\
-menu [menu $canvas.context.sel.shear.d -tearoff no]
#
$canvas.context.sel.shear.d add command -label Free\
-command "$self shearMode free"
$canvas.context.sel.shear.d add command -label Parallel\
-command "$self shearMode"
$canvas.context.sel.shear.d add command -label Horizontal\
-command "$self shearMode horizontal"
$canvas.context.sel.shear.d add command -label Vertical\
-command "$self shearMode vertical"
#
# Warp
#
$canvas.context.sel add cascade -label Warp\
-menu [menu $canvas.context.sel.warp -tearoff no]
#
$canvas.context.sel.warp add command -label Free\
-command "$self warpMode both"
$canvas.context.sel.warp add command -label Horizontal\
-command "$self warpMode horizontal"
$canvas.context.sel.warp add command -label Vertical\
-command "$self warpMode vertical"
#
$canvas.context.sel add separator
#
$canvas.context.sel add cascade -label Property\
-menu [menu $canvas.context.sel.prop]
#
$canvas.context.sel.prop add cascade -label fill\
-menu [menu $canvas.context.sel.prop.fill]
$canvas.context.sel.prop.fill add command -label "Color …"\
-command "$self changeFillColor"
$canvas.context.sel.prop.fill add command -label Brighten\
-command "$self withUndo selected brighten fill 1.1"
$canvas.context.sel.prop.fill add command -label Darken\
-command "$self withUndo selected brighten fill 0.97"
$canvas.context.sel.prop.fill add command -label Transparent\
-command "$self withUndo selected configure -fill transparent"
#
$canvas.context.sel.prop add cascade -label Line\
-menu [menu $canvas.context.sel.prop.line]
$canvas.context.sel.prop.line add command -label "Color …"\
-command "$self changeLineColor"
$canvas.context.sel.prop.line add command -label Brighten\
-command "$self withUndo selected brighten outline 1.1"
$canvas.context.sel.prop.line add command -label Darken\
-command "$self withUndo selected brighten outline 0.97"
$canvas.context.sel.prop.line add command -label Transparent\
-command "$self withUndo selected configure -outline transparent"
#
$canvas.context.sel.prop add cascade -label Width\
-menu [menu $canvas.context.sel.prop.width]
for {set i 1} {$i <= 10} {incr i} {
$canvas.context.sel.prop.width add command -label $i\
-command "$self changeLineWidth $i"
}
$canvas.context.sel.prop.width add command -label Widen\
-command "$self selected wider [expr {2**(1.0/3)}]"
$canvas.context.sel.prop.width add command -label Narrow\
-command "$self selected wider [expr {2**(-1.0/3)}]"
#
$canvas.context.sel add cascade -label Constraint\
-menu [menu $canvas.context.sel.constraint -tearoff no]
$canvas.context.sel.constraint add cascade -label Add\
-menu [menu $canvas.context.sel.constraint.add -tearoff no]
$canvas.context.sel.constraint add cascade -label Remove\
-menu [menu $canvas.context.sel.constraint.remove -tearoff no]
#
foreach constr {
noprint size orient shear gravity fillcolor linecolor linewidth
} {
$canvas.context.sel.constraint.add add command\
-label [string totitle $constr]\
-command "$self withUndo selected constraint $constr yes"
$canvas.context.sel.constraint.remove add command\
-label [string totitle $constr]\
-command "$self withUndo selected constraint $constr no"
}
#
$canvas.context.sel.constraint add command -label Inspect\
-command "$self makeConstraintDialog"
#
$canvas.context.sel add command -label Numeric\
-command "$self numericDialog"
#
$canvas.context.sel add separator
#
$canvas.context.sel add cascade -label Arrange\
-menu [menu $canvas.context.sel.arrange]
#
$canvas.context.sel.arrange add command -label Left\
-command "$self withUndo align left"
$canvas.context.sel.arrange add command -label Center\
-command "$self withUndo align center"
$canvas.context.sel.arrange add command -label Right\
-command "$self withUndo align right"
$canvas.context.sel.arrange add separator
$canvas.context.sel.arrange add command -label Top\
-command "$self withUndo align top"
$canvas.context.sel.arrange add command -label Middle\
-command "$self withUndo align middle"
$canvas.context.sel.arrange add command -label Bottom\
-command "$self withUndo align bottom"
#
$canvas.context.sel.arrange add separator
$canvas.context.sel.arrange add command -label Evenly\
-command "$self alignEvenly"
#
# Stackorder
#
$canvas.context.sel add command -label Raise\
-command "$self raiseSelection"
$canvas.context.sel add command -label Lower\
-command "$self lowerSelection"
#
$canvas.context.sel add separator
#
$canvas.context.sel add command -label Colorize -command [list apply {
self {
# create fill object out of selection
set color\
[tk_chooseColor -initialcolor [$self private lastFillColor]]
if {$color ne ""} then {
set before [$self dump]
$self private lastFillColor $color
set lines [concat {*}[$self selected split yes]]
#
foreach line $lines {
foreach dot [$line dots -end] {
foreach other [$dot lines] {
if {[$other ni $lines]} then {
$line unjoin $other
break
}
}
}
}
#
set fill [obj new fill -fill $color {*}$lines]
$self select
$fill draw no
$fill draw
append before \n "$fill empty"
set after [$self dump]
$self initUndoRedo $before $after
}
}
} $self]
#
$canvas.context.sel add separator
#
# Group
#
$canvas.context.sel add command -label Group -accelerator ^g\
-command "$self createGroup"
#
$canvas.context.sel add command -label Edit\
-command "$self editSelected" -accelerator ^e
#
$canvas.context.sel add separator
#
$canvas.context.sel add cascade -label Special\
-menu [menu $canvas.context.sel.special -tearoff yes]
$canvas.context.sel.special add command -label Intersect -command [list apply {
self {
lassign [$self selected] a b
if {$a ne "" && $b ne "" && [$a isa line] && [$b isa line]} then {
set before [$self dump]
if {[$a cget -smooth] || [$b cget -smooth]} then {
$a configure -smooth yes
$b configure -smooth yes
}
lassign [$a cut $b] fracA fracB
if {$fracA ne ""} then {
set a1 [$a intersect $fracA]
set b1 [$b intersect $fracB]
$a draw
$a1 draw
$b draw
$b1 draw
$self select
$self select $a1 $b1
} else {
eval $before
return -code error {No crossing!}
}
set after [$self dump]
$self initUndoRedo $before $after
}
}
} $self]
$canvas.context.sel.special add command -label Tangens -command [list apply {
self {
lassign [$self selected] a b
if {
$a ne "" &&
$b ne "" &&
[$a isa line] &&
[$a cget -smooth] &&
[$b isa line] &&
[$b cget -smooth]
} then {
set before [$self dump]
lassign [$a tangensTo $b] l1 l2 l3
$a draw coords
$b draw coords
$l1 draw
$l2 draw
$l3 draw
$self select
$self select $l1 $l2 $l3
set after [$self dump]
$self initUndoRedo $before $after
}
}
} $self]
#
$canvas.context.sel add separator
$canvas.context.sel add command -label Save -command [list apply [list self {
set directory\
[file join [file normalize [file dirname [info script]]] lib]
file mkdir $directory
set file [tk_getSaveFile\
-initialdir $directory\
-title "Save Selection"\
-defaultextension .vectorleaf\
-filetypes {{Vectorleaf .vectorleaf}}]
if {$file ne ""} then {
set ch [open $file w]
puts $ch [$self selectionToXML]
close $ch
}
} [namespace current]] $self]
#
$canvas.context.sel add separator
#
$canvas.context.sel add command -label Duplicate -command [list apply {
self {
$self copyToClipboard
$self select
$self pasteFromClipboard
}
} $self]
#
$canvas.context.sel add separator
#
$canvas.context.sel add command -label Cut -accelerator ^x -command "
$self copyToClipboard
$self deleteSelection
"
$canvas.context.sel add command -label Copy -accelerator ^c -command "
$self copyToClipboard
$self select
"
$canvas.context.sel add command -label Delete -accelerator Del\
-command "$self deleteSelection"
#
$canvas.context.sel add separator
$canvas.context.sel add command -label Undo\
-command "$self undo" -accelerator ^z
$canvas.context.sel add command -label Redo\
-command "$self redo" -accelerator ^Z
#
# No Selection
#
$canvas.context add cascade -label noselect\
-menu [menu $canvas.context.nosel -tearoff no]
#
if {$level([my canvas]) <= 1} then {
$self buildFileMenu $canvas.context.nosel
$canvas.context.nosel add separator
} else {
$canvas.context.nosel add command -label Info\
-command "$self buildInfoWindow"
}
#
$canvas.context.nosel add cascade -label Select\
-menu [menu $canvas.context.nosel.select -tearoff no]
#
$canvas.context.nosel.select add command -label Enclosed\
-command "$self createSelRect enclosed"
$canvas.context.nosel.select add command -label Overlapping\
-command "$self createSelRect overlapping"
$canvas.context.nosel.select add command -label All\
-command [list apply {
self {
$self select {*}[$self elements]
}
} $self]
$canvas.context.nosel add separator
#
$canvas.context.nosel add cascade -label Draw\
-menu [menu $canvas.context.nosel.create -tearoff no]
#
$canvas.context.nosel.create add cascade -label Line\
-menu [menu $canvas.context.nosel.create.line -tearoff no]
$canvas.context.nosel.create.line add command -label Free\
-command "$self createLine"
$canvas.context.nosel.create.line add command -label Horizontal\
-command "$self createLine horizontal"
$canvas.context.nosel.create.line add command -label Vertical\
-command "$self createLine vertical"
#
$canvas.context.nosel.create add command -label Rectangle\
-command "$self createRectangle"
#
$canvas.context.nosel add command -label Load\
-command [list apply [list self {
set directory\
[file join [file normalize [file dirname [info script]]] lib]
file mkdir $directory
set file [tk_getOpenFile\
-initialdir $directory\
-title "Load from library"\
-defaultextension .vectorleaf\
-filetypes {{Vectorleaf .vectorleaf}}]
if {$file ne ""} then {
set ch [open $file r]
set xml [read $ch]
close $ch
set before [$self dump]
set elements [$self elements]
$self processXML $xml
set after [$self dump]
$self initUndoRedo $before $after
$self select
foreach object [$self elements] {
if {$object ni $elements} then {
$self select $object
}
}
}
} [namespace current]] $self]
#
$canvas.context.nosel add command -label Cube\
-command [list apply [list self {
variable level
if {$level([my canvas]) <= 1} then {
$self select
$self basicBindings off
$self memory before [$self dump]
set cube [::GlassCube::slider [my canvas] on]
bind [my canvas] <Escape> "
::GlassCube::slider [my canvas] off
$self basicBindings
destroy [my canvas].cubeDone
$self memory after \[$self dump\]
$self initUndoRedo \[$self memory before\] \[$self memory after\]
"
bind [my canvas] <3>\
"tk_popup [menu [my canvas].cubeDone -tearoff no] %X %Y"
#
[my canvas].cubeDone add command -label Copy\
-command [subst -novariable {
clipboard clear
clipboard append\
"Horizontal: $::GlassCube::phi Vertical: $::GlassCube::chi"
}]
#
[my canvas].cubeDone add command -label Numeric\
-command [list apply {
{menu canvas} {
set numeric $menu.numeric
destroy $numeric
toplevel $numeric
wm transient $numeric [winfo toplevel $canvas]
wm title $numeric "Base Cube"
wm resizable $numeric no no
grid\
[label $numeric.hL -text Horizontal]\
[entry $numeric.h -textvariable ::GlassCube::phi]\
-sticky e
grid\
[label $numeric.vL -text Vertical]\
[entry $numeric.v -textvariable ::GlassCube::chi]\
-sticky e
bind $numeric.h <Return> ::GlassCube::glassCube
bind $numeric.v <Return> [bind $numeric.h <Return>]
lassign\
[split [winfo geometry [winfo toplevel $canvas]] +x]\
w h x y
if {$x >= 0 && $y >= 0} then {
wm geometry $numeric +$x+$y
}
}
} [my canvas].cubeDone [my canvas]]
#
[my canvas].cubeDone add command -label Done\
-command "event generate [my canvas] <Escape>"
# $self buildInfoWindow
$self statusLine "Editing base cube"
}
} [namespace current]] $self]
#
$canvas.context.nosel add separator
#
$canvas.context.nosel add cascade -label Preview\
-menu [menu $canvas.context.nosel.preview -tearoff no]
$canvas.context.nosel.preview add command -label Window\
-command "
$self basicBindings off
$self statusLine Non-printing objects are now invisible. Click to finish.
$self elements hide
$self canvas configure -cursor X_cursor
bind [my canvas] <<Click>> {
$self elements hide no
$self basicBindings on
[my canvas] configure -cursor {}
}
$self buildInfoWindow
"
$canvas.context.nosel.preview add command -label SVG\
-command [list apply {
self {
$self elements hide
$self selected blink off
global externalApp
set ch [open tmp.svg w]
puts $ch [canvasexport svg [$self private canvas]]
close $ch
$self selected blink on
$self elements hide no
exec [$self setting svgtool] tmp.svg &
}
} $self]
$canvas.context.nosel.preview add command -label Postscript\
-command [list apply {
self {
set file [dict get [$self private settings] filename]
set ps tmp.ps
$self selected blink off
$self elements hide
$self canvas postscript -file $ps\
-pagewidth [$self canvas cget -width]
$self elements hide no
$self selected blink on
exec evince $ps &
}
} $self]
#
$canvas.context.nosel add cascade -label Zoom\
-menu [menu $canvas.context.nosel.zoom -tearoff no]
$canvas.context.nosel.zoom add command -label In -command "$self zoom in yes"
$canvas.context.nosel.zoom add command -label Out -command "$self zoom out yes"
$canvas.context.nosel.zoom add command -label Original -command "$self zoom none yes"
$canvas.context.nosel.zoom add command -label Scroll -command "$self scrollbars"
#
$canvas.context.nosel add separator
#
$canvas.context.nosel add command -label Paste\
-command "$self pasteFromClipboard" -accelerator ^v
$canvas.context.nosel add command -label Undo\
-command "$self undo" -accelerator ^z
$canvas.context.nosel add command -label Redo\
-command "$self redo" -accelerator ^Z
#
$canvas.context.nosel add separator
$canvas.context.nosel add command -label Help -command "$self help"
#
if {$level([my canvas]) > 1} then {
$canvas.context.nosel add separator
$canvas.context.nosel add command -label Done\
-command "$self destroy" -accelerator Esc
bind $canvas <Escape> "$canvas.context.nosel invoke Done"
} else {
bind $canvas <Escape> "$self select"
}
string cat $canvas.context
}
© Wolf-Dieter Busch | Home | Sitemap | Urheber | A-Z