aboutsummaryrefslogtreecommitdiff
path: root/video
diff options
context:
space:
mode:
authorAleksey Veresov <aleksey@veresov.pro>2021-04-13 16:56:48 +0300
committerAleksey Veresov <aleksey@veresov.pro>2023-12-06 19:47:22 +0300
commita58cb55a0310f1634203cfaff3722eae99e7c704 (patch)
tree4677fb02e89e92569cc9f4c89787179f75646f74 /video
parentfac5c4745fc0da0e9f8b6e0fa997c019a7c753e0 (diff)
downloadsuem-a58cb55a0310f1634203cfaff3722eae99e7c704.tar
suem-a58cb55a0310f1634203cfaff3722eae99e7c704.tar.xz
suem-a58cb55a0310f1634203cfaff3722eae99e7c704.zip
Another piece of work is done.
Diffstat (limited to 'video')
-rw-r--r--video/Main.hs2
-rw-r--r--video/src/Video.hs46
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)