2014年9月21日日曜日

Stateモナドを利用して、gifヘッダの解析をやってみた

Stateモナドで状態を引き回す


とりあえず暇だったので、GIF画像のヘッダ情報を解析するコードをHaskellで書いてみました。

GIFヘッダは

  • Gif Header
  • Image Block
  • Graphic Control Extension
  • Comment Extention
  • Plain Text Extention
  • Application Extention

というように、分かれていますが、今回は「Gif Header」だけに限って解析してみました。

まずperlのgifcat.plを利用して情報を見てみる


あの有名なperlスクリプト、gifcat.plスクリプトを利用してヘッダ情報を確認してみる、
こんな感じのラッパースクリプトを作成して確認。
もちろん、gifcat.plは別途用意してください。
#!/usr/bin/perl

require "gifcat.pl";
@files = ("ai.gif");          # 解析したいGIF画像
print &gifcat'gifcat(@files);
このスクリプトを実行しますと、この様にヘッダ情報が確認できます。
cuomo@karky7 ~ $ perl checkGifHead.pl
=====================================
GifHeader
=====================================
Signature:                     GIF
Version:                       89a
Logical Screen Width:          300
Logical Screen Height:         423
Global Color Table Flag:       1
Color Resolution:              7
Sort Flag:                     0
Size of Global Color Table:    256 * 3
Background Color Index:        255
Pixel Aspect Ratio:            0
Global Color Table:
  10 0F 04 1B 15 05 24 15 06 32 18 0C 33 16 1F 26
  1E 0C 2E 1E 0D 39 1D 09 52 14 19 27 20 28 26 20
  2F 35 20 09 2E 23 08 32 22 09 6E 13 1D 2C 26 33
  4E 1D 2E 33 28 11 33 29 0A 39 27 0E 27 2A 33 4E
  22 12 2C 28 3C 65 18 36 3A 28 18 41 26 1B 39 26
  35 44 27 12 4B 25 12 49 29 0C 3A 2B 2B 41 2D 0C
  40 2D 13 3B 2F 10 46 2D 06 4D 25 45 56 2D 12 55
  2D 1A 62 2A 14 59 2C 1B 44 34 12 5C 2D 16 39 34
  40 50 31 1A 49 34 1A 43 36 19 53 32 15 4D 34 14
  4F 32 26 35 36 50 48 35 2B 96 21 27 4A 3A 17 A3
  1F 1E 8A 29 34 9C 23 3B 52 3F 16 5A 3D 1C 50 41
  1E 89 2C 48 6B 3A 17 54 40 20 50 40 2C 6F 38 20
  62 3C 1F 75 37 1F 69 3B 20 61 3D 26 67 3B 29 5C
  40 2E 5C 41 26 82 31 58 C5 24 2E 56 47 23 6A 3D
  4F 62 45 24 5C 47 24 5A 47 2C 5F 40 63 50 44 72
  43 4A 63 4E 49 51 7D 43 19 5C 4A 44 88 41 2B 62
  4D 2A C7 2D 40 3F 50 76 7F 45 2B 84 44 2A 6B 4C
  2B 7B 48 24 73 4B 2C 7A 49 2D 74 4D 1C 78 4A 37
  6F 4D 34 BA 37 3E 6D 4E 3D 63 52 3C C7 33 52 BA
  3D 52 BB 3B 65 92 50 35 8E 52 38 99 4F 36 8D 56
  32 8A 58 3C 88 58 44 82 5B 3A A8 4C 6A AE 4D 4F
  80 5C 42 7C 5D 4B A9 56 31 93 5E 2F B3 55 30 4F
  69 93 A2 5B 32 8F 5C 6F 7A 60 88 5E 69 82 75 68
  66 A2 5E 45 96 63 47 AA 5E 45 9F 64 40 E2 4E 5D
  93 6A 49 8C 6B 59 99 68 52 91 6B 51 9F 6A 4D D0
  66 3B D4 63 66 A5 74 57 B8 70 51 C3 6F 46 E1 61
  7C AD 74 5C B5 74 47 AB 77 54 D1 69 7B 9E 7B 5F
  9E 7D 51 A7 79 61 C8 74 3B C6 72 68 C0 72 94 C5
  73 7D AE 7D 5F 67 8A B3 8D 88 7F A5 83 74 B2 83
  4F B9 7D 79 A6 83 8C 81 8D A4 B3 85 6D C4 80 6D
  B6 85 66 CC 81 62 CE 82 58 BE 85 6D BC 87 63 B2
  8B 62 C7 86 57 B4 8E 6F BD 8C 6D AA 8C AB BC 8E
  74 E1 89 57 D9 8A 68 E8 84 7E D6 8D 79 C2 95 74
  E0 90 4F C9 93 79 DC 8F 73 C3 96 7C D2 94 68 D4
  92 7B DA 94 5F CF 96 73 EB 8C 95 C1 9A 8C CA 9B
  74 D4 9A 63 D2 9B 80 CA 9E 84 CD 9E 7D E5 96 AD
  E6 9D 8B CF A7 75 9C AE C8 B1 AC AB D1 A2 B0 DB
  A4 86 DF A5 77 DF A3 8B D1 A7 8D D9 A6 80 EA A3
  6D F0 A3 65 F3 A3 60 D6 A9 87 DC A7 8F C7 AD 9B
  E6 AA 72 D3 AC 9C CF B0 90 D9 AF 94 EA B2 95 F0
  B4 7F E6 B6 98 F8 B4 77 ED B3 B0 DE B9 A2 E1 BA
  9B E5 B8 A4 EA BB 93 DA BD B0 D5 C2 9A E3 C0 85
  EF B9 CA D7 C3 AE B9 C8 D9 F6 BE 89 E6 C2 A9 E4
  C4 B0 F5 C3 95 E7 CB 96 E4 C6 D1 FA C6 91 CD D0
  D5 F7 C9 A0 F3 CC A9 EF CD B3 EA D0 AB ED CE B9
  EF CD C3 FA C9 CB F3 CD CB EA D3 BB EF D3 C4 EB
  D7 C6 E4 D9 C8 F4 DE CD F6 E0 B8 F5 E3 D8 F3 E6
  D2 DF EC E5 F4 EA DD FE F2 E5 F8 F4 E4 F5 F7 EF
