Another piece of work is done.

2 files changed, 41 insertions, 7 deletions

diff --git a/video/Main.hs b/video/Main.hs
index 627103b..ca6151b 100644
--- a/video/Main.hs
+++ b/video/Main.hs
@@ -6,7 +6,7 @@ import Video
 
 
 inet_socket :: Parser ConfigSocket
-inet_socket = ConfigInet <$> strOption
+inet_socket = ConfigInet <$> option auto
   (  long "inet"
   <> short 'i'
   <> metavar "ADDR"
diff --git a/video/src/Video.hs b/video/src/Video.hs
index d03439a..d98230a 100644
--- a/video/src/Video.hs
+++ b/video/src/Video.hs
@@ -1,13 +1,47 @@
+{-# LANGUAGE BinaryLiterals #-}
 module Video (ConfigSocket(..), video) where
 
 import Graphics.Gloss
-import Data.ByteString (pack)
+import Graphics.Gloss.Interface.IO.Simulate
+import Data.ByteString (pack, hPut, hGetNonBlocking)
+import Data.Word
+import Data.IORef
+import Data.String
+import Network.Socket
+import System.IO
+import Control.Monad
+
+
+data ConfigSocket = ConfigInet PortNumber | ConfigUnix String
+
+
+makeSocket :: ConfigSocket -> IO Socket
+makeSocket (ConfigUnix a) = do
+    sock <- socket AF_UNIX Stream defaultProtocol
+    Network.Socket.connect sock $ SockAddrUnix a
+    return sock
+makeSocket (ConfigInet p) = do
+    sock <- socket AF_INET Stream defaultProtocol
+    Network.Socket.connect sock $ SockAddrInet p 0x0100007f
+    return sock
+
+
+producePicture :: [Word8] -> IO Picture
+producePicture pic = do
+    return $ bitmapOfByteString 256 256 (BitmapFormat TopToBottom PxRGBA)
+                                (pack pic) False
+
+
+control :: Handle -> ViewPort -> Float -> [Word8] -> IO [Word8]
+control h _ _ pic = do
+    cmd <- hGetNonBlocking h 1
+    return pic
 
-data ConfigSocket = ConfigInet String | ConfigUnix String
 
 video :: ConfigSocket -> IO ()
-video _ = do
+video sock = do
+    s <- makeSocket sock
+    h <- socketToHandle s ReadWriteMode
     let pic = replicate (256 * 256 * 4) 255
-        bmp = bitmapOfByteString 256 256 (BitmapFormat TopToBottom PxRGBA)
-                                 (pack pic) False
-    display (InWindow "Suem Video" (256, 256) (0, 0)) black bmp
+    simulateIO (InWindow "Suem Video" (256, 256) (0, 0)) black 60
+               pic producePicture (control h)