Further dealing with retinal displays: The scrollbars and related glyphs
now scale with Opts(scale), which is a zoom scalefactor (default 1), and Opts(toolscale) sets an independent sizing for the toolbar icons, which is multiplied by the Opts(scale) scalefactor. Also: Added GR_LIBS to the link options for magicexec and magicdnull, to avoid compile-time problems on some systems (thank you to Charlene of OpenBSD for the patch!).
This commit is contained in:
parent
2572421162
commit
6049b7e00e
|
|
@ -19,7 +19,7 @@ EXTRA_LIBS = ${MAGICDIR}/cmwind/libcmwind.o ${MAGICDIR}/commands/libcommands.o \
|
||||||
${MAGICDIR}/plow/libplow.o ${MAGICDIR}/utils/libutils.o \
|
${MAGICDIR}/plow/libplow.o ${MAGICDIR}/utils/libutils.o \
|
||||||
${MAIN_EXTRA_LIBS}
|
${MAIN_EXTRA_LIBS}
|
||||||
|
|
||||||
BITMAPS = up.xbm down.xbm left.xbm right.xbm zoom.xbm lock.xbm
|
BITMAPS = up.png down.png left.png right.png zoom.png lock.xbm
|
||||||
DEST_XBM = $(BITMAPS:%=$(DESTDIR)${INSTALL_TCLDIR}/bitmaps/%)
|
DEST_XBM = $(BITMAPS:%=$(DESTDIR)${INSTALL_TCLDIR}/bitmaps/%)
|
||||||
|
|
||||||
DFLAGS += -DMAGIC_DATE="\"`date`\"" -DCAD_DIR="${LIBDIR}"
|
DFLAGS += -DMAGIC_DATE="\"`date`\"" -DCAD_DIR="${LIBDIR}"
|
||||||
|
|
|
||||||
Binary file not shown.
|
After Width: | Height: | Size: 290 B |
Binary file not shown.
|
After Width: | Height: | Size: 291 B |
Binary file not shown.
|
After Width: | Height: | Size: 289 B |
Binary file not shown.
|
After Width: | Height: | Size: 290 B |
Binary file not shown.
|
After Width: | Height: | Size: 276 B |
|
|
@ -49,11 +49,13 @@ install-tcl: magicexec magicdnull ${BIN_FILES} ${TCL_FILES}
|
||||||
|
|
||||||
magicexec: magicexec.c ${MAGICDIR}/defs.mak
|
magicexec: magicexec.c ${MAGICDIR}/defs.mak
|
||||||
${CC} ${CFLAGS} ${CPPFLAGS} ${DFLAGS_NOSTUB} ${LDFLAGS} magicexec.c \
|
${CC} ${CFLAGS} ${CPPFLAGS} ${DFLAGS_NOSTUB} ${LDFLAGS} magicexec.c \
|
||||||
-o magicexec ${LD_RUN_PATH} ${LIBS} ${LIB_SPECS_NOSTUB}
|
-o magicexec ${LD_RUN_PATH} ${LIB_SPECS_NOSTUB} ${LIBS} \
|
||||||
|
${GR_LIBS}
|
||||||
|
|
||||||
magicdnull: magicdnull.c ${MAGICDIR}/defs.mak
|
magicdnull: magicdnull.c ${MAGICDIR}/defs.mak
|
||||||
${CC} ${CFLAGS} ${CPPFLAGS} ${DFLAGS_NOSTUB} ${LDFLAGS} magicdnull.c \
|
${CC} ${CFLAGS} ${CPPFLAGS} ${DFLAGS_NOSTUB} ${LDFLAGS} magicdnull.c \
|
||||||
-o magicdnull ${LD_RUN_PATH} ${LIBS} ${LIB_SPECS_NOSTUB}
|
-o magicdnull ${LD_RUN_PATH} ${LIB_SPECS_NOSTUB} ${LIBS} \
|
||||||
|
${GR_LIBS}
|
||||||
|
|
||||||
magic.tcl: magic.tcl.in ${MAGICDIR}/defs.mak
|
magic.tcl: magic.tcl.in ${MAGICDIR}/defs.mak
|
||||||
sed -e /TCL_DIR/s%TCL_DIR%${TCLDIR}%g \
|
sed -e /TCL_DIR/s%TCL_DIR%${TCLDIR}%g \
|
||||||
|
|
|
||||||
|
|
@ -22,26 +22,43 @@ if {[lsearch [namespace children] ::tkshell] < 0} {
|
||||||
catch {source ${CAD_ROOT}/magic/tcl/tkshell.tcl}
|
catch {source ${CAD_ROOT}/magic/tcl/tkshell.tcl}
|
||||||
}
|
}
|
||||||
|
|
||||||
# Button images
|
proc magic::makeglyphimages {} {
|
||||||
|
global Opts
|
||||||
|
global Glyph
|
||||||
|
global CAD_ROOT
|
||||||
|
|
||||||
set Glyph(up) [image create bitmap \
|
# Check if glyphs exist---don't need to make them more than once
|
||||||
-file ${CAD_ROOT}/magic/tcl/bitmaps/up.xbm \
|
if {![catch {set Glyph(up)}]} {return}
|
||||||
-background gray -foreground steelblue]
|
|
||||||
set Glyph(down) [image create bitmap \
|
# Glyph images
|
||||||
-file ${CAD_ROOT}/magic/tcl/bitmaps/down.xbm \
|
|
||||||
-background gray -foreground steelblue]
|
set gsize [expr {int($Opts(scale) * 13)}]
|
||||||
set Glyph(left) [image create bitmap \
|
set gscale [expr {int($Opts(scale))}]
|
||||||
-file ${CAD_ROOT}/magic/tcl/bitmaps/left.xbm \
|
|
||||||
-background gray -foreground steelblue]
|
image create photo stdglyph -file ${CAD_ROOT}/magic/tcl/bitmaps/up.png
|
||||||
set Glyph(right) [image create bitmap \
|
image create photo Glyph(up) -width $gsize -height $gsize
|
||||||
-file ${CAD_ROOT}/magic/tcl/bitmaps/right.xbm \
|
Glyph(up) copy stdglyph -zoom $gscale
|
||||||
-background gray -foreground steelblue]
|
|
||||||
set Glyph(zoom) [image create bitmap \
|
image create photo stdglyph -file ${CAD_ROOT}/magic/tcl/bitmaps/down.png
|
||||||
-file ${CAD_ROOT}/magic/tcl/bitmaps/zoom.xbm \
|
image create photo Glyph(down) -width $gsize -height $gsize
|
||||||
-background gray -foreground steelblue]
|
Glyph(down) copy stdglyph -zoom $gscale
|
||||||
set Glyph(lock) [image create bitmap \
|
|
||||||
|
image create photo stdglyph -file ${CAD_ROOT}/magic/tcl/bitmaps/left.png
|
||||||
|
image create photo Glyph(left) -width $gsize -height $gsize
|
||||||
|
Glyph(left) copy stdglyph -zoom $gscale
|
||||||
|
|
||||||
|
image create photo stdglyph -file ${CAD_ROOT}/magic/tcl/bitmaps/right.png
|
||||||
|
image create photo Glyph(right) -width $gsize -height $gsize
|
||||||
|
Glyph(right) copy stdglyph -zoom $gscale
|
||||||
|
|
||||||
|
image create photo stdglyph -file ${CAD_ROOT}/magic/tcl/bitmaps/zoom.png
|
||||||
|
image create photo Glyph(zoom) -width $gsize -height $gsize
|
||||||
|
Glyph(zoom) copy stdglyph -zoom $gscale
|
||||||
|
|
||||||
|
image create bitmap Glyph(lock) \
|
||||||
-file ${CAD_ROOT}/magic/tcl/bitmaps/lock.xbm \
|
-file ${CAD_ROOT}/magic/tcl/bitmaps/lock.xbm \
|
||||||
-background gray80 -foreground steelblue4]
|
-background gray80 -foreground steelblue4]
|
||||||
|
}
|
||||||
|
|
||||||
# Menu button callback functions
|
# Menu button callback functions
|
||||||
|
|
||||||
|
|
@ -537,7 +554,8 @@ set Opts(crosshair) 0
|
||||||
set Opts(hidelocked) 0
|
set Opts(hidelocked) 0
|
||||||
set Opts(hidespecial) 0
|
set Opts(hidespecial) 0
|
||||||
set Opts(toolbar) 0
|
set Opts(toolbar) 0
|
||||||
set Opts(toolsize) 16
|
set Opts(scale) 1.0
|
||||||
|
set Opts(toolscale) 1.0
|
||||||
set Opts(drc) 1
|
set Opts(drc) 1
|
||||||
set Opts(autobuttontext) 1
|
set Opts(autobuttontext) 1
|
||||||
|
|
||||||
|
|
@ -723,7 +741,8 @@ proc magic::toolupdate {win {yesno "yes"} {layerlist "none"}} {
|
||||||
proc magic::maketoolimages {} {
|
proc magic::maketoolimages {} {
|
||||||
global Opts
|
global Opts
|
||||||
|
|
||||||
set tsize $Opts(toolsize)
|
# Tool size expands with the GUI scale but can also be expanded independently.
|
||||||
|
set tsize [expr {int($Opts(scale) * $Opts(toolscale) * 16)}]
|
||||||
|
|
||||||
# Generate a layer image for "space" that will be used when layers are
|
# Generate a layer image for "space" that will be used when layers are
|
||||||
# invisible.
|
# invisible.
|
||||||
|
|
@ -900,6 +919,8 @@ proc magic::techrebuild {winpath {cmdstr ""}} {
|
||||||
# current view in magic (in pixels)
|
# current view in magic (in pixels)
|
||||||
|
|
||||||
proc magic::setscrollvalues {win} {
|
proc magic::setscrollvalues {win} {
|
||||||
|
global Opts
|
||||||
|
|
||||||
set svalues [${win} view get]
|
set svalues [${win} view get]
|
||||||
set bvalues [${win} view bbox]
|
set bvalues [${win} view bbox]
|
||||||
|
|
||||||
|
|
@ -926,16 +947,19 @@ proc magic::setscrollvalues {win} {
|
||||||
set ya [expr { $wheight - $ya }]
|
set ya [expr { $wheight - $ya }]
|
||||||
set yb [expr { $wheight - $yb }]
|
set yb [expr { $wheight - $yb }]
|
||||||
|
|
||||||
${framename}.xscroll.bar coords slider $xa 2 $xb 15
|
set swidth [expr {int($Opts(scale) * 13)}]
|
||||||
${framename}.yscroll.bar coords slider 2 $ya 15 $yb
|
set slength [expr {$swidth + 2}]
|
||||||
|
|
||||||
|
${framename}.xscroll.bar coords slider $xa 2 $xb $slength
|
||||||
|
${framename}.yscroll.bar coords slider 2 $ya $slength $yb
|
||||||
|
|
||||||
set xb [expr { 1 + ($xa + $xb) / 2 }]
|
set xb [expr { 1 + ($xa + $xb) / 2 }]
|
||||||
set xa [expr { $xb - 2 }]
|
set xa [expr { $xb - 2 }]
|
||||||
${framename}.xscroll.bar coords centre $xa 4 $xb 13
|
${framename}.xscroll.bar coords centre $xa 4 $xb $swidth
|
||||||
|
|
||||||
set yb [expr { 1 + ($ya + $yb) / 2 }]
|
set yb [expr { 1 + ($ya + $yb) / 2 }]
|
||||||
set ya [expr { $yb - 2 }]
|
set ya [expr { $yb - 2 }]
|
||||||
${framename}.yscroll.bar coords centre 4 $ya 13 $yb
|
${framename}.yscroll.bar coords centre 4 $ya $swidth $yb
|
||||||
}
|
}
|
||||||
|
|
||||||
# Procedure to update scrollbars in response to an internal command
|
# Procedure to update scrollbars in response to an internal command
|
||||||
|
|
@ -1019,6 +1043,9 @@ proc magic::dragscroll { w v orient } {
|
||||||
proc magic::makescrollbar { fname orient win } {
|
proc magic::makescrollbar { fname orient win } {
|
||||||
global scale
|
global scale
|
||||||
global Glyph
|
global Glyph
|
||||||
|
global Opts
|
||||||
|
|
||||||
|
set swidth [expr {int($Opts(scale) * 13)}]
|
||||||
|
|
||||||
set scale($orient,update) 0
|
set scale($orient,update) 0
|
||||||
set scale($orient,origin) 0
|
set scale($orient,origin) 0
|
||||||
|
|
@ -1026,19 +1053,19 @@ proc magic::makescrollbar { fname orient win } {
|
||||||
# To be done: add glyphs for the arrows
|
# To be done: add glyphs for the arrows
|
||||||
|
|
||||||
if { "$orient" == "x" } {
|
if { "$orient" == "x" } {
|
||||||
canvas ${fname}.bar -height 13 -relief sunken -borderwidth 1
|
canvas ${fname}.bar -height $swidth -relief sunken -borderwidth 1
|
||||||
button ${fname}.lb -image $Glyph(left) -borderwidth 1 \
|
button ${fname}.lb -image Glyph(left) -borderwidth 1 \
|
||||||
-command "${win} scroll left .1 w"
|
-command "${win} scroll left .1 w"
|
||||||
button ${fname}.ub -image $Glyph(right) -borderwidth 1 \
|
button ${fname}.ub -image Glyph(right) -borderwidth 1 \
|
||||||
-command "${win} scroll right .1 w"
|
-command "${win} scroll right .1 w"
|
||||||
pack ${fname}.lb -side left
|
pack ${fname}.lb -side left
|
||||||
pack ${fname}.bar -fill $orient -expand true -side left
|
pack ${fname}.bar -fill $orient -expand true -side left
|
||||||
pack ${fname}.ub -side right
|
pack ${fname}.ub -side right
|
||||||
} else {
|
} else {
|
||||||
canvas ${fname}.bar -width 13 -relief sunken -borderwidth 1
|
canvas ${fname}.bar -width $swidth -relief sunken -borderwidth 1
|
||||||
button ${fname}.lb -image $Glyph(down) -borderwidth 1 \
|
button ${fname}.lb -image Glyph(down) -borderwidth 1 \
|
||||||
-command "${win} scroll down .1 w"
|
-command "${win} scroll down .1 w"
|
||||||
button ${fname}.ub -image $Glyph(up) -borderwidth 1 \
|
button ${fname}.ub -image Glyph(up) -borderwidth 1 \
|
||||||
-command "${win} scroll up .1 w"
|
-command "${win} scroll up .1 w"
|
||||||
pack ${fname}.ub
|
pack ${fname}.ub
|
||||||
pack ${fname}.bar -fill $orient -expand true
|
pack ${fname}.bar -fill $orient -expand true
|
||||||
|
|
@ -1054,7 +1081,7 @@ proc magic::makescrollbar { fname orient win } {
|
||||||
# Create a small mark in the center of the scrolling rectangle which aids
|
# Create a small mark in the center of the scrolling rectangle which aids
|
||||||
# in determining how much the window is being scrolled when the full
|
# in determining how much the window is being scrolled when the full
|
||||||
# scrollbar extends past the window edges.
|
# scrollbar extends past the window edges.
|
||||||
${fname}.bar create rect 4 4 13 13 -fill black -width 0 -tag centre
|
${fname}.bar create rect 4 4 $swidth $swidth -fill black -width 0 -tag centre
|
||||||
${fname}.bar bind centre <Button-1> "magic::setscroll %W %$orient $orient"
|
${fname}.bar bind centre <Button-1> "magic::setscroll %W %$orient $orient"
|
||||||
${fname}.bar bind centre <ButtonRelease-1> "magic::scrollview %W $win $orient"
|
${fname}.bar bind centre <ButtonRelease-1> "magic::scrollview %W $win $orient"
|
||||||
${fname}.bar bind centre <B1-Motion> "magic::dragscroll %W %$orient $orient"
|
${fname}.bar bind centre <B1-Motion> "magic::dragscroll %W %$orient $orient"
|
||||||
|
|
@ -1127,12 +1154,14 @@ proc magic::openwrapper {{cell ""} {framename ""}} {
|
||||||
|
|
||||||
pack ${framename}.pane -side top -fill both -expand true
|
pack ${framename}.pane -side top -fill both -expand true
|
||||||
|
|
||||||
frame ${layoutframe}.xscroll -height 13
|
set swidth [expr {int($Opts(scale) * 13)}]
|
||||||
frame ${layoutframe}.yscroll -width 13
|
frame ${layoutframe}.xscroll -height $swidth
|
||||||
|
frame ${layoutframe}.yscroll -width $swidth
|
||||||
|
|
||||||
|
magic::makeglyphimages
|
||||||
magic::makescrollbar ${layoutframe}.xscroll x ${winname}
|
magic::makescrollbar ${layoutframe}.xscroll x ${winname}
|
||||||
magic::makescrollbar ${layoutframe}.yscroll y ${winname}
|
magic::makescrollbar ${layoutframe}.yscroll y ${winname}
|
||||||
button ${layoutframe}.zb -image $Glyph(zoom) -borderwidth 1 -command "${winname} zoom 2"
|
button ${layoutframe}.zb -image Glyph(zoom) -borderwidth 1 -command "${winname} zoom 2"
|
||||||
|
|
||||||
# Add bindings for mouse buttons 2 and 3 to the zoom button
|
# Add bindings for mouse buttons 2 and 3 to the zoom button
|
||||||
bind ${layoutframe}.zb <Button-3> "${winname} zoom 0.5"
|
bind ${layoutframe}.zb <Button-3> "${winname} zoom 0.5"
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue