1 > module Main (main) where
9 > import System -- 1.3 (partain)
12 > --fakeArgs = "game001.txt"
13 > --fakeArgs = "pca2.pgn"
14 > --fakeArgs = "silly.pgn"
15 > --fakeArgs = "small.pgn"
16 > --fakeArgs = "sicil.pgn"
17 > --fakeArgs = "badgame.pgn"
18 > --fakeArgs = "mycgames.pgn"
19 > fakeArgs = "rab.pgn"
26 > let (style,fn,filename) = interpArgs args
27 > file <- readFile filename
28 > std_in <- getContents
29 > let games = pgnParser fn file -- parse relavent pgn games
30 > putStr (prog style std_in games)
34 > getArgs abort $ \ args ->
35 > --let args = (words "-d tex analgames.pgn") in
36 > let (style,fn,filename) = interpArgs args in
37 > readFile filename abort $ \ file ->
38 > readChan stdin abort $ \ std_in ->
39 > let games = pgnParser fn file -- parse relavent pgn games
41 > appendChan stdout (prog style std_in games) abort done
44 > interpArgs :: [String] -> (OutputStyle,Int -> Bool,String)
45 > --interpArgs [] = (ViewGame,const True,fakeArgs)
46 > interpArgs [] = interpArgs (words "-d pgn analgames.pgn")
47 > interpArgs files = interpArgs' OutputPGN (const True) files
49 > interpArgs' style fn ("-d":"pgn":xs) = interpArgs' OutputPGN fn xs
50 > interpArgs' style fn ("-d":"rawpgn":xs) = interpArgs' OutputRawPGN fn xs
51 > interpArgs' style fn ("-d":"play":xs) = interpArgs' ViewGame fn xs
52 > interpArgs' style fn ("-d":"parser":xs) = interpArgs' OutputParser fn xs
53 > interpArgs' style fn ("-d":"tex":xs) = interpArgs' OutputTEX fn xs
54 > interpArgs' style fn ("-d":"head":xs) = interpArgs' OutputHeader fn xs
55 > interpArgs' style fn ("-g":range:xs)
56 > = interpArgs' style (changeFn (parse range)) xs
58 > changeFn (Digit n:Line:Digit m:r) x = moreChangeFn r x || x >= n && x <= m
59 > changeFn (Line:Digit m:r) x = moreChangeFn r x || x <= m
60 > changeFn (Digit n:Line:r) x = moreChangeFn r x || x >= n
61 > changeFn (Digit n:r) x = moreChangeFn r x || x == n
62 > changeFn _ _ = rangeError
63 > moreChangeFn [] = const False
64 > moreChangeFn (Comma:r) = changeFn r
65 > moreChangeFn _ = rangeError
67 > | isDigit n = case span isDigit xs of
68 > (dig,rest) -> Digit (read dig) : parse rest
69 > parse ('-':r) = Line : parse r
70 > parse (',':r) = Comma : parse r
72 > parse _ = rangeError
73 > rangeError = error ("incorrect -g option (" ++ range ++ ")\n")
75 > interpArgs' style fn [file] = (style,fn,file)
76 > interpArgs' style fn args = error ("bad args: " ++ unwords args)
86 > | OutputRawPGN -- rawpgn
87 > | OutputHeader -- header
89 > | ViewGameEmacs -- emacs
94 Finally the debug options.
96 > | OutputParser -- simply dump out the string read in.
97 > | CmpGen -- cmp 2nd and 3rd generations of output
101 > prog :: OutputStyle -- style of action
102 > -> String -- stdin (for interactive bits)
103 > -> [AbsGame] -- input games
104 > -> String -- result
106 > = pgnPrinter True -- print out game(s)
107 > . map runInterp -- interprete all games
108 > prog OutputRawPGN _
109 > = pgnPrinter False -- print out game(s)
110 > . map runInterp -- interprete all games
111 > prog OutputHeader _
112 > = pgnHeadPrinter -- print out game(s) headers
113 > . map runInterp -- interprete all games
115 > = texPrinter -- print out game(s)
116 > . map runInterp -- interprete all games
117 > prog ViewGame std_in
118 > = interactViewer std_in -- print out game(s)
119 > . runInterp -- interprete the game
120 > . head -- should check for only *one* object
121 > prog OutputParser _
124 %------------------------------------------------------------------------------
126 Printing the pgn file.
128 1) if White, *always* print number,
129 2) is After comment / variation, print number, ie 2. Nf4 ( <stuff> ) 2... Rh8
132 > type PrintState = (Bool,MoveNumber)
134 > pgnPrinter :: Bool -> [RealGame] -> String
135 > pgnPrinter detail = unlines . concat . map printGame
137 > printMoveNumber :: Bool -> MoveNumber -> String
138 > printMoveNumber False (MoveNumber _ Black) = ""
139 > printMoveNumber _ mvnum = userFormat mvnum ++ " "
141 > printQuantums :: PrintState -> [Quantum] -> [String]
142 > printQuantums ps = concat . fst . mapAccumL printQuantum ps
144 > printQuantum :: PrintState -> Quantum -> ([String],PrintState)
145 > printQuantum (pnt,mv) (QuantumMove move ch an brd) =
146 > ([printMoveNumber pnt mv ++ move ++ ch],(False,incMove mv))
147 > printQuantum (pnt,mv) (QuantumNAG i) =
149 > then (["$" ++ show i],(False,mv))
150 > else ([],(False,mv))
151 > printQuantum (pnt,mv) (QuantumComment comms) =
153 > then ("{" : comms ++ ["}"],(True,mv))
154 > else ([],(False,mv))
155 > printQuantum (pnt,mv) (QuantumAnalysis anal) =
157 > then ("(" : printQuantums (True,decMove mv) anal ++ [")"],
159 > else ([],(False,mv))
160 > printQuantum (pnt,mv) (QuantumResult str) = ([str],(True,mv))
161 > printQuantum _ _ = error "PANIC: strange Quantum"
163 > printGame :: RealGame -> [String]
164 > printGame (Game tags qu) =
165 > [ userFormat tag | tag <- tags] ++
166 > formatText 75 (printQuantums (False,initMoveNumber) qu)
168 %------------------------------------------------------------------------------
170 > printHeadGame :: RealGame -> [String]
171 > printHeadGame (Game tags qu) = [
172 > rjustify 4 gameno ++ " " ++
173 > take 20 (rjustify 20 white) ++ " - " ++
174 > take 20 (ljustify 20 black) ++ " " ++
175 > take 26 (ljustify 28 site) ++ " " ++ result ]
177 > (date,site,game_no,res,white,black,opening) = getHeaderInfo tags
178 > gameno = case game_no of
181 > result = userFormat res
183 > pgnHeadPrinter :: [RealGame] -> String
184 > pgnHeadPrinter = unlines . concat . map printHeadGame
186 %------------------------------------------------------------------------
188 This gives an interactive playback of a game.
190 > interactViewer :: String -> RealGame -> String
191 > interactViewer stdin (Game tags qu) = replayQ qu (lines stdin)
193 > replayQ (QuantumMove _ _ _ brd:rest) std_in
194 > = "\027[H" ++ userFormat brd ++ waitQ rest std_in
195 > replayQ (_:rest) std_in = replayQ rest std_in
198 > waitQ game std_in = ">>" ++
201 > (q:qs) -> replayQ game qs)