File: ps.lisp

package info (click to toggle)
cedilla 0.6-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 812 kB
  • ctags: 308
  • sloc: lisp: 3,716; makefile: 50; sh: 13
file content (63 lines) | stat: -rw-r--r-- 2,355 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
;;; This file is part of Cedilla.
;;; Copyright (C) 2002 by Juliusz Chroboczek.

;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.

;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.

(in-package "CEDILLA")

(defmethod select-font-instance ((instance ps-font-instance) out)
  (unless (ps-font-instance-name instance)
    (error "Selecting unnamed instance."))
  (format out "~A setfont~%" (ps-font-instance-name instance)))

(defmethod setup-font (out (font ps-font) size name)
  (setf (ps-font-name font) name)
  (format out "/~A /~A findfont ~A scalefont def~%"
          name (font-name font) size))

(defun output-encoding (vector out)
  (let ((n 0))
    (loop for i from 0 upto 255
          when (aref vector i)
          do (incf n))
    (cond
      ((>= n 100)
       (format out "[ ")
       (loop for i from 0 upto 255
            when (and (not (zerop i)) (= 0 (mod i 8)))
             do (format out "~%  ")
             do (format out "/~A "
                        (if (aref vector i)
                            (glyph-name (aref vector i))
                            ".notdef")))
       (format out "]~%"))
      (t
       (format out "UE~%")
       (loop for i from 0 upto 255
             when (aref vector i)
             do (format out "dup ~A /~A put~%" i 
                        (glyph-name (aref vector i))))))))

(defmethod typeset-font-glyph :before (glyph (instance ps-font-instance)
                                             index out)
  (declare (ignore glyph index))
  (unless (eql *current-instance* instance)
    (finish-string out)
    (select-font-instance instance out)
    (setf *current-instance* instance)))

(defmethod typeset-font-glyph ((glyph font-glyph) (instance ps-font-instance)
                               index out)
  (synchronise-position out)
  (output-character (code-char index) out)
  (let ((width (scaled-glyph-width glyph)))
    (incf *current-x* width)
    (incf *typesetter-x* width)))