2009/04/30

ABCL での Java 呼び出し

JVM で動く Common Lisp である Armed Bear Common Lisp (ABCL) の Java 呼び出しはちょっとめんどくさい。クラス名やメソッド名を文字列で指定するのが悲しい。なのでちょっと書いてみたのが下のコード。

Java は大文字小文字の区別があるのでシンボルは縦棒付き。見た感じはタイプするのがめんどくさそうであるが、SLIME が立派なので sDM まで打てば |showMessageDialog| と縦棒付きで補完してくれる。 SLIME えらい。

jcc はチェーンで jcs はカスケード。 yourself はあなた自身ですね。Smalltalk さん。

github に置いておく。いまさらだけど github ってなんかいいね。 fork とか pull request とか。

(eval-when (:compile-toplevel :load-toplevel :execute)
(asdf:oos 'asdf:load-op :cl-ppcre))

(defmacro jimport (fqcn &optional (package *package*))
(let ((fqcn (string fqcn))
(package package))
(ppcre:register-groups-bind (class-name)
(".*\\.(.*)" fqcn)
(let ((class (jclass fqcn)))
`(progn
(defparameter ,(intern fqcn package) ,class)
(defparameter ,(intern class-name package) ,class)
,@(map 'list
(lambda (method)
(let ((symbol (intern (jmethod-name method) package))
(fn (if (jmember-static-p method)
#'jstatic
#'jcall)))
`(progn
(defun ,symbol (&rest args)
(apply ,fn ,(symbol-name symbol) args))
(defparameter ,symbol #',symbol))))
(jclass-methods class)))))))

(defun new (class &rest args)
(apply #'jnew
(apply #'jconstructor class (mapcar #'jclass-of args))
args))


(defmacro jcc (receiver message &rest rest)
(loop for i in rest
with args = nil
if (and (symbolp i)
(typep (symbol-value i) 'function))
do (setf receiver `(,message ,receiver ,@(nreverse args))
message i
args nil)
else
do (push i args)
finally (return `(,message ,receiver ,@(nreverse args)))))

(defmacro jcs (receiver message &rest rest)
(let ((yourself (gensym "yourself")))
`(let ((,yourself ,receiver))
,@(let (result)
(loop for i in rest
with args = nil
if (and (symbolp i)
(typep (symbol-value i) 'function))
do (progn
#1=(push `(,message ,yourself ,@(nreverse args))
result)
(setf message i
args nil))
else
do (push i args)
finally (if (eq i :yourself)
(progn
(push `(,message ,yourself
,@(nreverse (cdr args)))
result)
(push yourself result))
#1#))
(nreverse result)))))
#|
(jimport |java.lang.String|)
(|toUpperCase| "Hello")
(|replaceAll| "Hello" "l" "*ま*")
(jcc "Hello" |toUpperCase| |replaceAll| "L" "*L*")

(jimport |java.lang.Integer|)
(|parseInt| |Integer| "123")

(jimport |java.util.ArrayList|)
(jcs (new |ArrayList|) |add| "a" |add| "b" |toString|)
(|toString| (jcs (new |ArrayList|) |add| "a" |add| "b" |add| "c" :yourself))

(jimport |javax.swing.JOptionPane|)
(|showMessageDialog| |JOptionPane| nil "Hello World! まみむめも♪")
↓は Clojure
(. javax.swing.JOptionPane (showMessageDialog nil "Hello World"))
|#

2009/04/27

やっぱりカメ

昨日もらったカメは「やっぱりカメ返して」と、あっさり強制徴収されてしまった。

2009/04/26

よしビューア作った

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-opengl)
(require :cl-glu)
(require :cl-glut)
(require :cl-jpeg)
(require :drakma))

(defclass jpeg-viewer (glut:window)
((image :initarg :image :initform nil :accessor image))
(:default-initargs :mode '(:rgb :single)))

(defmethod glut:display-window :before ((w jpeg-viewer))
(gl:clear-color 0 0 0 0)
(%gl:shade-model :flat)
(gl:pixel-store :unpack-alignment 1))

(defmethod glut:display ((window jpeg-viewer))
(with-accessors ((image image)
(width glut:width)
(height glut:height)) window
(gl:clear :color-buffer-bit)
(gl:raster-pos 0 0)
(gl:draw-pixels width height :rgb :unsigned-byte image)
(%gl:flush)))

(defmethod glut:reshape ((window jpeg-viewer) w h)
(%gl:viewport 0 0 w h)
(%gl:matrix-mode :projection)
(%gl:load-identity)
(glu:ortho-2d 0 w 0 h)
(%gl:matrix-mode :modelview)
(%gl:load-identity))

(defmethod glut:keyboard ((window jpeg-viewer) key x y)
(declare (ignore x y))
(case key
((#\Esc #\q) (glut:destroy-current-window))))

(defun view (url)
(multiple-value-bind (image height width)
(jpeg:decode-stream (drakma:http-request url :want-stream t))
(loop for h from 0 below (/ height 2)
do (rotatef (subseq image (* h width 3) (* (1+ h) width 3))
(subseq image (- (* height width 3)
(* (1+ h) width 3))
(- (* height width 3)
(* h width 3)))))
(loop for i from 0 below (* height width 3) by 3
do (rotatef (aref image i) (aref image (+ i 2))))
(glut:display-window
(make-instance 'jpeg-viewer
:image image
:width width
:height height))))

;;(view "http://anime.nifty.com/luckystar/images/ls_wp_tpa.jpg")

突然の来訪とつれあいの携帯電話

子供とお風呂にはいっていたら、お義父さんとお義母さんが突然の来訪。私がゴールデンウィーク中に予定されていた合同誕生日会に出席できそうもないということで、誕生日の今日祝いに来てくれた。ありごうございます。

それと、今日はつれあいの携帯電話を買った。初期状態でいろんな有料割引プランが勝手につくのはどうにかならないのかね。いろんなメールも勝手に配信されてくるみたいだし。それらの解約方法の説明を聞くだけでぐったりしてしまった。説明してくれるのはいいけど、どうせならな最初からついてこなければいいのに。

娘からは誕生日プレゼントにカメ(お気に入りのぬいぐるみ)をもらった。本当にくれたのかな?きっと返して、と言われると思う。

イメージ

『OpenGLプログラミングガイド 第2版』はずっととばして第8章へ。イメージを。

glut:reshape のときに glut:width と glut:height が自動的に更新されてほしい気がするだが気のせいだろうか。

(defmethod glut:reshape ((window glut:window) w h)
(setf (glut:width window) w
(glut:height window) h))
というメソッドが定義済であって欲しい。

image.c の cl-opengl バージョン。ひさしぶりに loop ではなく dotimes を使った気がする。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-opengl)
(require :cl-glu)
(require :cl-glut))

(defconstant +width+ 64)
(defconstant +height+ 64)

(defclass image-window (glut:window)
((image :initform (make-array (* +height+ +width+ 3))
:accessor image)
(zoom-factor :initform 1.0
:accessor zoom-factor))
(:default-initargs :mode '(:rgb :single )))

(defmethod make-check-image ((window image-window))
(with-accessors ((image image)) window
(let ((index -1))
(dotimes (i +height+)
(dotimes (j +width+)
(let ((c (* (logxor (if (zerop (logand i #x8)) 1 0)
(if (zerop (logand j #x8)) 1 0))
255)))
(setf (aref image (incf index)) c)
(setf (aref image (incf index)) c)
(setf (aref image (incf index)) c)))))))

(defmethod glut:display-window :before ((w image-window))
(make-check-image w)
(gl:clear-color 0 0 0 0)
(%gl:shade-model :flat)
(gl:pixel-store :unpack-alignment 1))

(defmethod glut:display ((window image-window))
(gl:clear :color-buffer-bit) ; クリア
(gl:raster-pos 0 0)
(gl:draw-pixels +width+ +height+ :rgb :unsigned-byte (image window))
(%gl:flush))

(defmethod glut:reshape ((window image-window) w h)
(setf (glut:width window) w
(glut:height window) h)
(%gl:viewport 0 0 w h)
(%gl:matrix-mode :projection)
(%gl:load-identity)
(glu:ortho-2d 0 w 0 h)
(%gl:matrix-mode :modelview)
(%gl:load-identity))

(defmethod glut:motion ((window image-window) x y)
(with-accessors ((zoom-factor zoom-factor)) window
(let ((screen-y (- (glut:height window) y)))
(print (list (glut:height window) screen-y y))
(gl:raster-pos x screen-y)
(%gl:pixel-zoom zoom-factor zoom-factor)
(%gl:copy-pixels 0 0 +width+ +height+ :color)
(%gl:pixel-zoom 1 1)
(%gl:flush))))

(defmethod glut:keyboard ((window image-window) key x y)
(declare (ignore x y))
(with-accessors ((zoom-factor zoom-factor)) window
(case key
((#\r #\R)
(setf zoom-factor 1)
(glut:post-redisplay))
(#\z
(when (<= 3 (incf zoom-factor 0.5))
(setf zoom-factor 3)))
(#\Z
(when (<= (decf zoom-factor 0.5) 0.5)
(setf zoom-factor 0.5)))
((#\Esc #\q) (glut:destroy-current-window)))))

;;(glut:display-window (make-instance 'image-window))

2009/04/21

光源の移動

もちろん光源も移動するよね。移動の方法はモデルと同じなんだね。

緑色の光にしてみた。

『OpenGLプログラミングガイド 第2版』の movelight.c を cl-opengl で。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-opengl)
(require :cl-glu)
(require :cl-glut))

(defclass move-light-window (glut:window)
((spin :initform 0))
(:default-initargs :title "Move Light"
:mode '(:single :rgb :depth)
:width 500 :height 500 :pos-x 300 :pos-y 300))

(defmethod glut:keyboard ((window move-light-window) key x y)
(declare (ignore x y))
(case key
(#\q (glut:destroy-current-window))))

(defmethod glut:display-window :before ((window move-light-window))
(gl:clear-color 0 0 0 0)
(%gl:shade-model :smooth)
(gl:enable :lighting :light0 :depth-test))

(defmethod glut:display ((window move-light-window))
(gl:clear :color-buffer-bit :depth-buffer-bit)
(gl:with-pushed-matrix
(glu:look-at 0 0 5
0 0 0
0 1 0)
(gl:with-pushed-matrix
(%gl:rotate-d (slot-value window 'spin) 1 0 0) ; x を軸に回転
(gl:light :light0 :position '(0 0 1.5 1))
(gl:light :light0 :diffuse '(0 1 0 1)) ; 緑色の光
(%gl:translate-d 0 0 1.5)
(gl:disable :lighting) ; wire-cube のとき光は関係ない
(gl:color 0 1 1)
(glut:wire-cube 0.1)
(gl:enable :lighting)) ; solid-torus のとき光が関係する
(glut:solid-torus 0.275 0.85 8 15))
(%gl:flush))

(defmethod glut:reshape ((window move-light-window) w h)
(%gl:viewport 0 0 w h)
(%gl:matrix-mode :projection)
(%gl:load-identity)
(glu:perspective 40 (/ w h) 1 20)
(%gl:matrix-mode :modelview)
(%gl:load-identity))

(defmethod glut:mouse ((window move-light-window) button state x y)
(with-slots (spin) window
(case button
(:left-button
(when (eq state :down)
(setf spin (mod (+ spin 30) 360)) ; 左クリックする度に30度光を移動する。
(glut:post-redisplay))))))

;;(glut:display-window (make-instance 'move-light-window))

2009/04/19

立体っぽくなった

ようやく照光処理まできた。『OpenGLプログラミングガイド 第2版』の第5章だ。

cl-opengl は作りがいいように感じる。素直に OpengGL の関数が使えるし、ちょっと面倒なところはちゃんとラッパーが用意されてる。今回の gl:material とか。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-opengl)
(require :cl-glu)
(require :cl-glut))

(defclass light-window (glut:window)
()
(:default-initargs :title "Light"
:mode '(:single :rgb :depth)
:width 500 :height 500 :pos-x 300 :pos-y 300))

(defmethod glut:keyboard ((window light-window) key x y)
(declare (ignore x y))
(case key
(#\q (glut:destroy-current-window))))

(defmethod glut:display-window :before ((window light-window))
(gl:clear-color 0 0 0 0)
(%gl:shade-model :smooth)

(gl:material :front :specular '(1 1 1 1))
(gl:material :front :shininess 50)
(gl:light :light0 :position '(1 1 1 0))

(gl:enable :lighting :light0 :depth-test))

(defmethod glut:display ((window light-window))
(gl:clear :color-buffer-bit :depth-buffer-bit)
(glut:solid-sphere 1 200 160)
(%gl:flush))

(defmethod glut:reshape ((window light-window) w h)
(%gl:viewport 0 0 w h)
(%gl:matrix-mode :projection)
(%gl:load-identity)
(if (<= w h)
(%gl:ortho -1.5 1.5 (* -1.5 (/ h w))
(* 1.5 (/ h w)) -10 10)
(%gl:ortho (* -1.5 (/ w h)) (* 1.5 (/ w h)) -1.5
1.5 -10 10))
(%gl:matrix-mode :modelview)
(%gl:load-identity))

;;(glut:display-window (make-instance 'light-window))

2009/04/18

cl-opengl で文字を表示するときに便利な opengl-text

opengl-text を使うと日本語フォントも表示できる。素晴しい。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-glut)
(require :opengl-text))

(defvar *font-loader*
(zpb-ttf:open-font-loader
#p"/usr/share/fonts/truetype/vlgothic/VL-PGothic-Regular.ttf"))

(defclass string-window (glut:window)
((opengl-text :initform (make-instance 'opengl-text:opengl-text
:font *font-loader*
:emsquare 64)))
(:default-initargs :title "OpenGL Text"
:mode '(:single :rgb :depth)))

(defmethod glut:keyboard ((window string-window) key x y)
(declare (ignore x y))
(case key
((#\Esc #\q) (glut:destroy-current-window))))

(defmethod glut:reshape ((window string-window) w h)
(gl:viewport 0 0 w h)
(gl:matrix-mode :projection)
(gl:load-identity)
(gl:ortho 0 w 0 h -1 1))

(defmethod glut:display-window :before ((w string-window))
(gl:clear-color 0 0 0 0)) ; 次の clear で使う色

(defmethod glut:display ((window string-window))
(with-slots (opengl-text) window
(gl:clear :color-buffer-bit) ; クリア
(%gl:color-3f 1 1 1) ; 描画に使う色
(gl:enable :texture-2d)
(gl:enable-client-state :vertex-array)
(gl:enable-client-state :texture-coord-array)
(gl:matrix-mode :modelview)
(gl:load-identity)
(gl:scale 24 24 1) ; 24 x 24 ピクセル
(gl:translate 0 0 0) ; デフォルト左下に表示
(opengl-text:draw-gl-string "まみむめも♪" opengl-text)
(gl:load-identity)
(gl:translate 0 (- (glut:height window) 24) 0) ; 一番上に表示
(gl:scale 24 24 1)
(opengl-text:draw-gl-string "こんにちは OpenGL!" opengl-text)
(gl:flush)))

;;(glut:display-window (make-instance 'string-window))

惑星系 planet.c

『OpenGLプログラミングガイド 第2版』の 惑星系 planet.c を cl-opengl で。

キー操作による動きがあるからまた面白い。

月も追加してみた。

Common Lisp で書く場合は、ちょこっとパラメータを変更して C-c C-c すれば、プログラム実行したまま即反映されるからとても楽だ。

動きがあると透視法射影の意味が実感できる。確かに遠近法だ。

カメラの上方向ベクトルってのは、カメラの上側の方向なんだ。 0 1 0 ならランドスケープで、1 0 0 ならポートレイト。 0 0 1 だと机に置いたものを接写しているイメージかな。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-glu)
(require :cl-glut))

(defclass planet-window (glut:window)
((year :initform 0)
(day :initform 0)
(month :initform 0))
(:default-initargs :title "Planet"
:mode '(:double :rgb)
:width 500 :height 500
:pos-x 100 :pos-y 100))

(defmethod glut:display-window :before ((window planet-window))
(%gl:clear-color 0 0 0 0)
(%gl:shade-model :flat))

(defmethod glut:display ((window planet-window))
(with-slots (year day month) window
(gl:clear :color-buffer-bit)
(%gl:color-3f 1 1 1)
(gl:with-pushed-matrix
(gl:color 1 0 0)
(glut:wire-sphere 1 20 16) ; 太陽。半径、経線数、緯線数
(%gl:rotate-f year 0 1 0) ; 地球の公転
(%gl:translate-f 2 0 0) ; 太陽と地球の距離
(gl:with-pushed-matrix
(%gl:rotate-f day 0 1 0) ; 地球の自転
(gl:color 0 0 1)
(glut:wire-sphere 0.2 10 8)) ; 地球
(%gl:rotate-f month 0 1 0) ; 月の公転
(%gl:translate-f 0.3 0 0) ; 地球と月の距離
(gl:color 1 1 0)
(glut:wire-sphere 0.05 8 6)) ;
(glut:swap-buffers)))

(defmethod glut:reshape ((window planet-window) width height)
(%gl:viewport 0 0 width height)
(%gl:matrix-mode :projection)
(%gl:load-identity)
(glu:perspective 60 ; 透視射影の視野角度
(/ width height) ; 縦横比
1 ; 手前の座標
20) ; 奥の座標
(%gl:matrix-mode :modelview)
(%gl:load-identity)
(glu:look-at 0 0 5 ; カメラの位置
0 0 0 ; 向いてる方向
0 1 0)) ; 上方向

(defmethod glut:keyboard ((window planet-window) key x y)
(declare (ignore x y))
(with-slots (year day month) window
(case key
((#\Esc #\q)
(glut:destroy-current-window))
(#\m
(setf month (mod (+ month 5) 360))
(glut:post-redisplay))
(#\M
(setf month (mod (- month 5) 360))
(glut:post-redisplay))
(#\d
(setf day (mod (+ day 10) 360))
(glut:post-redisplay))
(#\D
(setf day (mod (- day 10) 360))
(glut:post-redisplay))
(#\y
(setf year (mod (+ year 5) 360))
(glut:post-redisplay))
(#\Y
(setf year (mod (- year 5) 360))
(glut:post-redisplay)))))

;;(glut:display-window (make-instance 'planet-window))

2009/04/17

まだ cl-opengl cube.c

frustum が透視法射影で、ortho が正射影。前者が遠近法。

カメラの位置と方向。上方向ベクトルって何?

ちょっとずつわかってきた。嬉しい。

『OpenGLプログラミングガイド 第2版』の cube.c を cl-opengl で。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-glu)
(require :cl-glut))

(defclass cube-window (glut:window)
()
(:default-initargs :title "Cube"
:mode '(:single :rgb)
:width 500 :height 500
:pos-x 200 :pos-y 100))

(defmethod glut:keyboard ((window cube-window) key x y)
(declare (ignore x y))
(case key
((#\Esc #\q) (glut:destroy-current-window))))

(defmethod glut:display-window :before ((window cube-window))
(%gl:clear-color 0 0 0 0)
(%gl:shade-model :flat))

(defmethod glut:display ((window cube-window))
(gl:clear :color-buffer-bit)
(%gl:color-3f 1 1 1)
(%gl:load-identity)
(glu:look-at 0 0 5 ; カメラの位置
0 0 0 ; カメラの方向
0 1 0) ; カメラの上方向ベクトル
(%gl:scale-f 1 2 1)
(glut:wire-cube 1)
(%gl:flush))

(defmethod glut:reshape ((window cube-window) width height)
(%gl:viewport 0 0 width height)
(%gl:matrix-mode :projection)
(%gl:load-identity)
(%gl:frustum ; 透視法射影
-1 ; left
1 ; right
-1 ; bottom
1 ; top
1.5 ; near
20) ; far
(%gl:matrix-mode :modelview))

;;(glut:display-window (make-instance 'cube-window))

mesa 系の lib をインストールしたら freeglut は動かなくなる?

2009/04/12

さすが小学生

近所の公園に緑の壁(ブタの鼻)と赤い棒がある。この春小学生になった娘がようやくその二つに登ることができるようになった。今日ははりきって公園に出かけて見せてもらった。

緑の壁の方は調子よかった。赤い棒の方はタイツをはいたまま来てしまったため、登れない。さらにジャンプした時、赤い棒に鼻をぶつけシクシク泣いてた。いったん家に帰ってタイツを脱いで再チャレンジ。今度はちゃんと登れた。さすが小学生だね。

次はダブルバッファ

『OpenGLプログラミングガイド 第2版』の次のサンプル double.c も cl-opengl で書いてみた。

ダブルバッファを使うには defclass の :default-initargs の :mode で :double を指定し、glut:display の最後に glut:swap-buffers を呼ぶ。

ダブルバッファといえば、どうしてトリプルバッファとかは聞かないんだろう、と思っていたが、バッファは2つあれば十分だからなんだ。でも、CPU のマルチコアが進めばマルチバッファも必要になってきたりしないのかな。

あとは、cl-opengl の実装上の選択により、eql スペシャライザのメソッドしかないとそのメソッドは呼び出されなかったりする。気をつけよ。ちょっとの間、CLOS ってそういう仕様っだたかと本気で悩んでしまった。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-glut))

(defclass double-window (glut:window)
((spin :initform 0.0)
(spin-p :initform nil))
(:default-initargs
:mode '(:double :rgb)))

(defmethod glut:keyboard ((window double-window) key x y)
(declare (ignore x y))
(case key
(#\q (glut:destroy-current-window))))

(defmethod glut:display-window :before ((window double-window))
(%gl:clear-color 0 0 0 0)
(%gl:shade-model :flat))

(defmethod glut:display ((window double-window))
(with-slots (spin) window
(gl:clear :color-buffer-bit)
(gl:with-pushed-matrix
(%gl:rotate-f spin 0.0 0.0 1.0)
(%gl:color-3f 1.0 1.0 1.0)
(%gl:rect-f -25.0 -25.0 25.0 25.0))
(glut:swap-buffers)))

(defgeneric spin-display (window))

(defmethod spin-display ((window double-window))
(with-slots (spin) window
(incf spin 2.0)
(when (< 360.0 spin)
(decf spin 360.0))
(glut:post-redisplay)))

(defmethod glut:reshape ((window double-window) w h)
(%gl:viewport 0 0 w h)
(%gl:matrix-mode :projection)
(%gl:load-identity)
(%gl:ortho -50.0 50.0 -50.0 50.0 -1.0 1.0)
(%gl:matrix-mode :modelview)
(%gl:load-identity))

(defmethod glut:idle ((window double-window))
(with-slots (spin-p) window
(when spin-p
(spin-display window))))

(defmethod glut:mouse ((window double-window)
(button (eql :left-button))
(state (eql :down))
x y)
(with-slots (spin-p) window
(setf spin-p t)))

(defmethod glut:mouse ((window double-window)
(button (eql :middle-button))
(state (eql :down))
x y)
(with-slots (spin-p) window
(setf spin-p nil)))

(defmethod glut:mouse ((window double-window) button state x y)
"cl-opengl の GLUT では eql スペシャライザを使わないメソッドがないと
メソッドが動いてくれないため、この空っぽのメソッドも必要となる。
glut:window にはデフォルトの実装のようなものがない。
display-window :around であらかじめ applicable メソッドを抽出しておく。
といったような理由から。詳細は inteface.lisp を参照"

(declare (ignore button state x y)))

(defun run ()
(glut:display-window (make-instance 'double-window)))
;;(run)


2009/04/11

slime-complete-form は C-c C-s

eval-when を書くたびにこのキーバインドは何だったろう、と思いつつ今日まできたが、ようやく確認したのでメモ。

slime-complete-form は C-c C-s です。

eval-when 書くときにはとても便利だ。

OpenGL の Hello World!

春ですね。何かを始めるにはいい季節です。何も始めないにしてもいい季節です。今月は誕生日もあります。

ということで OpenGL でも勉強してみる。昔々に買った『OpenGLプログラミングガイド 第2版』を読みながら。いまは第5版が出てるのか。それにしてもお高いものですね。よくこんな高い本買ったね。> 昔の私

もちろん C を使ったりはせず Common Lisp の cl-opengl を使う。

cl-opengl では GLUT が CLOS で実装されている。それを使って『OpenGLプログラミングガイド 第2版』の最初のサンプルを書いてみたのが下のコード。

glut:window を継承した窓クラスを定義。その描画は glut:display メソッドで。 glut:display-window は窓表示前の初期化処理。 glut:reshape は窓のサイズ変更時に呼ばれるが、今回は使わない。窓のインスタンスを作って、glut:display-window を呼べば表示さる。あと glut:keyboard でエスケープキーか q が押されたら窓が閉じるようにしてある。

ortho とか何のことだかまださっぱり分からないけど、なかなか楽しい。

本の中では C で書いてあるこのコードが hello.c となっていた。四角いポリゴンを書くのが OpenGL の Hello World! ということか。

(eval-when (:compile-toplevel :load-toplevel :execute)
(require :cl-glut))

(defclass test-window (glut:window)
()
(:default-initargs :title "Test" ; title 日本語はばける。
:mode '(:single :rgb :depth)))

(defmethod glut:keyboard ((window test-window) key x y)
(declare (ignore x y))
(case key
((#\Esc #\q) (glut:destroy-current-window))))

(defmethod glut:display-window :before ((w test-window))
(gl:clear-color 0 0 0 0) ; 次の clear で使う色
(gl:matrix-mode :projection)
(gl:load-identity)
(gl:ortho 0 1 0 1 -1 1)) ; 座標系と写像の指定?

(defmethod glut:display ((window test-window))
(gl:clear :color-buffer-bit) ; クリア
(%gl:color-3f (random 1.0) (random 1.0) (random 1.0)) ; 描画に使う色
(gl:begin :polygon) ; end までがポリゴン描画
(%gl:vertex-3f 0.25 0.25 0)
(%gl:vertex-3f 0.75 0.25 0)
(%gl:vertex-3f 0.75 0.75 0)
(%gl:vertex-3f 0.25 0.75 0)
(gl:end)
(gl:flush)) ; 実行

;;(defmethod glut:reshape ((window test-window) width height)
;; )

(defun run-test ()
(glut:display-window (make-instance 'test-window)))

;;(run-test)

2009/04/06

入学式

小学校の入学式。シンプルでなかなかよい入学式だった。

時間は容赦なくすごい。

親子ともどもね。