Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Parse protocols from phi_dm and show a map.

  • Loading branch information...
commit 2645781037d901333915478d17c907cefb87784d 1 parent e690fff
@napthats authored
Showing with 47 additions and 8 deletions.
  1. +32 −0 PhiVty/Protocol.hs
  2. +15 −8 main.hs
View
32 PhiVty/Protocol.hs
@@ -0,0 +1,32 @@
+module PhiVty.Protocol (
+ parse,
+ ServerProtocol(..),
+ ) where
+
+
+data ServerProtocol =
+ Map String
+ | NormalMessage String
+ | Unknown
+
+parse :: String -> ServerProtocol
+parse ('#':protocol) =
+ case takeWhile ((/=) ' ') protocol of
+ "map" ->
+ if protocol !! 4 == 'M'
+ then
+ let (_, map_str) = splitAt 17 protocol in
+ Map $ "???????" ++ (foldl
+ (\acc ord ->
+ (if ord `mod` 10 == 0 then "?" else "")
+ ++ [map_str !! ord]
+ ++ (if ord `mod` 10 == 8 then "?" else "")
+ ++ acc)
+ "???????"
+ [48, 46..0])
+ else Unknown
+ _ -> Unknown
+parse mes =
+ NormalMessage mes
+
+
View
23 main.hs
@@ -1,8 +1,8 @@
import PhiVty.UI
import PhiVty.DB
import PhiVty.Socket
+import PhiVty.Protocol
import Control.Concurrent
-import Control.Monad
import Control.Monad.Trans
import Control.Concurrent.STM.TChan
import Control.Concurrent.STM
@@ -15,7 +15,7 @@ import Codec.Binary.UTF8.String
main :: IO ()
main = do
uidata <- initialPhiUI
- forkIO $ do
+ _ <- forkIO $ do
let new_db = initialDB 0
tchan <- atomically newTChan
let recv_handler mes =
@@ -27,11 +27,18 @@ main = do
send "#version-cli 05103010" soc
let loop db = do
new_mes <- atomically $ readTChan tchan
- (_, next_db) <- runDB db $ do
- old_mes_list <- getMessageLog
- let new_mes_list = new_mes : old_mes_list
- lift $ setMessage uidata $ intercalate "\n" $ reverse new_mes_list
- setMessageLog new_mes_list
- loop next_db
+ case parse new_mes of
+ NormalMessage n_mes -> do
+ (_, next_db) <- runDB db $ 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 next_db
+ Map m_mes -> do
+ (_, next_db) <- runDB db $ do
+ lift $ setMap uidata m_mes []
+ loop next_db
+ Unknown -> loop db
loop new_db
runPhiUI uidata
Please sign in to comment.
Something went wrong with that request. Please try again.