...
...
...
cuomo@karky7 ~ $

今度は、haskellでやってみる

まずは、解析したいGIF画像を選ぶのですが、私は「篠崎愛ちゃん」のファンでしたが、最近は心境の変化により若干趣味思考が変わってきたのでサヨナラの意味も込めて、「篠崎愛ちゃん」のGIFヘッダを解析して、心の区切りをつけようと思います。

デスから、画像はこれ、



これをGIFに変換したものを利用します。
で、コードはこちら、Stateモナドを利用してGIFのバイトデータを1バイトづつ解析しています。
{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.ByteString.Lazy as L
import System.Environment (getArgs)
import Control.Applicative ((<$>))
import Control.Monad.State
import Data.Bits ((.&.), shiftR)
import Data.Int
import Data.Word
import Data.Char
import Text.Printf


data GifHeader = GifHeader {
  signature        :: L8.ByteString,     -- GIF for 3bytes
  version          :: L8.ByteString,     -- Version 3bytes
  log_sc_width     :: Word16,            -- Logical Screen width 2bytes
  log_sc_height    :: Word16,            -- Logical Screen height 2bytes
  packfeild        :: Word8,             -- Image info 1byte
  bgcol_idx        :: Word8,             -- Background color index 1byte
  pix_asp_ratio    :: Word8,
  global_col_tbl   :: L8.ByteString      -- Global Color table
} deriving (Show)


data StateBuffer = StateBuffer {
  buffer :: L8.ByteString,
  offset :: Int64
} deriving(Show)


type StateBuff a = State StateBuffer a


parseBytes :: Int64 -> StateBuff L.ByteString
parseBytes n = get >>= \st ->
  case L.splitAt n (buffer st) of
    (bs, remainder) -> put new_state >>= \_ -> return bs
      where new_state = StateBuffer { buffer = remainder,
                                  offset = new_offset }
            new_offset = offset st + n


settpl :: L.ByteString -> [(Word8, Int)]
settpl v = zip v' [1 .. length v']
           where v' = L.unpack v


