Got Gtk working, started Xl parsing implementation

app/Main.hs

@@ -5,9 +5,10 @@ import QuoteSource.DDE
 import QuoteSource.DataImport
 import Control.Concurrent
 import Control.Monad
+import Control.Monad.IO.Class
+import Data.IORef
+import Graphics.UI.Gtk hiding (Action, backspace)
 
-import Graphics.UI.FLTK.LowLevel.FL
-import Graphics.UI.FLTK.LowLevel.FLTKHS
 
 callback :: DdeCallback
 callback = undefined
@@ -15,11 +16,11 @@ callback = undefined
 main :: IO ()
 main = do
   dis <- initDataImportServer "atrade"
-  forever $ threadDelay 1000
-  window <- windowNew (Size (Width 320) (Height 170))
-                Nothing Nothing
-  end window
-  showWidget window
-  _ <- run
-  return ()
+  void initGUI
+  window <- windowNew
+  window `on` deleteEvent $ do
+    liftIO mainQuit
+    return False
+  widgetShowAll window
+  mainGUI
 

quik-connector.cabal

@@ -20,7 +20,9 @@ library
                      , QuoteSource.DataImport
   build-depends:       base >= 4.7 && < 5
                      , Win32
-                     , fltkhs
+                     , gtk
+                     , binary
+                     , bytestring
   default-language:    Haskell2010
   extra-libraries:     "user32"
 
@@ -31,6 +33,7 @@ executable quik-connector-exe
   build-depends:       base
                      , quik-connector
                      , Win32
+                     , gtk
   default-language:    Haskell2010
   extra-libraries:     "user32"
 

src/QuoteSource/DDE.hs

@@ -19,11 +19,13 @@ import Control.Exception
 import Control.Monad
 import Data.Bits
 import Data.Typeable
+import Data.ByteString hiding (map)
 import System.Win32.DLL
 import System.Win32.Types
 import Foreign
 import Foreign.C.Types
 import Foreign.C.String
+import Foreign.Marshal.Array
 
 data DdeException = ApiError String
   deriving (Show, Typeable)
@@ -47,28 +49,34 @@ ddeCpWinAnsi = 1004
 
 instance Exception DdeException
 
-foreign import stdcall unsafe "windows.h DdeInitializeW"
+foreign import ccall unsafe "windows.h DdeInitializeW"
   ddeInitialize :: LPDWORD -> FunPtr DdeCallback -> DWORD -> DWORD -> IO CUInt
 
-foreign import stdcall unsafe "windows.h DdeUninitialize"
+foreign import ccall unsafe "windows.h DdeUninitialize"
   ddeUninitialize :: DWORD -> IO BOOL
 
-foreign import stdcall unsafe "windows.h DdeCreateStringHandleW"
+foreign import ccall unsafe "windows.h DdeCreateStringHandleW"
   ddeCreateStringHandle :: DWORD -> LPSTR -> CInt -> IO HANDLE
 
-foreign import stdcall unsafe "windows.h DdeFreeStringHandleW"
+foreign import ccall unsafe "windows.h DdeFreeStringHandleW"
   ddeFreeStringHandle :: DWORD -> LPSTR -> IO HANDLE
 
-foreign import stdcall unsafe "windows.h DdeNameService"
+foreign import ccall unsafe "windows.h DdeNameService"
   ddeNameService :: DWORD -> HANDLE -> HANDLE -> CInt -> IO HANDLE
 
-foreign import stdcall unsafe "windows.h DdeCmpStringHandles"
+foreign import ccall unsafe "windows.h DdeCmpStringHandles"
   ddeCmpStringHandles :: HANDLE -> HANDLE -> IO CInt
 
-foreign import stdcall unsafe "windows.h DdeQueryStringW"
+foreign import ccall unsafe "windows.h DdeQueryStringW"
   ddeQueryString :: DWORD -> HANDLE -> CString -> DWORD -> CInt -> IO DWORD
 
