CommonLispのモダンな開発環境を整える

qiita.com

CommonLispでの開発はこれまでEmacs+slimeが主流でした。
Vimとslimeを組み合わせて使うslimv.vimというのもありましたが、いずれにせよ古いエディターですので初心者には敷居が高いというのが現実です。

最近はSublimeTextやAtomなどの新進気鋭なエディターが人気で、Vimなどから移ってくる人も少なくありません。
そろそろ、その波がCommonLispに来ても良い頃合いだと思います。

今回はエディターとしてAtomを使い、処理系の管理にRoswellを使うという環境を構築するための手順を記します。
Roswellについては深町さんの記事が分かりやすいかと思います。

blog.8arrow.org

それでは手順です。
Windowsでの場合を書いていきますが、他の環境でも同様に行えると思います。
各インストール場所は各々の環境に合わせて置き換えてください。

まずRoswellをダウンロードして、C:\roswellに展開します。
ここにパスを通せばコマンドラインから利用出来るようになります。
Windows10だと スタートを右クリック→システム→システムの詳細設定→環境変数 から行えます。
PATHにC:\roswellを追加してください。

msys2などを利用している場合は~/.bash_profileあたりにPATH="/c/roswell:${PATH}"などしてパスを通せば利用可能です。

次にAtomをインストールします。

atom.io

上のページからインストーラーをダウンロードし、それに従ってインストールを行ってください。

インストールが完了したらAtomでCommonLispを書くためのパッケージを導入します。
パッケージインストールタブを開いて、

• atom-slime
• language-lisp
• lisp-paredit

をインストールしてください。

終わったらatom-slimeのセットアップ手順に従い、slimeをダウンロードします。

github.com

上のページのClone or downloadという緑色のボタンからzipをダウンロードして、C:\slimeに展開します。
そしてatom-slimeの設定画面でSlime Pathを先ほど展開したC:\slimeに設定してください。

次にLisp ProcessのところでRoswellの処理系を使うようにします。
もともと使えなかったようなのですが、Roswellの方にissueを書いたらatom-slimeの方にプルリクを送ってもらえました。
2016/10/04現在はマージされていませんが、ここに書いてある通りに書き加えれば利用出来るようになります。
lib/swank-starter.coffeeの17行目あたりを以下のように書き換えてください。

args = [] # 17行目
args.push 'run' if command.match(/ros/) # ここが追加した行
args.push '--load' unless command.match(/clisp/)  # CLISP does not have a --load option

Windowsの場合、AtomのパッケージはC:\Users\your-name\.atom\packagesにあるのでそこから直接ファイルを編集します。
パッケージの修正が終わったらLisp Processにrosと入力してください。
以上でAtomの設定は完了となります。

さらにパッケージの読み込みなどはASDFのみで行い、外部からのインストールはRoswellで行うようにしましょう。
ASDFのsource-registry.confにRoswellでインストールされるパッケージの場所を書きます。
C:\Users\your-name\AppData\Local\config\common-lisp\source-registry.confを以下の内容で作成してください。

(:source-registry
  (:tree "/Users/your-name/.roswell/lisp/quicklisp/dists/quicklisp/software/")
  :INHERIT-CONFIGURATION)

以上でAtomとRoswellを組み合わせたモダンな開発環境の完成です！
新しくパッケージをインストールしたい場合はコマンドラインから、ros install package-nameで行うようにしましょう。

atom-slimeの使い方についてはまた別の記事で書く予定です。

Re: Common Lispでパーティクル

以前に書いたパーティクル描画のやつを手直しして、描画にポイントスプライトを用いるようにしました。
書き方も前より多少マシになったと思います。

これを書くまでに、パッケージ周りについて調べたり、CFFIについて調べてみたりと、CLの基本の部分を学ぶことが出来ました。
ので、ようやく初心者の域は脱したように感じています。長かった…

書いたものに説明を付け加えると、Z・X・A・Sキーでテクスチャを切り替えられます。
CLでOpenGLを触っている例がほとんど無いので画像の読み込みなどには四苦八苦しました。
今回は少し楽をしてRGBA配列のRAW画像を用意したので、大きな苦労は無かったです。