toWord8 :: (Enum a) => a -> Word8
toWord8 = toEnum . fromEnum


toWord16 :: (Enum a) => a -> Word16
toWord16 = toEnum . fromEnum


sumWord8 :: Enum a => (a, Int) -> Word16 -> Word16
sumWord8 (w, v) b = (toWord16 w) * (toWord16 v ^ 8) + b


getWord :: Int64 -> StateBuff [(Word8, Int)]
getWord n = settpl <$> parseBytes n


parseW8 :: StateBuff Word8
parseW8 = head . L.unpack <$> parseBytes 1


parseW16toInt :: StateBuff Word16
parseW16toInt = foldr sumWord8 0 <$> getWord 2


sizeOfGCT :: Word8 -> Int64
sizeOfGCT feild
  | (f /= 0) = 3 * 2 ^ ((feild .&. 0x07) + 1)
  | otherwise = 0
  where f = (feild .&. 0x80)


sizeOfSGCT :: Word8 -> Int
sizeOfSGCT bf = 2 ^ ((bf .&. 0x07) + 1)


readGifHeader :: StateBuff GifHeader
readGifHeader = parseBytes 3 >>= \sig ->
  parseBytes 3 >>= \ver ->
  parseW16toInt >>= \lw ->
  parseW16toInt >>= \lh ->
  parseW8       >>= \pf ->
  parseW8       >>= \bgi ->
  parseW8       >>= \pixar ->
  parseBytes (sizeOfGCT pf) >>= \gct ->
  return GifHeader { signature = sig,
                     version = ver,
                     log_sc_width = lw,
                     log_sc_height = lh,
                     packfeild = pf,
                     bgcol_idx = bgi,
                     pix_asp_ratio = pixar,
                     global_col_tbl = gct }


readGifFile :: FilePath -> IO L.ByteString
readGifFile filename = L.readFile filename


wordToChar :: Word8 -> Char
wordToChar = chr . fromIntegral


toWordsToChar :: L.ByteString -> [Char]
toWordsToChar = (map wordToChar) . L.unpack


isColTableFlag :: Word8 -> Int
isColTableFlag bf
  | f /= 0 = 1
  | otherwise = 0
     where f = bf .&. 0x80


getColResolusion :: Word8 -> Word8
getColResolusion bf = (bf `shiftR` 4) .&. 0x07 + 1


getSortFlag :: Word8 -> Word8
getSortFlag bf = (bf `shiftR` 3) .&. 0x01


putGifHeader :: GifHeader -> IO ()
putGifHeader v = do
    putStr $ "====================\n" ++
           "GifHeader \n" ++
           "====================\n" ++
           "Signature:                     " ++ toWordsToChar (signature v) ++ "\n" ++ 
           "Version:                       " ++ toWordsToChar (version v) ++ "\n" ++
           "Logical Screen Width:          " ++ show (log_sc_width v) ++ "\n" ++
           "Logical Screen Height:         " ++ show (log_sc_height v) ++ "\n" ++
           "Global Color Table Flag:       " ++ show (packfeild v) ++ "(" ++ show (isColTableFlag $ packfeild v) ++ ")" ++ "\n" ++
           "Color Resolution:              " ++ show (getColResolusion $ packfeild v) ++ "\n" ++
           "Sort Flag:                     " ++ show (getSortFlag $ packfeild v) ++ "\n" ++
           "Size of Global Color Table:    " ++ show (sizeOfGCT $ packfeild v) ++ "(" ++ show (sizeOfSGCT (packfeild v)) ++ " * 3)" ++ "\n" ++
           "Background Color Index:        " ++ show (bgcol_idx v) ++ "\n" ++
           "Pixel Aspect Ratio:            " ++ show (pix_asp_ratio v) ++ "\n" ++
           "Global Color Table:             \n"
    putStr $ dump (L.unpack $ global_col_tbl v)


