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
64
65
66
67
68
69
70
71
72
73
74
75
|
;;; 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 get-glyph ((font fixed-encoding-font) name &optional index)
(declare (ignore name))
(and index (>= index 0) (< index (length (font-glyphs font)))
(aref (font-glyphs font) index)))
(defmethod put-glyph ((font fixed-encoding-font) glyph &optional index)
(when (and index (>= index 0) (< index (length (font-glyphs font))))
(setf (aref (font-glyphs font) index) glyph)))
(defmethod find-font-glyph (ccs (font fixed-encoding-font) &optional dotless)
(if dotless
(find-font-glyph (dotless-character ccs) font nil)
(let ((index (funcall (font-encoding font) ccs)))
(and index (>= index 0) (< index (length (font-glyphs font)))
(aref (font-glyphs font) index)))))
(defun fixed-glyph-index (glyph font)
(loop for i from 0 upto (min 255 (- (length (font-glyphs font)) 1))
when (eql glyph (aref (font-glyphs font) i))
do (return-from fixed-glyph-index i))
nil)
(defmethod ensure-instance-with-font (glyph (font fixed-encoding-font))
(unless (glyph-instance glyph)
(unless (font-instances font)
(make-font-instance font))
(let ((instance (car (font-instances font)))
(index (fixed-glyph-index glyph font)))
(unless index
(error "Unknown glyph: ~S ~S" glyph font))
(setf (glyph-instance glyph) instance
(glyph-index glyph) index))))
(defmethod ensure-instance-with-font ((glyph transformed-glyph)
(font fixed-encoding-font))
(let ((glyph* (transformed-glyph-glyph glyph))
(font* (transformed-font-font font)))
(unless (font-instances font)
(make-font-instance font))
(let ((instance (car (font-instances font)))
(index (fixed-glyph-index glyph* font*)))
(unless index
(error "Unknown glyph: ~S ~S" glyph font))
(setf (glyph-instance glyph) instance
(glyph-index glyph) index
(aref (font-glyphs font) index) glyph))))
(defmethod make-font-instance ((font fixed-encoding-ps-font))
(when (font-instances font)
(error "Only one font instance per fixed encoding font"))
(let ((instance (make-instance 'fixed-encoding-ps-font-instance
:font font)))
(push instance (font-instances font))
instance))
(defmethod setup-font-instance (out (instance fixed-encoding-ps-font-instance)
name)
(setf (ps-font-instance-name instance) name)
(format out "/~A ~A def~%"
name (ps-font-name (instance-font instance))))
|
