HaskellでRayTracerを作りはじめました。

はじめに

RayTracerには以前から興味はあったのですが、なかなかきっかけがなくはじめる事ができていませんでした。が、3D描画の基礎の復習とHaskellの勉強を兼ねて作りはじめました。

現状、球が一つ、ポイントライトが一つ置かれたシーンを、
直接光による照明で描画できるだけです。

実装に関して以下のサイト、ソースを参考にさせていただきました。

http://boegel.kejo.be/ELIS/Haskell/HRay/
http://www.t-pot.com/program/92_RayTraceSphere/index.html
http://www.t-pot.com/program/94_RayTraceLighting/index.html

実装

カメラから全ピクセルへ向けてレイを飛し、球に当れば照明計算、
当らなければ背景色として幅×高さ分の色を求めてBMP化しています。

カメラ周りの処理がいい加減なので、行列型の追加とあわせて修正したいです。

現状描画できる画像例


[640x640, bmp, rendering time 1 sec.]

実行環境
OS : Mac OS X Version 10.6.7
CPU : 2.26 GHz Intel Core 2 Duo
Memory : 2GB 1067 MHz DDR3

今後

次はカメラ処理の修正、モデルデータの読み取り、光線追跡法の実装をしてみようかと思います。
将来的にはPhoton Mappingの実装ができればいいかなと思っています。

RJsonを触ってみました。

動機

個人的に作成中のアプリケーションでJsonが必要になったのでHaskellJsonモジュールについて調べてみたところ、
RJsonがREADMEが充実していて良さそうだったので触ってみました。
備忘録として記事にしておきます。

導入

cabal install RJson

使い方

Google Translateの結果のJsonを例に書きます。
まず結果のJsonに含まれるデータを表す型を作ります。

data GoogleTranslateJson = GoogleTranslateJson {
     _data :: GoogleTranslateJsonData
} deriving Show

data GoogleTranslateJsonData = GoogleTranslateJsonData {
     _translations :: [GoogleTranslateJsonTranslation]
} deriving Show

data GoogleTranslateJsonTranslation = GoogleTranslateJsonTranslation {
     _translatedText :: String
} deriving Show

次にこの型をRJsonのシステムに登録します。

$(derive[''GoogleTranslateJson, ''GoogleTranslateJsonData, ''GoogleTranslateJsonTranslation])

後は使用するソースで以下のオプションを有効にし、必要なモジュールをimportします。

