高橋メソッドなプレゼンツール on wxHaskell
wxHaskellを使って、高橋メソッドなプレゼンツールを作ってみました。Haskellでプレゼンツールってあんまりないですよね？
ダウンロード: Windows用実行形式 + ソースコード
チュートリアル:
- アーカイブ中のsample.batを実行してください。サンプルのプレゼンテーションが始まります。
- プレゼンテーションの書き方については、sample.txtを参考にしてください。
操作方法:
- テキストファイルをwxtm.exeにドラッグ & ドロップします。
- お好みに応じて画面を最大化します。
- キーボードを使ってページをめくります。キーバインドはlessです。以上。
BUGS:
参照: 高橋メソッド
以下、ソースです。相変らずIOの山です。うーむ。GUIでIOとそれ以外を上手く分離するにはどうしたらいいんだろう。
ファイル: wxtm.hs
module Main (main) where
import Control.Monad as M (when)
import Graphics.UI.WX
import Graphics.UI.WXCore
import System (getArgs)
import System.IO (readFile)
type Page = [String]
main :: IO ()
main = start . gui . parse =<< readFiles =<< getArgs
readFiles :: [String] -> IO String
readFiles [] = error "set files."
readFiles files = return . concat =<< mapM readFile files
parse :: String -> [Page]
parse s = parse' $ lines s
where
parse' :: [String] -> [Page]
parse' [] = [[]]
parse' ([] : ss) = [] : parse' ss
parse' (s : ss) =
let (p : ps) = parse' ss
in ((s : p) : ps)
gui :: [Page] -> IO ()
gui pages = do
vpageno <- varCreate (0)
f <- frame [text := "wxtm", clientSize := sz 640 480]
set f [on paint := onPaint f vpageno pages,
on anyKey := onKey f vpageno pages]
onPaint :: Frame () -> Var Int -> [Page] -> DC () -> Rect -> IO ()
onPaint f vpageno pages dc view = do
set dc [fontFace := "MS", fontWeight := WeightBold,
penColor := white, brushColor := white]
csz <- windowGetClientSize f
pageno <- varGet vpageno
drawPage csz (pages !! pageno)
set f [text := "wxtm - page:" ++ (show (pageno + 1))]
where
drawPage :: Size -> Page -> IO ()
drawPage csz page = do
drawRect dc view []
sequence_ $ zipWith (drawLine csz (length page)) [0 ..] page
drawLine :: Size -> Int -> Int -> String -> IO ()
drawLine csz nlines lineno line = do
let margin = 5 -- %
cw = sizeW csz
ch = sizeH csz `div` nlines
w = cw * (100 - margin) `div` 100
h = ch * (100 - margin) `div` 100
tsz <- setFontSize (sz w h) h (h `div` 20) line
let tw = sizeW tsz
th = sizeH tsz
x = (cw - tw) `div` 2
y = (lineno * ch) + ((ch - th) `div` 2)
drawText dc line (Point x y) []
setFontSize :: Size -> Int -> Int -> String -> IO Size
setFontSize sz fontSz fontStep s = do
set dc [fontSize := fontSz]
tsz <- getTextExtent dc s
if ((sizeW tsz > sizeW sz) || (sizeH tsz > sizeH sz))
then setFontSize sz (fontSz - fontStep) fontStep s
else return tsz
onKey :: Frame () -> Var Int -> [Page] -> Key -> IO ()
onKey f vpageno pages key = do
case key of
KeyEscape -> close f
KeyChar 'q' -> close f
KeyReturn -> nextPage
KeySpace -> nextPage
KeyBack -> prevPage
KeyDelete -> prevPage
KeyChar 'b' -> prevPage
KeyChar 'p' -> firstPage
KeyChar 'G' -> lastPage
KeyPrior -> prevPage
KeyNext -> nextPage
KeyHome -> firstPage
KeyEnd -> lastPage
otherwise -> return ()
where
firstPage :: IO ()
firstPage = varSet vpageno 0 >> repaint f
lastPage :: IO ()
lastPage = varSet vpageno (length pages - 1) >> repaint f
nextPage :: IO ()
nextPage = do
pageno <- varGet vpageno
M.when (pageno < length pages - 1) $ varSet vpageno (pageno + 1)
repaint f
prevPage :: IO ()
prevPage = do
pageno <- varGet vpageno
M.when (pageno > 0) $ varSet vpageno (pageno - 1)
repaint f
-- Local Variables:
-- compile-command: "ghc -W -fno-warn-unused-matches --make -o wxtm wxtm"
-- End:ファイル: Makefile
TARGET = wxtm HC = ghc HCFLAGS = -W -fno-warn-unused-matches --make HCFLAGS_REL = -optl-mwindows UPX = upx UPXFLAGS = --overlay=strip --strip-relocs=0 EXE = .exe all: $(TARGET)$(EXE) $(TARGET)$(EXE): $(TARGET).hs $(HC) $(HCFLAGS) $(HCFLAGS_REL) $< -o $@ $(UPX) $(UPXFLAGS) $@ clean: rm -f $(TARGET)_d$(EXE) $(TARGET)$(EXE) *.o *.hi
