2013年11月15日金曜日

開発環境

C実践プログラミング 第3版 (Steve Oualline (著)、 望月 康司 (監訳) (翻訳)、谷口 功 (翻訳)、オライリー・ジャパン)のⅡ部(単純なプログラミング)の11章(ビット演算)、11.8(ビットマップグラフィックス)、11.10(プログラミング実習)、実習11-2をHaskellで解いてみる。

その他参考書籍

実習11-2.

コード(BBEdit)

Sample.hs

{-# OPTIONS -Wall -Werror #-}
import Data.Bits
import Data.Word

main :: IO ()
main = putStr $ makeGraphics $ square 10

canvas :: [[Word8]]
canvas = replicate (div xSize 8) $ replicate ySize 0

square :: Int -> [[Word8]]
square n = foldr mySetBit
                 canvas
                 [(x, y) | x <- [0..n - 1], y <- [0..n - 1]]

xSize :: Int
xSize = 40

ySize :: Int
ySize = 60

mySetBit :: (Int, Int) -> [[Word8]] -> [[Word8]]
mySetBit (x, y) graphics =
    let a = div x 8
        b = graphics !! a
        c = take y b ++ ((b !! y) .|. (shiftR 0x80 (mod x 8))):drop (y + 1) b
    in take a graphics ++ c:drop (a + 1) graphics

myClearBit :: (Int, Int) -> [[Word8]] -> [[Word8]]
myClearBit (x, y) graphics =
    let a = div x 8
        b = graphics !! a
        c = take y b ++
            b !! y .&.
            complement ((shiftR 0x80 (mod x 8)) :: Word8):drop (y + 1) b
    in take a graphics ++ c:drop (a + 1) graphics

myTestBit :: (Int, Int) -> [[Word8]] -> Bool
myTestBit (x, y) graphics =
    graphics !! (div x 8) !! y .&. shiftR 0x80 (mod x 8) > 0

makeGraphics :: [[Word8]] -> String
makeGraphics graphics = unlines $ concatStrings (div xSize 8) $
    map (\(y, x) -> (map (\b -> if graphics !! x !! y .&. b /= 0 then
                                    'X'
                                else
                                    '.')    
                         (takeWhile (>0) $ geometricShift 0x80 1)))
        [(y, x) | y <- [0..ySize - 1], x <- [0..(div xSize 8) - 1]]

geometricShift :: (Bits b) => b -> Int -> [b]
geometricShift a r = a:(map (`shiftR`r) $ geometricShift a r)

concatStrings :: Int -> [String] -> [String]
concatStrings _ [] = []
concatStrings n x = concat (take n x):concatStrings n (drop n x)

入出力結果(Terminal, runghc)

$ runghc Sample.hs
XXXXXXXXXX..............................
XXXXXXXXXX..............................
XXXXXXXXXX..............................
XXXXXXXXXX..............................
XXXXXXXXXX..............................
XXXXXXXXXX..............................
XXXXXXXXXX..............................
XXXXXXXXXX..............................
XXXXXXXXXX..............................
XXXXXXXXXX..............................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
$

{-# OPTIONS -Wall -Werror #-}を記述してるから、細かく型を指定(:: Double)しないと警告がいっぱい出た。慣れるまでは{-# OPTIONS -Wall -Werror #-}の記述を消さずに細かく型を指定していくことに。

0 コメント:

コメントを投稿