interfaces/xmaxima/Tkmaxima/Fonts.tcl

   1 # -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
   2 #
   3 #       $Id: Fonts.tcl,v 1.8 2006-06-27 13:33:42 villate Exp $
   4 #
   5
   6 # set font {Courier 8}
   7 global maxima_priv fontCourier8 fixedFont fontSize
   8 set maxima_priv(fixedFont) Courier
   9
  10 # Pick a default font size in pixels
  11 set _screenheight [winfo screenheight .]
  12 # if {$_screenheight < 500} {
  13 #     # for 640x480
  14 #     set _pixel 10
  15 #     set _point 8
  16 #     # Pick a default borderwidth which smaller
  17 #     set _bd 1
  18 # } elseif {$_screenheight < 700} {
  19 #     # for 800x600
  20 #     set _pixel 12
  21 #     set _point 8
  22 # } elseif {$_screenheight < 800} {
  23 #     # for 1024x768
  24 #     set _pixel 12
  25 #     set _point 8
  26 # } elseif {$_screenheight < 1100} {
  27 #     # for 1200x1000
  28 #     set _pixel 14
  29 #     set _point 10
  30 # } else {
  31 #     set _pixel 18
  32 #     set _point 12
  33 # }
  34
  35 # ZW: this actually produces better result
  36 set _pixel 10
  37 set _point 8
  38 set fontSize $_pixel
  39
  40 # setup defaults depending on the OS and Window Manager
  41 # Really should do another version for mono
  42 switch -exact -- $tcl_platform(platform) {
  43     windows {
  44         set _prop_default Tahoma
  45         set _fixed_default {Courier New}
  46     }
  47     default {
  48         set _prop_default {Bitstream Vera Sans}
  49         set _fixed_default {Bitstream Vera Sans Mono}
  50     }
  51 }
  52 # make sure these fonts are installed
  53 set _allowed [string tolow [font families]]
  54 foreach font [list $_prop_default "MS Sans Serif" Tahoma Arial Helvetica \
  55                  fixed system] {
  56     if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
  57         set _prop_default $font
  58         break
  59     }
  60 }
  61 foreach font [list $_fixed_default Courier fixed system] {
  62     if {[lsearch -exact $_allowed [string tolow $font]] > -1} {
  63         set _fixed_default $font
  64         break
  65     }
  66 }
  67 set fontCourier8 [list $_fixed_default $_pixel]
  68 set fixedFont [font create -family $_fixed_default -size $_pixel]
  69 set buttonfont [font create -family $_prop_default -size $_pixel]
  70
  71
  72 global maxima_default
  73 set maxima_default(adjust) 0
  74 # I think this is too crude and wont work with WM schemes
  75 if {0} {
  76     catch {
  77         set width_ [expr {.9 * [winfo screenwidth .]}]
  78         if { [winfo width .] >= 500 } {
  79             set width_ [winfo width .]
  80         }
  81         set maxima_default(adjust) [expr {
  82                                           $width_<= 640 ? -1 :
  83                                           $width_<= 800 ? 0 :
  84                                           1 } ]
  85         unset width_
  86     }
  87 }
  88
  89
  90
  91 ######### font choosing utilities #########
  92 global tcl_platform
  93 global isFixedp
  94
  95 if { "$tcl_platform(platform)" == "unix" } {
  96     array set isFixedp {
  97         fixed 1 {fangsong ti} 1 {clearlyu alternate glyphs} 0 lucidatypewriter 1 charter 0 lucidabright 0 times 0 ming 1 {lucidux sans} 0 {open look glyph} 0 {song ti} 1 newspaper 0 helvetica 0 {open look cursor} 1 li 1 mincho 1 {clearlyu ligature} 0 {clearlyu pua} 0 {lucidux mono} 1 courier 1 clearlyu 0 utopia 0 lucida 0 nil 1 clean 1 terminal 1 kai 1 gothic 1 cursor 0 symbol 0 {clearlyu arabic extra} 0 {lucidux serif} 0 {new century schoolbook} 0 song 1
  98     }
  99 }
 100
 101 proc getFontFamilies { fixed } {
 102     global isFixedp
 103     foreach font  [font families] {
 104         if { ![info exists isFixedp($font)] } {
 105             set isFixedp($font) [font metrics [list $font] -fixed]
 106         }
 107         if { $isFixedp($font) == $fixed } {
 108             lappend answer $font
 109         }
 110     }
 111     return [lsort $answer]
 112 }
 113
 114