-foreign import stdcall "wrapper"
+foreign import ccall unsafe "windows.h DdeAccessData"
+  ddeAccessData :: HANDLE -> LPDWORD -> IO (Ptr CUChar)
+
+foreign import ccall unsafe "windows.h DdeUnaccessData"
+  ddeUnaccessData :: HANDLE -> IO ()
+
+foreign import ccall "wrapper"
   mkCallbackPtr :: DdeCallback -> IO (FunPtr DdeCallback)
 
 data DdeState = DdeState {
@@ -90,8 +98,8 @@ initializeDde appName topicName callback = alloca (\instancePtr -> do
     when (rc /= CUInt 0) $ throw $ ApiError "Unable to initialize DDE"
 
     withCString appName (\appNameRaw -> withCString topicName (\topicNameRaw -> do
-      appNameHandle <- ddeCreateStringHandle instanceRaw appNameRaw 0
-      topicNameHandle <- ddeCreateStringHandle instanceRaw topicNameRaw 0
+      appNameHandle <- ddeCreateStringHandle instanceRaw appNameRaw ddeCpWinAnsi
+      topicNameHandle <- ddeCreateStringHandle instanceRaw topicNameRaw ddeCpWinAnsi
       when (appNameHandle == nullHANDLE || topicNameHandle == nullHANDLE) $ throw $ ApiError "Unable to create strings handles"
 
       rc2 <- ddeNameService instanceRaw appNameHandle nullPtr 1
@@ -112,3 +120,10 @@ queryString state maxSize handle = allocaBytes maxSize (\x -> do
     then return Nothing
     else Just <$> peekCAString x)
 
+accessData :: HANDLE -> IO ByteString
+accessData handle = alloca (\dataSizePtr -> do
+  dataPtr <- ddeAccessData handle dataSizePtr
+  dataSize <- peek dataSizePtr
+  pack . (map (toEnum . fromEnum)) <$> peekArray (fromEnum dataSize) dataPtr)
+
+

src/QuoteSource/DataImport.hs

@@ -13,7 +13,10 @@ import Foreign.C.Types
 import Foreign.C.String
 
 import QuoteSource.DDE
+import QuoteSource.XlParser
 import Data.IORef
+import Text.Printf
+import Data.Binary
 
 data ServerState = ServerState {
   dde :: DdeState,
@@ -21,22 +24,17 @@ data ServerState = ServerState {
 }
 
 ddeCallback :: IORef ServerState -> CUInt -> CUInt -> HANDLE -> HANDLE -> HANDLE -> HANDLE -> LPDWORD -> LPDWORD -> IO HANDLE
-ddeCallback state msgType format hConv hsz1 hsz2 hData dwData1 dwData2 = do
-  putStrLn "Callback"
-  return nullHANDLE
-
-{-
+ddeCallback state msgType format hConv hsz1 hsz2 hData dwData1 dwData2
     | msgType == ddeXtypConnect = handleConnect state hsz1 hsz2 
     | msgType == ddeXtypPoke = handlePoke state hsz1 hData
     | otherwise = do
-      print msgType
+      putStrLn $ printf "msgtype: %08x" $ toInteger msgType
       return nullHANDLE
   where
     handleConnect state hsz1 hsz2 = do
       myAppName <- appName <$> readIORef state
       myDdeState <- dde <$> readIORef state
       maybeAppName <- queryString myDdeState 256 hsz2
-      putStrLn "Connect"
       case maybeAppName of
         Just incomingAppName -> do
           putStrLn incomingAppName
@@ -46,10 +44,10 @@ ddeCallback state msgType format hConv hsz1 hsz2 hData dwData1 dwData2 = do
         Nothing -> return ddeResultFalse
 
     handlePoke state hsz1 hData = do
-      putStrLn "Poke"
-      return ddeResultAck
-      -}
-        
+      myDdeState <- dde <$> readIORef state
+      maybeTopic <- queryString myDdeState 256 hsz1
+      case maybeTopic of
+        Nothing -> return ddeResultFalse
 
 initDataImportServer :: String -> IO (IORef ServerState)
 initDataImportServer applicationName = do

src/QuoteSource/TableParser.hs

@@ -0,0 +1,4 @@
+
+module QuoteSource.TableParser (
+) where
+

src/QuoteSource/XlParser.hs

@@ -0,0 +1,39 @@
+
+module QuoteSource.XlParser (
+  XlData(..),
+  xlParser
+) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Binary.Get
+import Data.ByteString
+
+data XlData = XlInt Int | XlDouble Double | XlString String | XlEmpty
+
+data XlPosition = XlPosition { width :: Int, height :: Int, xPos :: Int, yPos :: Int }
+
+btTable = 16
+btFloat = 1
+btString = 2
+btBlank = 5
+btInt = 6
+btSkip = 7
+
+incrementPosition :: XlPosition -> Maybe XlPosition
+incrementPosition pos = do
+  if 1 + xPos pos < width pos
+    then Just pos { xPos = 1 + xPos pos }
+    else if 1 + yPos pos < height pos
+      then Just pos { xPos = 0, yPos = 1 + yPos pos }
+      else Nothing
+
+xlParser :: Get (Int, Int, [XlData])
+xlParser = do
+  datatype <- getWord16le
+  when (datatype /= btTable) $ fail "First entry should be table"
+  blocksize <- fromEnum <$> getWord16le
+  when (blocksize /= 4) $ fail "Table entry should have size 4"
+  return (0, 0, [])
+
+