Climacs でビットマップフォントを使った時のフォンサイズ変更

ビットマップフォントを使うというより X のフォント描画を使う場合のフォントサイズは clim-clx::*clx-text-sizes* で指定する。

参考: McCLIM (Climacs) でビットマプフォン使って日本語を表示する

;; X のフォント描画を使う場合のフォント設定
(setq clim-clx::*clx-text-family+face-map*
  '(:fix
    ("*-*"
     (:roman               "medium-r"
      :bold                "bold-r"
      :italic              "medium-o"
      :bold-italic         "bold-o"
      :italic-bold         "bold-o"))
    :sans-serif
    ("*-*"
     (:roman               "medium-r"
      :bold                "bold-r"
      :italic              "medium-o"
      :bold-italic         "bold-o"
      :italic-bold         "bold-o"))
    :serif
    ("*-*"
     (:roman               "medium-r"
      :bold                "bold-r"
      :italic              "medium-i"
      :bold-italic         "bold-i"
      :italic-bold         "bold-i"))))

;; ビットマップでのフォントサイズを 2 ずつ大きくする。
(setq clim-clx::*clx-text-sizes*
  '(:normal         16
    :tiny           10
    :very-small     12
    :small          14
    :large          20
    :very-large     22
    :huge           26))

X のフォント描画を使う場合は、次が必要になるかと。

;;; ビットマップフォントで日本語表示するために一行追加する。
(in-package :clim-clx)
(defmethod medium-draw-text* ((medium clx-medium) string x y
                              start end
                              align-x align-y
                              toward-x toward-y transform-glyphs)
  (declare (ignore toward-x toward-y transform-glyphs))
  (with-transformed-position ((sheet-native-transformation (medium-sheet medium))
                              x y)
    (with-clx-graphics (medium)
      (when (characterp string)
        (setq string (make-string 1 :initial-element string)))
      (when (null end) (setq end (length string)))
      (multiple-value-bind (text-width text-height x-cursor y-cursor baseline)
          (text-size medium string :start start :end end)
        (declare (ignore x-cursor y-cursor))
        (unless (and (eq align-x :left) (eq align-y :baseline))
          (setq x (- x (ecase align-x
                         (:left 0)
                         (:center (round text-width 2))
                         (:right text-width))))
          (setq y (ecase align-y
                    (:top (+ y baseline))
                    (:center (+ y baseline (- (floor text-height 2))))
                    (:baseline y)
                    (:bottom (+ y baseline (- text-height)))))))
      (let ((x (round-coordinate x))
            (y (round-coordinate y)))
        (when (and (<= #x-8000 x #x7FFF)
                   (<= #x-8000 y #x7FFF))
          (multiple-value-bind (halt width)
              (xlib:draw-glyphs mirror gc x y string
                                :start start :end end
                                :size 16 ; この一行を追加
                                :translate #'translate)))))))