src/renderer/raux.lisp

   1 ;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: R2; -*-
   2 ;;; --------------------------------------------------------------------------------------
   3 ;;;     Title: Auxiliary render functions
   4 ;;;   Created: 1999-02-24
   5 ;;;    Author: Gilbert Baumann <gilbert@base-engineering.com>
   6 ;;;   License: MIT style (see below)
   7 ;;; --------------------------------------------------------------------------------------
   8 ;;;  (c) copyright 1998,1999 by Gilbert Baumann
   9
  10 ;;;  Permission is hereby granted, free of charge, to any person obtaining
  11 ;;;  a copy of this software and associated documentation files (the
  12 ;;;  "Software"), to deal in the Software without restriction, including
  13 ;;;  without limitation the rights to use, copy, modify, merge, publish,
  14 ;;;  distribute, sublicense, and/or sell copies of the Software, and to
  15 ;;;  permit persons to whom the Software is furnished to do so, subject to
  16 ;;;  the following conditions:
  17 ;;;
  18 ;;;  The above copyright notice and this permission notice shall be
  19 ;;;  included in all copies or substantial portions of the Software.
  20 ;;;
  21 ;;;  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  22 ;;;  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  23 ;;;  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  24 ;;;  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  25 ;;;  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
  26 ;;;  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
  27 ;;;  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  28
  29 (in-package :R2)
  30
  31 (defun pt-data (x)
  32   (cond ((text-element-p x)
  33          (map 'string #'rune-char (element-text x)))
  34         ((apply 'concatenate 'string
  35                 (mapcar #'pt-data (element-children x))))))
  36
  37 (defun pt-data-iso10646 (x)
  38   (cond ((text-element-p x)
  39          (element-text x))
  40         ((apply 'concatenate 'rod
  41                 (mapcar #'pt-data-iso10646 (element-children x))))))
  42
  43 (defun white-space-rune-p* (rune)
  44   (or (eq rune 9)
  45       (eq rune 10)
  46       (eq rune 12)
  47       (eq rune 13)
  48       (eq rune 32)))
  49
  50 (defun white-space-rune-p*/no-nl (rune)
  51   (or (eq rune 9)
  52       (eq rune 12)
  53       (eq rune 13)
  54       (eq rune 32)))
  55
  56 (define-compiler-macro white-space-rune-p* (rune)
  57   `((lambda (rune)
  58       (or (eq rune 9)
  59           (eq rune 10)
  60           (eq rune 12)
  61           (eq rune 13)
  62           (eq rune 32)))
  63     ,rune))
  64
  65 (define-compiler-macro white-space-rune-p*/no-nl (rune)
  66   `((lambda (rune)
  67       (or (eq rune 9)
  68           (eq rune 12)
  69           (eq rune 13)
  70           (eq rune 32)))
  71     ,rune))
  72
  73 (defun maybe-resolve-percentage (x total)
  74   (cond ((css:percentage-p x)   (round (* (cdr x) total) 100))
  75         ((integerp x)           x)
  76         ((realp x)              (round x))
  77         (t                      x)))
  78
  79
  80
  81
  82
  83
  84