/[cello]/cello/font.lisp
ViewVC logotype

Contents of /cello/font.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Mon Jun 5 01:47:49 2006 UTC (7 years, 10 months ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +14 -20 lines
Beginnings only of merge with Celtk
1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cello; -*-
2 #|
3
4 Copyright (C) 2004 by Kenneth William Tilton
5
6 This library is free software; you can redistribute it and/or
7 modify it under the terms of the Lisp Lesser GNU Public License
8 (http://opensource.franz.com/preamble.html), known as the LLGPL.
9
10 This library is distributed WITHOUT ANY WARRANTY; without even
11 the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12
13 See the Lisp Lesser GNU Public License for more details.
14
15 |#
16
17 (in-package :cello)
18
19 (defstruct font)
20
21
22 ;---------------------------------------------------------
23
24 (defmethod font-string-length :around (font string &optional start end)
25 (declare (ignorable font start end))
26 (if string
27 (call-next-method)
28 0))
29
30
31
32 ;------------------------------------------------------------
33 (defun font-string-width
34 (target-resolution
35 font string
36 &optional (start 0 start-supplied) (end (length string)))
37 (if (or (null string)
38 (eql start end))
39 0
40 (floor (* (cs-logical-dpi) (if start-supplied
41 (font-string-length font string start end)
42 (font-string-length font string)))
43 target-resolution)))
44
45

  ViewVC Help
Powered by ViewVC 1.1.5