printByte :: Word8 -> String
printByte = printf "%02X "


dump ::  [Word8] -> String
dump = dump' 0


dump' :: Int64 -> [Word8] -> String
dump' _ [] = "\n"
dump' i (b:xs)
  | (i `mod` 16 == 0) = "  " ++ printByte b ++ dump' (i+1) xs
  | (i `mod` 16 == 15) = printByte b ++ "\n" ++ dump' (i+1) xs
  | otherwise = printByte b ++ dump' (i+1) xs


putRemainState :: StateBuffer -> IO ()
putRemainState s = do
    let buff = buffer s
        off = offset s
    putStr $ "-------------------\n" ++
           "StateBuffer \n" ++
           "-------------------\n" ++
           "offset:      " ++ show(off) ++ "\n" ++
           "Remain buffer:\n"
    putStr $ dump (L.unpack buff)


initStateBuffer :: L8.ByteString -> StateBuffer
initStateBuffer buff = StateBuffer { buffer = buff, offset = 0 }


main :: IO()
main = do
  args <- getArgs
  buff <- readGifFile $ head args
  let (h, s) = runState readGifHeader $ initStateBuffer buff
  putGifHeader h
  putRemainState s
実行してみると、
cuomo@karky7 ~ $ runghc gifcat2.hs ai.gif
====================
GifHeader
====================
Signature:                     GIF
Version:                       89a
Logical Screen Width:          300
Logical Screen Height:         423
Global Color Table Flag:       231(1)
Color Resolution:              7
Sort Flag:                     0
Size of Global Color Table:    768(256 * 3)
Background Color Index:        255
Pixel Aspect Ratio:            0
Global Color Table:
  10 0F 04 1B 15 05 24 15 06 32 18 0C 33 16 1F 26
  1E 0C 2E 1E 0D 39 1D 09 52 14 19 27 20 28 26 20
  2F 35 20 09 2E 23 08 32 22 09 6E 13 1D 2C 26 33
  4E 1D 2E 33 28 11 33 29 0A 39 27 0E 27 2A 33 4E
  22 12 2C 28 3C 65 18 36 3A 28 18 41 26 1B 39 26
  35 44 27 12 4B 25 12 49 29 0C 3A 2B 2B 41 2D 0C
  40 2D 13 3B 2F 10 46 2D 06 4D 25 45 56 2D 12 55
  2D 1A 62 2A 14 59 2C 1B 44 34 12 5C 2D 16 39 34
  40 50 31 1A 49 34 1A 43 36 19 53 32 15 4D 34 14
  4F 32 26 35 36 50 48 35 2B 96 21 27 4A 3A 17 A3
  1F 1E 8A 29 34 9C 23 3B 52 3F 16 5A 3D 1C 50 41
  1E 89 2C 48 6B 3A 17 54 40 20 50 40 2C 6F 38 20
  62 3C 1F 75 37 1F 69 3B 20 61 3D 26 67 3B 29 5C
  40 2E 5C 41 26 82 31 58 C5 24 2E 56 47 23 6A 3D
  4F 62 45 24 5C 47 24 5A 47 2C 5F 40 63 50 44 72
  43 4A 63 4E 49 51 7D 43 19 5C 4A 44 88 41 2B 62
  4D 2A C7 2D 40 3F 50 76 7F 45 2B 84 44 2A 6B 4C
  2B 7B 48 24 73 4B 2C 7A 49 2D 74 4D 1C 78 4A 37
  6F 4D 34 BA 37 3E 6D 4E 3D 63 52 3C C7 33 52 BA
  3D 52 BB 3B 65 92 50 35 8E 52 38 99 4F 36 8D 56
  32 8A 58 3C 88 58 44 82 5B 3A A8 4C 6A AE 4D 4F
  80 5C 42 7C 5D 4B A9 56 31 93 5E 2F B3 55 30 4F
  69 93 A2 5B 32 8F 5C 6F 7A 60 88 5E 69 82 75 68
  66 A2 5E 45 96 63 47 AA 5E 45 9F 64 40 E2 4E 5D
  93 6A 49 8C 6B 59 99 68 52 91 6B 51 9F 6A 4D D0
  66 3B D4 63 66 A5 74 57 B8 70 51 C3 6F 46 E1 61
  7C AD 74 5C B5 74 47 AB 77 54 D1 69 7B 9E 7B 5F
  9E 7D 51 A7 79 61 C8 74 3B C6 72 68 C0 72 94 C5
  73 7D AE 7D 5F 67 8A B3 8D 88 7F A5 83 74 B2 83
  4F B9 7D 79 A6 83 8C 81 8D A4 B3 85 6D C4 80 6D
  B6 85 66 CC 81 62 CE 82 58 BE 85 6D BC 87 63 B2
  8B 62 C7 86 57 B4 8E 6F BD 8C 6D AA 8C AB BC 8E
  74 E1 89 57 D9 8A 68 E8 84 7E D6 8D 79 C2 95 74
  E0 90 4F C9 93 79 DC 8F 73 C3 96 7C D2 94 68 D4
  92 7B DA 94 5F CF 96 73 EB 8C 95 C1 9A 8C CA 9B
  74 D4 9A 63 D2 9B 80 CA 9E 84 CD 9E 7D E5 96 AD
  E6 9D 8B CF A7 75 9C AE C8 B1 AC AB D1 A2 B0 DB
  A4 86 DF A5 77 DF A3 8B D1 A7 8D D9 A6 80 EA A3
  6D F0 A3 65 F3 A3 60 D6 A9 87 DC A7 8F C7 AD 9B
  E6 AA 72 D3 AC 9C CF B0 90 D9 AF 94 EA B2 95 F0
  B4 7F E6 B6 98 F8 B4 77 ED B3 B0 DE B9 A2 E1 BA
  9B E5 B8 A4 EA BB 93 DA BD B0 D5 C2 9A E3 C0 85
  EF B9 CA D7 C3 AE B9 C8 D9 F6 BE 89 E6 C2 A9 E4
  C4 B0 F5 C3 95 E7 CB 96 E4 C6 D1 FA C6 91 CD D0
  D5 F7 C9 A0 F3 CC A9 EF CD B3 EA D0 AB ED CE B9
  EF CD C3 FA C9 CB F3 CD CB EA D3 BB EF D3 C4 EB
  D7 C6 E4 D9 C8 F4 DE CD F6 E0 B8 F5 E3 D8 F3 E6
  D2 DF EC E5 F4 EA DD FE F2 E5 F8 F4 E4 F5 F7 EF

