diff --git a/cloe/pkgdcl.lisp b/cloe/pkgdcl.lisp new file mode 100644 index 0000000000000000000000000000000000000000..53977141d864a8853adcc2bed9da3e57902ecc52 --- /dev/null +++ b/cloe/pkgdcl.lisp @@ -0,0 +1,11 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- + +;; $fiHeader: pkgdcl.lisp,v 1.2 92/02/24 13:24:03 cer Exp $ + +(in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user) + +"Copyright (c) 1992 Symbolics, Inc. All rights reserved." + +(#-(or ANSI-90 Lucid) clim-lisp::defpackage #+(or ANSI-90 Lucid) defpackage cloe-clim + (:use clim-lisp clim-sys clim clim-utils silica)) + diff --git a/postscript/laserwriter-metrics.lisp b/postscript/laserwriter-metrics.lisp new file mode 100644 index 0000000000000000000000000000000000000000..5225ba9af6bed22d10cb37147f839a7c76209395 --- /dev/null +++ b/postscript/laserwriter-metrics.lisp @@ -0,0 +1,2145 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-POSTSCRIPT; Base: 10; Lowercase: Yes -*- + +;; $fiHeader: laserwriter-metrics.lisp,v 1.2 92/02/24 13:08:01 cer Exp $ + +(in-package :clim-postscript) + +"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." + +;;; Font Metrics for Apple Laser Writer builtin fonts + +;;; Note that the X values in the bounding box are incorrect. I don't +;;; know how this data was generated (it was inherited from the Genera +;;; LGP2 support) but it is apparent that the font box information +;;; (/FontBBox element of a PostScript fnt dictionary) was not scaled by +;;; the font's matrix (/FontMatrix). For the fonts that I tested (using +;;; the PostScript program at the end of this file), the Y values were +;;; correct but some of the X values were not. Fortunately nothing uses +;;; them. [1/9/90 naha] + +(setup-laserwriter-metrics + '(("Times-Roman" 1000 (-167 -252 1004 904)) + (#o040 250.0 "space") + (#o041 333.0 "exclam") + (#o042 408.0 "quotedbl") + (#o043 500.0 "numbersign") + (#o044 500.0 "dollar") + (#o045 833.0 "percent") + (#o046 778.0 "ampersand") + (#o047 333.0 "quoteright") + (#o050 333.0 "parenleft") + (#o051 333.0 "parenright") + (#o052 500.0 "asterisk") + (#o053 564.0 "plus") + (#o054 250.0 "comma") + (#o055 333.0 "hyphen") + (#o056 250.0 "period") + (#o057 278.0 "slash") + (#o060 500.0 "zero") + (#o061 500.0 "one") + (#o062 500.0 "two") + (#o063 500.0 "three") + (#o064 500.0 "four") + (#o065 500.0 "five") + (#o066 500.0 "six") + (#o067 500.0 "seven") + (#o070 500.0 "eight") + (#o071 500.0 "nine") + (#o072 278.0 "colon") + (#o073 278.0 "semicolon") + (#o074 564.0 "less") + (#o075 564.0 "equal") + (#o076 564.0 "greater") + (#o077 444.0 "question") + (#o100 921.0 "at") + (#o101 722.0 "A") + (#o102 667.0 "B") + (#o103 667.0 "C") + (#o104 722.0 "D") + (#o105 611.0 "E") + (#o106 556.0 "F") + (#o107 722.0 "G") + (#o110 722.0 "H") + (#o111 333.0 "I") + (#o112 389.0 "J") + (#o113 722.0 "K") + (#o114 611.0 "L") + (#o115 889.0 "M") + (#o116 722.0 "N") + (#o117 722.0 "O") + (#o120 556.0 "P") + (#o121 722.0 "Q") + (#o122 667.0 "R") + (#o123 556.0 "S") + (#o124 611.0 "T") + (#o125 722.0 "U") + (#o126 722.0 "V") + (#o127 944.0 "W") + (#o130 722.0 "X") + (#o131 722.0 "Y") + (#o132 611.0 "Z") + (#o133 333.0 "bracketleft") + (#o134 278.0 "backslash") + (#o135 333.0 "bracketright") + (#o136 469.0 "asciicircum") + (#o137 500.0 "underscore") + (#o140 333.0 "quoteleft") + (#o141 444.0 "a") + (#o142 500.0 "b") + (#o143 444.0 "c") + (#o144 500.0 "d") + (#o145 444.0 "e") + (#o146 333.0 "f") + (#o147 500.0 "g") + (#o150 500.0 "h") + (#o151 278.0 "i") + (#o152 278.0 "j") + (#o153 500.0 "k") + (#o154 278.0 "l") + (#o155 778.0 "m") + (#o156 500.0 "n") + (#o157 500.0 "o") + (#o160 500.0 "p") + (#o161 500.0 "q") + (#o162 333.0 "r") + (#o163 389.0 "s") + (#o164 278.0 "t") + (#o165 500.0 "u") + (#o166 500.0 "v") + (#o167 722.0 "w") + (#o170 500.0 "x") + (#o171 500.0 "y") + (#o172 444.0 "z") + (#o173 480.0 "braceleft") + (#o174 200.0 "bar") + (#o175 480.0 "braceright") + (#o176 541.0 "asciitilde") + (#o241 333.0 "exclamdown") + (#o242 500.0 "cent") + (#o243 500.0 "sterling") + (#o244 167.0 "fraction") + (#o245 500.0 "yen") + (#o246 500.0 "florin") + (#o247 500.0 "section") + (#o250 500.0 "currency") + (#o251 180.0 "quotesingle") + (#o252 444.0 "quotedblleft") + (#o253 500.0 "guillemotleft") + (#o254 333.0 "guilsinglleft") + (#o255 333.0 "guilsinglright") + (#o256 556.0 "fi") + (#o257 556.0 "fl") + (#o261 500.0 "endash") + (#o262 500.0 "dagger") + (#o263 500.0 "daggerdbl") + (#o264 250.0 "periodcentered") + (#o266 453.0 "paragraph") + (#o267 350.0 "bullet") + (#o270 333.0 "quotesinglbase") + (#o271 444.0 "quotedblbase") + (#o272 444.0 "quotedblright") + (#o273 500.0 "guillemotright") + (#o274 1000.0 "ellipsis") + (#o275 1000.0 "perthousand") + (#o277 444.0 "questiondown") + (#o301 333.0 "grave") + (#o302 333.0 "acute") + (#o303 333.0 "circumflex") + (#o304 333.0 "tilde") + (#o305 333.0 "macron") + (#o306 333.0 "breve") + (#o307 333.0 "dotaccent") + (#o310 333.0 "dieresis") + (#o312 333.0 "ring") + (#o313 333.0 "cedilla") + (#o315 333.0 "hungarumlaut") + (#o316 333.0 "ogonek") + (#o317 333.0 "caron") + (#o320 1000.0 "emdash") + (#o341 889.0 "AE") + (#o343 276.0 "ordfeminine") + (#o350 611.0 "Lslash") + (#o351 722.0 "Oslash") + (#o352 889.0 "OE") + (#o353 310.0 "ordmasculine") + (#o361 667.0 "ae") + (#o365 278.0 "dotlessi") + (#o370 278.0 "lslash") + (#o371 500.0 "oslash") + (#o372 722.0 "oe") + (#o373 500.0 "germandbls") + )) + +(setup-laserwriter-metrics + '(("Times-Italic" 1000 (-176 -252 998 930)) + (#o040 250.0 "space") + (#o041 333.0 "exclam") + (#o042 420.0 "quotedbl") + (#o043 500.0 "numbersign") + (#o044 500.0 "dollar") + (#o045 833.0 "percent") + (#o046 778.0 "ampersand") + (#o047 333.0 "quoteright") + (#o050 333.0 "parenleft") + (#o051 333.0 "parenright") + (#o052 500.0 "asterisk") + (#o053 675.0 "plus") + (#o054 250.0 "comma") + (#o055 333.0 "hyphen") + (#o056 250.0 "period") + (#o057 278.0 "slash") + (#o060 500.0 "zero") + (#o061 500.0 "one") + (#o062 500.0 "two") + (#o063 500.0 "three") + (#o064 500.0 "four") + (#o065 500.0 "five") + (#o066 500.0 "six") + (#o067 500.0 "seven") + (#o070 500.0 "eight") + (#o071 500.0 "nine") + (#o072 333.0 "colon") + (#o073 333.0 "semicolon") + (#o074 675.0 "less") + (#o075 675.0 "equal") + (#o076 675.0 "greater") + (#o077 500.0 "question") + (#o100 920.0 "at") + (#o101 611.0 "A") + (#o102 611.0 "B") + (#o103 667.0 "C") + (#o104 722.0 "D") + (#o105 611.0 "E") + (#o106 611.0 "F") + (#o107 722.0 "G") + (#o110 722.0 "H") + (#o111 333.0 "I") + (#o112 444.0 "J") + (#o113 667.0 "K") + (#o114 556.0 "L") + (#o115 833.0 "M") + (#o116 667.0 "N") + (#o117 722.0 "O") + (#o120 611.0 "P") + (#o121 722.0 "Q") + (#o122 611.0 "R") + (#o123 500.0 "S") + (#o124 556.0 "T") + (#o125 722.0 "U") + (#o126 611.0 "V") + (#o127 833.0 "W") + (#o130 611.0 "X") + (#o131 556.0 "Y") + (#o132 556.0 "Z") + (#o133 389.0 "bracketleft") + (#o134 278.0 "backslash") + (#o135 389.0 "bracketright") + (#o136 422.0 "asciicircum") + (#o137 500.0 "underscore") + (#o140 333.0 "quoteleft") + (#o141 500.0 "a") + (#o142 500.0 "b") + (#o143 444.0 "c") + (#o144 500.0 "d") + (#o145 444.0 "e") + (#o146 278.0 "f") + (#o147 500.0 "g") + (#o150 500.0 "h") + (#o151 278.0 "i") + (#o152 278.0 "j") + (#o153 444.0 "k") + (#o154 278.0 "l") + (#o155 722.0 "m") + (#o156 500.0 "n") + (#o157 500.0 "o") + (#o160 500.0 "p") + (#o161 500.0 "q") + (#o162 389.0 "r") + (#o163 389.0 "s") + (#o164 278.0 "t") + (#o165 500.0 "u") + (#o166 444.0 "v") + (#o167 667.0 "w") + (#o170 444.0 "x") + (#o171 444.0 "y") + (#o172 389.0 "z") + (#o173 400.0 "braceleft") + (#o174 275.0 "bar") + (#o175 400.0 "braceright") + (#o176 541.0 "asciitilde") + (#o241 389.0 "exclamdown") + (#o242 500.0 "cent") + (#o243 500.0 "sterling") + (#o244 167.0 "fraction") + (#o245 500.0 "yen") + (#o246 500.0 "florin") + (#o247 500.0 "section") + (#o250 500.0 "currency") + (#o251 214.0 "quotesingle") + (#o252 556.0 "quotedblleft") + (#o253 500.0 "guillemotleft") + (#o254 333.0 "guilsinglleft") + (#o255 333.0 "guilsinglright") + (#o256 500.0 "fi") + (#o257 500.0 "fl") + (#o261 500.0 "endash") + (#o262 500.0 "dagger") + (#o263 500.0 "daggerdbl") + (#o264 250.0 "periodcentered") + (#o266 523.0 "paragraph") + (#o267 350.0 "bullet") + (#o270 333.0 "quotesinglbase") + (#o271 556.0 "quotedblbase") + (#o272 556.0 "quotedblright") + (#o273 500.0 "guillemotright") + (#o274 889.0 "ellipsis") + (#o275 1000.0 "perthousand") + (#o277 500.0 "questiondown") + (#o301 333.0 "grave") + (#o302 333.0 "acute") + (#o303 333.0 "circumflex") + (#o304 333.0 "tilde") + (#o305 333.0 "macron") + (#o306 333.0 "breve") + (#o307 333.0 "dotaccent") + (#o310 333.0 "dieresis") + (#o312 333.0 "ring") + (#o313 333.0 "cedilla") + (#o315 333.0 "hungarumlaut") + (#o316 333.0 "ogonek") + (#o317 333.0 "caron") + (#o320 889.0 "emdash") + (#o341 889.0 "AE") + (#o343 276.0 "ordfeminine") + (#o350 556.0 "Lslash") + (#o351 722.0 "Oslash") + (#o352 944.0 "OE") + (#o353 310.0 "ordmasculine") + (#o361 667.0 "ae") + (#o365 278.0 "dotlessi") + (#o370 278.0 "lslash") + (#o371 500.0 "oslash") + (#o372 667.0 "oe") + (#o373 500.0 "germandbls") + )) + +(setup-laserwriter-metrics + '(("Times-Bold" 1000 (-172 -257 1008 965)) + (#o040 250.0 "space") + (#o041 333.0 "exclam") + (#o042 555.0 "quotedbl") + (#o043 500.0 "numbersign") + (#o044 500.0 "dollar") + (#o045 1000.0 "percent") + (#o046 833.0 "ampersand") + (#o047 333.0 "quoteright") + (#o050 333.0 "parenleft") + (#o051 333.0 "parenright") + (#o052 500.0 "asterisk") + (#o053 570.0 "plus") + (#o054 250.0 "comma") + (#o055 333.0 "hyphen") + (#o056 250.0 "period") + (#o057 278.0 "slash") + (#o060 500.0 "zero") + (#o061 500.0 "one") + (#o062 500.0 "two") + (#o063 500.0 "three") + (#o064 500.0 "four") + (#o065 500.0 "five") + (#o066 500.0 "six") + (#o067 500.0 "seven") + (#o070 500.0 "eight") + (#o071 500.0 "nine") + (#o072 333.0 "colon") + (#o073 333.0 "semicolon") + (#o074 570.0 "less") + (#o075 570.0 "equal") + (#o076 570.0 "greater") + (#o077 500.0 "question") + (#o100 930.0 "at") + (#o101 722.0 "A") + (#o102 667.0 "B") + (#o103 722.0 "C") + (#o104 722.0 "D") + (#o105 667.0 "E") + (#o106 611.0 "F") + (#o107 778.0 "G") + (#o110 778.0 "H") + (#o111 389.0 "I") + (#o112 500.0 "J") + (#o113 778.0 "K") + (#o114 667.0 "L") + (#o115 944.0 "M") + (#o116 722.0 "N") + (#o117 778.0 "O") + (#o120 611.0 "P") + (#o121 778.0 "Q") + (#o122 722.0 "R") + (#o123 556.0 "S") + (#o124 667.0 "T") + (#o125 722.0 "U") + (#o126 722.0 "V") + (#o127 1000.0 "W") + (#o130 722.0 "X") + (#o131 722.0 "Y") + (#o132 667.0 "Z") + (#o133 333.0 "bracketleft") + (#o134 278.0 "backslash") + (#o135 333.0 "bracketright") + (#o136 581.0 "asciicircum") + (#o137 500.0 "underscore") + (#o140 333.0 "quoteleft") + (#o141 500.0 "a") + (#o142 556.0 "b") + (#o143 444.0 "c") + (#o144 556.0 "d") + (#o145 444.0 "e") + (#o146 333.0 "f") + (#o147 500.0 "g") + (#o150 556.0 "h") + (#o151 278.0 "i") + (#o152 333.0 "j") + (#o153 556.0 "k") + (#o154 278.0 "l") + (#o155 833.0 "m") + (#o156 556.0 "n") + (#o157 500.0 "o") + (#o160 556.0 "p") + (#o161 556.0 "q") + (#o162 444.0 "r") + (#o163 389.0 "s") + (#o164 333.0 "t") + (#o165 556.0 "u") + (#o166 500.0 "v") + (#o167 722.0 "w") + (#o170 500.0 "x") + (#o171 500.0 "y") + (#o172 444.0 "z") + (#o173 394.0 "braceleft") + (#o174 220.0 "bar") + (#o175 394.0 "braceright") + (#o176 520.0 "asciitilde") + (#o241 333.0 "exclamdown") + (#o242 500.0 "cent") + (#o243 500.0 "sterling") + (#o244 167.0 "fraction") + (#o245 500.0 "yen") + (#o246 500.0 "florin") + (#o247 500.0 "section") + (#o250 500.0 "currency") + (#o251 278.0 "quotesingle") + (#o252 500.0 "quotedblleft") + (#o253 500.0 "guillemotleft") + (#o254 333.0 "guilsinglleft") + (#o255 333.0 "guilsinglright") + (#o256 556.0 "fi") + (#o257 556.0 "fl") + (#o261 500.0 "endash") + (#o262 500.0 "dagger") + (#o263 500.0 "daggerdbl") + (#o264 250.0 "periodcentered") + (#o266 540.0 "paragraph") + (#o267 350.0 "bullet") + (#o270 333.0 "quotesinglbase") + (#o271 500.0 "quotedblbase") + (#o272 500.0 "quotedblright") + (#o273 500.0 "guillemotright") + (#o274 1000.0 "ellipsis") + (#o275 1000.0 "perthousand") + (#o277 500.0 "questiondown") + (#o301 333.0 "grave") + (#o302 333.0 "acute") + (#o303 333.0 "circumflex") + (#o304 333.0 "tilde") + (#o305 333.0 "macron") + (#o306 333.0 "breve") + (#o307 333.0 "dotaccent") + (#o310 333.0 "dieresis") + (#o312 333.0 "ring") + (#o313 333.0 "cedilla") + (#o315 333.0 "hungarumlaut") + (#o316 333.0 "ogonek") + (#o317 333.0 "caron") + (#o320 1000.0 "emdash") + (#o341 1000.0 "AE") + (#o343 300.0 "ordfeminine") + (#o350 667.0 "Lslash") + (#o351 778.0 "Oslash") + (#o352 1000.0 "OE") + (#o353 330.0 "ordmasculine") + (#o361 722.0 "ae") + (#o365 278.0 "dotlessi") + (#o370 278.0 "lslash") + (#o371 500.0 "oslash") + (#o372 722.0 "oe") + (#o373 556.0 "germandbls") + )) + +(setup-laserwriter-metrics + '(("Times-BoldItalic" 1000 (-183 -250 1004 973)) + (#o040 250.0 "space") + (#o041 389.0 "exclam") + (#o042 555.0 "quotedbl") + (#o043 500.0 "numbersign") + (#o044 500.0 "dollar") + (#o045 833.0 "percent") + (#o046 778.0 "ampersand") + (#o047 333.0 "quoteright") + (#o050 333.0 "parenleft") + (#o051 333.0 "parenright") + (#o052 500.0 "asterisk") + (#o053 570.0 "plus") + (#o054 250.0 "comma") + (#o055 333.0 "hyphen") + (#o056 250.0 "period") + (#o057 278.0 "slash") + (#o060 500.0 "zero") + (#o061 500.0 "one") + (#o062 500.0 "two") + (#o063 500.0 "three") + (#o064 500.0 "four") + (#o065 500.0 "five") + (#o066 500.0 "six") + (#o067 500.0 "seven") + (#o070 500.0 "eight") + (#o071 500.0 "nine") + (#o072 333.0 "colon") + (#o073 333.0 "semicolon") + (#o074 570.0 "less") + (#o075 570.0 "equal") + (#o076 570.0 "greater") + (#o077 500.0 "question") + (#o100 832.0 "at") + (#o101 667.0 "A") + (#o102 667.0 "B") + (#o103 667.0 "C") + (#o104 722.0 "D") + (#o105 667.0 "E") + (#o106 667.0 "F") + (#o107 722.0 "G") + (#o110 778.0 "H") + (#o111 389.0 "I") + (#o112 500.0 "J") + (#o113 667.0 "K") + (#o114 611.0 "L") + (#o115 889.0 "M") + (#o116 722.0 "N") + (#o117 722.0 "O") + (#o120 611.0 "P") + (#o121 722.0 "Q") + (#o122 667.0 "R") + (#o123 556.0 "S") + (#o124 611.0 "T") + (#o125 722.0 "U") + (#o126 667.0 "V") + (#o127 889.0 "W") + (#o130 667.0 "X") + (#o131 611.0 "Y") + (#o132 611.0 "Z") + (#o133 333.0 "bracketleft") + (#o134 278.0 "backslash") + (#o135 333.0 "bracketright") + (#o136 570.0 "asciicircum") + (#o137 500.0 "underscore") + (#o140 333.0 "quoteleft") + (#o141 500.0 "a") + (#o142 500.0 "b") + (#o143 444.0 "c") + (#o144 500.0 "d") + (#o145 444.0 "e") + (#o146 333.0 "f") + (#o147 500.0 "g") + (#o150 556.0 "h") + (#o151 278.0 "i") + (#o152 278.0 "j") + (#o153 500.0 "k") + (#o154 278.0 "l") + (#o155 778.0 "m") + (#o156 556.0 "n") + (#o157 500.0 "o") + (#o160 500.0 "p") + (#o161 500.0 "q") + (#o162 389.0 "r") + (#o163 389.0 "s") + (#o164 278.0 "t") + (#o165 556.0 "u") + (#o166 444.0 "v") + (#o167 667.0 "w") + (#o170 500.0 "x") + (#o171 444.0 "y") + (#o172 389.0 "z") + (#o173 348.0 "braceleft") + (#o174 220.0 "bar") + (#o175 348.0 "braceright") + (#o176 570.0 "asciitilde") + (#o241 389.0 "exclamdown") + (#o242 500.0 "cent") + (#o243 500.0 "sterling") + (#o244 167.0 "fraction") + (#o245 500.0 "yen") + (#o246 500.0 "florin") + (#o247 500.0 "section") + (#o250 500.0 "currency") + (#o251 278.0 "quotesingle") + (#o252 500.0 "quotedblleft") + (#o253 500.0 "guillemotleft") + (#o254 333.0 "guilsinglleft") + (#o255 333.0 "guilsinglright") + (#o256 556.0 "fi") + (#o257 556.0 "fl") + (#o261 500.0 "endash") + (#o262 500.0 "dagger") + (#o263 500.0 "daggerdbl") + (#o264 250.0 "periodcentered") + (#o266 500.0 "paragraph") + (#o267 350.0 "bullet") + (#o270 333.0 "quotesinglbase") + (#o271 500.0 "quotedblbase") + (#o272 500.0 "quotedblright") + (#o273 500.0 "guillemotright") + (#o274 1000.0 "ellipsis") + (#o275 1000.0 "perthousand") + (#o277 500.0 "questiondown") + (#o301 333.0 "grave") + (#o302 333.0 "acute") + (#o303 333.0 "circumflex") + (#o304 333.0 "tilde") + (#o305 333.0 "macron") + (#o306 333.0 "breve") + (#o307 333.0 "dotaccent") + (#o310 333.0 "dieresis") + (#o312 333.0 "ring") + (#o313 333.0 "cedilla") + (#o315 333.0 "hungarumlaut") + (#o316 333.0 "ogonek") + (#o317 333.0 "caron") + (#o320 1000.0 "emdash") + (#o341 944.0 "AE") + (#o343 266.0 "ordfeminine") + (#o350 611.0 "Lslash") + (#o351 722.0 "Oslash") + (#o352 944.0 "OE") + (#o353 300.0 "ordmasculine") + (#o361 722.0 "ae") + (#o365 278.0 "dotlessi") + (#o370 278.0 "lslash") + (#o371 500.0 "oslash") + (#o372 722.0 "oe") + (#o373 500.0 "germandbls") + )) + + +(setup-laserwriter-metrics + '(("Helvetica" 1000 (-174 -234 1001 941)) + (#o040 278.0 "space") + (#o041 278.0 "exclam") + (#o042 355.0 "quotedbl") + (#o043 556.0 "numbersign") + (#o044 556.0 "dollar") + (#o045 889.0 "percent") + (#o046 667.0 "ampersand") + (#o047 222.0 "quoteright") + (#o050 333.0 "parenleft") + (#o051 333.0 "parenright") + (#o052 389.0 "asterisk") + (#o053 584.0 "plus") + (#o054 278.0 "comma") + (#o055 333.0 "hyphen") + (#o056 278.0 "period") + (#o057 278.0 "slash") + (#o060 556.0 "zero") + (#o061 556.0 "one") + (#o062 556.0 "two") + (#o063 556.0 "three") + (#o064 556.0 "four") + (#o065 556.0 "five") + (#o066 556.0 "six") + (#o067 556.0 "seven") + (#o070 556.0 "eight") + (#o071 556.0 "nine") + (#o072 278.0 "colon") + (#o073 278.0 "semicolon") + (#o074 584.0 "less") + (#o075 584.0 "equal") + (#o076 584.0 "greater") + (#o077 556.0 "question") + (#o100 1015.0 "at") + (#o101 667.0 "A") + (#o102 667.0 "B") + (#o103 722.0 "C") + (#o104 722.0 "D") + (#o105 667.0 "E") + (#o106 611.0 "F") + (#o107 778.0 "G") + (#o110 722.0 "H") + (#o111 278.0 "I") + (#o112 500.0 "J") + (#o113 667.0 "K") + (#o114 556.0 "L") + (#o115 833.0 "M") + (#o116 722.0 "N") + (#o117 778.0 "O") + (#o120 667.0 "P") + (#o121 778.0 "Q") + (#o122 722.0 "R") + (#o123 667.0 "S") + (#o124 611.0 "T") + (#o125 722.0 "U") + (#o126 667.0 "V") + (#o127 944.0 "W") + (#o130 667.0 "X") + (#o131 667.0 "Y") + (#o132 611.0 "Z") + (#o133 278.0 "bracketleft") + (#o134 278.0 "backslash") + (#o135 278.0 "bracketright") + (#o136 469.0 "asciicircum") + (#o137 556.0 "underscore") + (#o140 222.0 "quoteleft") + (#o141 556.0 "a") + (#o142 556.0 "b") + (#o143 500.0 "c") + (#o144 556.0 "d") + (#o145 556.0 "e") + (#o146 278.0 "f") + (#o147 556.0 "g") + (#o150 556.0 "h") + (#o151 222.0 "i") + (#o152 222.0 "j") + (#o153 500.0 "k") + (#o154 222.0 "l") + (#o155 833.0 "m") + (#o156 556.0 "n") + (#o157 556.0 "o") + (#o160 556.0 "p") + (#o161 556.0 "q") + (#o162 333.0 "r") + (#o163 500.0 "s") + (#o164 278.0 "t") + (#o165 556.0 "u") + (#o166 500.0 "v") + (#o167 722.0 "w") + (#o170 500.0 "x") + (#o171 500.0 "y") + (#o172 500.0 "z") + (#o173 334.0 "braceleft") + (#o174 260.0 "bar") + (#o175 334.0 "braceright") + (#o176 584.0 "asciitilde") + (#o241 333.0 "exclamdown") + (#o242 556.0 "cent") + (#o243 556.0 "sterling") + (#o244 167.0 "fraction") + (#o245 556.0 "yen") + (#o246 556.0 "florin") + (#o247 556.0 "section") + (#o250 556.0 "currency") + (#o251 191.0 "quotesingle") + (#o252 333.0 "quotedblleft") + (#o253 556.0 "guillemotleft") + (#o254 333.0 "guilsinglleft") + (#o255 333.0 "guilsinglright") + (#o256 500.0 "fi") + (#o257 500.0 "fl") + (#o261 556.0 "endash") + (#o262 556.0 "dagger") + (#o263 556.0 "daggerdbl") + (#o264 278.0 "periodcentered") + (#o266 537.0 "paragraph") + (#o267 350.0 "bullet") + (#o270 222.0 "quotesinglbase") + (#o271 333.0 "quotedblbase") + (#o272 333.0 "quotedblright") + (#o273 556.0 "guillemotright") + (#o274 1000.0 "ellipsis") + (#o275 1000.0 "perthousand") + (#o277 611.0 "questiondown") + (#o301 333.0 "grave") + (#o302 333.0 "acute") + (#o303 333.0 "circumflex") + (#o304 333.0 "tilde") + (#o305 333.0 "macron") + (#o306 333.0 "breve") + (#o307 333.0 "dotaccent") + (#o310 333.0 "dieresis") + (#o312 333.0 "ring") + (#o313 333.0 "cedilla") + (#o315 333.0 "hungarumlaut") + (#o316 333.0 "ogonek") + (#o317 333.0 "caron") + (#o320 1000.0 "emdash") + (#o341 1000.0 "AE") + (#o343 370.0 "ordfeminine") + (#o350 556.0 "Lslash") + (#o351 778.0 "Oslash") + (#o352 1000.0 "OE") + (#o353 365.0 "ordmasculine") + (#o361 889.0 "ae") + (#o365 278.0 "dotlessi") + (#o370 222.0 "lslash") + (#o371 611.0 "oslash") + (#o372 944.0 "oe") + (#o373 611.0 "germandbls") + )) + +(setup-laserwriter-metrics + '(("Helvetica-Oblique" 1000 (-174 -234 1001 941)) + (#o040 278.0 "space") + (#o041 278.0 "exclam") + (#o042 355.0 "quotedbl") + (#o043 556.0 "numbersign") + (#o044 556.0 "dollar") + (#o045 889.0 "percent") + (#o046 667.0 "ampersand") + (#o047 222.0 "quoteright") + (#o050 333.0 "parenleft") + (#o051 333.0 "parenright") + (#o052 389.0 "asterisk") + (#o053 584.0 "plus") + (#o054 278.0 "comma") + (#o055 333.0 "hyphen") + (#o056 278.0 "period") + (#o057 278.0 "slash") + (#o060 556.0 "zero") + (#o061 556.0 "one") + (#o062 556.0 "two") + (#o063 556.0 "three") + (#o064 556.0 "four") + (#o065 556.0 "five") + (#o066 556.0 "six") + (#o067 556.0 "seven") + (#o070 556.0 "eight") + (#o071 556.0 "nine") + (#o072 278.0 "colon") + (#o073 278.0 "semicolon") + (#o074 584.0 "less") + (#o075 584.0 "equal") + (#o076 584.0 "greater") + (#o077 556.0 "question") + (#o100 1015.0 "at") + (#o101 667.0 "A") + (#o102 667.0 "B") + (#o103 722.0 "C") + (#o104 722.0 "D") + (#o105 667.0 "E") + (#o106 611.0 "F") + (#o107 778.0 "G") + (#o110 722.0 "H") + (#o111 278.0 "I") + (#o112 500.0 "J") + (#o113 667.0 "K") + (#o114 556.0 "L") + (#o115 833.0 "M") + (#o116 722.0 "N") + (#o117 778.0 "O") + (#o120 667.0 "P") + (#o121 778.0 "Q") + (#o122 722.0 "R") + (#o123 667.0 "S") + (#o124 611.0 "T") + (#o125 722.0 "U") + (#o126 667.0 "V") + (#o127 944.0 "W") + (#o130 667.0 "X") + (#o131 667.0 "Y") + (#o132 611.0 "Z") + (#o133 278.0 "bracketleft") + (#o134 278.0 "backslash") + (#o135 278.0 "bracketright") + (#o136 469.0 "asciicircum") + (#o137 556.0 "underscore") + (#o140 222.0 "quoteleft") + (#o141 556.0 "a") + (#o142 556.0 "b") + (#o143 500.0 "c") + (#o144 556.0 "d") + (#o145 556.0 "e") + (#o146 278.0 "f") + (#o147 556.0 "g") + (#o150 556.0 "h") + (#o151 222.0 "i") + (#o152 222.0 "j") + (#o153 500.0 "k") + (#o154 222.0 "l") + (#o155 833.0 "m") + (#o156 556.0 "n") + (#o157 556.0 "o") + (#o160 556.0 "p") + (#o161 556.0 "q") + (#o162 333.0 "r") + (#o163 500.0 "s") + (#o164 278.0 "t") + (#o165 556.0 "u") + (#o166 500.0 "v") + (#o167 722.0 "w") + (#o170 500.0 "x") + (#o171 500.0 "y") + (#o172 500.0 "z") + (#o173 334.0 "braceleft") + (#o174 260.0 "bar") + (#o175 334.0 "braceright") + (#o176 584.0 "asciitilde") + (#o241 333.0 "exclamdown") + (#o242 556.0 "cent") + (#o243 556.0 "sterling") + (#o244 167.0 "fraction") + (#o245 556.0 "yen") + (#o246 556.0 "florin") + (#o247 556.0 "section") + (#o250 556.0 "currency") + (#o251 191.0 "quotesingle") + (#o252 333.0 "quotedblleft") + (#o253 556.0 "guillemotleft") + (#o254 333.0 "guilsinglleft") + (#o255 333.0 "guilsinglright") + (#o256 500.0 "fi") + (#o257 500.0 "fl") + (#o261 556.0 "endash") + (#o262 556.0 "dagger") + (#o263 556.0 "daggerdbl") + (#o264 278.0 "periodcentered") + (#o266 537.0 "paragraph") + (#o267 350.0 "bullet") + (#o270 222.0 "quotesinglbase") + (#o271 333.0 "quotedblbase") + (#o272 333.0 "quotedblright") + (#o273 556.0 "guillemotright") + (#o274 1000.0 "ellipsis") + (#o275 1000.0 "perthousand") + (#o277 611.0 "questiondown") + (#o301 333.0 "grave") + (#o302 333.0 "acute") + (#o303 333.0 "circumflex") + (#o304 333.0 "tilde") + (#o305 333.0 "macron") + (#o306 333.0 "breve") + (#o307 333.0 "dotaccent") + (#o310 333.0 "dieresis") + (#o312 333.0 "ring") + (#o313 333.0 "cedilla") + (#o315 333.0 "hungarumlaut") + (#o316 333.0 "ogonek") + (#o317 333.0 "caron") + (#o320 1000.0 "emdash") + (#o341 1000.0 "AE") + (#o343 370.0 "ordfeminine") + (#o350 556.0 "Lslash") + (#o351 778.0 "Oslash") + (#o352 1000.0 "OE") + (#o353 365.0 "ordmasculine") + (#o361 889.0 "ae") + (#o365 278.0 "dotlessi") + (#o370 222.0 "lslash") + (#o371 611.0 "oslash") + (#o372 944.0 "oe") + (#o373 611.0 "germandbls") + )) + +(setup-laserwriter-metrics + '(("Helvetica-Bold" 1000 (-173 -241 1003 936)) + (#o040 278.0 "space") + (#o041 333.0 "exclam") + (#o042 474.0 "quotedbl") + (#o043 556.0 "numbersign") + (#o044 556.0 "dollar") + (#o045 889.0 "percent") + (#o046 722.0 "ampersand") + (#o047 278.0 "quoteright") + (#o050 333.0 "parenleft") + (#o051 333.0 "parenright") + (#o052 389.0 "asterisk") + (#o053 584.0 "plus") + (#o054 278.0 "comma") + (#o055 333.0 "hyphen") + (#o056 278.0 "period") + (#o057 278.0 "slash") + (#o060 556.0 "zero") + (#o061 556.0 "one") + (#o062 556.0 "two") + (#o063 556.0 "three") + (#o064 556.0 "four") + (#o065 556.0 "five") + (#o066 556.0 "six") + (#o067 556.0 "seven") + (#o070 556.0 "eight") + (#o071 556.0 "nine") + (#o072 333.0 "colon") + (#o073 333.0 "semicolon") + (#o074 584.0 "less") + (#o075 584.0 "equal") + (#o076 584.0 "greater") + (#o077 611.0 "question") + (#o100 975.0 "at") + (#o101 722.0 "A") + (#o102 722.0 "B") + (#o103 722.0 "C") + (#o104 722.0 "D") + (#o105 667.0 "E") + (#o106 611.0 "F") + (#o107 778.0 "G") + (#o110 722.0 "H") + (#o111 278.0 "I") + (#o112 556.0 "J") + (#o113 722.0 "K") + (#o114 611.0 "L") + (#o115 833.0 "M") + (#o116 722.0 "N") + (#o117 778.0 "O") + (#o120 667.0 "P") + (#o121 778.0 "Q") + (#o122 722.0 "R") + (#o123 667.0 "S") + (#o124 611.0 "T") + (#o125 722.0 "U") + (#o126 667.0 "V") + (#o127 944.0 "W") + (#o130 667.0 "X") + (#o131 667.0 "Y") + (#o132 611.0 "Z") + (#o133 333.0 "bracketleft") + (#o134 278.0 "backslash") + (#o135 333.0 "bracketright") + (#o136 584.0 "asciicircum") + (#o137 556.0 "underscore") + (#o140 278.0 "quoteleft") + (#o141 556.0 "a") + (#o142 611.0 "b") + (#o143 556.0 "c") + (#o144 611.0 "d") + (#o145 556.0 "e") + (#o146 333.0 "f") + (#o147 611.0 "g") + (#o150 611.0 "h") + (#o151 278.0 "i") + (#o152 278.0 "j") + (#o153 556.0 "k") + (#o154 278.0 "l") + (#o155 889.0 "m") + (#o156 611.0 "n") + (#o157 611.0 "o") + (#o160 611.0 "p") + (#o161 611.0 "q") + (#o162 389.0 "r") + (#o163 556.0 "s") + (#o164 333.0 "t") + (#o165 611.0 "u") + (#o166 556.0 "v") + (#o167 778.0 "w") + (#o170 556.0 "x") + (#o171 556.0 "y") + (#o172 500.0 "z") + (#o173 389.0 "braceleft") + (#o174 280.0 "bar") + (#o175 389.0 "braceright") + (#o176 584.0 "asciitilde") + (#o241 333.0 "exclamdown") + (#o242 556.0 "cent") + (#o243 556.0 "sterling") + (#o244 167.0 "fraction") + (#o245 556.0 "yen") + (#o246 556.0 "florin") + (#o247 556.0 "section") + (#o250 556.0 "currency") + (#o251 238.0 "quotesingle") + (#o252 500.0 "quotedblleft") + (#o253 556.0 "guillemotleft") + (#o254 333.0 "guilsinglleft") + (#o255 333.0 "guilsinglright") + (#o256 611.0 "fi") + (#o257 611.0 "fl") + (#o261 556.0 "endash") + (#o262 556.0 "dagger") + (#o263 556.0 "daggerdbl") + (#o264 278.0 "periodcentered") + (#o266 556.0 "paragraph") + (#o267 350.0 "bullet") + (#o270 278.0 "quotesinglbase") + (#o271 500.0 "quotedblbase") + (#o272 500.0 "quotedblright") + (#o273 556.0 "guillemotright") + (#o274 1000.0 "ellipsis") + (#o275 1000.0 "perthousand") + (#o277 611.0 "questiondown") + (#o301 333.0 "grave") + (#o302 333.0 "acute") + (#o303 333.0 "circumflex") + (#o304 333.0 "tilde") + (#o305 333.0 "macron") + (#o306 333.0 "breve") + (#o307 333.0 "dotaccent") + (#o310 333.0 "dieresis") + (#o312 333.0 "ring") + (#o313 333.0 "cedilla") + (#o315 333.0 "hungarumlaut") + (#o316 333.0 "ogonek") + (#o317 333.0 "caron") + (#o320 1000.0 "emdash") + (#o341 1000.0 "AE") + (#o343 370.0 "ordfeminine") + (#o350 611.0 "Lslash") + (#o351 778.0 "Oslash") + (#o352 1000.0 "OE") + (#o353 365.0 "ordmasculine") + (#o361 889.0 "ae") + (#o365 278.0 "dotlessi") + (#o370 278.0 "lslash") + (#o371 611.0 "oslash") + (#o372 944.0 "oe") + (#o373 611.0 "germandbls") + )) + +(setup-laserwriter-metrics + '(("Helvetica-BoldOblique" 1000 (-173 -241 1003 936)) + (#o040 278.0 "space") + (#o041 333.0 "exclam") + (#o042 474.0 "quotedbl") + (#o043 556.0 "numbersign") + (#o044 556.0 "dollar") + (#o045 889.0 "percent") + (#o046 722.0 "ampersand") + (#o047 278.0 "quoteright") + (#o050 333.0 "parenleft") + (#o051 333.0 "parenright") + (#o052 389.0 "asterisk") + (#o053 584.0 "plus") + (#o054 278.0 "comma") + (#o055 333.0 "hyphen") + (#o056 278.0 "period") + (#o057 278.0 "slash") + (#o060 556.0 "zero") + (#o061 556.0 "one") + (#o062 556.0 "two") + (#o063 556.0 "three") + (#o064 556.0 "four") + (#o065 556.0 "five") + (#o066 556.0 "six") + (#o067 556.0 "seven") + (#o070 556.0 "eight") + (#o071 556.0 "nine") + (#o072 333.0 "colon") + (#o073 333.0 "semicolon") + (#o074 584.0 "less") + (#o075 584.0 "equal") + (#o076 584.0 "greater") + (#o077 611.0 "question") + (#o100 975.0 "at") + (#o101 722.0 "A") + (#o102 722.0 "B") + (#o103 722.0 "C") + (#o104 722.0 "D") + (#o105 667.0 "E") + (#o106 611.0 "F") + (#o107 778.0 "G") + (#o110 722.0 "H") + (#o111 278.0 "I") + (#o112 556.0 "J") + (#o113 722.0 "K") + (#o114 611.0 "L") + (#o115 833.0 "M") + (#o116 722.0 "N") + (#o117 778.0 "O") + (#o120 667.0 "P") + (#o121 778.0 "Q") + (#o122 722.0 "R") + (#o123 667.0 "S") + (#o124 611.0 "T") + (#o125 722.0 "U") + (#o126 667.0 "V") + (#o127 944.0 "W") + (#o130 667.0 "X") + (#o131 667.0 "Y") + (#o132 611.0 "Z") + (#o133 333.0 "bracketleft") + (#o134 278.0 "backslash") + (#o135 333.0 "bracketright") + (#o136 584.0 "asciicircum") + (#o137 556.0 "underscore") + (#o140 278.0 "quoteleft") + (#o141 556.0 "a") + (#o142 611.0 "b") + (#o143 556.0 "c") + (#o144 611.0 "d") + (#o145 556.0 "e") + (#o146 333.0 "f") + (#o147 611.0 "g") + (#o150 611.0 "h") + (#o151 278.0 "i") + (#o152 278.0 "j") + (#o153 556.0 "k") + (#o154 278.0 "l") + (#o155 889.0 "m") + (#o156 611.0 "n") + (#o157 611.0 "o") + (#o160 611.0 "p") + (#o161 611.0 "q") + (#o162 389.0 "r") + (#o163 556.0 "s") + (#o164 333.0 "t") + (#o165 611.0 "u") + (#o166 556.0 "v") + (#o167 778.0 "w") + (#o170 556.0 "x") + (#o171 556.0 "y") + (#o172 500.0 "z") + (#o173 389.0 "braceleft") + (#o174 280.0 "bar") + (#o175 389.0 "braceright") + (#o176 584.0 "asciitilde") + (#o241 333.0 "exclamdown") + (#o242 556.0 "cent") + (#o243 556.0 "sterling") + (#o244 167.0 "fraction") + (#o245 556.0 "yen") + (#o246 556.0 "florin") + (#o247 556.0 "section") + (#o250 556.0 "currency") + (#o251 238.0 "quotesingle") + (#o252 500.0 "quotedblleft") + (#o253 556.0 "guillemotleft") + (#o254 333.0 "guilsinglleft") + (#o255 333.0 "guilsinglright") + (#o256 611.0 "fi") + (#o257 611.0 "fl") + (#o261 556.0 "endash") + (#o262 556.0 "dagger") + (#o263 556.0 "daggerdbl") + (#o264 278.0 "periodcentered") + (#o266 556.0 "paragraph") + (#o267 350.0 "bullet") + (#o270 278.0 "quotesinglbase") + (#o271 500.0 "quotedblbase") + (#o272 500.0 "quotedblright") + (#o273 556.0 "guillemotright") + (#o274 1000.0 "ellipsis") + (#o275 1000.0 "perthousand") + (#o277 611.0 "questiondown") + (#o301 333.0 "grave") + (#o302 333.0 "acute") + (#o303 333.0 "circumflex") + (#o304 333.0 "tilde") + (#o305 333.0 "macron") + (#o306 333.0 "breve") + (#o307 333.0 "dotaccent") + (#o310 333.0 "dieresis") + (#o312 333.0 "ring") + (#o313 333.0 "cedilla") + (#o315 333.0 "hungarumlaut") + (#o316 333.0 "ogonek") + (#o317 333.0 "caron") + (#o320 1000.0 "emdash") + (#o341 1000.0 "AE") + (#o343 370.0 "ordfeminine") + (#o350 611.0 "Lslash") + (#o351 778.0 "Oslash") + (#o352 1000.0 "OE") + (#o353 365.0 "ordmasculine") + (#o361 889.0 "ae") + (#o365 278.0 "dotlessi") + (#o370 278.0 "lslash") + (#o371 611.0 "oslash") + (#o372 944.0 "oe") + (#o373 611.0 "germandbls") + )) + + +;;; In fact, the Courier metrics never get used because they are fixed-width +;;; fonts that get handled specially by the PostScript code itself. + +(setup-laserwriter-metrics + '(("Courier" 1000 (0 -251 600 700)) + (#o040 600.0 "space") + (#o041 600.0 "exclam") + (#o042 600.0 "quotedbl") + (#o043 600.0 "numbersign") + (#o044 600.0 "dollar") + (#o045 600.0 "percent") + (#o046 600.0 "ampersand") + (#o047 600.0 "quoteright") + (#o050 600.0 "parenleft") + (#o051 600.0 "parenright") + (#o052 600.0 "asterisk") + (#o053 600.0 "plus") + (#o054 600.0 "comma") + (#o055 600.0 "hyphen") + (#o056 600.0 "period") + (#o057 600.0 "slash") + (#o060 600.0 "zero") + (#o061 600.0 "one") + (#o062 600.0 "two") + (#o063 600.0 "three") + (#o064 600.0 "four") + (#o065 600.0 "five") + (#o066 600.0 "six") + (#o067 600.0 "seven") + (#o070 600.0 "eight") + (#o071 600.0 "nine") + (#o072 600.0 "colon") + (#o073 600.0 "semicolon") + (#o074 600.0 "less") + (#o075 600.0 "equal") + (#o076 600.0 "greater") + (#o077 600.0 "question") + (#o100 600.0 "at") + (#o101 600.0 "A") + (#o102 600.0 "B") + (#o103 600.0 "C") + (#o104 600.0 "D") + (#o105 600.0 "E") + (#o106 600.0 "F") + (#o107 600.0 "G") + (#o110 600.0 "H") + (#o111 600.0 "I") + (#o112 600.0 "J") + (#o113 600.0 "K") + (#o114 600.0 "L") + (#o115 600.0 "M") + (#o116 600.0 "N") + (#o117 600.0 "O") + (#o120 600.0 "P") + (#o121 600.0 "Q") + (#o122 600.0 "R") + (#o123 600.0 "S") + (#o124 600.0 "T") + (#o125 600.0 "U") + (#o126 600.0 "V") + (#o127 600.0 "W") + (#o130 600.0 "X") + (#o131 600.0 "Y") + (#o132 600.0 "Z") + (#o133 600.0 "bracketleft") + (#o134 600.0 "backslash") + (#o135 600.0 "bracketright") + (#o136 600.0 "asciicircum") + (#o137 600.0 "underscore") + (#o140 600.0 "quoteleft") + (#o141 600.0 "a") + (#o142 600.0 "b") + (#o143 600.0 "c") + (#o144 600.0 "d") + (#o145 600.0 "e") + (#o146 600.0 "f") + (#o147 600.0 "g") + (#o150 600.0 "h") + (#o151 600.0 "i") + (#o152 600.0 "j") + (#o153 600.0 "k") + (#o154 600.0 "l") + (#o155 600.0 "m") + (#o156 600.0 "n") + (#o157 600.0 "o") + (#o160 600.0 "p") + (#o161 600.0 "q") + (#o162 600.0 "r") + (#o163 600.0 "s") + (#o164 600.0 "t") + (#o165 600.0 "u") + (#o166 600.0 "v") + (#o167 600.0 "w") + (#o170 600.0 "x") + (#o171 600.0 "y") + (#o172 600.0 "z") + (#o173 600.0 "braceleft") + (#o174 600.0 "bar") + (#o175 600.0 "braceright") + (#o176 600.0 "asciitilde") + (#o241 600.0 "exclamdown") + (#o242 600.0 "cent") + (#o243 600.0 "sterling") + (#o244 600.0 "fraction") + (#o245 600.0 "yen") + (#o246 600.0 "florin") + (#o247 600.0 "section") + (#o250 600.0 "currency") + (#o251 600.0 "quotesingle") + (#o252 600.0 "quotedblleft") + (#o253 600.0 "guillemotleft") + (#o254 600.0 "guilsinglleft") + (#o255 600.0 "guilsinglright") + (#o256 600.0 "fi") + (#o257 600.0 "fl") + (#o261 600.0 "endash") + (#o262 600.0 "dagger") + (#o263 600.0 "daggerdbl") + (#o264 600.0 "periodcentered") + (#o266 600.0 "paragraph") + (#o267 600.0 "bullet") + (#o270 600.0 "quotesinglbase") + (#o271 600.0 "quotedblbase") + (#o272 600.0 "quotedblright") + (#o273 600.0 "guillemotright") + (#o274 600.0 "ellipsis") + (#o275 600.0 "perthousand") + (#o277 600.0 "questiondown") + (#o301 600.0 "grave") + (#o302 600.0 "acute") + (#o303 600.0 "circumflex") + (#o304 600.0 "tilde") + (#o305 600.0 "macron") + (#o306 600.0 "breve") + (#o307 600.0 "dotaccent") + (#o310 600.0 "dieresis") + (#o312 600.0 "ring") + (#o313 600.0 "cedilla") + (#o315 600.0 "hungarumlaut") + (#o316 600.0 "ogonek") + (#o317 600.0 "caron") + (#o320 600.0 "emdash") + (#o341 600.0 "AE") + (#o343 600.0 "ordfeminine") + (#o350 600.0 "Lslash") + (#o351 600.0 "Oslash") + (#o352 600.0 "OE") + (#o353 600.0 "ordmasculine") + (#o361 600.0 "ae") + (#o365 600.0 "dotlessi") + (#o370 600.0 "lslash") + (#o371 600.0 "oslash") + (#o372 600.0 "oe") + (#o373 600.0 "germandbls") + )) + +(setup-laserwriter-metrics + '(("Courier-Oblique" 1000 (0 -251 600 700)) + (#o040 600.0 "space") + (#o041 600.0 "exclam") + (#o042 600.0 "quotedbl") + (#o043 600.0 "numbersign") + (#o044 600.0 "dollar") + (#o045 600.0 "percent") + (#o046 600.0 "ampersand") + (#o047 600.0 "quoteright") + (#o050 600.0 "parenleft") + (#o051 600.0 "parenright") + (#o052 600.0 "asterisk") + (#o053 600.0 "plus") + (#o054 600.0 "comma") + (#o055 600.0 "hyphen") + (#o056 600.0 "period") + (#o057 600.0 "slash") + (#o060 600.0 "zero") + (#o061 600.0 "one") + (#o062 600.0 "two") + (#o063 600.0 "three") + (#o064 600.0 "four") + (#o065 600.0 "five") + (#o066 600.0 "six") + (#o067 600.0 "seven") + (#o070 600.0 "eight") + (#o071 600.0 "nine") + (#o072 600.0 "colon") + (#o073 600.0 "semicolon") + (#o074 600.0 "less") + (#o075 600.0 "equal") + (#o076 600.0 "greater") + (#o077 600.0 "question") + (#o100 600.0 "at") + (#o101 600.0 "A") + (#o102 600.0 "B") + (#o103 600.0 "C") + (#o104 600.0 "D") + (#o105 600.0 "E") + (#o106 600.0 "F") + (#o107 600.0 "G") + (#o110 600.0 "H") + (#o111 600.0 "I") + (#o112 600.0 "J") + (#o113 600.0 "K") + (#o114 600.0 "L") + (#o115 600.0 "M") + (#o116 600.0 "N") + (#o117 600.0 "O") + (#o120 600.0 "P") + (#o121 600.0 "Q") + (#o122 600.0 "R") + (#o123 600.0 "S") + (#o124 600.0 "T") + (#o125 600.0 "U") + (#o126 600.0 "V") + (#o127 600.0 "W") + (#o130 600.0 "X") + (#o131 600.0 "Y") + (#o132 600.0 "Z") + (#o133 600.0 "bracketleft") + (#o134 600.0 "backslash") + (#o135 600.0 "bracketright") + (#o136 600.0 "asciicircum") + (#o137 600.0 "underscore") + (#o140 600.0 "quoteleft") + (#o141 600.0 "a") + (#o142 600.0 "b") + (#o143 600.0 "c") + (#o144 600.0 "d") + (#o145 600.0 "e") + (#o146 600.0 "f") + (#o147 600.0 "g") + (#o150 600.0 "h") + (#o151 600.0 "i") + (#o152 600.0 "j") + (#o153 600.0 "k") + (#o154 600.0 "l") + (#o155 600.0 "m") + (#o156 600.0 "n") + (#o157 600.0 "o") + (#o160 600.0 "p") + (#o161 600.0 "q") + (#o162 600.0 "r") + (#o163 600.0 "s") + (#o164 600.0 "t") + (#o165 600.0 "u") + (#o166 600.0 "v") + (#o167 600.0 "w") + (#o170 600.0 "x") + (#o171 600.0 "y") + (#o172 600.0 "z") + (#o173 600.0 "braceleft") + (#o174 600.0 "bar") + (#o175 600.0 "braceright") + (#o176 600.0 "asciitilde") + (#o241 600.0 "exclamdown") + (#o242 600.0 "cent") + (#o243 600.0 "sterling") + (#o244 600.0 "fraction") + (#o245 600.0 "yen") + (#o246 600.0 "florin") + (#o247 600.0 "section") + (#o250 600.0 "currency") + (#o251 600.0 "quotesingle") + (#o252 600.0 "quotedblleft") + (#o253 600.0 "guillemotleft") + (#o254 600.0 "guilsinglleft") + (#o255 600.0 "guilsinglright") + (#o256 600.0 "fi") + (#o257 600.0 "fl") + (#o261 600.0 "endash") + (#o262 600.0 "dagger") + (#o263 600.0 "daggerdbl") + (#o264 600.0 "periodcentered") + (#o266 600.0 "paragraph") + (#o267 600.0 "bullet") + (#o270 600.0 "quotesinglbase") + (#o271 600.0 "quotedblbase") + (#o272 600.0 "quotedblright") + (#o273 600.0 "guillemotright") + (#o274 600.0 "ellipsis") + (#o275 600.0 "perthousand") + (#o277 600.0 "questiondown") + (#o301 600.0 "grave") + (#o302 600.0 "acute") + (#o303 600.0 "circumflex") + (#o304 600.0 "tilde") + (#o305 600.0 "macron") + (#o306 600.0 "breve") + (#o307 600.0 "dotaccent") + (#o310 600.0 "dieresis") + (#o312 600.0 "ring") + (#o313 600.0 "cedilla") + (#o315 600.0 "hungarumlaut") + (#o316 600.0 "ogonek") + (#o317 600.0 "caron") + (#o320 600.0 "emdash") + (#o341 600.0 "AE") + (#o343 600.0 "ordfeminine") + (#o350 600.0 "Lslash") + (#o351 600.0 "Oslash") + (#o352 600.0 "OE") + (#o353 600.0 "ordmasculine") + (#o361 600.0 "ae") + (#o365 600.0 "dotlessi") + (#o370 600.0 "lslash") + (#o371 600.0 "oslash") + (#o372 600.0 "oe") + (#o373 600.0 "germandbls") + )) + +(setup-laserwriter-metrics + '(("Courier-Bold" 1000 (0 -251 600 700)) + (#o040 600.0 "space") + (#o041 600.0 "exclam") + (#o042 600.0 "quotedbl") + (#o043 600.0 "numbersign") + (#o044 600.0 "dollar") + (#o045 600.0 "percent") + (#o046 600.0 "ampersand") + (#o047 600.0 "quoteright") + (#o050 600.0 "parenleft") + (#o051 600.0 "parenright") + (#o052 600.0 "asterisk") + (#o053 600.0 "plus") + (#o054 600.0 "comma") + (#o055 600.0 "hyphen") + (#o056 600.0 "period") + (#o057 600.0 "slash") + (#o060 600.0 "zero") + (#o061 600.0 "one") + (#o062 600.0 "two") + (#o063 600.0 "three") + (#o064 600.0 "four") + (#o065 600.0 "five") + (#o066 600.0 "six") + (#o067 600.0 "seven") + (#o070 600.0 "eight") + (#o071 600.0 "nine") + (#o072 600.0 "colon") + (#o073 600.0 "semicolon") + (#o074 600.0 "less") + (#o075 600.0 "equal") + (#o076 600.0 "greater") + (#o077 600.0 "question") + (#o100 600.0 "at") + (#o101 600.0 "A") + (#o102 600.0 "B") + (#o103 600.0 "C") + (#o104 600.0 "D") + (#o105 600.0 "E") + (#o106 600.0 "F") + (#o107 600.0 "G") + (#o110 600.0 "H") + (#o111 600.0 "I") + (#o112 600.0 "J") + (#o113 600.0 "K") + (#o114 600.0 "L") + (#o115 600.0 "M") + (#o116 600.0 "N") + (#o117 600.0 "O") + (#o120 600.0 "P") + (#o121 600.0 "Q") + (#o122 600.0 "R") + (#o123 600.0 "S") + (#o124 600.0 "T") + (#o125 600.0 "U") + (#o126 600.0 "V") + (#o127 600.0 "W") + (#o130 600.0 "X") + (#o131 600.0 "Y") + (#o132 600.0 "Z") + (#o133 600.0 "bracketleft") + (#o134 600.0 "backslash") + (#o135 600.0 "bracketright") + (#o136 600.0 "asciicircum") + (#o137 600.0 "underscore") + (#o140 600.0 "quoteleft") + (#o141 600.0 "a") + (#o142 600.0 "b") + (#o143 600.0 "c") + (#o144 600.0 "d") + (#o145 600.0 "e") + (#o146 600.0 "f") + (#o147 600.0 "g") + (#o150 600.0 "h") + (#o151 600.0 "i") + (#o152 600.0 "j") + (#o153 600.0 "k") + (#o154 600.0 "l") + (#o155 600.0 "m") + (#o156 600.0 "n") + (#o157 600.0 "o") + (#o160 600.0 "p") + (#o161 600.0 "q") + (#o162 600.0 "r") + (#o163 600.0 "s") + (#o164 600.0 "t") + (#o165 600.0 "u") + (#o166 600.0 "v") + (#o167 600.0 "w") + (#o170 600.0 "x") + (#o171 600.0 "y") + (#o172 600.0 "z") + (#o173 600.0 "braceleft") + (#o174 600.0 "bar") + (#o175 600.0 "braceright") + (#o176 600.0 "asciitilde") + (#o241 600.0 "exclamdown") + (#o242 600.0 "cent") + (#o243 600.0 "sterling") + (#o244 600.0 "fraction") + (#o245 600.0 "yen") + (#o246 600.0 "florin") + (#o247 600.0 "section") + (#o250 600.0 "currency") + (#o251 600.0 "quotesingle") + (#o252 600.0 "quotedblleft") + (#o253 600.0 "guillemotleft") + (#o254 600.0 "guilsinglleft") + (#o255 600.0 "guilsinglright") + (#o256 600.0 "fi") + (#o257 600.0 "fl") + (#o261 600.0 "endash") + (#o262 600.0 "dagger") + (#o263 600.0 "daggerdbl") + (#o264 600.0 "periodcentered") + (#o266 600.0 "paragraph") + (#o267 600.0 "bullet") + (#o270 600.0 "quotesinglbase") + (#o271 600.0 "quotedblbase") + (#o272 600.0 "quotedblright") + (#o273 600.0 "guillemotright") + (#o274 600.0 "ellipsis") + (#o275 600.0 "perthousand") + (#o277 600.0 "questiondown") + (#o301 600.0 "grave") + (#o302 600.0 "acute") + (#o303 600.0 "circumflex") + (#o304 600.0 "tilde") + (#o305 600.0 "macron") + (#o306 600.0 "breve") + (#o307 600.0 "dotaccent") + (#o310 600.0 "dieresis") + (#o312 600.0 "ring") + (#o313 600.0 "cedilla") + (#o315 600.0 "hungarumlaut") + (#o316 600.0 "ogonek") + (#o317 600.0 "caron") + (#o320 600.0 "emdash") + (#o341 600.0 "AE") + (#o343 600.0 "ordfeminine") + (#o350 600.0 "Lslash") + (#o351 600.0 "Oslash") + (#o352 600.0 "OE") + (#o353 600.0 "ordmasculine") + (#o361 600.0 "ae") + (#o365 600.0 "dotlessi") + (#o370 600.0 "lslash") + (#o371 600.0 "oslash") + (#o372 600.0 "oe") + (#o373 600.0 "germandbls") + )) + +(setup-laserwriter-metrics + '(("Courier-BoldOblique" 1000 (0 -251 600 700)) + (#o040 600.0 "space") + (#o041 600.0 "exclam") + (#o042 600.0 "quotedbl") + (#o043 600.0 "numbersign") + (#o044 600.0 "dollar") + (#o045 600.0 "percent") + (#o046 600.0 "ampersand") + (#o047 600.0 "quoteright") + (#o050 600.0 "parenleft") + (#o051 600.0 "parenright") + (#o052 600.0 "asterisk") + (#o053 600.0 "plus") + (#o054 600.0 "comma") + (#o055 600.0 "hyphen") + (#o056 600.0 "period") + (#o057 600.0 "slash") + (#o060 600.0 "zero") + (#o061 600.0 "one") + (#o062 600.0 "two") + (#o063 600.0 "three") + (#o064 600.0 "four") + (#o065 600.0 "five") + (#o066 600.0 "six") + (#o067 600.0 "seven") + (#o070 600.0 "eight") + (#o071 600.0 "nine") + (#o072 600.0 "colon") + (#o073 600.0 "semicolon") + (#o074 600.0 "less") + (#o075 600.0 "equal") + (#o076 600.0 "greater") + (#o077 600.0 "question") + (#o100 600.0 "at") + (#o101 600.0 "A") + (#o102 600.0 "B") + (#o103 600.0 "C") + (#o104 600.0 "D") + (#o105 600.0 "E") + (#o106 600.0 "F") + (#o107 600.0 "G") + (#o110 600.0 "H") + (#o111 600.0 "I") + (#o112 600.0 "J") + (#o113 600.0 "K") + (#o114 600.0 "L") + (#o115 600.0 "M") + (#o116 600.0 "N") + (#o117 600.0 "O") + (#o120 600.0 "P") + (#o121 600.0 "Q") + (#o122 600.0 "R") + (#o123 600.0 "S") + (#o124 600.0 "T") + (#o125 600.0 "U") + (#o126 600.0 "V") + (#o127 600.0 "W") + (#o130 600.0 "X") + (#o131 600.0 "Y") + (#o132 600.0 "Z") + (#o133 600.0 "bracketleft") + (#o134 600.0 "backslash") + (#o135 600.0 "bracketright") + (#o136 600.0 "asciicircum") + (#o137 600.0 "underscore") + (#o140 600.0 "quoteleft") + (#o141 600.0 "a") + (#o142 600.0 "b") + (#o143 600.0 "c") + (#o144 600.0 "d") + (#o145 600.0 "e") + (#o146 600.0 "f") + (#o147 600.0 "g") + (#o150 600.0 "h") + (#o151 600.0 "i") + (#o152 600.0 "j") + (#o153 600.0 "k") + (#o154 600.0 "l") + (#o155 600.0 "m") + (#o156 600.0 "n") + (#o157 600.0 "o") + (#o160 600.0 "p") + (#o161 600.0 "q") + (#o162 600.0 "r") + (#o163 600.0 "s") + (#o164 600.0 "t") + (#o165 600.0 "u") + (#o166 600.0 "v") + (#o167 600.0 "w") + (#o170 600.0 "x") + (#o171 600.0 "y") + (#o172 600.0 "z") + (#o173 600.0 "braceleft") + (#o174 600.0 "bar") + (#o175 600.0 "braceright") + (#o176 600.0 "asciitilde") + (#o241 600.0 "exclamdown") + (#o242 600.0 "cent") + (#o243 600.0 "sterling") + (#o244 600.0 "fraction") + (#o245 600.0 "yen") + (#o246 600.0 "florin") + (#o247 600.0 "section") + (#o250 600.0 "currency") + (#o251 600.0 "quotesingle") + (#o252 600.0 "quotedblleft") + (#o253 600.0 "guillemotleft") + (#o254 600.0 "guilsinglleft") + (#o255 600.0 "guilsinglright") + (#o256 600.0 "fi") + (#o257 600.0 "fl") + (#o261 600.0 "endash") + (#o262 600.0 "dagger") + (#o263 600.0 "daggerdbl") + (#o264 600.0 "periodcentered") + (#o266 600.0 "paragraph") + (#o267 600.0 "bullet") + (#o270 600.0 "quotesinglbase") + (#o271 600.0 "quotedblbase") + (#o272 600.0 "quotedblright") + (#o273 600.0 "guillemotright") + (#o274 600.0 "ellipsis") + (#o275 600.0 "perthousand") + (#o277 600.0 "questiondown") + (#o301 600.0 "grave") + (#o302 600.0 "acute") + (#o303 600.0 "circumflex") + (#o304 600.0 "tilde") + (#o305 600.0 "macron") + (#o306 600.0 "breve") + (#o307 600.0 "dotaccent") + (#o310 600.0 "dieresis") + (#o312 600.0 "ring") + (#o313 600.0 "cedilla") + (#o315 600.0 "hungarumlaut") + (#o316 600.0 "ogonek") + (#o317 600.0 "caron") + (#o320 600.0 "emdash") + (#o341 600.0 "AE") + (#o343 600.0 "ordfeminine") + (#o350 600.0 "Lslash") + (#o351 600.0 "Oslash") + (#o352 600.0 "OE") + (#o353 600.0 "ordmasculine") + (#o361 600.0 "ae") + (#o365 600.0 "dotlessi") + (#o370 600.0 "lslash") + (#o371 600.0 "oslash") + (#o372 600.0 "oe") + (#o373 600.0 "germandbls") + )) + + +(setup-laserwriter-metrics + '(("Symbol" 1000 (-180 -293 1090 1010)) + (#o040 250.0 "space") + (#o041 333.0 "exclam") + (#o042 713.0 "universal") + (#o043 500.0 "numbersign") + (#o044 549.0 "existential") + (#o045 833.0 "percent") + (#o046 778.0 "ampersand") + (#o047 439.0 "suchthat") + (#o050 333.0 "parenleft") + (#o051 333.0 "parenright") + (#o052 500.0 "asteriskmath") + (#o053 549.0 "plus") + (#o054 250.0 "comma") + (#o055 549.0 "minus") + (#o056 250.0 "period") + (#o057 278.0 "slash") + (#o060 500.0 "zero") + (#o061 500.0 "one") + (#o062 500.0 "two") + (#o063 500.0 "three") + (#o064 500.0 "four") + (#o065 500.0 "five") + (#o066 500.0 "six") + (#o067 500.0 "seven") + (#o070 500.0 "eight") + (#o071 500.0 "nine") + (#o072 278.0 "colon") + (#o073 278.0 "semicolon") + (#o074 549.0 "less") + (#o075 549.0 "equal") + (#o076 549.0 "greater") + (#o077 444.0 "question") + (#o100 549.0 "congruent") + (#o101 696.0 "Alpha") + (#o102 660.0 "Beta") + (#o103 710.0 "Chi") + (#o104 612.0 "Delta") + (#o105 652.0 "Epsilon") + (#o106 763.0 "Phi") + (#o107 603.0 "Gamma") + (#o110 765.0 "Eta") + (#o111 351.0 "Iota") + (#o112 631.0 "theta1") + (#o113 724.0 "Kappa") + (#o114 686.0 "Lambda") + (#o115 918.0 "Mu") + (#o116 739.0 "Nu") + (#o117 750.0 "Omicron") + (#o120 768.0 "Pi") + (#o121 741.0 "Theta") + (#o122 580.0 "Rho") + (#o123 592.0 "Sigma") + (#o124 632.0 "Tau") + (#o125 690.0 "Upsilon") + (#o126 439.0 "sigma1") + (#o127 768.0 "Omega") + (#o130 645.0 "Xi") + (#o131 795.0 "Psi") + (#o132 650.0 "Zeta") + (#o133 333.0 "bracketleft") + (#o134 863.0 "therefore") + (#o135 333.0 "bracketright") + (#o136 658.0 "perpendicular") + (#o137 500.0 "underscore") + (#o140 500.0 "radicalex") + (#o141 631.0 "alpha") + (#o142 549.0 "beta") + (#o143 549.0 "chi") + (#o144 494.0 "delta") + (#o145 439.0 "epsilon") + (#o146 521.0 "phi") + (#o147 411.0 "gamma") + (#o150 603.0 "eta") + (#o151 329.0 "iota") + (#o152 603.0 "phi1") + (#o153 549.0 "kappa") + (#o154 549.0 "lambda") + (#o155 576.0 "mu") + (#o156 521.0 "nu") + (#o157 549.0 "omicron") + (#o160 549.0 "pi") + (#o161 521.0 "theta") + (#o162 549.0 "rho") + (#o163 603.0 "sigma") + (#o164 439.0 "tau") + (#o165 576.0 "upsilon") + (#o166 713.0 "omega1") + (#o167 686.0 "omega") + (#o170 493.0 "xi") + (#o171 686.0 "psi") + (#o172 494.0 "zeta") + (#o173 480.0 "braceleft") + (#o174 200.0 "bar") + (#o175 480.0 "braceright") + (#o176 549.0 "similar") + (#o241 620.0 "Upsilon1") + (#o242 247.0 "minute") + (#o243 549.0 "lessequal") + (#o244 167.0 "fraction") + (#o245 713.0 "infinity") + (#o246 500.0 "florin") + (#o247 753.0 "club") + (#o250 753.0 "diamond") + (#o251 753.0 "heart") + (#o252 753.0 "spade") + (#o253 1042.0 "arrowboth") + (#o254 987.0 "arrowleft") + (#o255 603.0 "arrowup") + (#o256 987.0 "arrowright") + (#o257 603.0 "arrowdown") + (#o260 400.0 "degree") + (#o261 549.0 "plusminus") + (#o262 411.0 "second") + (#o263 549.0 "greaterequal") + (#o264 549.0 "multiply") + (#o265 713.0 "proportional") + (#o266 494.0 "partialdiff") + (#o267 460.0 "bullet") + (#o270 549.0 "divide") + (#o271 549.0 "notequal") + (#o272 549.0 "equivalence") + (#o273 549.0 "approxequal") + (#o274 1000.0 "ellipsis") + (#o275 603.0 "arrowvertex") + (#o276 1000.0 "arrowhorizex") + (#o277 658.0 "carriagereturn") + (#o300 823.0 "aleph") + (#o301 686.0 "Ifraktur") + (#o302 795.0 "Rfraktur") + (#o303 987.0 "weierstrass") + (#o304 768.0 "circlemultiply") + (#o305 768.0 "circleplus") + (#o306 823.0 "emptyset") + (#o307 768.0 "intersection") + (#o310 768.0 "union") + (#o311 713.0 "propersuperset") + (#o312 713.0 "reflexsuperset") + (#o313 713.0 "notsubset") + (#o314 713.0 "propersubset") + (#o315 713.0 "reflexsubset") + (#o316 713.0 "element") + (#o317 713.0 "notelement") + (#o320 768.0 "angle") + (#o321 713.0 "gradient") + (#o322 790.0 "registerserif") + (#o323 790.0 "copyrightserif") + (#o324 890.0 "trademarkserif") + (#o325 823.0 "product") + (#o326 549.0 "radical") + (#o327 250.0 "dotmath") + (#o330 713.0 "logicalnot") + (#o331 603.0 "logicaland") + (#o332 603.0 "logicalor") + (#o333 1042.0 "arrowdblboth") + (#o334 987.0 "arrowdblleft") + (#o335 603.0 "arrowdblup") + (#o336 987.0 "arrowdblright") + (#o337 603.0 "arrowdbldown") + (#o340 494.0 "lozenge") + (#o341 329.0 "angleleft") + (#o342 790.0 "registersans") + (#o343 790.0 "copyrightsans") + (#o344 786.0 "trademarksans") + (#o345 713.0 "summation") + (#o346 384.0 "parenlefttp") + (#o347 384.0 "parenleftex") + (#o350 384.0 "parenleftbt") + (#o351 384.0 "bracketlefttp") + (#o352 384.0 "bracketleftex") + (#o353 384.0 "bracketleftbt") + (#o354 494.0 "bracelefttp") + (#o355 494.0 "braceleftmid") + (#o356 494.0 "braceleftbt") + (#o357 494.0 "braceex") + (#o360 790.0 "apple") + (#o361 329.0 "angleright") + (#o362 274.0 "integral") + (#o363 686.0 "integraltp") + (#o364 686.0 "integralex") + (#o365 686.0 "integralbt") + (#o366 384.0 "parenrighttp") + (#o367 384.0 "parenrightex") + (#o370 384.0 "parenrightbt") + (#o371 384.0 "bracketrighttp") + (#o372 384.0 "bracketrightex") + (#o373 384.0 "bracketrightbt") + (#o374 494.0 "bracerighttp") + (#o375 494.0 "bracerightmid") + (#o376 494.0 "bracerightbt") + )) + + +;;; If you suspect the numbers above, you can run this postscript program +;;; (probably by copying it to a file and printing that file) and compare +;;; the numbers that get printed with those of the corresponding fonts and +;;; characters above. Remember that the numbers above are scaled to be +;;; 1000 times as big (second element of the car of the first argument of +;;; SETUP-LASERWRITER-METRICS is the scale factor) as the widths this +;;; program will print. + +#|| +%! +% Postscript program to print out the widths of a representative set of +% characters in each of several fonts. + +% By Mark Nahabedian, 1/8/90, Symbolics Inc. + +% Sample set of characters toprint out widths for: +/TheseChars (1AaMN.ilI!) def + +% Sample sets of fonts to print out widths of characters for: +/TheseFonts [ /Helvetica-BoldOblique /Times-Roman ] def +/CourierFonts [ /Courier /Courier-Bold /Courier-Oblique /Courier-BoldOblique ] def + +% Text 'cursor' positioning stuff: +/StartPage { /y 700 def } def +/NextLine { /y y 20 sub def } def +/Space { ( ) show } def +/Tab0 { 30 y moveto } def +/Tab1 { 178 y moveto } def +/Tab2 { 230 y moveto } def + +/stringbuf 100 string def + +% single character string interval +/DoChar { + Tab1 scaled setfont + dup show + Tab2 unscaled setfont + stringwidth pop stringbuf cvs + scaled setfont show NextLine +} def + +% fontname +/FontSetup { + findfont dup /unscaled exch def + /scaled exch 10 scalefont def +} def + +% X Y +/ShowXandY { + stringbuf cvs show Space + stringbuf cvs show +} def + +% fontdict +/ShowFontBBox { + ([ ) show + dup /FontMatrix get dup 3 -1 roll % stack: fontdict, FontMatrix, FontMatrix + /FontBBox get dup 0 get exch + dup 1 get exch + % stack: BBox, BBox[1], BBox[0], FontMatrix, FontMatrix + 4 1 roll 3 -1 roll + transform exch ShowXandY Space + dup 2 get exch + 3 get + % stack: BBox[3], BBox[2], FontMatrix + 3 -1 roll + transform exch ShowXandY Space + ( ]) show +} def + +% fontname +/DoFont { + dup FontSetup + scaled setfont Tab0 + stringbuf cvs show Tab1 + unscaled ShowFontBBox NextLine + 0 1 TheseChars length 1 sub { TheseChars exch 1 getinterval DoChar } for +} def + +% I tried doing this with forall but it didn't work. + +StartPage +0 1 TheseFonts length 1 sub { TheseFonts exch get DoFont } for +showpage + +StartPage +0 1 CourierFonts length 1 sub { CourierFonts exch get DoFont } for +showpage + +||# diff --git a/postscript/pkgdcl.lisp b/postscript/pkgdcl.lisp new file mode 100644 index 0000000000000000000000000000000000000000..68a1fcb41dbba5c11e19161eb17ac4cab36a5b18 --- /dev/null +++ b/postscript/pkgdcl.lisp @@ -0,0 +1,11 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- + +;; $fiHeader: pkgdcl.lisp,v 1.1 92/02/24 13:28:11 cer Exp $ + +(in-package #-ANSI-90 :user #+ANSI-90 :common-lisp-user) + +"Copyright (c) 1992 Symbolics, Inc. All rights reserved." + +(#-ANSI-90 clim-lisp::defpackage #+ANSI-90 defpackage postscript-clim + (:use clim-lisp clim-sys clim clim-utils silica)) + diff --git a/postscript/postscript-medium.lisp b/postscript/postscript-medium.lisp new file mode 100644 index 0000000000000000000000000000000000000000..51509c3613ea1cb310d7641c45ab570fd3176fe4 --- /dev/null +++ b/postscript/postscript-medium.lisp @@ -0,0 +1,491 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*- + +;; $fiHeader: postscript-medium.lisp,v 1.1 92/02/24 13:08:01 cer Exp $ + +(in-package :postscript-clim) + +"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." + +(defmacro convert-to-postscript-coordinates (transform &body positions) + (assert (evenp (length positions)) (positions) + "There must be an even number of elements in ~S" positions) + (let ((forms nil)) + (loop + (when (null positions) + (return `(progn ,@(nreverse forms)))) + (let* ((x (pop positions)) + (y (pop positions))) + (push `(multiple-value-setq (,x ,y) + (transform-position ,transform ,x ,y)) + forms))))) + +(defmacro convert-to-postscript-distances (transform &body positions) + (assert (evenp (length positions)) (positions) + "There must be an even number of elements in ~S" positions) + (let ((forms nil)) + (loop + (when (null positions) + (return `(progn ,@(nreverse forms)))) + (let* ((x (pop positions)) + (y (pop positions))) + (push `(multiple-value-setq (,x ,y) + (transform-distance ,transform ,x ,y)) + forms))))) + +(defun use-line-style (stream line-style) + (let ((thickness (case (line-style-unit line-style) + (:normal (normal-line-thickness (stream-display-device-type stream) + (line-style-thickness line-style))) + (:points (line-style-thickness line-style)))) + (dashes (line-style-dashes line-style))) + (with-slots (printer-stream) stream + (format printer-stream " ~D setlinewidth~%" thickness) + (when dashes + (making-ps-array (printer-stream) + (let ((limit (length dashes))) + (dotimes (i limit) + (write (elt dashes i) :stream printer-stream :escape nil) + (unless (>= (1+ i) limit) + (write-char #\space printer-stream))))) + (format printer-stream "0 setdash~%"))))) + +(defun color-equal (c1 c2) + (or (eq c1 c2) + (and (colorp c1) + (colorp c2) + (multiple-value-bind (r1 g1 b1) (color-rgb c1) + (multiple-value-bind (r2 g2 b2) (color-rgb c2) + (and (= r1 r2) (= g1 g2) (= b1 b2))))))) + +(defmethod maybe-set-color + ((stream postscript-medium) (ink (eql +foreground-ink+))) + (maybe-set-color stream (or (slot-value stream 'current-color) +black+))) + +(defmethod maybe-set-color + ((stream postscript-medium) (ink (eql +background-ink+))) + (maybe-set-color stream +white+)) + +(defmethod maybe-set-color + ((stream postscript-medium) (ink flipping-ink)) + (error "Postscript devices can't draw with flipping inks.")) + +(defmethod maybe-set-color ((stream postscript-medium) (ink color)) + (with-slots (current-color printer-stream) stream + (when (or (null current-color) + (not (color-equal current-color ink))) + (setf current-color ink) + (multiple-value-bind (r g b) (color-rgb ink) + (format printer-stream " ~,2F ~,2F ~,2F setrgbcolor~%" r g b))))) + +(defmethod maybe-set-color ((stream postscript-medium) (ink rectangular-tile)) + ;; Handled in the patterned fill/stroke case + ) + +(defmethod maybe-set-color + ((stream postscript-medium) (ink contrasting-ink)) + (maybe-set-color stream (make-color-for-contrasting-ink ink))) + +(defmacro with-postscript-drawing-options ((stream printer-stream-var + &key ink line-style epilogue (newpath T)) + &body body) + (let ((printer-stream (or printer-stream-var (make-symbol "printer-stream")))) + `(let ((,printer-stream (slot-value ,stream 'printer-stream))) + (when ,line-style + (use-line-style ,stream ,line-style)) + (maybe-set-color ,stream ,ink) + ,@(when newpath `((format ,printer-stream " newpath~%"))) + ,@body + ,@(case epilogue + (:default `((if (null ,line-style) + (ps-fill ,stream ,printer-stream ,ink) + (ps-stroke ,stream ,printer-stream ,ink)))) + (:fill `((ps-fill ,stream ,printer-stream ,ink))) + (:stroke `((ps-stroke ,stream ,printer-stream ,ink))))))) + +(defmethod medium-draw-point* ((medium clx-medium) x y) + (let* ((transform +identity-transformation+) + (ink (medium-ink medium)) + (line-style (medium-line-style medium))) + (with-postscript-drawing-options (medium printer-stream + :epilogue :stroke + :ink ink :line-style line-style) + (ps-pos-op medium "m" x y) + (ps-rel-pos-op medium "rlineto" 0 0)) + (annotating-postscript (medium printer-stream) + (format printer-stream " (medium-draw-point* ~D ~D ...)" + x y)))) + +(defmethod medium-draw-line* ((medium postscript-medium) x1 y1 x2 y2) + (let* ((transform +identity-transformation+) + (ink (medium-ink medium)) + (line-style (medium-line-style medium))) + (convert-to-postscript-coordinates transform + x1 y1 x2 y2) + (with-postscript-drawing-options (medium printer-stream + :epilogue :stroke + :ink ink :line-style line-style) + (ps-pos-op medium "m" start-x start-y) + (ps-pos-op medium "lineto" end-x end-y)) + (annotating-postscript (medium printer-stream) + (format printer-stream " (medium-draw-line* ~D ~D ~D ~D ...)" + start-x start-y end-x end-y)))) + +(defmethod medium-draw-rectangle* ((medium postscript-medium) + left top right bottom filled) + (let* ((transform +identity-transformation+) + (ink (medium-ink medium)) + (line-style (medium-line-style medium))) + (convert-to-postscript-coordinates transform + left top right bottom) + (with-postscript-drawing-options (medium printer-stream + :epilogue :default + :ink ink :line-style line-style) + (ps-pos-op medium "m" left top) + (ps-pos-op medium "lineto" right top) + (ps-pos-op medium "lineto" right bottom) + (ps-pos-op medium "lineto" left bottom) + (format printer-stream " closepath ")) ;no cr + (annotating-postscript (medium printer-stream) + (format printer-stream " (medium-draw-rectangle* ~D ~D ~D ~D ...)" + left top right bottom)))) + +;;--- POSITION-SEQ can be a general sequence! +(defmethod medium-draw-polygon* ((medium postscript-medium) position-seq closed filled) + (let* ((transform +identity-transformation+) + (ink (medium-ink medium)) + (line-style (medium-line-style medium))) + (let ((minx most-positive-fixnum) + (miny most-positive-fixnum) + (points (copy-list position-seq))) + (do* ((points points (cddr points))) + ((null points)) + (let ((x (first points)) + (y (second points))) + (convert-to-postscript-coordinates transform x y) + (setf (first points) x) + (setf (second points) y) + (if (< x minx) (setq minx x)) + (if (< y miny) (setq miny y)))) + (with-postscript-drawing-options (medium printer-stream + :epilogue :default + :ink ink :line-style line-style) + (let ((start-x (first points)) + (start-y (second points))) + (ps-pos-op medium "m" start-x start-y) + (do* ((points (cddr points) (cddr points)) + (ex (first points) (first points)) + (ey (second points) (second points))) + ((null points) + (when closed + (format printer-stream " closepath "))) + (ps-pos-op medium "lineto" ex ey)))) + (annotating-postscript (medium printer-stream) + (format printer-stream " (medium-draw-polygon* ~A ...)" + position-seq))))) + +(defmethod medium-draw-ellipse* ((medium postscript-medium) + center-x center-y + radius-1-dx radius-1-dy radius-2-dx radius-2-dy + start-angle end-angle filled) + (maybe-send-feature medium 'ellipse *ps-ellipse-code*) + (let* ((transform +identity-transformation+) + (ink (medium-ink medium)) + (line-style (medium-line-style medium))) + (convert-to-postscript-coordinates transform center-x center-y) + (convert-to-postscript-distances transform + radius-1-dx radius-1-dy radius-2-dx radius-2-dy) + (when (null start-angle) + (setq start-angle 0 + end-angle 2pi)) + (when (< end-angle start-angle) + (setq end-angle (+ end-angle 2pi))) + (multiple-value-bind (x-radius y-radius) + (cond ((and (= radius-1-dx 0) (= radius-2-dy 0)) + (values (abs radius-2-dx) (abs radius-1-dy))) + ((and (= radius-2-dx 0) (= radius-1-dy 0)) + (values (abs radius-1-dx) (abs radius-2-dy))) + (t (nyi))) + (pixels-to-points x-radius y-radius) + (flet ((skew-angle (a) + (atan (* (sin a) x-radius) + (* (cos a) y-radius)))) + (with-postscript-drawing-options (medium printer-stream + :epilogue :default + :ink ink :line-style line-style) + (ps-pos-op medium "ellipse" center-x center-y + x-radius y-radius + ;; don't allow the common full-circle case to be + ;; screwed up by floating point error: + (if (zerop start-angle) + 0 + (radians->degrees (skew-angle start-angle))) + (if (= end-angle 2pi) + 360 + (radians->degrees (skew-angle end-angle))))) + (annotating-postscript (medium printer-stream) + (format printer-stream + " (medium-draw-ellipse* ~D ~D ~D ~D ~D ~D ~D ~D ...)" + center-x center-y + radius-1-dx radius-1-dy + radius-2-dx radius-2-dy + start-angle end-angle)))))) + +;; These 2 clones of draw-string would be much more modular if there +;; were a reasonable way of passing arguments transparently, so that +;; we might be able to share code. +(defmethod medium-draw-string* ((medium genera-medium) + string x y start end align-x align-y + towards-x towards-y transform-glyphs) + (unless start + (setq start 0)) + (unless end + (setq end (length string))) + (let* ((transform +identity-transformation+) + (ink (medium-ink medium)) + (text-style (medium-merged-text-style medium))) + (convert-to-postscript-coordinates transform x y) + (when towards-x + (convert-to-postscript-coordinates transform towards-x towards-y)) + (let* ((fcs (get-font-compat-str medium text-style)) + (height (psfck-clim-height fcs)) + (descent (psfck-clim-descent fcs)) + (ascent (- height descent))) + (let ((x-adjust (clim-internals::compute-text-x-adjustment + align-x medium character text-style)) + (y-adjust (clim-internals::compute-text-y-adjustment + align-y descent ascent height))) + (incf x x-adjust) + (incf y y-adjust) + (when towards-x + (incf towards-x x-adjust) + (incf towards-y y-adjust))) + ;; do raster/ink stuff. + (set-font-if-needed medium fcs) + (with-postscript-drawing-options (medium printer-stream + :epilogue nil :newpath nil + :ink ink) + (ps-pos-op medium "m" x y) + (carefully-output-ps-showstring printer-stream string start end)) + (annotating-postscript (medium printer-stream) + (format printer-stream " (medium-draw-string* ~S ~D ~D ~D ~D ~S ~S ...)" + string x y start end align-x align-y))))) + +(defmethod medium-draw-character* ((medium postscript-medium) + character x y align-x align-y + towards-x towards-y transform-glyphs) + (let* ((transform +identity-transformation+) + (ink (medium-ink medium)) + (text-style (medium-merged-text-style medium))) + (convert-to-postscript-coordinates transform x y) + (when towards-x + (convert-to-postscript-coordinates transform towards-x towards-y)) + (with-slots (printer-stream ch1buf) medium + (setf (aref ch1buf 0) character) + (let* ((fcs (get-font-compat-str medium text-style)) + (height (psfck-clim-height fcs)) + (descent (psfck-clim-descent fcs)) + (ascent (- height descent))) + (let ((x-adjust (clim-internals::compute-text-x-adjustment + align-x medium character text-style)) + (y-adjust (clim-internals::compute-text-y-adjustment + align-y descent ascent height))) + (incf x x-adjust) + (incf y y-adjust) + (when towards-x + (incf towards-x x-adjust) + (incf towards-y y-adjust))) + ;; do raster/ink stuff. + (set-font-if-needed medium fcs) + (with-postscript-drawing-options (medium printer-stream + :epilogue nil :newpath nil + :ink ink) + (ps-pos-op medium "m" x y) + (carefully-output-ps-showstring printer-stream ch1buf 0 1)) + (annotating-postscript (medium printer-stream) + (format printer-stream " (medium-draw-character* ~C ~D ~D ~S ~S ...)" + character x y align-x align-y)))))) + +(defmethod medium-draw-text* ((medium postscript-medium) + string-or-char x y start end + align-x align-y + towards-x towards-y transform-glyphs) + (if (characterp string-or-char) + (medium-draw-character* medium string-or-char x y + align-x align-y towards-x towards-y transform-glyphs) + (medium-draw-string* medium string-or-char x y start end + align-x align-y towards-x towards-y transform-glyphs))) + +#+++ignore +(defmethod draw-vertical-string-internal ((stream postscript-medium) + x-offset y-offset + string x y start end + align-x align-y text-style ink) + (unless end + (setq end (length string))) + (unless text-style + (setq text-style (medium-merged-text-style stream))) + (translate-positions x-offset y-offset x y) + (let* ((fcs (get-font-compat-str stream text-style)) + (height (psfck-clim-height fcs)) + (descent (psfck-clim-descent fcs)) + (ascent (- height descent))) + (let ((x-adjust (compute-text-x-adjustment + align-x stream string text-style start end)) + (y-adjust (compute-text-y-adjustment + align-y descent ascent height))) + (set-font-if-needed stream fcs) + (with-postscript-drawing-options (stream printer-stream + :epilogue nil :newpath nil + :ink ink) + (with-postscript-gsave stream + (ps-pos-op stream "m" x y) + (format printer-stream " currentpoint translate 90 rotate ") + (ps-rel-pos-op stream "rmoveto" x-adjust y-adjust) + (carefully-output-ps-showstring printer-stream string start end)))))) + +;;; provide a way for the "user" to start a new page. +;;; Should this have a different name? +;;; Should this functionality be invoked by wriuting the #\page character? +(defmethod new-page ((stream postscript-medium)) + (with-slots (printer-stream orientation) stream + (format printer-stream "new-page~%")) + ;; simulate WINDOW-CLEAR: + (clear-output-history stream) + (when (extended-output-stream-p stream) ;can we assume this? + (stream-set-cursor-position* stream 0 0) + (setf (stream-baseline stream) 0 + (stream-current-line-height stream) 0))) + +(defmacro with-ps-stream-glyph-for-character (&body body) + `(macrolet ((stream-glyph-for-character (stream character style &optional our-font) + `(with-slots (display-device-type) ,stream + (multiple-value-bind (character-set index) + (char-character-set-and-index ,character) + (declare (ignore character-set)) + ;; For now we are asserting that each string passed to WRITE-STRING will + ;; have no style changes within it. This is what our-font is all + ;; about. + (let* ((fcs (or our-font (get-font-compat-str stream ,style))) + (CWT (psfck-width-table fcs)) + (relwidth (if (numberp CWT) + CWT + (aref CWT index))) + (escapement-x (* (psfck-clim-height fcs) relwidth)) + (escapement-y 0) + (origin-x 0) + (origin-y (psfck-clim-ascent fcs)) + ;; really ought know real dope, but not avl yet + (bb-x escapement-x) + (bb-y (psfck-clim-height fcs))) + (values index fcs escapement-x escapement-y origin-x origin-y + bb-x bb-y (numberp cwt))))))) + ,@body)) + +(defmethod stream-glyph-for-character ((stream postscript-medium) + character style &optional our-font) + (declare (values index font escapement-x escapement-y origin-x origin-y bb-x bb-y + fixed-width-font-p)) + (with-ps-stream-glyph-for-character + (stream-glyph-for-character stream character style our-font))) + +(defmethod stream-scan-string-for-writing ((stream postscript-medium) string + start end style cursor-x max-x + &optional glyph-buffer) + (declare (type coordinate cursor-x max-x)) + (declare (fixnum start end)) + (with-ps-stream-glyph-for-character + (stream-scan-string-for-writing-body))) + +(defmethod set-font-if-needed ((stream postscript-medium) fcs) + (with-slots (printer-stream curfont) stream + (unless (eq curfont fcs) + (format printer-stream "~D f " (psfck-index fcs)) + (setf curfont fcs)))) + +(defun carefully-output-ps-showstring (printer-stream data start end) + (assert (<= end (length data))) + (write-char #\( printer-stream) + (loop + (let ((next-special (position-if #'(lambda (char) + (or (eql char #\( ) + (eql char #\) ) + (eql char #\\ ))) + data :start start :end end))) + (write-string data printer-stream :start start :end (or next-special end)) + (when next-special + (write-char #\\ printer-stream) + (write-char (elt data next-special) printer-stream)) + (unless next-special (return)) + (setq start (1+ next-special)))) + (format printer-stream ") show~%")) + +(defmethod get-font-compat-str ((stream postscript-medium) text-style) + (with-slots (font-map printer-stream draw-p) stream + (let* ((styledesc (parse-text-style text-style)) + (al (length font-map)) + (fcs + (do ((i 0 (1+ i))) + ((>= i al) + (error "Font map overflow for ~S" stream)) + (let ((fcs (aref font-map i))) + (when (null fcs) + (setq fcs (make-new-fcs styledesc i)) + (setf (aref font-map i) fcs) + (return fcs)) + (when (eq styledesc (psfck-style-descriptor fcs)) + (return fcs)))))) + (when (and fcs + draw-p + (not (psfck-established fcs))) + (format printer-stream "~D ~D /~A estfont~%" + (psfck-index fcs) (psfck-points fcs) (get-ps-fam-face-name fcs)) + (setf (psfck-established fcs) t)) + fcs))) + + +;; PostScript's "default user space" is measured in printers' points. +;; Should these force the stream to map the font and then get the +;; information from the FCS? + +(defmethod text-style-width + ((text-style standard-text-style) (medium postscript-medium)) + ;; An 'M' is often square and of height approximating the point size of the font. + ;;--- This should consult the real metrics. + (text-style-size-in-points text-style medium)) + +(defmethod text-style-height + ((text-style standard-text-style) (medium postscript-medium)) + (text-style-size-in-points text-style medium)) + +(defmethod text-style-ascent + ((text-style standard-text-style) (medium postscript-medium)) + (* (text-style-height text-style medium) (- 1 *ps-magic-baseline-factor*))) + +(defmethod text-style-descent ((text-style standard-text-style) + (medium postscript-medium)) + (* (text-style-height text-style medium) *ps-magic-baseline-factor*)) + +;;;--- This can probably go away when we have standardized text styles. +(defmethod text-style-size-in-points + ((text-style standard-text-style) (medium postscript-medium)) + (let* ((family (text-style-family text-style)) + (size (text-style-size text-style)) + (famdat (or (assoc family *postscript-font-translate-data*) + (error "Don't have PostScript support for family ~A." family))) + (points (if (numberp size) + size + (point-size-for-size-keyword size famdat)))) + points)) + +(defmethod text-style-fixed-width-p + ((text-style standard-text-style) (stream postscript-medium)) + (let* ((family (text-style-family text-style)) + (face (text-style-face text-style)) + (psfam (or (second (assoc family *postscript-font-translate-data*)) + (error "Don't have PostScript support for family ~A." family))) + (famdat (cdr (or (assoc psfam *ps-font-family-data* :test #'string-equal) + (error "No info for PostScript font family ~A?" psfam)))) + (info (cdr (or (assoc face famdat) + (error "No info for PostScript family ~A face ~A." psfam face)))) + (cname (first info))) + (numberp cname))) diff --git a/postscript/postscript-port.lisp b/postscript/postscript-port.lisp new file mode 100644 index 0000000000000000000000000000000000000000..27db5cfdf1e546e96fb2586e3aa8d1163cbda9da --- /dev/null +++ b/postscript/postscript-port.lisp @@ -0,0 +1,781 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: POSTSCRIPT-CLIM; Base: 10; Lowercase: Yes -*- + +;; $fiHeader: postscript-port.lisp,v 1.1 92/02/24 13:08:01 cer Exp $ + +(in-package :postscript-clim) + +"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." + +;;; This does not conform to the conventions described under Appendix C: +;;; Structuring Conventions of the PostScript Language Reference Manual. +;;; Part of the reason for non-conformance is the maybe-send-feature +;;; hack. Were it possible for this implementation to send more than +;;; one page to the printer, then the stuff downloaded using the +;;; maybe-send-feature hack would be associated with a single page +;;; rather than with the whole document and reordering of the pages by +;;; some other tool could cause features which were first generated by +;;; one page and later referenced by another to become undefined if +;;; those pages were reordered. The %% comments do conform except for +;;; %%Page and the feature reordering problem. + +;;; Line thickness currently uses "1 setlinewidth" for minimum line +;;; thickness. This can produce a line 2 pixels wide since there can be +;;; 2 pixels that are less than or equal to 1/2 away from the line. "0 +;;; setlinewidth" means to use the minimum for the resolution of the +;;; device. At least now, for the case of line thickness of 1 :normal, this +;;; will use 0 setlinewidth for output to the Apple Laser Writer. + +(defparameter *ps-magic-baseline-factor* 0.2) ;estimation of % baseline to bottom. + +(defparameter *1-pixel=points* 1.2) ;1 "average" pixel is about 1.2 points + +;; Convert CLIM units ("pixels") to (printers') points +(defmacro pixels-to-points (&rest pixels) + (let ((forms nil)) + (dolist (pixel pixels) + (push `(setq ,pixel (* ,pixel *1-pixel=points*)) forms)) + `(progn ,@(nreverse forms)))) + +;; Convert (printers') points to CLIM units ("pixels") +(defmacro points-to-pixels (&rest points) + (let ((forms nil)) + (dolist (point points) + (push `(setq ,point (/ ,point *1-pixel=points*)) forms)) + `(progn ,@(nreverse forms)))) + +(defvar *annotate-postscript* nil) + +(defmacro annotating-postscript ((medium printer-stream) &body body) + `(when *annotate-postscript* + (let* ((,printer-stream (slot-value ,medium 'printer-stream)) + (text (with-output-to-string (,printer-stream) ,@body)) + (start 0)) + (loop + (let ((newline (position #\newline text :start start))) + (write-string "% " ,printer-stream) + (write-string text ,printer-stream :start start :end newline) + (unless newline (return)) + (setq start (1+ newline)))) + (fresh-line ,printer-stream)))) + + +;;; How the font hackery works: + +;;; For each CLIM text style used in the output, a corresponding scaled +;;; font must exist in the PostScript engine. (The PostScript books +;;; recommend that for efficiency you cache the results of operations +;;; like scalefont). There is one PS-FONT-COMPAT-KLUDGE structure +;;; created for each CLIM text style used. These structures are stored +;;; in the FONT-MAP slot of POSTSCRIPT-MEDIUM streams. +;;; Inside the PostScript engine there is a corresponding array named +;;; fontarray, whose i'th element contains the scaled postscript font +;;; object described by the i'th element of FONT-MAP. + +;;; The function GET-FONT-COMPAT-STR is used to find the +;;; PS-FONT-COMPAT-KLUDGE object corresponding to a CLIM text style. +;;; The first time a CLIM text style is encounterred, +;;; GET-FONT-COMPAT-STR creates a PS-FONT-COMPAT-KLUDGE object for it, +;;; stores it in FONT-MAP and generates postscript code to construct the +;;; corresponding scaled postscript font and store it in fontarray +;;; using the postscript estfont procedure defined in the preamble. + +;;; CONVERT-CLIM-TO-PS-FONT-DESCRIPTION converts a CLIM text style, eg. +;;; (:serif :bold :large) to a postscript font description, eg. ("Times" +;;; :bold 12). When estfont is used, it interns a font "Times-Bold" of +;;; size 12 as the appropriate element of fontarray. + +;;; This structure is used to represent a PostScript font masquerading as a +;;; CLIM-world entity. They populate the font-map array of the stream. +(defstruct (ps-font-compat-kludge (:conc-name psfck-)) + index ;index into stream's array. + style-descriptor ;parse-text-style output. + true-ps-descriptor ;("Times" :italic 6 [pts]) + points ;point-size + clim-height ;equivalent size in CLIM "pixels" + clim-ascent ;top-to-baseline, "pixels" + clim-descent ;baseline-to-bottom + width-table ;width array or constant #. + (established nil)) ;T ==> written to the printer + +;;; Each element is ((family face) width-or-width-table-array height ascent descent) +(defvar *char-width-tables* nil) + +(defun make-new-fcs (text-style index) + (let ((fcs (make-ps-font-compat-kludge + :index index + :style-descriptor text-style + :true-ps-descriptor (convert-clim-to-ps-font-description text-style)))) + (initialize-fcs fcs) + fcs)) + +(defun initialize-fcs (fcs) + (let* ((points (third (psfck-true-ps-descriptor fcs))) + (key `(,(first (psfck-true-ps-descriptor fcs)) + ,(second (psfck-true-ps-descriptor fcs)))) + (metrics (assoc key *char-width-tables* :test #'equal))) + (unless metrics + (error "No font metrics for ~S" key)) + (setf (psfck-points fcs) points) + (let ((width-table (second metrics)) + (height (third metrics)) + (ascent (fourth metrics)) + (descent (fifth metrics))) + (setf (psfck-clim-height fcs) (* points height)) + (setf (psfck-clim-ascent fcs) (* points ascent)) + (setf (psfck-clim-descent fcs) (* points descent)) + (setf (psfck-width-table fcs) width-table))) + nil) + +;;; Each element is composed of: +;;; - a CLIM text family keyword, +;;; - the name of a font to use for that family, +;;; - a list of point sizes corresponding to the text size keywords +;;; in the corresponding positions in *psftd-keywords*. +;;; We should be able to phjase this out since we have a +;;; STANDARDIZE-STYLE method for postscript devices. +(defparameter *postscript-font-translate-data* + '((:fix "Courier" (4 6 7 9 11 14 18)) + (:sans-serif "Helvetica" (5 7 8 10 12 16 20)) + (:serif "Times" (5 7 8 10 12 16 20)))) + +(defparameter *psftd-keywords* '(:tiny :very-small :small :normal :large :very-large :huge)) + +;; The second element is a character size, which is either a number or a +;; place to go looking to get the character width table +(defparameter *ps-font-family-data* + '(("Times" + (nil "tir" "Times-Roman") + (:bold "tib" "Times-Bold") + (:italic "tii" "Times-Italic") + (:bold-italic "tibi" "Times-BoldItalic")) + ("Helvetica" + (nil "he" "Helvetica") + (:bold "heb" "Helvetica-Bold") + (:italic "heo" "Helvetica-Oblique") + (:bold-italic "hebo" "Helvetica-BoldOblique")) + ("Courier" + (nil 0.6 "Courier") + (:bold 0.6 "Courier-Bold") + (:italic 0.6 "Courier-Oblique") + (:bold-italic 0.6 "Courier-BoldOblique")))) + +(defun get-ps-fam-face-name (fcs) + (let ((fam (first (psfck-true-ps-descriptor fcs))) + (face (second (psfck-true-ps-descriptor fcs)))) + (let ((famdata (cdr (or (assoc fam *ps-font-family-data* :test #'string-equal) + (error "No info for PostScript font family ~A" fam))))) + (third (or (assoc face famdata) + (error "No info for PostScript family ~A face ~A." fam face)))))) + +;; Value is a 3 element list acceptable as a returned value from +;; CONVERT-CLIM-TO-PS-FONT-DESCRIPTION: a postscript family name as +;; appears in the CARs of the elements of *PS-FONT-FAMILY-DATA*, a face +;; keyword as returned by the function KEYWORDIFY-STYLE-FACE, and a +;; size in points. +(defparameter *ps-font-description-for-undefined-style* '("Courier" nil 4)) + +(defun convert-clim-to-ps-font-description (style) + (let ((size (text-style-size style)) + (face (keywordify-style-face (text-style-face style))) + (family (text-style-family style))) + (if (and *ps-font-description-for-undefined-style* + (eq style *undefined-text-style*)) + ;;--- Probably pointless to issue any sort of warning here + *ps-font-description-for-undefined-style* + (let* ((famdat (or (assoc family *postscript-font-translate-data*) + (error "Don't have PostScript support for family ~A." family))) + (points (if (numberp size) + size + (point-size-for-size-keyword size famdat))) + (psname (second famdat))) + `(,psname ,face ,points))))) + +(defun keywordify-style-face (face) + (cond ((eq face ':roman) nil) + ((atom face) face) + ((equal face '(:bold :italic)) :bold-italic) + ((equal face '(:italic :bold)) :bold-italic) + (t (list :numeric-code face)))) + +(defun point-size-for-size-keyword (size-keyword family-data) + (nth (or (position size-keyword *psftd-keywords*) + (error "Don't have PostScript support for size ~A." size-keyword)) + (third family-data))) + +;;; This actually reads metrics for the Apple LaserWriter. Some day we +;;; should make the font width table stuff device independent. +;;; The metrics are in sys:clim;laserwriter-metrics.lisp.newest. +;;; That file consists of invocations of this function. +;;; Don't bother loading the width information for fixed width fonts like Courrier +;;; which already have their width hard-coded in *ps-font-family-data*? +(defun setup-laserwriter-metrics (font-info) + (let ((char-widths (cdr font-info)) + (name (caar font-info)) + (scale (cadar font-info)) + (box (caddar font-info)) + (width-table nil)) + (multiple-value-bind (family face size-kludge) + (find-family-and-face-for-postscript-font-name name) + ;; if the kludgy size element of the font's description in + ;; *ps-font-family-data* is a number, just use it instead of + ;; building the width table. + (cond ((numberp size-kludge) + (setq width-table size-kludge)) + (t + (setq width-table (make-array 256)) + (dolist (char-info char-widths) + (let ((char-code (first char-info)) + (char-width (/ (second char-info) scale))) + (setf (aref width-table char-code) char-width))))) + (let ((key `(,family ,face))) + (when (car key) ;check family to make sure we found the name + (let* ((temp (assoc key *char-width-tables* :test #'equal)) + (height (abs (/ (- (fourth box) (second box)) scale))) + (ascent (abs (/ (fourth box) scale))) + (descent (abs (/ (second box) scale))) + (data `(,width-table ,height ,ascent ,descent))) + (if temp + (setf (cdr temp) data) + (push `(,key ,@data) *char-width-tables*)))))))) + +(defun find-family-and-face-for-postscript-font-name (name) + (dolist (family-data *ps-font-family-data*) + (let ((family (car family-data))) + (dolist (face-data (cdr family-data)) + (let ((face (first face-data)) + (size-kludge (second face-data)) + (fname (third face-data))) + (when (string= name fname) + (return-from find-family-and-face-for-postscript-font-name + (values family face size-kludge)))))))) + + +(defclass postscript-medium () + ((printer-stream :initarg :stream) + (current-color :initform nil) ;for decoding stippled inks + (features-sent :initform nil) + (curfont :initform nil) ;a psfck structure + (ch1buf :initform (make-array 1 :element-type 'character)) ;used for char ops. + (font-map :initform (make-array 30 :initial-element nil)) + (header-comments :initform nil :initarg :header-comments) + (orientation :initform :portrait :initarg :orientation) + ;; For multi-page output, analogous to a window's scroll position + (multi-page :initform nil :initarg :multi-page) + (viewport-x :initform 0) + (viewport-y :initform 0))) + +(defmethod implementation-pixels-per-point ((medium postscript-medium)) + (/ *1-pixel=points*)) + +(defmethod stream-force-output ((medium postscript-medium)) + (force-output (slot-value medium 'printer-stream))) + +(defmethod stream-finish-output ((medium postscript-medium)) + (finish-output (slot-value medium 'printer-stream))) + +(defmethod stream-clear-output ((medium postscript-medium)) + (clear-output (slot-value medium 'printer-stream))) + +;;; Methods that might be needed: +;;; what about other "window" protocols? +;;; host-window-margins +;;; window-margins (being flushed, should return (values 0 0 0 0)) +;;; window-beep +;;; window-clear (do a fresh-page?) + +;;; Support routines + +(defmacro making-ps-array ((printer-stream) &body body) + `(progn (write-string " [ " ,printer-stream) + ,@body + (write-string " ] " ,printer-stream))) + +(defmacro making-ps-hex-string ((printer-stream) &body body) + `(progn (write-char #\< ,printer-stream) + ,@body + (write-char #\> ,printer-stream))) + +(defmacro with-postscript-gsave (stream &body body) + `(flet ((with-gsave-body () ,@body)) + (declare (dynamic-extent #'with-gsave-body)) + (invoke-with-postscript-gsave ,stream #'with-gsave-body))) + +(defmethod invoke-with-postscript-gsave ((stream postscript-medium) continuation) + (with-slots (printer-stream) stream + (format printer-stream " gsave~%") + (funcall continuation) + (format printer-stream " grestore~%"))) + +(defmethod maybe-send-feature ((stream postscript-medium) feature-name code) + (with-slots (features-sent printer-stream) stream + (unless (member feature-name features-sent) + (annotating-postscript (stream printer-stream) + (format printer-stream "---------------- Feature ~A ----------------" + feature-name)) + (write-string code printer-stream) + (annotating-postscript (stream printer-stream) + (format printer-stream "---------------- End Feature ~A ----------------" + feature-name)) + (push feature-name features-sent)))) + +(defmethod ps-pos-op ((stream postscript-medium) op x y &rest args) + (declare (dynamic-extent args)) + (pixels-to-points x y) + (with-slots (printer-stream display-device-type) stream + (write-char #\space printer-stream) + (ps-optimal-flonize + (+ (* (slot-value display-device-type 'page-indent) + (slot-value display-device-type 'device-units-per-inch)) x) + printer-stream) + (write-char #\space printer-stream) + (ps-optimal-flonize + (- (* (slot-value display-device-type 'page-height) + (slot-value display-device-type 'device-units-per-inch)) y) + printer-stream) + (dolist (arg args) + (write-char #\space printer-stream) + (if (numberp arg) + (ps-optimal-flonize arg printer-stream) + (write arg :stream printer-stream :escape nil))) + (format printer-stream " ~A" op) + (if (string-equal op "m") + (write-char #\space printer-stream) + (terpri printer-stream)))) + +(defmethod ps-rel-pos-op ((stream postscript-medium) op x y &rest args) + (declare (dynamic-extent args)) + (pixels-to-points x y) + (with-slots (printer-stream) stream + (write-char #\space printer-stream) + (ps-optimal-flonize x printer-stream) + (write-char #\space printer-stream) + (ps-optimal-flonize (- y) printer-stream) + (dolist (arg args) + (write-char #\space printer-stream) + (if (numberp arg) + (ps-optimal-flonize arg printer-stream) + (write arg :stream printer-stream :escape nil))) + (format printer-stream " ~A~%" op))) + +;;; the software that drives the LGP2 (sys:hardcopy;postscript.lisp) +;;; uses LGP:FAST-PRINT-NUM except for writing transformation matrices, +;;; for which it uses +;;; (prin1 (if (fixp elem) elem (float elem)) output-stream) +;;; and also some cases of Format ~D. +(defun ps-optimal-flonize (n stream) + ;; lifted from definition of LGP:FAST-PRINT-NUM in "Q:>sys>hardcopy>postscript.lisp.1679" + (if (and (not (zerop n)) + (< -1 n 1)) + (format stream "~F" (float n)) + (multiple-value-bind (integer frac) + (etypecase n + (integer (values (abs n) 0)) + (float (truncate (round (* (abs n) 100.)) 100)) + (rational (truncate (round (* (abs n) 100.)) 100))) + (if (>= integer 10000.) + (if (integerp n) + (write n :stream stream :escape nil :base 10 :radix nil) + (format stream "~$" n)) + (let ((from 8) + (negative-p nil)) + (when (minusp n) + (setq negative-p t)) + (with-stack-array (string from :element-type 'extended-char) + (macrolet ((add-char (char) + `(setf (aref string (decf from)) ,char))) + (when (/= frac 0) + (multiple-value-bind (frac1 frac2) + (truncate frac 10.) + (when (/= frac2 0) + (add-char (code-char (+ (char-code #\0) frac2)))) + (add-char (code-char (+ (char-code #\0) frac1)))) + (add-char #\.)) + (let ((digit 0)) + (loop + (multiple-value-setq (integer digit) + (truncate integer 10.)) + (add-char (code-char (+ (char-code #\0) digit))) + (when (zerop integer) (return)))) + (when negative-p (add-char #\-)) + (write-string string stream :start from) + n))))))) + +;; "Not suitable for ritual use." +(defparameter *ps-ellipse-code* +" +/emtrx matrix def +/elpd 8 dict def +/ellipse {{arc} ellipsei} def +/ellipsen {{arcn} ellipsei} def +/ellipsei {elpd begin /arcp exch def /ea exch def /sa exch def /yra exch def /xra exch def + /y exch def /x exch def +emtrx currentmatrix +x y translate xra yra scale 0 0 1 sa ea arcp setmatrix end} def +") + +(defparameter *pattern-code* + ;; for drawing filled patterns + "/imgdict 12 dict def +%draw image. One source pixel to one user space unit. +%width width-rounded-up height +/img { imgdict begin + [/height /bitwidth /width ] {exch def} forall + /nbits bitwidth height mul def + /str 100 string def + nbits 0 ne { + gsave width height scale + bitwidth height true [bitwidth 0 0 height neg 0 height] + { nbits 800 ge {/nbits nbits 800 sub def str} + {nbits 8 idiv string /nbits 0 def} + ifelse + currentfile exch readhexstring pop} + imagemask grestore + } if end + } def +/fmod { 2 copy div floor mul sub } bind def +%draw patterned rectangle. One source pixel to scale device units (ignoring user scale). +%width height pattern scale +/pat { imgdict begin gsave + [/scal /patseq ] {exch def} forall + /patheight patseq length def + /patwidth patseq 0 get length 8 mul def +%back up to an even phase boundary + /pswidth patwidth scal mul def + /psheight patheight scal mul def + pswidth psheight idtransform + 0 0 transform psheight fmod neg exch pswidth fmod neg exch idtransform + 3 -1 roll exch dup 0 gt {add} {exch pop} ifelse + 3 1 roll dup 0 gt {add} {exch pop} ifelse exch 2 copy translate + 3 -1 roll exch abs add 3 1 roll abs add exch dtransform + psheight div abs ceiling cvi patheight mul /height exch def + pswidth div abs ceiling cvi patwidth mul /width exch def + width 0 ne { height 0 ne { + /scanline -1 def /linebits 0 def + width height idtransform abs scale scal dup scale + width height true [width 0 0 height neg 0 height] + { linebits 0 le { /linebits width def + /scanline scanline 1 add patheight mod def + /linepat patseq scanline get def + } if + /linebits linebits patwidth sub def linepat } + imagemask } if } if grestore end + } def +%draw pattern in all of visible area. +%pattern scale opaque-p +/patfill1 { initmatrix clippath +%condition-case for nocurrentpoint, returning empty rectangle + errordict begin + /nocurrentpoint dup dup load exch { pop 0 0 0 0 } def + pathbbox + 6 -2 roll def end + 4 2 roll 2 copy translate 4 -2 roll + 3 -1 roll sub 3 1 roll exch sub exch + 3 -1 roll { 2 copy gsave 1 setgray newpath + 0 0 moveto 0 exch lineto 0 rlineto currentpoint pop 0 lineto + closepath fill grestore } if + 4 -2 roll pat } def +%like fill, etc. but with pattern, scale and opaque-p options. +/patfill { gsave clip patfill1 grestore newpath } def +/pateofill { gsave eoclip patfill1 grestore newpath } def +/patstroke { gsave strokepath clip patfill1 grestore newpath } def + ") + +(defvar *postscript-prologue* + "statusdict /waittimeout 30 put +/fontarray 30 array def +/f {fontarray exch get setfont} def +/estfont {findfont exch scalefont fontarray 3 1 roll put} def +/m {moveto} def +") + +(defmethod postscript-prologue ((stream postscript-medium)) + (with-slots (printer-stream header-comments display-device-type orientation) stream + (format printer-stream "%!PS-Adobe-2.0 EPSF-2.0~%") + (multiple-value-bind (left top right bottom) + (postscript-bounding-box-edges stream) + (format printer-stream "%%BoundingBox: ~D ~D ~D ~D~%" + left top right bottom)) + (format printer-stream "%%Creator: CLIM 2.0~%") + (let ((title (getf header-comments :title))) + (when title + (format printer-stream "%%Title: ~A~%" title))) + (let ((for (or (getf header-comments :for) #+Genera zl:user-id))) + (when for + (format printer-stream "%%For: ~A~%" for))) + (multiple-value-bind (second minute hour date month year) + (decode-universal-time (get-universal-time)) + (format printer-stream "%%CreationDate: ~D-~A-~D ~2,'0D:~2,'0D:~2,'0D~%" + date (svref #("Jan" "Feb" "Mar" "Apr" "May" "Jun" + "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") month) year + hour minute second)) + (format printer-stream "%%DocumentFonts: (atend)~%") + (format printer-stream "%%EndComments~%") + (write-string *postscript-prologue* printer-stream) + (ecase orientation + (:portrait + (format printer-stream + "/format-rotation 0 def ~%/format-y-translation 0 def~%")) + (:landscape + (format printer-stream + "/format-rotation -90 def ~%/format-y-translation ~D def~%" + (* (slot-value display-device-type 'page-width) + (slot-value display-device-type 'device-units-per-inch))))) + (format printer-stream + "/new-matrix {0 format-y-translation translate + format-rotation rotate} def + /new-page {showpage new-matrix} def~%") + (postscript-device-prologue display-device-type printer-stream) + (format printer-stream "%%EndProlog~%") + (format printer-stream "~%new-matrix~%"))) + +(defmethod postscript-epilogue ((stream postscript-medium)) + (with-slots (printer-stream display-device-type font-map) stream + (format printer-stream "showpage~%") + (postscript-device-epilogue display-device-type printer-stream) + (format printer-stream "%%Trailer~%") + (let ((font-names-used nil)) + (dotimes (index (length font-map)) + (let ((fcs (aref font-map index))) + (when fcs + (pushnew (get-ps-fam-face-name fcs) font-names-used :test #'string-equal)))) + (format printer-stream "%%DocumentFonts:~{~^ ~A~}~%" (nreverse font-names-used))))) + +(defun send-pattern (stream printer-stream pattern) + (maybe-send-feature stream 'pattern-program *pattern-code*) + (making-ps-array (printer-stream) + (let ((height (array-dimension pattern 0)) + (width (array-dimension pattern 1))) + (dotimes (j height) + (making-ps-hex-string (printer-stream) + (send-raster printer-stream pattern 0 j width (1+ j) nil))))) + (terpri printer-stream) + (write-string " 4 true " printer-stream)) + +(defun send-raster (printer-stream raster left top right bottom &optional (terpri t)) + (assert (= bottom (1+ top))) + (unless (zerop (rem right 8)) + (error "Sorry, can't hack right /= 0 (mod 8); you have ~D" right)) + (with-stack-array (arr (array-total-size raster) :element-type '(unsigned-byte 8) + :displaced-to raster) + (with-temporary-string (buf :length 100) + (let ((bytes-per-row (truncate (array-dimension raster 1) 8)) + (bytes-per-raster (ceiling (- right left) 8))) + (let ((toprow (* top bytes-per-row)) + (botrow (* bottom bytes-per-row)) + (bigend-digit-char "084c2a6e195d3b7f") + (j 0) + #+Genera (buf buf) + #+Genera (arr arr)) + #+Genera (declare (sys:array-register bigend-digit-char buf arr)) + (flet ((force-buf () + (setf (fill-pointer buf) j) + (with-temporary-substring (subbuf buf 0 j) + (write-string subbuf printer-stream) + (when terpri + (terpri printer-stream))))) + (do* ((index (- botrow bytes-per-row) (- index bytes-per-row)) + (i index index)) + ((< index toprow)) + (dotimes (n bytes-per-raster) + #-(or Allegro Minima) (declare (ignore n)) + (let ((byte (aref arr i))) + (setf (aref buf j) + (aref bigend-digit-char (ldb (byte 4 0) byte))) + (setf (aref buf (1+ j)) + (aref bigend-digit-char (ldb (byte 4 4) byte))) + (incf i) + (incf j 2) + (when (> j 80) (force-buf))))) + (when (> j 0) (force-buf)))))))) + +(defun ps-fill (stream printer-stream ink) + (cond ((typep ink 'rectangular-tile) + ;;--- Kludgy way to determine whether to use patterned drawing + (multiple-value-bind (array width height) + (decode-tile-as-stipple ink) + (declare (ignore width height)) + (unless array + (error "Rectangular tiles other than stipples are not supported yet.")) + (send-pattern stream printer-stream array) + (format printer-stream " patfill~%"))) + (t + (format printer-stream " fill~%")))) + +(defun ps-stroke (stream printer-stream ink) + (cond ((typep ink 'rectangular-tile) + ;;--- Kludgy way to determine whether to use patterned drawing + (multiple-value-bind (array width height) + (decode-tile-as-stipple ink) + (declare (ignore width height)) + (unless array + (error "Rectangular tiles other than stipples are not supported yet.")) + (send-pattern stream printer-stream array) + (format printer-stream " patstroke~%"))) + (t + (format printer-stream " stroke~%")))) + + +(defclass postscript-port (standard-port) + ;; 72 points per inch on PostScript devices + ((device-units-per-inch :initform 72 :allocation :class))) + +(defmethod standardize-text-style ((device postscript-device) character-set style) + (declare (ignore character-set)) + (let ((size (text-style-size style))) + (if (numberp size) + style + (let* ((family (text-style-family style)) + (sizes (third (assoc family *postscript-font-translate-data*))) + (position (position size *psftd-keywords*)) + (new-size (and position (nth position sizes)))) + (cond (new-size + (make-text-style family (text-style-face style) new-size)) + ((eql family :stand-in-for-undefined-style) + (make-text-style family (text-style-face style) 10)) + (t + (cerror "Use the undefined text style stand-in instead" + "This display device does not know how to map the logical text ~ + style size ~S in ~S" + size style) + *undefined-text-style*)))))) + +;; Some people need to be able to specialize this +(defmethod postscript-device-prologue ((device postscript-device) printer-stream) + (declare (ignore printer-stream))) + +;; Some people need to be able to specialize this, too +(defmethod postscript-device-epilogue ((device postscript-device) printer-stream) + (declare (ignore printer-stream))) + + +(defclass apple-laser-writer (postscript-port) + ((x-resolution :initform 300) ;pixels per inch + (y-resolution :initform 300) + (page-indent :initform 0.5) ;in inches + (page-width :initform 7.5) + (page-height :initform 10.5))) + +;;; allow a display device to do something appropriate for a line thickness in :normal units +(defgeneric normal-line-thickness (display-device thickness)) + +(defmethod normal-line-thickness ((postscript-device display-device) (thickness number)) + thickness) + +(defmethod normal-line-thickness ((postscript-device apple-laser-writer) (thickness number)) + (if (= thickness 1) + 0 + (* 0.5 thickness (/ (slot-value postscript-device 'device-units-per-inch) + (slot-value postscript-device 'x-resolution))))) + +(define-display-device *postscript-device* apple-laser-writer + :font-for-undefined-style "Courier") + +(defclass postscript-stream + (graphics-output-recording + output-recording-mixin + output-protocol-mixin) + () + (:default-initargs :display-device-type *postscript-device* + :default-text-margin 1000)) + +(defun make-postscript-stream (stream) + (make-instance 'postscript-stream :stream stream)) + +(defmethod close ((stream postscript-stream) &key abort) + (unless abort + (postscript-epilogue stream))) + +(defmethod postscript-bounding-box-edges ((stream postscript-stream)) + (with-bounding-rectangle* (left top right bottom) + (stream-output-history stream) + (pixels-to-points left top right bottom) + (values (floor left) (floor top) + (ceiling right) (ceiling bottom)))) + +(defmethod window-inside-width ((stream postscript-stream)) + (with-slots (display-device-type) stream + (/ (* (slot-value display-device-type 'page-width) + (slot-value display-device-type 'device-units-per-inch)) + *1-pixel=points*))) + +(defmethod stream-ensure-cursor-visible ((stream postscript-stream) + &optional cx cy) + (declare (ignore cx cy)) + nil) + +(defmethod stream-move-for-line-height-change ((stream postscript-stream) + movement old-height cursor-x cursor-y) + (declare (ignore movement old-height cursor-x cursor-y))) + +;; Replay some PostScript output, breaking it into multiple pages +(defmethod stream-replay ((stream postscript-stream) &optional region) + (with-slots (output-record record-p draw-p display-device-type + printer-stream orientation multi-page viewport-x viewport-y) stream + (when draw-p + (when output-record + (letf-globally ((record-p nil)) + (if (or region (not multi-page)) + (replay output-record stream region) + (with-bounding-rectangle* (left top right bottom) output-record + (let* ((page-width + (floor (* (slot-value display-device-type 'page-width) + (slot-value display-device-type 'device-units-per-inch)) + *1-pixel=points*)) + (page-height + (floor (* (slot-value display-device-type 'page-height) + (slot-value display-device-type 'device-units-per-inch)) + *1-pixel=points*)) + (first-page t)) + (setq viewport-x 0 viewport-y 0) + ;; Draw each chunk of output on its own page + (unwind-protect + (do ((y top (+ y page-height))) + ((> y bottom)) + (do ((x left (+ x page-width))) + ((> x right)) + (if first-page + (setq first-page nil) + (format printer-stream "gsave new-page grestore~%")) + (let ((region (make-bounding-rectangle + x y (+ x page-width) (+ y page-height)))) + (replay output-record stream region)) + (incf viewport-x page-width)) + (setf viewport-x 0) + (incf viewport-y page-height)) + (setq viewport-x 0 viewport-y 0)))))))))) + + +(defmacro with-output-to-postscript-stream ((stream-var file-stream &rest args) &body body) + (declare (arglist (stream-var file-stream + &key (display-device *postscript-device*) + header-comments multi-page + (orientation :portrait)) + &body body)) + `(flet ((postscript-output-body (,stream-var) ,@body)) + (declare (dynamic-extent #'postscript-output-body)) + (invoke-with-output-to-postscript-stream ,file-stream #'postscript-output-body ,@args))) + +;; This could really be WITH-OPEN-STREAM, but that isn't going to call CLIM:CLOSE. +;; Fixed in the CLOS stream system. +(defun invoke-with-output-to-postscript-stream (file-stream continuation + &key (display-device *postscript-device*) + header-comments multi-page + (orientation :portrait)) + (let ((postscript-stream (make-instance 'postscript-stream + :stream file-stream + :display-device-type display-device + :header-comments header-comments + :orientation orientation + :multi-page multi-page)) + (abort-p t)) + (with-output-recording-options (postscript-stream :record t :draw nil) + (unwind-protect + (multiple-value-prog1 + (funcall continuation postscript-stream) + (postscript-prologue postscript-stream) + ;; Now do the output to the printer, breaking up the output into + ;; multiple pages if that was requested + (with-output-recording-options (postscript-stream :record nil :draw t) + (frame-replay *application-frame* postscript-stream)) + (setq abort-p nil)) + (close postscript-stream :abort abort-p))))) diff --git a/postscript/postscript-prefill.lisp b/postscript/postscript-prefill.lisp new file mode 100644 index 0000000000000000000000000000000000000000..cc2095761cdf4d66b5b6e173d93c8e7597bbcac7 --- /dev/null +++ b/postscript/postscript-prefill.lisp @@ -0,0 +1,6 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CLIM-INTERNALS; Base: 10; Lowercase: Yes -*- + +(in-package :clim-postscript) + +"Copyright (c) 1990, 1991, 1992 Symbolics, Inc. All rights reserved." +