mirror of
https://github.com/RTimothyEdwards/magic.git
synced 2026-08-29 17:39:28 +02:00
Tim Edwards
3e0ad4ff58
respect to using the 3rd mouse button to hide a layer, and indicating the layer is hidden by blanking the icon (which works better with the new scrollable icon list, but got broken by the same). Also: Added a previously missing behavior, which is to correctly update the icon settings based on using the command "see" and "see no" with layer aliases (e.g., "allm1").
242 lines
8.4 KiB
Tcl
242 lines
8.4 KiB
Tcl
global Opts
|
|
global Winopts
|
|
|
|
global current_toolbar
|
|
global fileName
|
|
|
|
# Generate the toolbar for the wrapper
|
|
proc magic::maketoolbar {framename} {
|
|
|
|
global Opts
|
|
global Winopts
|
|
# Don't do anything if in suspend mode
|
|
set topname [winfo toplevel $framename]
|
|
if {[info exists Winopts(${topname},suspend)]} {
|
|
if { $Winopts(${topname},suspend) > 0} { return }
|
|
}
|
|
|
|
if {$Opts(toolbar) == 0} {
|
|
magic::maketoolimages
|
|
set Opts(toolbar) 1
|
|
}
|
|
|
|
# Destroy any existing toolbar before starting
|
|
set alltools [winfo children ${framename}.toolbar]
|
|
foreach i $alltools { destroy $i }
|
|
|
|
# All toolbar commands will be passed to the appropriate window
|
|
set win ${framename}.magic
|
|
|
|
# Generate layer images and buttons for toolbar
|
|
if {$Opts(hidespecial) == 0} {
|
|
set special_layers {errors labels subcell}
|
|
} else {
|
|
set special_layers {}
|
|
}
|
|
|
|
if {$Opts(hidelocked) == 0} {
|
|
set all_layers [concat $special_layers [magic::tech layer "*"]]
|
|
} else {
|
|
set all_layers [concat $special_layers [magic::tech unlocked]]
|
|
}
|
|
|
|
# Create a canvas for the toolbar
|
|
if {![winfo exists ${framename}.toolbar.canvas]} {
|
|
canvas ${framename}.toolbar.canvas
|
|
}
|
|
grid ${framename}.toolbar.canvas -row 0 -column 0 -sticky "news"
|
|
|
|
# Add a frame to the canvas, on which the layer buttons and
|
|
# labels are placed
|
|
frame ${framename}.toolbar.canvas.frame
|
|
${framename}.toolbar.canvas create window 0 0 -anchor nw \
|
|
-window ${framename}.toolbar.canvas.frame
|
|
|
|
# Read layers from a tcl file [tech name]_toolbar.tcl
|
|
|
|
global current_toolbar
|
|
global fileName
|
|
|
|
# Check if the file exists, and if not, create it and populate with a default_toolbar
|
|
# and a current_toolbar. current_toolbar is a placeholder
|
|
if {![file exists "./[tech name]_toolbars.tcl"]} {
|
|
# If the file doesn't exist, just set the global variable current_toolba
|
|
# which is a default toolbar ordering
|
|
set current_toolbar $all_layers
|
|
set fileName ""
|
|
} else {
|
|
# otherwise, use the current_toolbar from the file
|
|
set fileName "./[tech name]_toolbars.tcl"
|
|
source $fileName
|
|
# this will set current_toolbar to the one from the file
|
|
}
|
|
|
|
|
|
# Place layers on the toolbar
|
|
set i 0
|
|
foreach layername $current_toolbar {
|
|
createLayerFrame $framename $layername $i
|
|
incr i
|
|
}
|
|
|
|
# Add mouswheel functionlity
|
|
# Bind Button-4 (scroll up) and Button-5 (scroll down) to the custom procedure
|
|
bind ${framename}.toolbar.canvas <Button-4> [subst { ${framename}.toolbar.canvas \
|
|
yview scroll -1 units}]
|
|
bind ${framename}.toolbar.canvas <Button-5> [subst { ${framename}.toolbar.canvas \
|
|
yview scroll 1 units}]
|
|
|
|
# Create a vertical scrollbar for the canvas
|
|
scrollbar ${framename}.toolbar.vscroll -orient "vertical" \
|
|
-command [list ${framename}.toolbar.canvas yview]
|
|
|
|
grid ${framename}.toolbar.vscroll -row 0 -column 1 -sticky "nws"
|
|
|
|
# Configure the canvas to use the scrollbar
|
|
${framename}.toolbar.canvas configure -yscrollcommand \
|
|
[list ${framename}.toolbar.vscroll set]
|
|
|
|
# Define the canvas scroll region (as an event callback)
|
|
bind ${framename} <Configure> "updateCanvasScrollRegion ${framename}"
|
|
}
|
|
|
|
# Function to place layer frame with a button and label
|
|
# on the toolbar, at a specific row $i
|
|
proc createLayerFrame {framename layername i} {
|
|
|
|
# All toolbar commands will be passed to the appropriate window
|
|
set win ${framename}.magic
|
|
|
|
# Frame to group together the layer button and label
|
|
frame ${framename}.toolbar.canvas.frame.f$layername
|
|
set layer_frame ${framename}.toolbar.canvas.frame.f$layername
|
|
grid $layer_frame -row $i -column 0 -sticky "news"
|
|
|
|
# Set short naming for buttons and labels
|
|
set toolbar_label ${layer_frame}.l
|
|
# Place label of layer next to the layer button
|
|
label $toolbar_label -text $layername
|
|
grid $toolbar_label -row $i -column 1 -sticky "w"
|
|
|
|
# Place the layer button, checking if it is locked or not
|
|
set locklist [tech locked]
|
|
|
|
if {[lsearch $locklist $layername] != -1} {
|
|
# Locked button bindings
|
|
|
|
set toolbar_button ${layer_frame}.p
|
|
button $toolbar_button -image pale_$layername
|
|
|
|
# Bind keypresses when mouse if over layer frame
|
|
bind $layer_frame <KeyPress-u> \
|
|
"$win tech unlock $layername ; \
|
|
grid forget $toolbar_button ; \
|
|
grid ${layer_frame}.b -row $i -column 0 -sticky w"
|
|
|
|
# Bindings for painiting, erasing and seeing layers,
|
|
# which are bound both to the layer button, as well
|
|
# as the layer label
|
|
set childrenList [winfo children $layer_frame]
|
|
|
|
foreach child $childrenList {
|
|
# 3rd mouse button makes layer invisible; 1st mouse button restores it.
|
|
# 2nd mouse button paints the layer color. Key "p" also does paint, esp.
|
|
# for users with 2-button mice. Key "e" erases, as does Shift-Button-2.
|
|
bind $child <ButtonPress-1> "$win see $layername"
|
|
bind $child <ButtonPress-3> "$win see no $layername"
|
|
|
|
# Intercept mousewheel on the layer/button as well
|
|
bind $child <Button-4> \
|
|
[subst { event generate ${framename}.toolbar.canvas <Button-4> }]
|
|
bind $child <Button-5> \
|
|
[subst { event generate ${framename}.toolbar.canvas <Button-5> }]
|
|
}
|
|
|
|
# Bind the mouse enter event to highlight the label
|
|
bind $toolbar_label <Enter> "$toolbar_label configure -background yellow"
|
|
|
|
bind $layer_frame <Enter> \
|
|
[subst {focus %W ; ${framename}.titlebar.message configure \
|
|
-text "$layername (locked)"}]
|
|
|
|
} else {
|
|
# Unlocked button bindings
|
|
|
|
set toolbar_button ${layer_frame}.b
|
|
button $toolbar_button -image img_$layername
|
|
|
|
# Bind keypresses when mouse if over layer frame
|
|
bind $layer_frame <KeyPress-p> "$win paint $layername"
|
|
bind $layer_frame <KeyPress-s> "$win select more area $layername"
|
|
bind $layer_frame <KeyPress-S> "$win select less area $layername"
|
|
bind $layer_frame <KeyPress-e> "$win erase $layername"
|
|
|
|
bind $layer_frame <KeyPress-l> \
|
|
"puts $i; \
|
|
$win tech lock $layername ; \
|
|
grid forget $toolbar_button ; \
|
|
grid ${layer_frame}.p -row $i -column 0 -sticky w"
|
|
|
|
# Bindings for painiting, erasing and seeing layers,
|
|
# which are bound both to the layer button, as well
|
|
# as the layer label
|
|
set childrenList [winfo children $layer_frame]
|
|
|
|
foreach child $childrenList {
|
|
# 3rd mouse button makes layer invisible; 1st mouse button restores it.
|
|
# 2nd mouse button paints the layer color. Key "p" also does paint, esp.
|
|
# for users with 2-button mice. Key "e" erases, as does Shift-Button-2.
|
|
bind $child <ButtonPress-1> "$win see $layername"
|
|
bind $child <ButtonPress-2> "$win paint $layername"
|
|
bind $child <Shift-ButtonPress-2> "$win erase $layername"
|
|
bind $child <ButtonPress-3> "$win see no $layername"
|
|
|
|
# Intercept mousewheel on the layer/button as well
|
|
bind $child <Button-4> \
|
|
[subst { event generate ${framename}.toolbar.canvas <Button-4> }]
|
|
bind $child <Button-5> \
|
|
[subst { event generate ${framename}.toolbar.canvas <Button-5> }]
|
|
}
|
|
|
|
# Bind the mouse enter event to highlight the label
|
|
bind $toolbar_label <Enter> "$toolbar_label configure -background yellow"
|
|
|
|
bind $layer_frame <Enter> \
|
|
[subst {focus %W ; ${framename}.titlebar.message configure -text "$layername"}]
|
|
|
|
}
|
|
|
|
# Common bindings
|
|
|
|
grid $toolbar_button -row $i -column 0 -sticky "w"
|
|
|
|
# Bindings: Leaving the layer row clears titlbar message
|
|
bind $layer_frame <Leave> \
|
|
[subst {${framename}.titlebar.message configure -text ""}]
|
|
|
|
# Intercept mousewheel and redirect command to the canvas
|
|
bind $layer_frame <Button-4> \
|
|
[subst { event generate ${framename}.toolbar.canvas <Button-4> }]
|
|
bind $layer_frame <Button-5> \
|
|
[subst { event generate ${framename}.toolbar.canvas <Button-5> }]
|
|
|
|
# Bind the mouse leave event to reset the label
|
|
set bgColor [${framename}.toolbar cget -background]
|
|
bind $toolbar_label <Leave> "$toolbar_label configure -background $bgColor"
|
|
|
|
}
|
|
|
|
# Function to update the canvas scrolling region after a resize
|
|
proc updateCanvasScrollRegion {framename} {
|
|
set bbox [${framename}.toolbar.canvas bbox all]
|
|
set minwidth [expr [lindex $bbox 2] - [lindex $bbox 0]]
|
|
if {[llength $bbox] == 4} {
|
|
${framename}.toolbar.canvas configure -scrollregion $bbox
|
|
}
|
|
${framename}.toolbar.canvas configure -width $minwidth
|
|
set winheight [expr [winfo height ${framename}] \
|
|
- [winfo height ${framename}.titlebar]]
|
|
|
|
${framename}.toolbar.canvas configure -height $winheight
|
|
}
|