-------------------
StateBuffer
-------------------
offset:      781
Remain buffer:
  21 FE 11 43 72 65 61 74 65 64 20 77 69 74 68 20
  47 49 4D 50 00 2C 00 00 00 00 2C 01 A7 01 00 08
  FE 00 B5 B1 1B 48 90 1D 37 2F 2E 56 28 64 C1 62
  C5 86 87 10 1F 82 58 40 71 82 C5 09 11 22 48 08
  C1 31 84 84 8F 12 22 30 10 C9 60 64 49 92 23 51
  96 5C C9 B2 A5 4B 06 05 5E 96 04 39 73 A6 04 06
  0D 24 34 D8 C9 12 E4 C7 10 20 72 B8 68 E3 02 0C
  18 17 42 81 2C 21 E1 A2 83 C3 40 07 38 38 3C 70
  60 81 01 01 02 00 68 D5 1A 20 00 06 01 18 AE 1A
  28 00 A0 EB D6 B2 01 B8 16 28 90 F6 AC DB B7 70
  E3 CA 95 DB 16 2D DA AE 6B 33 5A 04 C1 B7 2F DF
  10 2D 5A A0 08 8C A2 30 C7 16 1D 13 2B F6 B9 B1
  E3 CD 8C 1A 43 92 6C B0 F6 AA 00 81 05 07 72 23
  BA 90 61 43 85 11 1F 52 5C 70 11 A3 46 C5 1E 21
  AB 26 29 92 B5 CC D7 2F D7 CA 64 CC E0 E6 47 9C
  3A 79 D6 66 0C 94 45 8E 36 6D 80 18 75 01 A4 B8
  8B A6 2E 86 04 82 B1 02 48 07 AA 03 BE 66 AD 5B
  36 82 81 B0 60 B3 0A A0 BE 35 C0 5A B3 DC E7 FE
  8A 1F 4F FE EE 5D EF 05 22 EC 9C E0 B7 2F E0 C0
  82 0B A3 08 31 FF 30 6A C7 1E 41 7A 4C 0D F9 A3
  46 92 6B 61 25 00 39 99 0D B4 0E 24 09 AD E0 D9
  67 A1 89 56 D1 45 19 6D 24 A1 4F AD AD 94 91 85
  26 C1 A6 21 4B 31 CD 56 DB 4A 37 D5 96 D3 4E 39
  D9 A6 5F 0B 20 14 91 C3 20 5A 14 05 06 17 4B B8
  40 02 10 4C 81 21 06 1C 1C 0C D1 D4 06 03 64 80
  15 77 E9 C9 80 9D 0C 58 B1 D5 5D 5B 02 7C C7 55
  79 4C 36 39 57 5A 5D 45 99 9E 7A EC B5 07 02 7D
  82 11 56 1F 7D F7 DD 37 E1 7E 92 45 28 52 48 38
  05 88 15 66 99 1D ...
  ....
