Browse files

Show charactors.

  • Loading branch information...
1 parent cc3d859 commit 5447dbaef18120593d07f8c23d1c3da6ba0f35aa @napthats committed Aug 3, 2013
Showing with 51 additions and 29 deletions.
  1. +33 −11 PhiVty/Protocol.hs
  2. +18 −18 main.hs
View
44 PhiVty/Protocol.hs
@@ -5,24 +5,46 @@ module PhiVty.Protocol (
data ServerProtocol =
- Map (String, String)
+ Map (String, String, [((Int, Int), String)])
| NormalMessage String
+ | Unfinished ServerProtocol
| Unknown
-parse :: String -> ServerProtocol
-parse ('#':protocol) =
+--newtype Umes = ServerProtocol
+
+parse :: (Maybe ServerProtocol) -> String -> ServerProtocol
+parse u_mes ('#':protocol) =
case takeWhile ((/=) ' ') protocol of
"m57" ->
- if protocol !! 4 == 'M'
- then
+ case protocol !! 4 of
+ 'M' ->
+ let chara_list = case u_mes of
+ Nothing -> []
+ Just (Map (_, _, l)) -> l
+ _ -> error "Invalid server protocol." in
let (_, map_str) = splitAt 17 protocol in
- Map $ (foldl
- (\(chip, op) ord -> (((map_str !! ord) : chip), ((map_str !! (ord + 1)) : op)))
- ("", "")
- [96, 94..0])
- else Unknown
+ let (m, o) = foldl
+ (\(chip, op) ord -> (((map_str !! ord) : chip), ((map_str !! (ord + 1)) : op)))
+ ("", "")
+ [96, 94..0] in
+ Unfinished $ Map (m, o, chara_list)
+ 'O' ->
+ let (ma, op, chara_list) = case u_mes of
+ Nothing -> ("", "", [])
+ Just (Map (m, o, l)) -> (m, o, l)
+ _ -> error "Invalid server protocol." in
+ let initial = protocol !! 18 in
+ let x = (read [protocol !! 12] :: Int) in
+ let y = (read [protocol !! 14] :: Int) in
+ Unfinished (Map (ma, op, ((x, y), [initial]) : chara_list))
+ '.' ->
+ case u_mes of
+ Nothing -> error "Invalid server protocol."
+ Just x -> x
+ _ ->
+ Unknown
_ -> Unknown
-parse mes =
+parse _ mes =
NormalMessage mes
View
36 main.hs
@@ -17,16 +17,16 @@ import Data.Char
main :: IO ()
main = do
let new_dbdata = initialDB 0
- cdod <- newCdo
+ c <- newCdo
tchan <- atomically newTChan
let recv_handler mes =
-- atomically $ writeTChan tchan (decodeString . unpack . convert "SJIS" "UTF-8" . pack $ mes)
atomically $ writeTChan tchan mes
soc <- connect "49.212.144.158" 20017 recv_handler
- uidata <- initialPhiUI soc cdod
+ uidata <- initialPhiUI soc c
_ <- forkIO $ do
let loop dbdata = do
- m <- getMonad cdod
+ m <- getMonad c
(_, next_dbdata) <- runDB dbdata $ do
_ <- m
return ()
@@ -46,26 +46,26 @@ main = do
send "#ex-switch ex-move-recv=true" soc
send "#ex-switch ex-list-mode-end=true" soc
send "#ex-switch ex-disp-magic=false" soc
- let loop = do
+ let loop u_mes = do
new_mes <- atomically $ readTChan tchan
- case parse new_mes of
+ case parse u_mes new_mes of
NormalMessage n_mes_raw -> do
let n_mes = decodeString . unpack . convert "SJIS" "UTF-8" . pack $ n_mes_raw
- cdo cdod $ do
+ cdo c $ do
old_mes_list <- getMessageLog
let new_mes_list = n_mes : old_mes_list
lift $ setMessage uidata $ intercalate "\n" $ reverse new_mes_list
setMessageLog new_mes_list
- loop
- Map (m_chip_string, m_op_string) -> do
- setMap uidata m_chip_string []
- cdo cdod $ do
- old_mes_list <- getMessageLog
- let new_mes_list = (concat (map show (map ord m_op_string))) : old_mes_list
- lift $ setMessage uidata $ intercalate "\n" $ reverse new_mes_list
- setMessageLog new_mes_list
- loop
- Unknown -> do
- loop
- loop
+ loop Nothing
+ Map (m_chip_string, m_op_string, chara_list) -> do
+ setMap uidata m_chip_string chara_list
+-- cdo c $ do
+-- old_mes_list <- getMessageLog
+-- let new_mes_list = (concat (map show (map ord m_op_string))) : old_mes_list
+-- lift $ setMessage uidata $ intercalate "\n" $ reverse new_mes_list
+-- setMessageLog new_mes_list
+ loop Nothing
+ Unfinished u -> loop $ Just u
+ Unknown -> loop Nothing
+ loop Nothing
runPhiUI uidata

0 comments on commit 5447dba

Please sign in to comment.