2013年11月14日木曜日

開発環境

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

その他参考書籍

実習11-1.

コード(BBEdit)

Sample.hs

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

main :: IO ()
main = do
    putStrLn $ makeGraphics cross
    let cross1 = myClearBit 19 19 cross
        cross2 = myClearBit 0 5 cross1
    putStrLn $ makeGraphics cross2
    mapM_ putStrLn $ map (\(a, b) -> a ++ ": " ++ show b)
                         [("0 × 0", myTestBit 0 0 cross2),
                          ("0 × 5", myTestBit 0 5 cross2),
                          ("19 × 19", myTestBit 19 19 cross2),
                          ("20 × 20", myTestBit 20 20 cross2)]

cross :: [[Word8]]
cross = foldr (\x acc -> mySetBit x x acc)
              (replicate xSize $ replicate ySize 0) $
              takeWhile (<xSize) [0..]


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 ++ 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 $
    map (\y -> concat (map (\x -> map (\b -> if (graphics !! x !! y .&. b) /= 0 then
                                                 'X'
                                             else
                                                 '.') $
                                      takeWhile (>0) $ geometricShift (0x80 :: Word8) 1)
                           $ takeWhile (<(div xSize 8)) [0..])) $
        takeWhile (<ySize) [0..]

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

入出力結果(Terminal, runghc)

$ runghc Sample.hs
X.......................................
.X......................................
..X.....................................
...X....................................
....X...................................
.....X..................................
......X.................................
.......X................................
........X...............................
.........X..............................
..........X.............................
...........X............................
............X...........................
.............X..........................
..............X.........................
...............X........................
................X.......................
.................X......................
..................X.....................
...................X....................
....................X...................
.....................X..................
......................X.................
.......................X................
........................X...............
.........................X..............
..........................X.............
...........................X............
............................X...........
.............................X..........
..............................X.........
...............................X........
................................X.......
.................................X......
..................................X.....
...................................X....
....................................X...
.....................................X..
......................................X.
.......................................X
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................

X.......................................
.X......................................
..X.....................................
...X....................................
....X...................................
.....X..................................
......X.................................
.......X................................
........X...............................
.........X..............................
..........X.............................
...........X............................
............X...........................
.............X..........................
..............X.........................
...............X........................
................X.......................
.................X......................
..................X.....................
........................................
....................X...................
.....................X..................
......................X.................
.......................X................
........................X...............
.........................X..............
..........................X.............
...........................X............
............................X...........
.............................X..........
..............................X.........
...............................X........
................................X.......
.................................X......
..................................X.....
...................................X....
....................................X...
.....................................X..
......................................X.
.......................................X
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................
........................................

0 × 0: True
0 × 5: False
19 × 19: False
20 × 20: True
$

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

0 コメント:

コメントを投稿