From 6049b7e00e288d7bb57d962300610281b21756da Mon Sep 17 00:00:00 2001 From: Tim Edwards Date: Mon, 17 Feb 2020 16:51:30 -0500 Subject: [PATCH] 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!). --- magic/Makefile | 2 +- magic/bitmaps/down.png | Bin 0 -> 290 bytes magic/bitmaps/left.png | Bin 0 -> 291 bytes magic/bitmaps/right.png | Bin 0 -> 289 bytes magic/bitmaps/up.png | Bin 0 -> 290 bytes magic/bitmaps/zoom.png | Bin 0 -> 276 bytes tcltk/Makefile | 6 ++- tcltk/wrapper.tcl | 95 ++++++++++++++++++++++++++-------------- 8 files changed, 67 insertions(+), 36 deletions(-) create mode 100644 magic/bitmaps/down.png create mode 100644 magic/bitmaps/left.png create mode 100644 magic/bitmaps/right.png create mode 100644 magic/bitmaps/up.png create mode 100644 magic/bitmaps/zoom.png diff --git a/magic/Makefile b/magic/Makefile index 2079bca5..4dc62515 100644 --- a/magic/Makefile +++ b/magic/Makefile @@ -19,7 +19,7 @@ EXTRA_LIBS = ${MAGICDIR}/cmwind/libcmwind.o ${MAGICDIR}/commands/libcommands.o \ ${MAGICDIR}/plow/libplow.o ${MAGICDIR}/utils/libutils.o \ ${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/%) DFLAGS += -DMAGIC_DATE="\"`date`\"" -DCAD_DIR="${LIBDIR}" diff --git a/magic/bitmaps/down.png b/magic/bitmaps/down.png new file mode 100644 index 0000000000000000000000000000000000000000..78c995180b6f428b733ea99c8ed6cb8c0b2037de GIT binary patch literal 290 zcmeAS@N?(olHy`uVBq!ia0vp@Ak4%JB>7u;-UBI?bVpxD28NCO+&S3Dk zz__fXwULpbQiP>m$K%LXpeEH4*NBpo#FA92@!;O_l%v literal 0 HcmV?d00001 diff --git a/magic/bitmaps/left.png b/magic/bitmaps/left.png new file mode 100644 index 0000000000000000000000000000000000000000..dd63f521c244b352b45a1b720c8043480dd02e23 GIT binary patch literal 291 zcmeAS@N?(olHy`uVBq!ia0vp@Ak4%JB>7u;-UBI?bVpxD28NCO+1b=SGH7YyFz6Q5 z;|^oL$asaDVdFj4q7$B7^MJZkOI#yLQW8s2t&)pUffR$0fsui(fswAEd5EEzm5G^^ qfr+kxsg;4j^huHFC>nC}Q!>*kacg*X{^4z)1_n=8KbLh*2~7a=eorR= literal 0 HcmV?d00001 diff --git a/magic/bitmaps/right.png b/magic/bitmaps/right.png new file mode 100644 index 0000000000000000000000000000000000000000..4ae31e9c8a9e5fa3ed5a98ce2ba08c56beed6590 GIT binary patch literal 289 zcmeAS@N?(olHy`uVBq!ia0vp@Ak4%JB>7u;-UBI?bVpxD28NCO+N1$1#t{3&#{_4-=zBos7JNLHKHUXu_V85l%cME*q4kei>9nO2EggI4N8SD*$4Pgg&ebxsLQ0LG?G{Qv*} literal 0 HcmV?d00001 diff --git a/magic/bitmaps/up.png b/magic/bitmaps/up.png new file mode 100644 index 0000000000000000000000000000000000000000..cbe449739f642a032b31865f9d89db956199e578 GIT binary patch literal 290 zcmeAS@N?(olHy`uVBq!ia0vp@Ak4%JB>7u;-UBI?bVpxD28NCO+!C8<`)MX5lF!N|bKK-a)X*U&t~(9Fuvz{>aG}y12r&sy85}Sb4q9e0Mh_XK>z>% literal 0 HcmV?d00001 diff --git a/magic/bitmaps/zoom.png b/magic/bitmaps/zoom.png new file mode 100644 index 0000000000000000000000000000000000000000..7d0f4484bd9c2c09304652e061442d6f7638571c GIT binary patch literal 276 zcmeAS@N?(olHy`uVBq!ia0vp@Ak4%JB>7u;-UBI?bVpxD28NCO+?an+uemJjk_iV$dUGRaSY+Oo}AFYeC>jO#6bln aPsvQH#I2!Wf0hwY1B0ilpUXO@geCyo)k?Vl literal 0 HcmV?d00001 diff --git a/tcltk/Makefile b/tcltk/Makefile index 5ff09b05..efa12d00 100644 --- a/tcltk/Makefile +++ b/tcltk/Makefile @@ -49,11 +49,13 @@ install-tcl: magicexec magicdnull ${BIN_FILES} ${TCL_FILES} magicexec: magicexec.c ${MAGICDIR}/defs.mak ${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 ${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 sed -e /TCL_DIR/s%TCL_DIR%${TCLDIR}%g \ diff --git a/tcltk/wrapper.tcl b/tcltk/wrapper.tcl index 3252fea0..2758cd96 100644 --- a/tcltk/wrapper.tcl +++ b/tcltk/wrapper.tcl @@ -22,26 +22,43 @@ if {[lsearch [namespace children] ::tkshell] < 0} { 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 \ - -file ${CAD_ROOT}/magic/tcl/bitmaps/up.xbm \ - -background gray -foreground steelblue] -set Glyph(down) [image create bitmap \ - -file ${CAD_ROOT}/magic/tcl/bitmaps/down.xbm \ - -background gray -foreground steelblue] -set Glyph(left) [image create bitmap \ - -file ${CAD_ROOT}/magic/tcl/bitmaps/left.xbm \ - -background gray -foreground steelblue] -set Glyph(right) [image create bitmap \ - -file ${CAD_ROOT}/magic/tcl/bitmaps/right.xbm \ - -background gray -foreground steelblue] -set Glyph(zoom) [image create bitmap \ - -file ${CAD_ROOT}/magic/tcl/bitmaps/zoom.xbm \ - -background gray -foreground steelblue] -set Glyph(lock) [image create bitmap \ + # Check if glyphs exist---don't need to make them more than once + if {![catch {set Glyph(up)}]} {return} + + # Glyph images + + set gsize [expr {int($Opts(scale) * 13)}] + set gscale [expr {int($Opts(scale))}] + + image create photo stdglyph -file ${CAD_ROOT}/magic/tcl/bitmaps/up.png + image create photo Glyph(up) -width $gsize -height $gsize + Glyph(up) copy stdglyph -zoom $gscale + + image create photo stdglyph -file ${CAD_ROOT}/magic/tcl/bitmaps/down.png + image create photo Glyph(down) -width $gsize -height $gsize + Glyph(down) copy stdglyph -zoom $gscale + + 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 \ -background gray80 -foreground steelblue4] +} # Menu button callback functions @@ -537,7 +554,8 @@ set Opts(crosshair) 0 set Opts(hidelocked) 0 set Opts(hidespecial) 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(autobuttontext) 1 @@ -723,7 +741,8 @@ proc magic::toolupdate {win {yesno "yes"} {layerlist "none"}} { proc magic::maketoolimages {} { 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 # invisible. @@ -900,6 +919,8 @@ proc magic::techrebuild {winpath {cmdstr ""}} { # current view in magic (in pixels) proc magic::setscrollvalues {win} { + global Opts + set svalues [${win} view get] set bvalues [${win} view bbox] @@ -926,16 +947,19 @@ proc magic::setscrollvalues {win} { set ya [expr { $wheight - $ya }] set yb [expr { $wheight - $yb }] - ${framename}.xscroll.bar coords slider $xa 2 $xb 15 - ${framename}.yscroll.bar coords slider 2 $ya 15 $yb + set swidth [expr {int($Opts(scale) * 13)}] + 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 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 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 @@ -1019,6 +1043,9 @@ proc magic::dragscroll { w v orient } { proc magic::makescrollbar { fname orient win } { global scale global Glyph + global Opts + + set swidth [expr {int($Opts(scale) * 13)}] set scale($orient,update) 0 set scale($orient,origin) 0 @@ -1026,19 +1053,19 @@ proc magic::makescrollbar { fname orient win } { # To be done: add glyphs for the arrows if { "$orient" == "x" } { - canvas ${fname}.bar -height 13 -relief sunken -borderwidth 1 - button ${fname}.lb -image $Glyph(left) -borderwidth 1 \ + canvas ${fname}.bar -height $swidth -relief sunken -borderwidth 1 + button ${fname}.lb -image Glyph(left) -borderwidth 1 \ -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" pack ${fname}.lb -side left pack ${fname}.bar -fill $orient -expand true -side left pack ${fname}.ub -side right } else { - canvas ${fname}.bar -width 13 -relief sunken -borderwidth 1 - button ${fname}.lb -image $Glyph(down) -borderwidth 1 \ + canvas ${fname}.bar -width $swidth -relief sunken -borderwidth 1 + button ${fname}.lb -image Glyph(down) -borderwidth 1 \ -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" pack ${fname}.ub 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 # in determining how much the window is being scrolled when the full # 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 "magic::setscroll %W %$orient $orient" ${fname}.bar bind centre "magic::scrollview %W $win $orient" ${fname}.bar bind centre "magic::dragscroll %W %$orient $orient" @@ -1127,12 +1154,14 @@ proc magic::openwrapper {{cell ""} {framename ""}} { pack ${framename}.pane -side top -fill both -expand true - frame ${layoutframe}.xscroll -height 13 - frame ${layoutframe}.yscroll -width 13 + set swidth [expr {int($Opts(scale) * 13)}] + frame ${layoutframe}.xscroll -height $swidth + frame ${layoutframe}.yscroll -width $swidth + magic::makeglyphimages magic::makescrollbar ${layoutframe}.xscroll x ${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 bind ${layoutframe}.zb "${winname} zoom 0.5"