{-# OPTIONS_GHC
    -XTemplateHaskell
    -XFlexibleInstances
    -XMultiParamTypeClasses
    -XFlexibleContexts
    -XUndecidableInstances #-}

import Text.RJson
import Data.Generics.SYB.WithClass.Basics
import Data.Generics.SYB.WithClass.Derive

これだけで、

toJson GoogleTranslateJson{ _data = GoogleTranslateJsonData{ _translations = [ GoogleTranslateJsonTranslation{ _translatedText = "fleurs" } ] } }
fromJsonString (undefined :: GoogleTranslateJson) "{\"data\": {\"translations\": [{\"translatedText\": \"fleurs\"}]}}"

という書き出し、読み込み用の二つの関数が使えるようになります。

便利そうです。

テストしたバージョン

  1. RJson-0.3.7
  2. GHC 6.12.1

一応テストしたソースも貼って置きます。

続きを読む

Haskellで有限状態機械を書いてみました。

題材

手元にあった実例で学ぶゲームAIプログラミングより、
西部の鉱夫の生活をFSMで表現したものをHaskellで書いてみました。

実例で学ぶゲームAIプログラミング

実例で学ぶゲームAIプログラミング

ソース説明

鉱夫の状態は以下の4種類です。

data MinnerState = MS_EnterMineAndDigForNugget -- 鉱山で金を探す
                 | MS_VisitBankAndDepositGold  -- 銀行に行き手持ちの金を預ける
                 | MS_QuenchThirst             -- 喉の乾きを癒しに酒場に行ってお酒を飲む
                 | MS_GoHomeAndSleepTilRested  -- 家に帰り眠って疲れをとる
                   deriving (Show, Eq)

各状態の遷移は以下のようになります。




鉱夫は以下のようなdataで表現されています。

data MinnerFSM = MinnerFSM{
        state       :: MinnerState
      , thirst      :: Int -- 喉の乾き
      , fatigue     :: Int -- 疲労度
      , goldCarried :: Int -- 所持金塊
      , location    :: Location
      , moneyInBank :: Int
    } deriving (Show, Eq)

そして鉱夫の状態は、

updateMinnerState :: MinnerState -> MinnerFSM -> MinnerFSM

という関数を使って更新されていきます。

例としてMS_EnterMineAndDigForNugget状態の場合の更新処理は以下のようになっています。

updateMinnerState MS_EnterMineAndDigForNugget m =
    m{state = newState, fatigue = newFatigue, goldCarried = newGold}
    where
      newState = if newGold > maxNuggets
                 then MS_VisitBankAndDepositGold
                 else if (thirst m) >= thirstLevel
                      then MS_QuenchThirst
                      else MS_EnterMineAndDigForNugget
      newGold = (goldCarried m) + 1
      newFatigue = (fatigue m) + 1

下で引数の状態変数の値でパターンマッチを行い、MS_EnterMineAndDigForNugget状態の場合にこの処理が呼ばれるようにしています。

updateMinnerState MS_EnterMineAndDigForNugget m =

さらにその一行下で戻値を定義し、whereの中で変更される値について具体的な定義をしています。

m{state = newState, fatigue = newFatigue, goldCarried = newGold}

このような処理が各状態ごとにありそれらを実行していき一定以上銀行預金が増えたら終了します。

思ったことなど

updateMinnerState :: MinnerState -> MinnerFSM -> MinnerFSM

でパターンマッチ用にMinnerStateのみ取り出して引数として渡していますが、もう少し綺麗に書けないかと思いました。
下のような感じでdataの全体を受け取りつつ中のフィールドの値でパターンマッチしたいと思いました。

updateMinnerState :: MinnerFSM -> MinnerFSM
updateMinnerState m{ state = MS_***} =
追記

下のような書き方でdata全体を受け取りつつ、フィールドでパターンマッチ出来るみたいです。

updateMinnerState m@MinnerFSM{state = MS_EnterMineAndDigForNugget} =

今後

今回のような規模のものだとかなり簡潔に書けました。
もう少し複雑なものを書く場合にどんな感じになるのか試してみようと思います。

ソース全文(一応)

--
-- MinnerFSM.hs
--

-- 定数
maxNuggets         = 10  -- 一度に持ち運べる金の個数
thirstLevel        = 10  -- 耐えられる喉の乾き
comfortLevel       = 5   -- 十分な銀行預金の残高
clearGold          = 100 -- ゲームクリアに必要な銀行預金の残高
tirednessThreshold = 0   -- fatigueがこの値以下であれば疲労していない

-- 鉱夫の状態
data MinnerState = MS_EnterMineAndDigForNugget -- 鉱山で金を探す
                 | MS_VisitBankAndDepositGold  -- 銀行に行き手持ちの金を預ける
                 | MS_QuenchThirst             -- 喉の乾きを癒しに酒場に行ってお酒を飲む
                 | MS_GoHomeAndSleepTilRested  -- 家に帰り眠って疲れをとる
                   deriving (Show, Eq)

-- 場所の種類
data Location = LOCATION_Home
              | LOCATION_Mine
              | LOCATION_Bank
              | LOCATION_Bar
                deriving (Show, Eq)

-- 鉱夫データ
data MinnerFSM = MinnerFSM{
        state       :: MinnerState
      , thirst      :: Int -- 喉の乾き
      , fatigue     :: Int -- 疲労度
      , goldCarried :: Int -- 所持金塊
      , location    :: Location
      , moneyInBank :: Int
    } deriving (Show, Eq)

-- メイン関数
main :: IO ()
main = do game

-- ゲームの実行 
game :: IO ()
game = do putStr "start."
          gameInner MinnerFSM{  state       = MS_EnterMineAndDigForNugget
                              , thirst      = 0
                              , fatigue     = 0
                              , goldCarried = 0
                              , location    = LOCATION_Mine
                              , moneyInBank = 50}
          putStr "end."

-- ゲームの更新
gameInner :: MinnerFSM -> IO MinnerFSM
gameInner m = do newFSM <- return $ updateMinner m
                 putStrLn $ show newFSM
                 -- クリア判定
                 if moneyInBank newFSM < clearGold
                 then gameInner newFSM
                 else return newFSM

-- 状態変更の通知
beginState :: MinnerFSM -> MinnerState -> MinnerState -> MinnerFSM
endState :: MinnerFSM -> MinnerState -> MinnerState -> MinnerFSM

-- 状態が変化したら状態にあった場所に移動させる
beginState m _ MS_EnterMineAndDigForNugget = m{location = LOCATION_Mine}
beginState m _ MS_VisitBankAndDepositGold = m{location = LOCATION_Bank}
beginState m _ MS_QuenchThirst = m{location = LOCATION_Bar}
beginState m _ MS_GoHomeAndSleepTilRested = m{location = LOCATION_Home}
beginState m _ _ = m

endState m _ _ = m

-- 鉱夫の更新 状態変化の通知管理
updateMinner :: MinnerFSM -> MinnerFSM
updateMinner m = if (state newFSM) /= (state m)
                then beginState newFSM' (state m) (state newFSM')
                else newFSM
    where newFSM = updateMinnerInner m
          newFSM' = (endState newFSM (state m) (state newFSM))

