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

トゥルータイプフォントなら (require :mcclim-freetype) で日本語表示できていたが、ビットマップフォントで日本語表示する法方がようやく分った。

clim-clx::*clx-text-family+face-map* で "adobe-xxxxx" を使うようになっているのを "*-*" に変更してしまう。

フォントサイズの指定は Climacs でビットマップフォントを使った時のフォンサイズ変更 を参照。

(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"))))

McCLIM の CLX バックエンドの文字を描画する所に 1 行追加する。

Index: Backends/CLX/medium.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp,v
retrieving revision 1.91
diff -u -r1.91 medium.lisp
--- Backends/CLX/medium.lisp    15 Nov 2009 11:27:26 -0000      1.91
+++ Backends/CLX/medium.lisp    15 Dec 2010 12:03:10 -0000
@@ -1101,6 +1101,7 @@
           (multiple-value-bind (halt width)
               (xlib:draw-glyphs mirror gc x y string
                                 :start start :end end
+                                :size 16
                                 :translate #'translate)))))))

 (defmethod medium-buffering-output-p ((medium clx-medium))
cvs diff: Diffing Backends/Graphic-Forms

これで、ビットマップフォントでも日本語表示ができるようになった。

McCLIM で PNG フォーマットの画像を表示する

McCLIM で画像を表示するには make-pattern-from-bitmap-file で画像ファイルを読み込み、draw-pattern* で描画すればいい。 bitamp と jpeg は対応したが png は対応していなかった。 CL-PNG を使って png 対応する。

新しい画像フォーマットに対応するためには clim-extensions:define-bitmap-file-reader でファイルを読み込んで (unsigned-byte 32) の2次元配列を返せばいいらしい。中身は RGB なんだけど、残りの 8 バイトが何だかよく分からない。そこはスルー。

mcclim/Extensions/Bitmap-formats/jpeg.lisp を参考しながら実装する。

(require :mcclim)
(require :png)

(in-package :clim-user)

(defparameter *png-file*
  (merge-pathnames "letter/lisp/clbuild/source/cl-png/test/images/butterfly8.png"
                   (user-homedir-pathname)))

(clim-extensions:define-bitmap-file-reader :png (pathname)
  (with-open-file (in pathname :element-type '(unsigned-byte 8))
    (let* ((png (png:decode in))
           (height (png:image-height png))
           (width (png:image-width png))
           (data (make-array (list height width)
                             :element-type '(unsigned-byte 32))))
      (dotimes (y height)
        (dotimes (x width)
          (let ((red (aref png y x 0))
                (green (aref png y x 1))
                (blue (aref png y x 2)))
            (setf (aref data y x)
                  (dpb red (byte 8 0)
                       (dpb green (byte 8 8)
                            (dpb blue (byte 8 16)
                                 (dpb (- 255 0) (byte 8 24) 0))))))))
      data)))

(define-application-frame my-frame ()
  ()
  (:pane
   (make-pane 'application-pane
              :display-function
              (lambda (frame stream)
                (declare (ignore frame))
                (let ((pattern (make-pattern-from-bitmap-file
                                *png-file* :format :png)))
                  (draw-pattern* stream
                                 pattern
                                 0 0))))))

;;(run-frame-top-level (make-application-frame 'my-frame))

McCLIM テーブルフォーマット

「グリッドビューみたいなのはどうするんかなぁ。」の件だけど、ちゃんとテーブルフォーマットあったよ。うん、確かにあったよ。 仕様はこちら。

ただプレゼンテーションと両立する方法がにわかりは分からなかった。いや、仕様を見ればちゃんと書いてある気がするけど、いまは英語を読む気力がない。あと幅の指定とかも。

(defun table-format (stream timeline)
  (fresh-line stream)
  (formatting-table (stream :x-spacing '(1 :character))
    (loop for tweet in timeline
          do (formatting-row (stream)
               (formatting-cell (stream)
                 (princ (twitter:twitter-user-screen-name
                         (twitter:tweet-user tweet))
                        stream))
               (formatting-cell (stream)
                 (princ (twitter:tweet-text tweet) stream))
               (formatting-cell (stream)
                 (princ (dispay-create-at tweet) stream))))))


(defun display-timeline (frame pane)
  (with-slots (timeline) frame
    (table-format pane timeline)))

;; (defun display-timeline (frame pane)
;;   (with-slots (timeline) frame
;;     (mapc (lambda (tweet)
;;             (updating-output (pane :unique-id tweet)
;;               (present tweet 'twitter:tweet :stream pane)
;;               (terpri pane)))
;;           timeline)))

(define-application-frame twitter-frame ()
  ((timeline :initform nil :accessor timeline)
   (last-id :initform 1 :accessor last-id)
   (worker))
  (:menu-bar t)
  (:panes (timeline-pane
           :application
           :incremental-redisplay t
           :display-function 'display-timeline)
          (text-editor
           :text-editor
           :space-requirement (make-space-requirement :width 900))
          (entry-button
           :push-button
           :label "投稿する"
           :activate-callback
           (lambda (button)
             (declare (ignore button))
             (execute-frame-command *application-frame*
                                    `(com-update-status)))))
  (:layouts (default (vertically (:width 900 :height 600)
                       timeline-pane
                       (horizontally (:height 50) text-editor entry-button)))))

McCLIM で twitter クライアントを作ってみた

昨日は clg で作ったので今日は McCLIM で作ってみた。作ったといっても昔書きちらしてたのを整理したという感じ。

やはり Common Lisper としては clg より McCLIM の方が落ち着く。見た目がしょぼかろうと、複雑怪奇であろうとやはり Common Lisp でコードを書いているという実感が嬉しいのかな。

いやそれほど複雑怪奇じゃないな。方向性がちょっと違うだけだよ。

define-presentation-type, define-presentation-method っていいね。これがあるからこそ画面上のそこにオブジェクトが「ある」と感じられる。

タイマーとかわかんなかったからスレッドでやっちゃた。グリッドビューみたいなのはどうするんかなぁ。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :quek)
  (require :mcclim)
  (require :mcclim-freetype)
  (require :mcclim-uim)
  (require :cl-twitter)
  (require :net-telent-date))

(defpackage :mcclim-twitter-html-client
    (:use :clim :clim-lisp))

(in-package :mcclim-twitter-html-client)

;; 文字コードは UTF-8 で
(setf drakma:*drakma-default-external-format* :utf-8)

(defvar *auth*
  (with-open-file (in (merge-pathnames ".twitter.lisp"
                                       (user-homedir-pathname)))
    (read in))
  "Basic 認証のパラメータを取得する。~/.twitter.lisp の中身は
(\"username\" \"password\")")

(defun dispay-create-at (tweet)
  (multiple-value-bind (second minute hour date month)
      (decode-universal-time
       (net.telent.date:parse-time (twitter:tweet-created-at tweet)))
    (format nil "~02,'0d/~02,'0d ~02,'0d:~02,'0d:~02,'0d"
            month date hour minute second)))

(defun update-timeline (frame)
  (with-output-to-string (*standard-output*)
    (with-slots (timeline last-id) frame
      (let ((update (twitter:friends-timeline :since-id last-id)))
        (when update
          (setf last-id (twitter:tweet-id (car update)))
          (setf timeline (append update timeline)))))))

(defun update-status (new-status)
  (twitter:send-tweet new-status))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (define-presentation-type twitter:tweet ()))

(define-presentation-method present (object (type twitter:tweet)
                                            stream view &key)
  (format stream "~15a ~a ~a"
          (twitter:twitter-user-screen-name
                                    (twitter:tweet-user object))
          (twitter:tweet-text object)
          (dispay-create-at object)))

(defun display-timeline (frame pane)
  (with-slots (timeline last-id) frame
    (mapc (lambda (tweet)
            (updating-output (pane :unique-id tweet)
              (present tweet 'twitter:tweet :stream pane)
              (terpri pane)))
          timeline)))

(define-application-frame twitter-frame ()
  ((timeline :initform nil :accessor timeline)
   (last-id :initform 1 :accessor last-id)
   (worker))
  (:menu-bar t)
  (:panes (timeline-pane
           :application
           :incremental-redisplay t
           :display-function 'display-timeline)
          (text-editor
           :text-editor
           :space-requirement (make-space-requirement :width 900))
          (entry-button
           :push-button
           :label "投稿する"
           :activate-callback
           (lambda (button)
             (declare (ignore button))
             (execute-frame-command *application-frame*
                                    `(com-update-status)))))
  (:layouts (default (vertically (:width 900 :height 600)
                       timeline-pane
                       (horizontally (:height 50) text-editor entry-button)))))

(define-twitter-frame-command (com-quit :menu t :name t) ()
  (frame-exit *application-frame*))

(define-twitter-frame-command (com-update-timeline :menu t :name t) ()
  (update-timeline *application-frame*))

(define-twitter-frame-command (com-update-status) ()
  (let* ((text-editor (find-pane-named *application-frame* 'text-editor))
         (new-status (gadget-value text-editor)))
    (update-status new-status)
    (setf (gadget-value text-editor) "")
    (update-timeline *application-frame*)
    (redisplay-frame-panes *application-frame*)))

(defmethod adopt-frame :after (manager (frame twitter-frame))
  (declare (ignore manager))
  (apply #'twitter:authenticate-user *auth*)
  (execute-frame-command frame `(com-update-timeline))
  (setf (slot-value frame 'worker)
        (quek:spawn (loop (quek:receive (:timeout 70)
                            (:quit (return)))
                          (update-timeline frame)
                          (redisplay-frame-panes frame)))))


(defmethod frame-exit :before ((frame twitter-frame))
  (quek:send (slot-value frame 'worker) :quit))

#+nil
(run-frame-top-level (make-application-frame 'twitter-frame
                                             :top 300 :left 600))

[Common Lisp] McCLIM で日本語入力

Common Lisp の GUI といえば CLIM で、その open source implementation である McCLIM がある。ただ残念ながら McCLIM では現状日本語入力ができない。そこでなんとか日本語入力できないものかと、もがいてみた。 Factor のときみたに XOpenIM とかすればいいかと思ったが、McCLIM では Xlib は使われていない。 Xlib の Common Lisp 版といえる clx が使われている。それじゃどうすりゃいいのと、適当に悩んだあげく uim(libuim)を CFFI で呼ぶことにした。

で、まあなんとか日本語が入力できるようになった。

# 試してみたいという方は次のように darcs で取得してみてください。 (require :mcclim-uim) すれば ok です。それとは別に McCLIM で日本語表示するためには (require :mcclim-freetype) も必要です。

git clone git://github.com/quek/mcclim-uim.git

https://github.com/quek/mcclim-uim