packages feed

LambdaINet 0.1.1 → 0.1.2

raw patch · 5 files changed

+37/−8 lines, 5 files

Files

LambdaINet.cabal view
@@ -1,5 +1,5 @@ name:          LambdaINet-version:       0.1.1+version:       0.1.2 homepage:      not available maintainer:    Paul H. Liu <paul@thev.net> cabal-version: >= 1.6@@ -19,8 +19,11 @@ data-files:    font.tga  executable LambdaINet-  Main-is:        Main.lhs+  Main-is:  Main.lhs   Other-Modules:  Diagram INet Lambda+  if os(darwin)+    Other-Modules:  EnableGUI+    cpp-options:    -D_EnableGUI_   Build-Depends:  base >= 3 && < 5, OpenGL, GLFW, containers, mtl   Hs-Source-Dirs: src 
README view
@@ -12,6 +12,9 @@ CHANGES ======= +*   Tue Sep 15 EDT 2009 - fix GUI on OS X; fix glitch when moving nodes. +                          bump version to 0.1.2.+ *   Mon Sep 14 EDT 2009 - fix the bug with app function, bump version to 0.1.1.  USAGE
src/Diagram.lhs view
@@ -448,11 +448,8 @@ >       let ax' = ax + truncate (realToFrac (mx' - mx) / scale / unit) >           ay' = ay + truncate (realToFrac (my - my') / scale / unit) >           i = atomID atom->           moved = abs (ax' - ax) >= 1 || abs (ay' - ay) >= 1->           posMap' = if moved->                       then adjust (\ ((x, y), d) -> ((ax', ay'), d)) i posMap ->                       else posMap->           r'@(_, render) = if moved then renderDiagram posMap' d else r+>           posMap' = adjust (\ ((x, y), d) -> ((ax', ay'), d)) i posMap +>           r'@(_, render) = renderDiagram posMap' d >       if status == GLFW.Release >         then return (UserAction $ buttonReleased d r', render) >         else return (UserAction $ buttonHolding but d r' atom s, render)
+ src/EnableGUI.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module EnableGUI(enableGUI) where
+
+import Data.Int
+import Foreign
+
+type ProcessSerialNumber = Int64
+
+foreign import ccall "GetCurrentProcess" getCurrentProcess :: Ptr ProcessSerialNumber -> IO Int16
+foreign import ccall "_CGSDefaultConnection" cgsDefaultConnection :: IO ()
+foreign import ccall "CPSEnableForegroundOperation" cpsEnableForegroundOperation :: Ptr ProcessSerialNumber -> IO ()
+foreign import ccall "CPSSignalAppReady" cpsSignalAppReady :: Ptr ProcessSerialNumber -> IO ()
+foreign import ccall "CPSSetFrontProcess" cpsSetFrontProcess :: Ptr ProcessSerialNumber -> IO ()
+
+enableGUI = alloca $ \psn -> do
+    getCurrentProcess psn
+    cgsDefaultConnection
+    cpsEnableForegroundOperation psn
+    cpsSignalAppReady psn
+    cpsSetFrontProcess psn
src/Main.lhs view
@@ -1,6 +1,6 @@ The main program for Lambdascope -> {-# LANGUAGE RecursiveDo #-}+> {-# LANGUAGE RecursiveDo,CPP #-}  > module Main where @@ -24,7 +24,12 @@  Main Program +#ifdef _EnableGUI_+> import EnableGUI+> main = enableGUI >> do+#else > main = do+#endif >   GLFW.initialize >   initWindow w h >   showHelp <- newIORef False