これで、「愛ちゃん」ヘッダ情報があらわになりました、StateBufferの項目は、まだ解析されていない残りのgifデータが格納されています...裸も同然です

haskellでやる良さ


だいたい手続き型の言語でバッファのデータを消費していくようなコードを書くと、バッファにインデックスでアクセスしていくようなループ処理になると思いますが、機能別に関数に分けたりすると、関数別にインデックスを進めるような感じのコードになりがちで、いまいち綺麗じゃありませんよね。まぁもうちょい頭を使えば綺麗にはなるとは思いますが...適当に書くとこんな感じかと。 適当に考えたコード
main()
{
    int cnt;
    Byte buff = read("ai.gif");
    cnt = func1(&buff, 0);
    cnt = func2(&buff, cnt);
    ...
    ...
}

int func1(Byte *buff, int start_index)
{
 int cnt = 0;
 ...
 // 消費したバイト数をかえす
 return start_index + cnt;
}

int func2(Byte *buff, int start_index)
{
 int cnt = 0;
 ...
 return start_index + cnt;
}
...
...
haskell版のコードの場合、その辺の細々した詳細をStateモナドが隠してくれているので、実際のヘッダ解析の処理にバッファのインデックスを操作する処理が見えないところが、余計な事を考えず処理を書くことに集中させてくれます。
さらに、parseBytesの引数に与えた取得したいバイト数しか、インデックスが進む事がないので、間違いが起こりにくい所なんかいいんではないでしょうか。
もし間違いがあるとすれば、readGifHeader関数で(>>=)で繋いでる関数に問題があるのがほぼ確定的に分かります。
それと、状態関数を走らせた後の結果に、直接別の関数を適用させる、ファンクターのfmapなんかすごくコードをシンプルしてくれます。

Stateモナドは、状態を持ち回る関数をコンビネータとしてつないで書いといて、初期状態を与えることによってつないである関数を走らせる、という難解なもののうちの1種だと私は思いますが、理解すると「これだ!」って感じにさせてくれるのが、私にとってのhaskellで、止められません...

「大人の表情(かお)をしたキミに、鼓動が高鳴る」とか言われたらアウトでしょ....


2014年9月12日金曜日

gentoo+pandoc+google-html5-slide でクールな美人スライドを作る

HTMLで作る、スライド


