diff options
| -rw-r--r-- | video/Main.hs | 2 | ||||
| -rw-r--r-- | video/src/Video.hs | 46 |
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) |