-- 鉱夫の状態更新処理
updateMinnerInner :: MinnerFSM -> MinnerFSM
updateMinnerInner m = updateMinnerState (state m) m{thirst = (thirst m) + 1} -- 毎フレーム喉の乾きは増していく

-- 鉱夫の状態別更新処理
updateMinnerState :: MinnerState -> MinnerFSM -> MinnerFSM

-- 鉱山で金を探す
updateMinnerState MS_EnterMineAndDigForNugget m =
    m{state = newState, fatigue = newFatigue, goldCarried = newGold}
    where
      newState = if newGold > maxNuggets
                 then MS_VisitBankAndDepositGold
                 else if (thirst m) >= thirstLevel
                      then MS_QuenchThirst
                      else MS_EnterMineAndDigForNugget
      newGold = (goldCarried m) + 1
      newFatigue = (fatigue m) + 1

-- 銀行に行き手持ちの金を預ける
updateMinnerState MS_VisitBankAndDepositGold m =
    m{state = newState, goldCarried = 0, moneyInBank = newBankInMoney}
    where
      newState = if newBankInMoney > comfortLevel
                 then MS_GoHomeAndSleepTilRested
                 else MS_EnterMineAndDigForNugget
      newBankInMoney = (moneyInBank m) + (goldCarried m)

-- 喉の乾きを癒しに酒場に行ってお酒を飲む
updateMinnerState MS_QuenchThirst m =
    m{state = newState, thirst = newThirst, moneyInBank = newMoneyInBank}
    where
      newState = MS_EnterMineAndDigForNugget
      newMoneyInBank = (moneyInBank m) - 3
      newThirst = 0

-- 家に帰り休む
updateMinnerState MS_GoHomeAndSleepTilRested m =
    m{state = newState, fatigue = newFatigue}
    where
      newState = if newFatigue < tirednessThreshold
                 then MS_EnterMineAndDigForNugget
                 else MS_GoHomeAndSleepTilRested
      newFatigue = (fatigue m) - 1

C-uを押した回数によって実行するコマンドを変えるコマンドを定義する為の拡張 prefix-arg-commands.el を公開しました。

動機