皆さんはもう知っているかも知れませんが、最近、美人なAPIを最近見つけてしまい、

「これは、APIで画像提供してくれているならば、是非私もいただきたい。」

とおもいまして、頑張って収集スクリプトを作って見ました。

しかし、やっぱり私は後々テキストファイルで編集するような事がしたいので

「markdownとかで編集してスライドを作るようなもんねぇーかなー...」


など思っていたところ、なんと、hackageにgoogle-html5-slideな素晴らしいパッケージがアルではないですか! @tanakhさんがgithubに上げてくださっていましたのでそちらを利用させていただき、gentooのebuilを作成しました。


最初にgoogle-html5-slideをインストールする


これは、私のgentooがローリングインストールになっているので、haskellのパッケージが色々腐った部分が発生していて、オリジナルのリポジトリからのemergeが失敗してしまうのでforkさせていただき、パッチ的なアレを適用してありますので、ご利用は計画的にお願いします。

現リビジョンで出来ないことは

  • divタグの処理が出来ない
  • spanタグの処理が出来てない
  • 色が出ない(これは致命的)

と言う感じになっています、今後修理していきます....ということでインストール


karky7 ~ # layman -a karky7
karky7 ~ # emerge -pv dev-haskell/google-html5-slide

These are the packages that would be merged, in order:

Calculating dependencies... done!
[ebuild  N    ~] dev-haskell/google-html5-slide-9999:0/9999::karky7  0 kB

Total: 1 package (1 new), Size of downloads: 0 kB

 * IMPORTANT: 25 news items need reading for repository 'gentoo'.
 * Use eselect news to read news items.

karky7 ~ # emerge dev-haskell/google-html5-slide


cuomo@karky7 ~ $ /usr/bin/google-html5-slide --help
The html5slide program

html5slide [OPTIONS] FILE

Common flags:
     --script-url=URL         URL of Google HTML5 slide script
     --slide-class=CLASSNAME  CSS class name of slide
     --style-css=FILE         Style CSS file
     --syntax-css=FILE        Syntax CSS file
     --poll                   Poll filesystem for changes
  -? --help                   Display help message
  -V --version                Print version information
cuomo@karky7 ~ $

これで/usr/binにgoogle-html5-slideコマンドが入るはずです!

美人の画像を収集してmarkdownのファイルを作成する

さぁ、画像を集める時間です、今回利用したのは、Bjin.Meっていうサイトの画像ですが、APIを提供していますのでそちらを利用して画像を取得します、でも待って!
人力で収集しなくてもいいんです、秘密のスクリプトがあるんです、他の人には内緒ですよ。

画像取得、markdownファイル作成

