mkdev/trofftable.ps

   1 %
   2 % Prologue for building troff width tables. The gsave/grestore pairs are
   3 % for hardcopy.
   4 %
   5
   6 /slowdown 25 def
   7 /flagduplicates false def
   8
   9 /ascenderheight -1 def
  10 /descenderdepth 0 def
  11 /octalescapes 256 def
  12 /startcomments 256 def
  13 /currentfontdict null def
  14 /scratchstring 512 string def
  15
  16 /Print {
  17         scratchstring cvs print flush
  18         slowdown {1 pop} repeat
  19 } def
  20
  21 /ReEncode {     % vector fontname ReEncode -
  22         dup
  23         findfont dup length dict begin
  24                 {1 index /FID ne {def}{pop pop} ifelse} forall
  25                 /Encoding 3 -1 roll def
  26                 currentdict
  27         end
  28         definefont pop
  29 } bind def
  30
  31 /SelectFont {   % fontname SelectFont -
  32         findfont
  33                 dup /PaintType get 0 eq {
  34                         /scaling 1 def
  35                         unitwidth resolution 72.0 div mul
  36                 }{
  37                         /scaling resolution 72 div def
  38                         unitwidth
  39                 } ifelse
  40         scalefont
  41         /currentfontdict exch def
  42 } def
  43
  44 /ChangeMetrics {DpostPrologue begin addmetrics end} def
  45
  46 /NamedInPrologue {
  47         dup
  48         DpostPrologue exch known {
  49                 DpostPrologue exch get type /nametype eq {
  50                         (named in prologue\n) Print
  51                 } if
  52         }{pop} ifelse
  53 } def
  54
  55 /SetAscender {
  56         /str exch def
  57
  58         gsave
  59                 currentfontdict setfont
  60                 newpath
  61                 0 0 moveto
  62                 str false charpath flattenpath pathbbox
  63                 /descenderdepth 4 -1 roll .5 mul def
  64                 exch pop exch pop
  65
  66                 newpath
  67                 0 0 moveto
  68                 str 0 1 getinterval false charpath flattenpath pathbbox
  69                 4 1 roll pop pop pop
  70                 dup 3 1 roll sub .25 mul add
  71                 /ascenderheight exch def
  72         grestore
  73 } def
  74
  75 /GetAscender {
  76         ascenderheight descenderdepth ge {
  77                 gsave
  78                         currentfontdict setfont
  79                         newpath
  80                         0 0 moveto
  81                         ( ) dup 0 4 -1 roll put
  82                         false charpath flattenpath pathbbox
  83                         exch pop 3 -1 roll pop
  84                         ascenderheight gt {2}{0} ifelse
  85                         exch descenderdepth lt {1}{0} ifelse
  86                         or
  87                 grestore
  88         }{0} ifelse
  89 } def
  90
  91 /GetWidth {
  92         gsave
  93                 currentfontdict setfont
  94                 ( ) dup 0 4 -1 roll put
  95                 stringwidth pop scaling mul round cvi
  96         grestore
  97 } def
  98
  99 /GetCode {
 100         256 3 1 roll            % last unprintable match
 101         0 3 -1 roll {
 102                 2 index eq {
 103                         dup 127 and 32 ge {exit} if
 104                         3 -1 roll pop
 105                         dup 3 1 roll
 106                 } if
 107                 1 add
 108         } forall
 109         exch pop
 110         dup 255 gt {pop}{exch pop} ifelse
 111 } def
 112
 113 % create a font with the given encoding array
 114 /TMPFont {
 115         dup length dict begin
 116                 { 1 index /FID ne {def} {pop pop} ifelse } forall
 117                 /Encoding exch def
 118                 currentdict
 119         end
 120         /tmp-font exch definefont
 121 } bind def
 122
 123 % print troff font glyph table for the given glyphs
 124 %
 125 % This function assumes "charset" global array contains troff
 126 % character names (even entries) and PS font names (odd entries);
 127 % see the list in StandardCharset function in shell.lib of devutf
 128 % for an example.  From this array, this function generates troff
 129 % font tables in three steps:
 130 %
 131 % 1. Initialize chcodes array to contain the position of charset characters
 132 %    in the encoding array of the current font (256 for characters not present)
 133 % 2. Generate a temporary font encoding array for the characters in charset
 134 %   (for finding the width of characters)
 135 % 3. Create a temporary font with this new encoding array
 136 % 4. Print troff table columns for each character in charset array
 137 /BuildFontCharset256 {
 138         % create the charcode array
 139         /chcodes charset length 2 idiv array def
 140         0 2 charset length 2 sub {
 141                 /i exch def
 142                 /key charset i get def
 143                 /val charset i 1 add get def
 144                 /chcode currentfontdict /Encoding get val GetCode def
 145                 chcodes i 2 idiv chcode put
 146         } for
 147         % create a temporary array for charset
 148         /tmpenc charset length array def
 149         0 2 charset length 2 sub {
 150                 /i exch def
 151                 /val charset i 1 add get def
 152                 val type /stringtype eq not {
 153                         tmpenc i 2 idiv val put
 154                 } if
 155         } for
 156
 157         % use the new font
 158         /prevfontdict currentfontdict def
 159         /currentfontdict tmpenc currentfontdict TMPFont def
 160         currentfontdict setfont
 161         /lastvalid 0 def                % last character was valid if 1
 162
 163         % print troff table
 164         0 2 charset length 2 sub {
 165                 /i exch def
 166                 /key charset i get def
 167                 /val charset i 1 add get def
 168                 /curcode i 2 idiv def           % tmpenc chcode
 169                 /chcode chcodes curcode get def % original chcode
 170                 val type /stringtype eq {
 171                         lastvalid 1 eq {
 172                                 key Print
 173                                 (\t) Print val Print
 174                                 (\n) Print
 175                         } if
 176                 }{
 177                         % output only available glyphs
 178                         currentfontdict /CharStrings get val known {
 179                                 chcode octalescapes ge key (---) eq and {
 180                                         (\\0) Print chcode 8 (   ) cvrs Print
 181                                 }{
 182                                         key Print
 183                                 } ifelse
 184                                 (\t) Print curcode GetWidth Print
 185                                 (\t) Print curcode GetAscender Print
 186                                 chcode startcomments lt {
 187                                         (\t) Print chcode Print
 188                                 } {
 189                                         (\t) Print val Print
 190                                 } ifelse
 191                                 (\n) Print
 192                                 /lastvalid 1 def
 193                         }{
 194                                 /lastvalid 0 def
 195                         } ifelse
 196                 } ifelse
 197         } for
 198         % restore the original font
 199         /currentfontdict prevfontdict def
 200 } def
 201
 202 % call BuildFontCharset256 for charsets of at most 256 characters
 203 %
 204 % BuildFontCharset256 assumes the charset array contains at most
 205 % 256 characters.  This function splits the charset array
 206 % otherwise and calls BuildFontCharset256 multiple times.
 207 /BuildFontCharset {
 208         /charset2 charset def
 209         0 512 charset2 length {
 210                 /i exch def
 211                 /len charset2 length i 512 add le { charset2 length i sub } {512} ifelse def
 212                 /charset charset2 i len getinterval def
 213                 BuildFontCharset256
 214         } for
 215         /charset charset2 def
 216 } def
 217
 218 /BuildDescCharset {
 219         /DescDict 512 dict def
 220         /Characters 0 def
 221
 222         0 1 charset length 1 sub {
 223                 /i exch def
 224                 /key charset i get def
 225
 226                 key length 2 eq {
 227                         DescDict key cvn known {
 228                                 flagduplicates {        % for debugging
 229                                         (<<<duplicated character: ) Print
 230                                         key Print
 231                                         (>>>\n) Print
 232                                 } if
 233                         }{
 234                                 DescDict key cvn 1 put
 235                                 key Print
 236                                 /Characters Characters 1 add def
 237                                 Characters 20 mod 0 eq {(\n)}{( )} ifelse Print
 238                         } ifelse
 239                 } if
 240         } for
 241 } def
 242