個人的に出来るだけMetaキーを使用しないキーバインドにしていてあれこれやりくりしてきましたが、打ち易いキーバインドが少くなくなってきたため、普段余り使わないC-u(universal-argument)コマンドを事前に実行した回数によってコマンドを呼び分けコマンドを作ることで、キーバインドを増やすために作ってみました。

機能

(prefix-arg-commands-defun
  prefix-arg-commands-forward-move-commands
  '(forward-char forward-sexp))

のような形の式を評価すると、呼ばれた時にC-uが一度も入力されていない場合forward-charが、一度入力するとforward-sexpが呼ばれるprefix-arg-commands-forward-move-commandsという関数が定義されます。
リスト部分に要素を追加すれば2回、3回とC-uを押した場合に呼ばれる関数が定義できます。
現在10回分まで対応しています。

導入

1. git clone git@github.com:tm8st/emacs-prefix-arg-commands.git
または、
2. https://github.com/tm8st/emacs-prefix-arg-commands/raw/master/prefix-arg-commands.el
または、
3. (auto-install-from-url "https://github.com/tm8st/emacs-prefix-arg-commands/raw/master/prefix-arg-commands.el") を評価する。

などして、ソースを入手後、
.emacs等に、

(require 'prefix-arg-commands)
;; exapmle commands
(global-set-key (kbd "C-f") 'prefix-arg-commands-forward-move-commands)
(global-set-key (kbd "C-b") 'prefix-arg-commands-backward-move-commands)
(global-set-key (kbd "C-a") 'prefix-arg-commands-back-to-indentation-move-commands)
(global-set-key (kbd "C-e") 'prefix-arg-commands-end-of-line-move-commands)
(global-set-key (kbd "C-;") 'prefix-arg-commands-set-frame-alpha)

のような感じのコードを追加してください。
prefix-arg-commands-defunが定義され、
C-f,C-bなどに単純な移動用サンプルコマンドが、
C-;にC-uを押した回数によって異なる値をフレームの半透明度に設定するコマンドがバインドされます。

設定については、お好みに合せ調整してください。
面白い設定などありましたらお知らせ下さい。

今後

不具合、ご要望などありましたら、
email、twitterなどでお知らせください。

行番号表示にスクロールバー風現在表示領域の表示機能を追加したyalinum.elを公開しました。

動機

画面内で意外と占有面積の広い行番号表示部分に情報を追加できないかと思いつくってみました。
基本はlinum.elで主に[ya]linum-update-window()を変更しています。

adviceなどで作れるとよかったのですが、実力不足でちょっとあれな形になっています。

機能

行番号表示時にバッファ内でどの辺りの位置を表示しているのかを、
スクロールバーのバーのような形で表示されます。


導入

1. git clone git@github.com:tm8st/emacs-yalinum.git
または、
2. https://github.com/tm8st/emacs-yalinum/raw/master/yalinum.el をダウンロード。
または、
3. (auto-install-from-url "https://github.com/tm8st/emacs-yalinum/raw/master/yalinum.el") を評価する。

などしてソースを入手後、パスを通し.emacs等に、

(require 'yalinum)
(global-yalinum-mode t)

のような感じのコードを追加してください。

設定については、お好みに合せ調整してください。

現状、

  yalinum-line-number-length-min
  yalinum-width-base
  yalinum-width-scale
  yalinum-line-number-display-format
  yalinum-face
  yalinum-bar-face

などの変数で見た目の調整が可能です。

今後

  1. 行番号表示枠に追加できそうな情報を探す。

不具合、ご要望などありましたら、
email、twitterなどでお知らせください。

手軽にimenuの候補生成設定を行なうための拡張、easy-imenu-index-generator.elを公開しました。

動機

UnrealScript、ScalaHowmなど日頃良く使用しているフォーマットのもののimenu用の設定が見つからず、
自作する際に手軽に作れるように作成しました。
現状文法上の階層構造を考慮していない作りになっています。

機能

使い方は、

  1. imenuの候補を生成する際に使用する設定用変数を作成。(以降、設定用変数をsettingとした場合)
  2. 設定を有効にしたいタイミングで (easy-imenu-index-generator-set-for-current-buffer setting) とするとそのバッファに対して設定されます。

(***-mode-hookなどへのadd-hookを利用するとmode別設定をしやすいです。)

という感じです。

scala用の設定例は、

(defvar easy-imenu-index-generator-scala
  (make-easy-imenu-index-generator-setting
   :alist
   `(
     ((caption . "[CLASS]  ")
      (regexp . "^[ \t]*\\(abstract \\)?\\(case \\)?class[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)"))
     ((caption . "[OBJECT] ")
      (regexp . "^[ \t]*object[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)"))
     ((caption . "[TRAIT]  ")
      (regexp . "^[ \t]*trait[ \t]+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)"))
     ((caption . "[FUNC]   ")
      (regexp . "^[ \t]*\\(private \\)?\\(override \\)?\\(final \\)?\\(def \\)+\\([a-zA-Z_]+[a-zA-Z0-9_]*\\)"))
     ((caption . "[VAR]    ")
      (regexp . "^[ \t]*\\(private \\)?\\var[ \t]"))
     ((caption . "[VAL]    ")
      (regexp . "^[ \t]*\\(private \\)?\\val[ \t]"))
     )
   :add-line-number-to-item t
   ))

(add-hook 'scala-mode-hook
	  (lambda ()
	    (easy-imenu-index-generator-set-for-current-buffer easy-imenu-index-generator-scala)))

のような感じになります。
(こちらの設定例は、easy-imenu-index-generator-config.elにはいっています。)

導入

  • git clone git@github.com:tm8st/emacs-easy-imenu-index-generator.git

でソースの入手。
もしくは

http://github.com/tm8st/emacs-easy-imenu-index-generator/raw/master/easy-imenu-index-generator-config.el
をダウンロードして、パスを通し、

.emacs等に、

(require 'easy-imenu-index-generator-config)

(add-hook 'scala-mode-hook
	  (lambda ()
	    (easy-imenu-index-generator-set-for-current-buffer easy-imenu-index-generator-scala)))

のような感じのコードを追加してください。

設定については、お好みに合せ調整してください。

今後

  1. 階層構造を考慮した候補生成への対応?

ご要望などありましたら、Twitterでお知らせください。

Chrome等のブラウザからエクスポートしたBookmarkファイル内のURLをanythingする。

動機

ミドルウェアのリファレンスページや、社内ページへのアクセスなど、
仕事上で使用するWebページが増えマウスでブックマーク選択をするのが億劫になってきたので、
Emacs上でanythingで絞り込み検索を行い、アクセスしたいと思い作成しました。
(ものすごくすでにありそうですが、自分の検索力では発見できなかったため、作成してしまいました。)

実装にあたって、id:k1LoWさんのanything-hatena-bookmark.elを参考にさせていただきました。

機能

ブラウザからエクスポートしたブックマークファイルを元に、
anythingで使用するデータのみを抜きだしたファイルを作成し、
anythingのソースとして使用するというシンプルなものになっています。

導入

  1. git clone git@github.com:tm8st/emacs-anything-netscape-bookmark.git

でソースの入手。
もしくは

  1. http://github.com/tm8st/emacs-anything-netscape-bookmark/raw/master/anything-netscape-bookmark.el

をダウンロードして、パスを通し、

.emacs等に、

(require 'anything-netscape-bookmark)
(global-set-key (kbd "C-q C-a C-b") 'anything-netscape-bookmark)
(global-set-key (kbd "C-q C-a C-v") 'anything-netscape-bookmark-get-dump)

とコードを追加してください。
(キーバインドについては、お好みに合せ調整してください。)

次にブラウザのブックマークをエクスポートし、
anything-netscape-bookmark-fileで設定したパスへ配置し、
(デフォルトでは"~/Documents/Bookmarks.html")
anything-netscape-bookmarkを実行するとブックマークをanythingできます。

今後

  1. 複数の元ファイルから一つのanything用ファイルの作成?

ご要望などありましたら、Twitterでお知らせください。