以下のファイルで画像を収集して、markdownファイルを作成する
このスクリプトはどこかディレクトリを掘ってそこへ設置してください。
{-# LANGUAGE OverloadedStrings #-}

import qualified Filesystem as F
import qualified Filesystem.Path as P
import Network.HTTP
import Data.Aeson
import qualified Data.Text as T
import Data.List.Split
import qualified Data.Attoparsec as AP (parseOnly)
import qualified Data.Attoparsec.Number as N (Number(I,D))
import Control.Applicative ((<$>),(<*>))
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.ByteString.Internal as I
import Data.Either.Utils (forceEither)

data Format = Xml | Json deriving(Show)
data RType = RRand | RNone deriving(Show)

data Req = Req {
  format :: Format,
  cnt :: Int,
  rtype :: RType
} deriving(Show)

data Vlist = Vlist {
  obj :: [Res]
} deriving(Show)

data Res = Res {
  cid :: Int,         -- コンテンID
  category :: String, -- 特定されている場合は人物の名
  thumb :: String,    -- thumnail
  link :: String,     -- Bjin.Mの表示リン
  pubDate :: String   -- このデータが発行された日
} deriving(Show)

instance FromJSON Res where
  parseJSON (Object val) = Res
                           <$> val .: "id"
                           <*> val .: "category"
                           <*> val .: "thumb"
                           <*> val .: "link"
                           <*> val .: "pubDate"
  parseJSON _            = mzero

req2url :: Req -> String
req2url r = bjnUrl ++ "type=" ++ (getrtype r) ++ "&count=" ++ show(cnt r) ++ "&format=" ++ (getfmttype r)
  where getrtype r = case rtype r of
                      RRand -> "rand"
                      RNone -> ""
        getfmttype r = case format r of
                         Xml -> "xml"
                         Json -> "json"

bjnUrl :: String
bjnUrl = "http://bjin.me/api/?"

bjnImgUrl :: String
bjnImgUrl = "http://bjin.me/images/"

getReq :: Req
getReq = Req { format = Json, cnt = 10, rtype = RRand }

getBjins :: String -> IO String
getBjins url = simpleHTTP (getRequest url) >>= getResponseBody

getRes :: Value -> [Res]
getRes res = do
  case fromJSON res of
    Success r -> r
    _ -> []

detailPics :: [Res] -> [String]
detailPics res = map (\r -> (bjnImgUrl ++ "pic" ++ show(cid r) ++ ".jpg")) res

storePics :: [String] -> IO ()
storePics [] = return ()
storePics (url:xs) = getBjins url >>= writePic file >> (putStrLn $ url ++ "...done") >> storePics xs
                       where file = last $ splitOn "/" url

mdFile :: P.FilePath
mdFile = "tammannai.md"

writePic :: String -> String -> IO ()
writePic file pic = L8.writeFile file (L8.pack pic) >> F.appendTextFile mdFile (createMd file)

createMd :: String -> T.Text
createMd file = T.replace (T.pack "<--PIC-->") (T.pack file) (T.pack center)
  where fill = "## pic1\n\n<article class='fill'>\n\n<img src='<--PIC-->'>\n\n</article>\n\n"
        center = "## pic\n\n<img  class='centered' src='<--PIC-->'>\n\n"

setHeader :: IO ()
setHeader = F.readTextFile mdFile >>= \t -> F.writeTextFile mdFile (T.pack h `T.append` t)
  where h = "% たまんない/gentoo <br>Majide Yabea ee.ee\n% @karky7\n% Sep 11, 2014\n\n君だけの思い出を創るんだっ!\n\nThere is more pictures just beautiful!.\n\n"

setFooter :: IO ()
setFooter = F.appendTextFile  mdFile (T.pack s)
  where s = "## Thank you!\n\n* [karky7.com](http://www.karky7.com)\n"

main :: IO ()
main = do
  res <- I.packChars <$> getBjins (req2url getReq)
  let vlist = getRes $ forceEither (AP.parseOnly json res)
  storePics $ detailPics vlist
  setHeader
  putStrLn "OK complete..."


そしてスライドを作成する 

後は実行するだけ、ランダムに画像を取得する仕組みになっていますが、画像がでかすぎたりするとうまく表示出来ない場合がありますので、その際はmarkdownファイルを修正してください。
実行したら、markdownファイルが作成されますので、google-html5-slideコマンドでhtmlファイルを作成してください。

最後に出来上がるのは、tamannnai,html(たまんない.html)です


cuomo@karky7 ~ $ mkdir ~/bjin
cuomo@karky7 ~ $ cd bjin/
cuomo@karky7 ~/bjin $ runghc bjin.hs 
http://bjin.me/images/pic20952.jpg...done
http://bjin.me/images/pic13645.jpg...done
http://bjin.me/images/pic248832.jpg...done
OK complete...
cuomo@karky7 ~/bjin $ google-html5-slide tammannai.md

さぁ、tamannai.htmlをブラウザで見てご覧

ぬぉぉ、これは、たまんない!でも綺麗につくれます、こんな感じになります


こんなに綺麗に簡単にスライドが作れるなら、PowerPointいらなくね?って感じになりますが...だがしかし、必要です

gentooとhaskellなら、無限の可能性を引き出せる感じがして、たまりません


いま、ドトールで書いているのデスが、隣のおねぇーさんが、こちらをみて不審そうな顔でぇ.....では