実際に動いてる動画がこちらです。

ソースコードとテクスチャのデータはGithubに上がってますが、こちらにも掲載しておきます。
ポイントスプライトとテクスチャオブジェクト、アルファブレンディングに関しては以下のページを参考にさせていただきました。
床井研究室 - Point Sprite を使ってみる
XXXXX_13 Programing 3D RealTime Rendering - テクスチャオブジェクトを作成し複数枚使い分ける
catalinaの備忘録 - OpenGLでパーティクル実験

;;
;;  Particle Rendering with OpenGL
;;

(in-package :cl)
(defpackage pixel-sprite
  (:nicknames :ps)
  (:use :cl))
(in-package :pixel-sprite)
(require "asdf")
(require 'cffi)
(require 'alexandria)
(require 'trivial-main-thread)
(require 'cl-opengl)
(require 'cl-glu)
(require 'cl-glfw3)

(setf *random-state* (make-random-state t))

(defstruct texture
  (data nil)
  (width 0)
  (height 0)) 

(defstruct mouse
  (start-x 0)
  (start-y 0)
  (pushed nil)
  (weight 0.5))

(defstruct particle
  (life 0.0)
  (fade-speed 0.01)
  (x 0.0) (y 0.0) (z 0.0)
  (r 1.0) (g 1.0) (b 1.0) (a 1.0)
  (move-x 10) (move-y 10) (move-z 10)
  (xg 0) (yg -0.8) (zg 0)) 

(defparameter *keys-pressed* nil)
(defparameter *mouse* (make-mouse))
(defparameter *window-size* nil)

(defparameter *particles0* nil)
(defparameter *particles1* nil)
(defparameter *particles2* nil)
(defparameter *particles3* nil)

(defparameter *angle-x* 0)
(defparameter *angle-y* 0)

(defparameter *textures* '())
(defparameter *texnames* nil)
(defparameter *current-texture* 0)
 
;; aref for texture-objects [GLuint* textures]
(defmacro texaref (texture-objects idx)
  `(cffi:mem-aref ,texture-objects '%gl:uint ,idx)) 

;; Load raw RGBA byte array for texture
(defun load-rgba-texture (path width height)
  (let ((texture (cffi:foreign-alloc '%gl:ubyte :count (* width height 4)))
        (image (alexandria:read-file-into-byte-vector path)))
    (loop for i from 0 to (1- (length image)) do
      (setf (cffi:mem-aref texture '%gl:ubyte i) (aref image i)))
    (make-texture :data texture :width width :height height)))

;; Call just once
(defun bind-texture-objects (texlist)
  (let* ((tc (list-length texlist))
        (texnames (cffi:foreign-alloc '%gl:uint :count tc)))
    (%gl:gen-textures tc texnames)
    (loop for i from 0 to (1- tc) do
      (%gl:bind-texture :texture-2d (texaref texnames i))
      (%gl:pixel-store-i :unpack-alignment 4)
      (%gl:tex-parameter-i :texture-2d :generate-mipmap #x1)
      (%gl:tex-parameter-i :texture-2d :texture-mag-filter #x2601)
      (%gl:tex-parameter-i :texture-2d :texture-min-filter #x2703)
      (%gl:tex-parameter-i :texture-2d :texture-wrap-s #x2900)
      (%gl:tex-parameter-i :texture-2d :texture-wrap-t #x2900)
      (%gl:tex-env-i :texture-env :texture-env-mode #x2100)
      (%gl:tex-env-i :point-sprite :coord-replace #x1)  
      (%gl:tex-image-2d :texture-2d 0 #x1908 (texture-width (nth i texlist)) (texture-height (nth i texlist))
        0 #x1908 :unsigned-byte (texture-data (nth i texlist))))
    texnames))

;; Loading textures
(defun initialize ()
  (%gl:pixel-store-i :unpack-alignment 4)
  (push (load-rgba-texture "yellow.raw" 32 32) *textures*)
  (format t "Loaded texture 3~%")
  (push (load-rgba-texture "blue.raw" 32 32) *textures*)
  (format t "Loaded texture 2~%")
  (push (load-rgba-texture "green.raw" 32 32) *textures*)
  (format t "Loaded texture 1~%")
  (push (load-rgba-texture "red.raw" 32 32) *textures*)
  (format t "Loaded texture 0~%")
  (setf *texnames* (bind-texture-objects *textures*))
  (format t "Succeeded to bind textures~%")
  (%gl:alpha-func :greater 0.5))

;; Destroy textures
(defun destroy ()
  (%gl:delete-textures (list-length *textures*) *texnames*)
  (format t "Deleted textures~%"))

;; Draw 4 colors particles
(defun draw-particles ()
  (gl:enable :blend)
  (gl:enable :texture-2d)
  (gl:enable :point-sprite)
  (gl:point-size 32)
  ; Draw red particles
  (%gl:bind-texture :texture-2d (texaref *texnames* 0))
  (gl:begin :points)
  (loop for p across *particles0*
        do (gl:color 1.0 1.0 1.0 (particle-life p))
        do (gl:vertex (particle-x p) (particle-y p) (particle-z p)))
  (gl:end)
  ; Draw green particles
  (%gl:bind-texture :texture-2d (texaref *texnames* 1))
  (gl:begin :points)
  (loop for p across *particles1*
        do (gl:color 1.0 1.0 1.0 (particle-life p))
        do (gl:vertex (particle-x p) (particle-y p) (particle-z p)))
  (gl:end)
  ; Draw blue particles
  (%gl:bind-texture :texture-2d (texaref *texnames* 2))
  (gl:begin :points)
  (loop for p across *particles2*
        do (gl:color 1.0 1.0 1.0 (particle-life p))
        do (gl:vertex (particle-x p) (particle-y p) (particle-z p)))
  (gl:end)
  ; Draw yellow particles
  (%gl:bind-texture :texture-2d (texaref *texnames* 3))
  (gl:begin :points)
  (loop for p across *particles3*
        do (gl:color 1.0 1.0 1.0 (particle-life p))
        do (gl:vertex (particle-x p) (particle-y p) (particle-z p)))
  (gl:end)
  (gl:disable :point-sprite)
  (gl:disable :texture-2d)
  (gl:disable :blend)
  (gl:point-size 1))

;; Add particle to vector for initialization
(defun add-particle (ptcls)
  (let ((p (make-particle)))
    (vector-push-extend p ptcls))) 

;; Initialize the particle
(defun init-particle (p)
  (setf (particle-life p) 1.0
        (particle-x p) 0
        (particle-y p) 0
        (particle-z p) 0
        (particle-fade-speed p) (+ (/ (random 99) 1000) 0.001)
        (particle-move-x p) (* (- (random 50) 25.0) 10)
        (particle-move-y p) (* (- (random 50) 25.0) 10)
        (particle-move-z p) (* (- (random 50) 25.0) 10)))

;; Move the particle
(defun move-particle (p)
  (let ((slow-down 10.0))
    (incf (particle-x p) (/ (particle-move-x p) (* 1000 slow-down)))
    (incf (particle-y p) (/ (particle-move-y p) (* 1000 slow-down)))
    (incf (particle-z p) (/ (particle-move-z p) (* 1000 slow-down)))
    (incf (particle-move-x p) (particle-xg p))
    (incf (particle-move-y p) (particle-yg p))
    (incf (particle-move-z p) (particle-zg p))))

;; Update particles
(defun update (ptcls id)
  (loop for i from 0 below (length ptcls) do
    (let ((p (aref ptcls i)))
      (decf (particle-life p) (particle-fade-speed p))
      (move-particle p) 
      (when (and (= *current-texture* id) (<= (particle-life p) 0))
        (init-particle p)))))

;; ESC -> quit
;;  Z  -> change particle color to Red
;;  X  -> Change particle color to Green
;;  A  -> Change particle color to Blue
;;  S  -> Change particle color to Yellow
(glfw:def-key-callback key-callback (window key scancode action mod-keys)
  (declare (ignore window scancode mod-keys))
  (when (and (eq key :escape) (eq action :press))
    (glfw:set-window-should-close))
  (if (eq action :press)
    (progn
      (when (eq key :z) (setf *current-texture* 0))
      (when (eq key :x) (setf *current-texture* 1))
      (when (eq key :a) (setf *current-texture* 2))
      (when (eq key :s) (setf *current-texture* 3))
      (pushnew key *keys-pressed*)))
  (if (eq action :release)
    (alexandria:deletef *keys-pressed* key)))

(glfw:def-mouse-button-callback mouse-callback (window button action mod-keys)
  (declare (ignore mod-keys))
  (if (eq action :press)
    (progn (if (eq button :left)
             (let ((pos (glfw:get-cursor-position window)))
               (setf (mouse-start-x *mouse*) (first pos))
               (setf (mouse-start-y *mouse*) (second pos)))
           (pushnew button (mouse-pushed *mouse*))))
    (alexandria:deletef (mouse-pushed *mouse*) button)))

;; It's called when on mouse move event
;; Change the camera angle by mouse position
(glfw:def-cursor-pos-callback cursor-callback (window x y)
  (declare (ignore window))
  (if (not (find :left (mouse-pushed *mouse*)))
    (let ((xdir (- x (mouse-start-x *mouse*)))
          (ydir (- y (mouse-start-y *mouse*))))
      (incf *angle-x* (* ydir (mouse-weight *mouse*)))
      (incf *angle-y* (* xdir (mouse-weight *mouse*)))
      (setf (mouse-start-x *mouse*) x)
      (setf (mouse-start-y *mouse*) y))))

;; It's called when on resize event
;; Scale the viewport by the window size
(glfw:def-window-size-callback update-viewport (window w h)
  (declare (ignore window))
  (set-viewport w h)) 

(defun set-viewport (width height)
  (gl:viewport 0 0 width height)
  (gl:matrix-mode :projection)
  (gl:load-identity)
  (glu:perspective 30.0 (/ 600 400) 1.0 100.0)
  (gl:matrix-mode :modelview))

;; Draw X-axis, Y-axis and Z-axis
(defun draw-xyz ()
  (gl:begin :lines)
  
  (gl:color 0 1 0)
  (gl:vertex -100 0)
  (gl:vertex 100 0)
  
  (gl:color 1 0 0)
  (gl:vertex 0 0)
  (gl:vertex 0 100)
  
  (gl:color 0 0 1)
  (gl:vertex 0 0 -100)
  (gl:vertex 0 0 100)
  
  (gl:end))

(defun main ()
  (trivial-main-thread:with-body-in-main-thread ()
    (glfw:with-init-window (:title "Particle Render" :width 600 :height 400)
      (setf %gl:*gl-get-proc-address* #'glfw:get-proc-address)
      (initialize)
      (glfw:set-key-callback 'key-callback)
      (glfw:set-mouse-button-callback 'mouse-callback)
      (glfw:set-cursor-position-callback 'cursor-callback)
      (glfw:set-window-size-callback 'update-viewport)
      (gl:clear-color 0 0 0 0)
      (gl:blend-func :src-alpha :one)
      (gl:disable :depth-test)
      (set-viewport 600 400)
      (setf *particles0* (make-array 4096 :adjustable t :fill-pointer 0))
      (setf *particles1* (make-array 4096 :adjustable t :fill-pointer 0))
      (setf *particles2* (make-array 4096 :adjustable t :fill-pointer 0))
      (setf *particles3* (make-array 4096 :adjustable t :fill-pointer 0))
      (loop repeat 4096 do (add-particle *particles0*))
      (loop repeat 4096 do (add-particle *particles1*))
      (loop repeat 4096 do (add-particle *particles2*))
      (loop repeat 4096 do (add-particle *particles3*))
      (format t "Particles generated~%")
      (loop until (glfw:window-should-close-p)
         do (gl:clear :color-buffer-bit :depth-buffer-bit)
            (gl:load-identity)
            (glu:look-at -6.0 7.0 8.0 0.0 0.0 0.0 0.0 1.0 0.0)
            (%gl:rotate-d *angle-x* 1 0 0)
            (%gl:rotate-d *angle-y* 0 1 0)
            (draw-xyz)
            (draw-particles)
            (update *particles0* 0)
            (update *particles1* 1)
            (update *particles2* 2)
            (update *particles3* 3)
            (gl:color 0 0 0)
            (glfw:swap-buffers)
            (glfw:poll-events))
      (destroy))))

(main)

構造体とクラスにおける循環参照

よくある階層構造(親子関係)を構造体とクラスで表現してみる。

;;;; 構造体の定義
(defstruct h-struct
  (val 0)
  (parent nil)
  (child nil))

;;;; クラスの定義
(defclass h-class ()
  ((val :accessor get-val
        :initarg :val
        :initform 0)
   (parent :accessor get-parent
           :initarg :parent
           :initform nil)
   (child :accessor get-child
          :initarg :child
          :initform nil)))

これを使って2つのオブジェクトを相互に参照させてみます。
まずは構造体の例。

;;;; 構造体における循環参照
(setf mother (make-h-struct :val 50))
(setf me (make-h-struct :val 20))

(setf (h-struct-child mother) me)
(setf (h-struct-parent me) mother) ;; ここで循環参照が完成

しかしスタックオーバーフローでエラー。止まります。
今度はクラスでやってみます。

;;;; クラスにおける循環参照
(setf you (make-instance 'h-class :val 25))
(setf son (make-instance 'h-class))

(setf (get-child you) son)
(setf (get-parent son) you) ;; ここで循環参照が完成

これは大丈夫。
何が違うのだろうか。

なんとなく構造体の例で参照先のフィールドを書き換えてみる。

(setf (h-struct-val (h-struct-child mother)) 30)
(print (h-struct-val me)) ;; 値渡しなら20のままのはず

;;;; 結果
30
30

どうやら参照が渡されているようだ。
一方クラスの場合。

(setf (get-val (get-parent son)) 20)
(print (get-val you)) ;; 値渡しなら25のままのはず

;;;; 結果
20
20

エラーが起きるか否かという違いを除いて、どちらも同じような結果を示した。
一体内部で何が起こっているんだろうか。そして構造体でも循環参照を実現する方法はあるのだろうか(ぶん投げ)。

結果はsbclとcclで確認しました。
処理系じゃなくてもっと根本的な問題でしょう。

と、いう内容で投稿しようと思ってたのですが…よく考えるとこれはREPLの問題ですね。
構造体のスロットを書き換えた時、REPLは構造体の中身を全て表示しようとするはずです。
一方クラスの場合はオブジェクト名が表示されるだけに留まります。

循環リストは*print-circle*をtにしてやれば表示が出来ました。
構造体の表示も結局はリストです。同様の効果が得られるでしょう。

(setq *print-circle* t)

こうしておけば構造体であっても循環参照が可能です。
あーすっきりした。

ちなみにC言語の場合は単純にparentとchildをポインタ型にすれば出来ます。
いわゆる自己参照構造体ってやつです。

今回のはある意味、REPLの弊害と言えるのではないでしょうか。
なんとなくデフォルトでtにしておいて欲しいと思うのですが…。

Lisp de Math 1

最近、数学にハマっています。 PRMLとかを読み進めるうちにだんだん面白くなってきて、ついに純粋数学に手を染めてしまいました。

本当は位相幾何学(トポロジー)に手を出したいのですが、今まで数学を適当にやってきた人間なのでまずは群論あたりから固めています。

さて、群論と言えば、ガロア理論ですね。

名前のカッコよさに惹かれていろいろ数学書を漁ってみたのですが、まあ、素人が読みこなせるようなものは少ないです。 何かスラスラ読めて高校生でも分かるぐらい噛み砕いててなおかつ実践的な本ないかな〜〜〜〜〜と思ってたんですが、ありました。

数学ガールのガロア理論です。

数学ガール/ガロア理論 (数学ガールシリーズ 5)

僕みたいな素人にはこっちの方が読みやすい。

まだ全部は読めてないですが、この本で題材にされている"あみだくじ"について、群であることを証明するプログラムを書いてみました。 証明と言っても、それぞれの公理について総当りしているだけなのですが……

ところで、今回初めてCLOSを使ってみました。 上手く書けてるか不安。

# ros -l group.lisp
Amida-kuji is a group.

Proof:
G = ((1 2 3) (2 3 1) (3 1 2) (1 3 2) (3 2 1) (2 1 3))
(G0) : Closure -> T
(G1) : Associativity -> T
(G2) : Identity -> (1 2 3)
(G3) : Inverse -> T
(C)  : Commutativity -> NIL

奥が深い。

ナベアツ算を書いてみた

もう1月を終えようとしていますが，あけましておめでとうございます．
いろいろ忙しく，記事を書く時間が割けないでいました．

とりあえず更新せねば，と思ったので書くだけ書きます．

今回は，あるブログ記事に触発されてナベアツ算なるものをCLで書いてみました．

tanakahisateru.hatenablog.jp

FizzBuzzに通じるところがありますね．

最近はRustにも手を出したりHaxeでLisp処理系の実装を試みたり，色々とやってみてはいますが，どうにも中途半端になりがちです…．

CommonLispでパーティクル

追記:2016/9/13 書き直しました

Lisp Advent Calendar 2015 の17日目の記事です．

qiita.com

題の通りCommonLispでパーティクルを描画してみました．
使用したライブラリは以下，全部Quicklispで入ります．

GitHub - cffi/cffi: The Common Foreign Function Interface

GitHub - 3b/cl-opengl: cl-opengl is a set of CFFI bindings to the OpenGL, GLU and GLUT APIs.

GitHub - AlexCharlton/cl-glfw3: Common Lisp bindings to GLFW version 3.x

GitHub - Shinmera/trivial-main-thread: Compatibility library to run things in the main thread.

alexandria / alexandria · GitLab

作成したコードを載せます．

OpenGLでのパーティクル描画に関しては 実践編04 - OpenGL de プログラミング を参考に(というかほとんどCommonLispに書き換えただけ…)させていただきました．

上のサイトではglutを使っていますが，丸パクリは流石に避けたいなと思ったのでglfw3を使用しました． alexandriaはキーハンドリングの部分に使っていますが，無くても出来ますね:)

今回初めてCommonLispでGUIプログラミングをしてみたのですが，思ったより書きやすかったです．
またcl-openglに用意されているマクロ(引数の数で呼び出す関数を変えてくれる)がとても便利ですね！

まとめ

CommonLisp楽しい．OpenGL面白い．

#| 遅れて申し訳ありませんでしたorz |#

繋がるAndroid端末とPC

先日，ECL Androidなるものがリリースされていました．

ECL自体はCommon Lispの処理系の１つで，Cのソースコードへ変換してコンパイルするのが特徴です．ECL AndroidはそれをAndroidアプリとして動作するようにしたもののようで，ちょうど手元にAndroidタブレットがあったので早速インストールしてみました．apkファイルはこちらからダウンロードしました．

起動画面

起動するとコンソールのような画面でeclが走ります．

初回起動時にはswankがインストール・コンパイルされます．

一見するとコンソールのような見た目ですが，キャレットもなく標準出力をそのまま表示しているだけのようです(？)．実際に式を評価するにはいちいち右上のメニューからEvalを選択して式を入力しなければならないようで．しかしEvalの上にSwank serverという項目があり，これを選択するとSwankサーバーが立ち上がります．

ということは，他の端末から接続することが出来るじゃないか！

接続方法

まず(Swankサーバーを立ち上げた)接続先の端末のIPアドレスを知る必要がありますね．

Androidの「設定」→「端末情報」→「端末の状態」→「IPアドレス」からIPアドレスを確認してどこかにメモっておきましょう．次に，接続先の端末と同じネットワーク環境内にある端末(PC)からCommon Lisp処理系を立ち上げます(ここはECLじゃなくても大丈夫です)．Swankサーバーに接続するために(ql:quickload :swank-client)したら，

(swank-client:with-slime-connection (conn "接続先のIPアドレス" Swankサーバーのポート番号)
(swank-client:slime-eval '(format t "Hello, Android!") conn))

を実行します．

するとAndroid端末の方にHello, Android!が出力されます．やったぜ．

(get-quicklisp)を評価するとquicklispも入るそうなので，もしかしたらAndroid端末上でCommon Lispプログラミングが出来るのかもしれません．とてもワクワクしますね！

Swankサーバーへの接続についてはこちらの記事を参考にさせて頂きました．