[PD-cvs] SF.net SVN: pure-data:[10630] branches/pd-devel/0.41.4/src

[mescalinum at users.sourceforge.net]

Revision: 10630
          http://pure-data.svn.sourceforge.net/pure-data/?rev=10630&view=rev
Author:   mescalinum
Date:     2009-01-25 01:57:16 +0000 (Sun, 25 Jan 2009)

Log Message:
-----------
Fix font size issues, by determining the best pixelsize for each pointsize that fits into our hardcoded font metrics.

This would fix for example text wider than object boxes et similar.

Modified Paths:
--------------
    branches/pd-devel/0.41.4/src/pd.tk
    branches/pd-devel/0.41.4/src/pdtk_text.tcl

Modified: branches/pd-devel/0.41.4/src/pd.tk
===================================================================
--- branches/pd-devel/0.41.4/src/pd.tk	2009-01-25 01:30:08 UTC (rev 10629)
+++ branches/pd-devel/0.41.4/src/pd.tk	2009-01-25 01:57:16 UTC (rev 10630)
@@ -25,6 +25,14 @@
 # for testing which platform we are running on ("aqua", "win32", or "x11")
 set windowingsystem ""
 
+# FONT STUFF:
+# default font family/weight, changed later in 'init' (if needed)
+set font_family {Bitstream Vera Sans Mono}
+set font_weight {normal}
+# this contains the font metric that Pd expects (we have to respect those
+#  when creating fonts in proc pdtk_init_fonts)
+set font_fixed_metrics {8 5 10 9 6 11 10 6 13 12 7 15 14 8 17 16 10 20 18 11 22 24 14 30 30 18 37 36 22 45}
+
 set pd_opendir [pwd]
 set pd_untitleddir [pwd]
 
@@ -107,6 +115,7 @@
 				{{Max Patch Files (.pat)} {.pat} }
 				{{Max Text Files (.mxt)}  {.mxt} }
 			}
+			set ::font_family {Monaco}
 		}
 		"win32" {
 			font create menufont -family Tahoma -size -11
@@ -120,13 +129,32 @@
 	}
 }
 
+# this proc gets the internal font name associated with each size
+proc pdtk_font_name {size} {
+    # TODO: return an error if size is not in $::font_fixed_metrics
+    return "pd_font_${size}"
+}
 
+# this proc creates all the needed fonts so that they fit
+# into the metrics given by  $::font_fixed_metrics
+proc pdtk_init_fonts {} {
+    foreach {size width height} $::font_fixed_metrics {
+        set fnt [pdtk_font_name $size]
+        font create $fnt -family $::font_family -weight $::font_weight \
+            -size [expr {-$height}]
+        while {[font measure $fnt M] > $width} {
+            incr height -1
+            font configure $fnt -size [expr {-$height}]
+        }
+    }
+}
+
 proc pdtk_pd_startup {version {args ""}} {
 	pdtk_post "version: $version"
 	pdtk_post "args: $args"
 	set oldtclversion 0
-	set fontlist "8 5 10 9 6 11 10 6 13 12 7 15 14 8 17 16 10 20 18 11 22 24 14 30 30 18 37 36 22 45"
-	pdsend "pd init [enquote_filename [pwd]] $oldtclversion $fontlist"
+	pdtk_init_fonts
+	pdsend "pd init [enquote_filename [pwd]] $oldtclversion $::font_fixed_metrics"
 	# TODO what else is needed from the original?
 }
 

Modified: branches/pd-devel/0.41.4/src/pdtk_text.tcl
===================================================================
--- branches/pd-devel/0.41.4/src/pdtk_text.tcl	2009-01-25 01:30:08 UTC (rev 10629)
+++ branches/pd-devel/0.41.4/src/pdtk_text.tcl	2009-01-25 01:57:16 UTC (rev 10630)
@@ -1,16 +1,10 @@
 
 package provide pdtk_text 0.1
 
-set font_family "Monaco"
-set font_weight "normal"
-#set default_font_family "Bitstream Vera Sans Mono"
-
-# TODO use a Tk 'font' as the main font
-
 ############ pdtk_text_new -- create a new text object #2###########
 proc pdtk_text_new {mycanvas canvasitem x y text font_size color} {
     $mycanvas create text $x $y -tags $canvasitem -text $text -fill $color \
-		-anchor nw -font "$::font_family $font_size $::font_weight"
+		-anchor nw -font [pdtk_font_name $font_size]
 	$mycanvas bind $canvasitem <Home> "$mycanvas icursor $canvasitem 0"
 	$mycanvas bind $canvasitem <End> "$mycanvas icursor $canvasitem end"
 	if {$::windowingsystem eq "aqua"} { # emacs bindings for Mac OS X


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.