diff --git a/schedevr.cabal b/schedevr.cabal
--- a/schedevr.cabal
+++ b/schedevr.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                schedevr
-version:             0.1.0.0
+version:             0.1.0.1
 synopsis:            Marge schedules and show EVR
 -- description:         
 license:             BSD3
@@ -18,7 +18,7 @@
 executable marge-schedule
   hs-source-dirs:      src/mkschd
   main-is:             marge-schedule.hs
-  -- other-modules:       
+  other-modules:       FromID, Output, Parser
   other-extensions:    TupleSections
   build-depends:       base >=4.6 && <4.7, xturtle >=0.1 && <0.2, time >=1.4 && <1.5, filepath >=1.3 && <1.4, old-locale >=1.0 && <1.1
   hs-source-dirs:      src
@@ -27,7 +27,7 @@
 executable show-progress
   hs-source-dirs:      src/mkschd, src/prog_graph
   main-is:             mkGraph.hs
-  -- other-modules:       
+  other-modules:       ScheduleEVR, WatchEVR
   other-extensions:    TupleSections
   build-depends:       base >=4.6 && <4.7, xturtle >=0.1 && <0.2, time >=1.4 && <1.5, filepath >=1.3 && <1.4, old-locale >=1.0 && <1.1, directory
   hs-source-dirs:      src
