imHo

unsafeInterleaveIO

haskell

超前衛的ゲームプログラミング方法論? - 純粋関数型雑記帳に習って、遅延リストでキーの状態をリストとして作成してそれを処理するテストをHSDLを使って書いてみた。きれいな処理してるだろ…嘘みたいだろ…IORef を使わずに状態処理してるんだぜ…それ

module Main where

import Multimedia.SDL
import System.IO.Unsafe (unsafeInterleaveIO)
import Control.Concurrent (threadDelay)

wndTitle = "delayed-stream test"
wndWidth = 256
wndHeight = 240
wndBpp = 32

frameRate = 60

-- 描画コマンド
type Scr = Surface -> IO ()

-- エントリ
main :: IO ()
main = do
	sdlInit [VIDEO]
	setCaption wndTitle wndTitle
	sur <- setVideoMode wndWidth wndHeight wndBpp [HWSURFACE, DOUBLEBUF, ANYFORMAT]
	do
		strm <- delayedStream (1000000 `div` frameRate) fetch
		let scrs = process $ map snd $ takeWhile notQuit strm
		mapM_ (\scr -> scr sur) scrs
	sdlQuit

	where
		-- 環境のフェッチ
		fetch = do
			quit <- checkSDLEvent
			ks <- getKeyState
			return (quit, ks)
		notQuit = not . fst

-- 遅延ストリーム
-- microsec 秒ごとに func を実行したアクションの結果をリストとして返す
delayedStream :: Int -> IO a -> IO [a]
delayedStream microsec func = unsafeInterleaveIO $ do
	threadDelay microsec
	x <- func
	xs <- delayedStream microsec func
	return $ x:xs

-- SDL のイベントを処理
-- 終了イベントがきたら True を返す
checkSDLEvent = do
	ev <- pollEvent
	case ev of
		Just QuitEvent	-> return True
		Just (KeyboardEvent { kbPress = True, kbKeysym = Keysym { ksSym = ks, ksMod = km } })
			| ks == SDLK_ESCAPE -> return True
			| ks == SDLK_F4 && (KMOD_LALT `elem` km || KMOD_RALT `elem` km) -> return True
		Nothing	-> return False
		_		-> checkSDLEvent

----

-- 状態
data GameState = GameState { x :: Int, y :: Int, cnt :: Int }

-- 初期状態
initialState = GameState { x = 100, y = 100, cnt = 0 }

-- キー入力を処理して描画コマンドを返す
process :: [[SDLKey]] -> [Scr]
process = loop initialState
	where
		loop gs [] = []
		loop gs (ks:kss) = scr' : loop gs' kss
			where (scr', gs') = update ks gs

-- 更新
update :: [SDLKey] -> GameState -> (Scr, GameState)
update ks gs = (render gs', gs')
	where
		gs' = GameState { x = x', y = y', cnt = cnt' }
		x' = x gs - (pressed SDLK_LEFT) + (pressed SDLK_RIGHT)
		y' = y gs - (pressed SDLK_UP) + (pressed SDLK_DOWN)
		cnt' = cnt gs + 1
		pressed k = if k `elem` ks then 1 else 0

-- 描画
render :: GameState -> Scr
render gs sur = do
	clearBG
	renderPlayer
	flipSurface sur
	return ()
	where
		clearBG = fillRect sur Nothing (fromInteger $ toInteger (cnt gs))
		renderPlayer = fillRect sur (Just $ Rect (x gs) (y gs) 16 16) 0xff0000

• アプリ側は IO モナドなし！
• 描画周りも超前衛的ゲームプログラミング方法論? - 純粋関数型雑記帳を参考に、描画コマンドを返すようにして処理
• 処理の重さにかかわらず threadDelay で一定時間時間待ちしてるだけなので、そこはもうすこしうまくやる必要がある
• アプリの終了までを処理するのに、遅延リストに対して「takeWhile notQuit strm」とできるのがすげー
• キーのリストを処理する側での終端チェック (loop gs ［］ = ［］) がメンドイ。これを回避するために、main の中の do を try で囲って例外をキャッチしてしまえば捕捉できる。しかし開発中には他の実行時エラーも捕捉してしまうという諸刃の剣。

Permalink | コメント(0) | トラックバック(0)

プリプリ

やべぇ、泣きそう

うまい、テラ高画質、家にこのドラムセット欲しい

こっちでもいい、つかすごすぎ

Permalink | コメント(0) | トラックバック(0)

フィボナッチ

algorithm

フィボナッチ in L - 純粋関数型雑記帳

累乗はO(logn)で計算できるので、結局フィボナッチはO(logn)で計算できる

すごく参考になった。べき乗をWikiPediaの上位桁から計算する方式を使えば、a を掛けるときの係数が 0 か 1 だけなので嬉しいね♪

# find the minimum value of power of 2 upper than x
def ceil2(x)
	n = 0
	while x >= 0
		n += 1
		x /= 2
	end
	n
end

# 2 dimensional matrix
class Mtx22 < Array
	def self.identity
		Mtx22.new([1,0, 0,1])
	end

	def *(m)
		Mtx22.new [
			self[0*2+0] * m[0*2+0] + self[0*2+1] * m[1*2+0],
			self[0*2+0] * m[0*2+1] + self[0*2+1] * m[1*2+1],
			self[1*2+0] * m[0*2+0] + self[1*2+1] * m[1*2+0],
			self[1*2+0] * m[0*2+1] + self[1*2+1] * m[1*2+1],
		]
	end

	def **(n)
		nb = ceil2(n)
		v = Mtx22.identity
		a = self
		(nb-1).downto(0) do |b|
			v *= v
			if n & (1<<b) != 0
				v *= a
			end
		end
		v
	end
end

def fib(n)
	m = Mtx22.new([0,1, 1,1])
	mm = m ** n
	mm[0*2+1]
end

あと、

(a*b) mod n = a mod n * b mod n

を使えばこれが解けるんじゃないかと思うんだけど考える気力がない。

Permalink | コメント(0) | トラックバック(1)