[Haskell-cafe] Re: Review request for my baby steps towards a "platform independent interactive graphics" using VNC

[C K Kashyap]

I've progressed further - now the VNC client opens up a window with
the dimensions set in the code!

https://github.com/ckkashyap/LearningPrograms/blob/master/Haskell/vnc/vnc.hs


I've pasted the code here for quick reference - would really
appreciate some feedback.

module Main where

import Network.Server
import Network.Socket
import Control.Monad
import System.IO

import qualified Data.ByteString.Lazy as BS
import Data.Char
import Data.Binary.Get
import Data.Binary.Put
import Data.Word


main :: IO ()
main = do
	running <- serveOne (Just $ UserWithDefaultGroup "ckk") server
	putStrLn "server is accepting connections!!!"
	waitFor running

	where server = Server (SockAddrInet 5901 iNADDR_ANY) Stream doVNC


doVNC :: ServerRoutine
doVNC (h,n,p) = do startRFB h


startRFB :: Handle -> IO ()
startRFB h = do
		hPutStr h "RFB 003.003\n"
		hFlush h

		clientHeaderByteStream <- BS.hGet h 12
		putStrLn (show clientHeaderByteStream)
		let (m,n) = ( runGet readClientHeader clientHeaderByteStream)

		-- Send 1 to the client, meaning, no auth required
		BS.hPutStr h (BS.pack [0,0,0,1])
		hFlush h

		clientInitMessage <- BS.hGet h 1

		let sharedOrNot = runGet (do {x<-getWord8;return(x);}) clientInitMessage

		putStrLn (show sharedOrNot)


		BS.hPutStr h serverInitMessage
		hFlush h






serverInitMessage :: BS.ByteString
serverInitMessage = runPut $ do
				putWord16be (300::Word16) -- width
				putWord16be (300::Word16) -- height
				--pixel format
				putWord8 (32::Word8) -- bits per pixl
				putWord8 (24::Word8) -- depth
				putWord8 (1::Word8) -- big endian
				putWord8 (1::Word8) -- true color
				putWord16be (255::Word16) -- red max
				putWord16be (255::Word16) -- green max
				putWord16be (255::Word16) -- blue max
				putWord8 (24::Word8) -- red shift
				putWord8 (1::Word8)  -- green shift
				putWord8 (1::Word8)  -- blue shift
				--padding
				putWord8 (0::Word8)
				putWord8 (0::Word8)
				putWord8 (0::Word8)
				--name length
				let name = "Haskell Framebuffer"
				putWord32be (((fromIntegral.length) name)::Word32)
				putLazyByteString (stringToByteString name)




byteString2Number :: BS.ByteString -> Int
byteString2Number bs = _byteString2Number 1 (digits bs)
	where
		_byteString2Number _ [] = 0
		_byteString2Number n (x:xs) = (n*x) + (_byteString2Number (n*10) xs)
		digits bs = map ((+(-48)).fromIntegral) (BS.unpack(BS.reverse bs))


readClientHeader  = do
	getLazyByteString 4
	m <- getLazyByteString 3
	getWord8
	n <- getLazyByteString 3
	getWord8
	let majorVersionNumber = byteString2Number m
	let minorVersionNumber = byteString2Number n
	if (majorVersionNumber /= 3) then
		fail ("ERROR: Unsupported version " ++ (show majorVersionNumber))
		else
		return (byteString2Number m,byteString2Number n)



word8ToByteString :: Word8 -> BS.ByteString
word8ToByteString n = runPut $ putWord8 n

word16ToByteString :: Word16 -> BS.ByteString
word16ToByteString n = runPut $ putWord16be n


word32ToByteString :: Word32 -> BS.ByteString
word32ToByteString n = runPut $ putWord32be n


stringToByteString :: String -> BS.ByteString
stringToByteString str = BS.pack (map (fromIntegral.ord) str)




On Thu, Nov 4, 2010 at 12:18 PM, C K Kashyap <ckkashyap at gmail.com> wrote:
> Hi,
>
> I started with the implementation of a VNC server library intended to
> be used as a library for rendering graphics and interacting with the
> user(mouse/keyboard). I'd appreciate it very much if I could  get some
> feedback on my approach to binary parsing and Haskellism.
> Also, any reference/suggestion on how I could go about using a state
> machine to deal with the RFB protocol.
>
> http://hpaste.org/41131/vnc_server
>
> It's really early - but just wanted to get some advice on the approach.
>
> --
> Regards,
> Kashyap
>



-- 
Regards,
Kashyap