diff --git a/src/mkschd/FromID.hs b/src/mkschd/FromID.hs
new file mode 100644
--- /dev/null
+++ b/src/mkschd/FromID.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE TupleSections #-}
+
+module FromID (convertOutput) where
+
+import Parser
+import Output
+import Control.Applicative
+import Data.Maybe
+
+fromID :: String -> String -> Maybe String
+fromID tbl i = lookup i (map parseItemList $ lines tbl)
+
+convertOutput :: String -> Output -> Output
+convertOutput tbl (d, i) = fromJust $ (d ,) <$> fromID tbl i
diff --git a/src/mkschd/Output.hs b/src/mkschd/Output.hs
new file mode 100644
--- /dev/null
+++ b/src/mkschd/Output.hs
@@ -0,0 +1,75 @@
+module Output (
+	Output, showOutputs, evrOutputs, fromItem, fromItem2, fromItemN
+) where
+
+import Parser
+import Data.Time
+import System.Locale
+
+type Output = ((Day, Day), String)
+
+evrOutputs :: [Output] -> String
+evrOutputs = unlines . map evrOutput
+
+evrOutput :: Output -> String
+evrOutput ((_, e), i) = i ++ "\t" ++ show e
+
+showOutputs :: [Output] -> String
+showOutputs = unlines . map showOutput
+
+showOutput :: Output -> String
+showOutput ((b, e), c)
+	| b >= e = showDay b ++ replicate 7 ' ' ++ c
+	| otherwise = showDay b ++ "-" ++ showDay e ++ " " ++ c
+	where
+	showDay = formatTime defaultTimeLocale "%m/%d"
+
+fromItem :: Day -> [Item] -> [Output]
+fromItem _ [] = []
+fromItem d ia@(i : is)
+	| isOK i d = ((d, pred $ ending i d), contents i) : fromItem (ending i d) is
+	| isLate i d = error "too late"
+	| otherwise = fromItem (succ d) ia
+
+fromItem2 :: Day -> [Item] -> [Item] -> [Output]
+fromItem2 d ia1 [] = fromItem d ia1
+fromItem2 d [] ia2 = fromItem d ia2
+fromItem2 d ia1@(i1 : is1) ia2@(i2 : is2)
+--	| isLate i1 e2 && isLate i2 e1 = error "too late"
+	| isOK i1 d && isLate i2 e1 =
+		((d, pred e1), contents i1) : fromItem2 e1 is1 ia2
+	| isLate i1 e2 && isOK i2 d =
+		((d, pred e2), contents i2) : fromItem2 e2 is2 ia1
+	| isOK i1 d =
+		((d, pred e1), contents i1) : fromItem2 e1 is1 ia2
+	| isOK i2 d =
+		((d, pred e2), contents i2) : fromItem2 e2 is2 ia1
+	| not (isLate i1 d) && not (isLate i2 d) = fromItem2 (succ d) ia1 ia2
+	| otherwise = error "too late"
+	where
+	e1 = ending i1 d
+	e2 = ending i2 d
+
+fromItemN :: Day -> [[Item]] -> [Output]
+fromItemN _ [] = []
+fromItemN d ias
+	| any null ias = fromItemN d $ filter (not . null) ias
+	| any (flip isLate d) (map head ias) = error "too late"
+fromItemN d ias = fromItemNSelect [] d es diag ias
+	where
+	es = map (flip ending d . head) ias
+	diag = diagonal $ map head ias
+
+fromItemNSelect :: [[Item]] -> Day -> [Day] -> [[Item]] -> [[Item]] -> [Output]
+fromItemNSelect pre d [] [] [] = fromItemN (succ d) pre
+fromItemNSelect pre d (e : es) (diag : diags) ((i : is) : ias)
+	| check d i e diag =
+		((d, pred e), contents i) : fromItemN e (is : pre ++ ias)
+fromItemNSelect pre d (e : es) (diag : diags) (ia : ias) =
+	fromItemNSelect (ia : pre) d es diags ias
+
+diagonal :: [a] -> [[a]]
+diagonal xs = map (\i -> take i xs ++ drop (i + 1) xs) [0 .. length xs - 1]
+
+check :: Day -> Item -> Day -> [Item] -> Bool
+check d i e diags = isOK i d && all (not . flip isLate e) diags
diff --git a/src/mkschd/Parser.hs b/src/mkschd/Parser.hs
new file mode 100644
--- /dev/null
+++ b/src/mkschd/Parser.hs
@@ -0,0 +1,62 @@
+module Parser (
+	parse, LES, Item, isOK, isLate, ending, contents,
+	parseItemList) where
+
+import Data.List
+import Data.Time
+import Data.Maybe
+import Data.Char
+import Control.Arrow
+
+data LES = SmallerThan | NoLargerThan | Equal | NoSmallerThan | LargerThan | Always
+	deriving (Show, Enum, Eq)
+
+type Item = (((LES, Day), Integer), String)
+
+isOK :: Item -> Day -> Bool
+isOK (((les, d), _), _) = flip (op les) d
+
+isLate :: Item -> Day -> Bool
+isLate (((SmallerThan, d), _), _) = (d <=)
+isLate (((NoLargerThan, d), _), _) = (d <)
+isLate (((Equal, d), _), _) = (d <)
+isLate _ = const False
+
+ending :: Item -> Day -> Day
+ending ((_, s), _) = addDays s
+
+contents :: Item -> String
+contents = snd
+
+readLES :: String -> Maybe LES
+readLES = flip lookup $ zip ["<", "<=", "=", ">=", ">", ""] [SmallerThan ..]
+
+op :: LES -> (Day -> Day -> Bool)
+op = fromJust . flip lookup (zip [SmallerThan ..]
+	[(<), (<=), (==), (>=), (>), const $ const True])
+
+parse :: String -> [Item]
+parse = map parseLine . lines
+
+parseLine :: String -> Item
+parseLine str = case split (== ':') str of 
+	[d, s, c] -> ((parseDay d, read s), c)
+	_ -> error "bad number of fields of line"
+
+split :: (Char -> Bool) -> String -> [String]
+split s = unfoldr $ \xs -> case (xs, span (not . s) xs) of
+	([], _) -> Nothing
+	(_, (_, [])) -> Just (dropSpaces xs, [])
+	(_, (r, _ : xs')) -> Just (dropSpaces r, xs')
+
+parseDay :: String -> (LES, Day)
+parseDay "" = (Always, read "0000-00-00")
+parseDay s = (fromJust . readLES *** read) $ span (not . isDigit) s
+
+dropSpaces :: String -> String
+dropSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+
+parseItemList :: String -> (String, String)
+parseItemList str = (is !! 0, is !! 2)
+	where
+	is = split (== ':') str
diff --git a/src/prog_graph/ScheduleEVR.hs b/src/prog_graph/ScheduleEVR.hs
new file mode 100644
--- /dev/null
+++ b/src/prog_graph/ScheduleEVR.hs
@@ -0,0 +1,13 @@
+module ScheduleEVR (dayItem, dayItemFile) where
+
+import Output
+import Parser
+import FromID
+import Data.Time
+import Control.Applicative
+
+dayItemFile :: Day -> [FilePath] -> IO [(Day, String)]
+dayItemFile b = (dayItem b <$>) . mapM readFile
+
+dayItem :: Day -> [String] -> [(Day, String)]
+dayItem b = ((b, "start") :) . map (\((_, e), i) -> (e, i)) . fromItemN b . map parse
diff --git a/src/prog_graph/WatchEVR.hs b/src/prog_graph/WatchEVR.hs
new file mode 100644
--- /dev/null
+++ b/src/prog_graph/WatchEVR.hs
@@ -0,0 +1,147 @@
+module WatchEVR (
+	idPoint', dayId, accumSecond, dayPoint, getConverter, progPercent,
+	waku, chart, fontsize
+) where
+
+import Graphics.X11.Turtle
+import Data.List
+import Data.Time
+import Data.Maybe
+import Control.Arrow
+import System.Environment
+import System.FilePath
+import Data.Char
+
+evrItemsName, evrScheduleName, evrProgressName :: FilePath
+-- evrItemsName = "evr_items.txt"
+evrItemsName = "item_list"
+evrScheduleName = "evr_schedule"
+evrProgressName = "progress"
+
+main :: IO ()
+main = do
+	prog <- getProgName
+	path <- getExecutablePath
+	let dir = takeDirectory path ++ "/"
+	eiCnt <- readFile $ dir ++ evrItemsName
+	esCnt <- readFile $ dir ++ evrScheduleName
+	espCnt <- readFile $ dir ++ evrProgressName
+	let
+--		ei = map idPoint $ tail $
+--			dropWhile (not . isPrefixOf "* タイトル") $ lines eiCnt
+		ei = map idPoint' $ lines eiCnt
+		es = map dayId $ lines esCnt
+		esp = map dayId $ lines espCnt
+		di = accumSecond (+) 0 $ dayPoint ei es
+		dip = accumSecond (+) 0 $ dayPoint ei esp
+		cnv = getConverter (50, 100) (400, 200) di
+		pc = progPercent dip di
+	f <- openField
+	topleft f
+	t <- newTurtle f
+	speed t "fastest"
+	flushoff t
+	waku t (50, 100) (400, 200) di
+	goto t 50 300
+	flushon t
+	speed t "slowest"
+	chart t "grey" cnv (50, 100) (400, 200) di
+	speed t "slow"
+	goto t 50 300
+	speed t "slowest"
+	chart t "black" cnv (50, 100) (400, 200) dip
+	speed t "fastest"
+	goto t 200 100
+	write t "Kochi Gothic" fontsize $ take 4 (show pc) ++ "%"
+	hideturtle t
+	onkeypress f $ return . (/= 'q')
+	waitField f
+
+progPercent :: [(Day, Int)] -> [(Day, Int)] -> Double
+progPercent p s = 100 *
+	fromIntegral (getPoint p) / fromIntegral (getPoint s)
+
+getPoint :: [(Day, Int)] -> Int
+getPoint = snd . last
+
+idPoint :: String -> (String, Int)
+idPoint ln = (i, read $ dropWhile (== '\t') p)
+	where
+	(i, p) = span (/= '\t') $ dropWhile (== '\t') $ dropWhile (/= '\t') ln
+
+idPoint' :: String -> (String, Int)
+idPoint' str = (is !! 0, read $ is !! 1)
+	where
+	is = split ':' str
+
+split :: Char -> String -> [String]
+split _ "" = []
+split c str = case span (/= c) str of
+	(s, "") -> [deleteSpaces s]
+	(s, _ : r) -> deleteSpaces s : split c r
+
+deleteSpaces :: String -> String
+deleteSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+
+dayId :: String -> (Day, String)
+dayId ln = (read d, i)
+	where
+	(i, d) = span (/= '\t') ln
+
+dayPoint :: [(String, Int)] -> [(Day, String)] -> [(Day, Int)]
+dayPoint tbl = map $ second $ fromJust . flip lookup tbl
+
+accumSecond :: (c -> b -> c) -> c -> [(a, b)] -> [(a, c)]
+accumSecond op r0 [] = []
+accumSecond op r0 ((x1, y1) : ps) =
+	(x1, r0 `op` y1) : accumSecond op (r0 `op` y1) ps
+
+fontsize = 10
+
+chart :: (Enum x, Enum y, Ord x, Show x, ColorClass c) => Turtle -> c ->
+	((x, y) -> (Double, Double)) ->
+	(Double, Double) -> (Double, Double) -> [(x, y)] -> IO ()
+chart t c converter tl@(left, top) wh@(width, height) dt = do
+	pencolor t c
+	turtleChart t $ map converter dt
+	penup t
+
+waku t tl@(left, top) wh@(width, height) dt = do
+		penup t
+		goto t left (top + height)
+		pendown t
+		goto t (left + width) (top + height)
+		penup t
+		goto t left (top + height)
+		pendown t
+		goto t left top
+		penup t
+		goto t (left - fontsize * 2) (top + height + fontsize * 1.5)
+		write t "Kochi Gothic" fontsize $ show minx
+		goto t (left + width - fontsize * 2) (top + height + fontsize * 1.5)
+		write t "Kochi Gothic" fontsize $ show maxx
+	where
+	minx = minimum $ map fst dt
+	maxx = maximum $ map fst dt
+
+turtleChart :: Turtle -> [(Double, Double)] -> IO ()
+turtleChart t ((x0, y0) : ps) = do
+	penup t
+	goto t x0 y0
+	pendown t
+	mapM_ (uncurry $ goto t) ps
+
+getConverter :: (Enum x, Enum y) => (Double, Double) -> (Double, Double) ->
+	[(x, y)] -> (x, y) -> (Double, Double)
+getConverter (left, top) (width, height) ps = convertx *** converty
+	where
+	maxx = maximum $ map (fromEnum . fst) ps
+	minx = minimum $ map (fromEnum . fst) ps
+	maxy = maximum $ map (fromEnum . snd) ps
+	miny = minimum $ map (fromEnum . snd) ps
+	convertx x = left +
+		(fromIntegral $ fromEnum x - minx) /
+		(fromIntegral $ maxx - minx) * width
+	converty y = top + height -
+		(fromIntegral $ fromEnum y - miny) /
+		(fromIntegral $ maxy - miny) * height