Correctly divide into library and executable

2 files changed, 0 insertions, 276 deletions

diff --git a/src/Phi/Panel.hs b/src/Phi/Panel.hs
deleted file mode 100644
index 23b022f..0000000
--- a/src/Phi/Panel.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE ExistentialQuantification #-}
-
-module Phi.Panel ( Panel(..)
-                 , PanelClass(..)
-                 , (<~>)
-                 , separator
-                 ) where
-
-import Data.Function
-
-class PanelClass a where
-  minSize :: a -> Int
-  
-  weight :: a -> Float
-  weight _ = 0
-
-data Panel = forall a. PanelClass a => Panel a
-
-instance PanelClass Panel where
-  minSize (Panel p) = minSize p
-  weight (Panel p) = weight p
-
-data CompoundPanel = CompoundPanel Panel Panel
-
-instance PanelClass CompoundPanel where
-  minSize (CompoundPanel a b) = ((+) `on` minSize) a b
-  weight (CompoundPanel a b) = ((+) `on` weight) a b
-
-(<~>) :: Panel -> Panel -> Panel
-a <~> b = Panel $ CompoundPanel a b
-
-
-data Separator = Separator Int Float
-
-instance PanelClass Separator where
-  minSize (Separator s _) = s
-  weight (Separator _ w) = w
-
-separator :: Int -> Float -> Panel
-separator s w = Panel $ Separator s w
diff --git a/src/Phi/X11.hs b/src/Phi/X11.hs
deleted file mode 100644
index 06bebfa..0000000
--- a/src/Phi/X11.hs
+++ /dev/null
@@ -1,236 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-module Phi.X11 ( PanelPosition(..)
-               , PhiXConfig(..)
-               , phiDefaultXConfig
-               , initPhi
-               ) where
-
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import Graphics.X11.Xinerama
-
-import Control.Monad
-import Data.Maybe
-import Data.Bits
-
-import Control.Monad.State
-import Control.Monad.Trans
-
-data PanelPosition = PanelPositionTop | PanelPositionBottom
-
-data PhiXConfig = PhiXConfig { phiXScreenInfo   :: Display -> IO [Rectangle]
-                             , phiPanelPosition :: PanelPosition
-                             , phiPanelSize     :: Int
-                             }
-
-data PhiState = PhiState { phiXConfig    :: PhiXConfig
-                         , phiDisplay    :: Display
-                         , phiRootPixmap :: Pixmap
-                         , phiPanels     :: [PanelState]
-                         }
-
-data PanelState = PanelState { panelWindow     :: Window
-                             , panelGC         :: GC
-                             , panelArea       :: Rectangle
-                             , panelScreenArea :: Rectangle
-                             }
-
-newtype Phi a = Phi (StateT PhiState IO a)
-              deriving (Monad, MonadState PhiState, MonadIO)
-
-runPhi :: PhiState -> Phi a -> IO (a, PhiState)
-runPhi st (Phi a) = runStateT a st
-
-
-phiDefaultXConfig = PhiXConfig { phiXScreenInfo   = getScreenInfo
-                               , phiPanelPosition = PanelPositionTop
-                               , phiPanelSize     = 24
-                               }
-
-
-initPhi :: PhiXConfig -> IO ()
-initPhi config = do
-  disp <- openDisplay []
-  selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask
-  
-  runPhi PhiState { phiXConfig = config, phiDisplay = disp, phiRootPixmap = 0, phiPanels = [] } $ do
-    updateRootPixmap
-    
-    screens <- liftIO $ phiXScreenInfo config disp
-    panels <- mapM createPanel screens
-    forM_ panels $ \panel -> do
-      setPanelProperties panel
-      liftIO $ mapWindow disp (panelWindow panel)
-    
-    modify $ \state -> state { phiPanels = panels }
-    
-    state <- get
-    liftIO $ allocaXEvent $ \xevent -> runPhi state $ do
-      forever $ do
-        liftIO $ nextEvent disp xevent
-        event <- liftIO $ getEvent xevent
-        
-        case event of
-          ExposeEvent {} -> updatePanels
-          PropertyEvent {} -> handlePropertyUpdate event
-          _ -> return ()
-  return ()
-
-
-updatePanels :: Phi ()
-updatePanels = do
-  disp <- gets phiDisplay
-  rootPixmap <- gets phiRootPixmap
-  panels <- gets phiPanels
-  forM_ panels $ \panel -> liftIO $ withRectangle (panelArea panel) (copyArea disp rootPixmap (panelWindow panel) (panelGC panel)) 0 0
-
-
-handlePropertyUpdate :: Event -> Phi ()
-handlePropertyUpdate PropertyEvent { ev_atom = atom } = do
-  disp <- gets phiDisplay
-  panels <- gets phiPanels
-  atom_XROOTPMAP_ID <- liftIO $ internAtom disp "_XROOTPMAP_ID" False
-  atom_XROOTMAP_ID <- liftIO $ internAtom disp "_XROOTMAP_ID" False
-
-  when (atom == atom_XROOTPMAP_ID || atom == atom_XROOTMAP_ID) $ do
-    updateRootPixmap
-    updatePanels
-  
-
-updateRootPixmap :: Phi ()
-updateRootPixmap = do
-  disp <- gets phiDisplay
-  let screen = defaultScreen disp
-      rootwin = defaultRootWindow disp
-  atom_XROOTPMAP_ID <- liftIO $ internAtom disp "_XROOTPMAP_ID" False
-  atom_XROOTMAP_ID <- liftIO $ internAtom disp "_XROOTMAP_ID" False
-  pixmap <- liftM (fromMaybe 0 . listToMaybe . join . catMaybes) $ forM [atom_XROOTPMAP_ID, atom_XROOTMAP_ID] $ \atom -> liftIO $ rawGetWindowProperty 32 disp atom rootwin
-  modify $ \state -> state { phiRootPixmap = pixmap }
-
-
-createPanel :: Rectangle -> Phi PanelState
-createPanel screen = do
-  config <- gets phiXConfig
-  let rect = panelBounds config screen
-  disp <- gets phiDisplay
-  win <- createPanelWindow rect
-  gc <- liftIO $ createGC disp win
-  return PanelState { panelWindow = win, panelGC = gc, panelArea = rect, panelScreenArea = screen }
-
-
-createPanelWindow :: Rectangle -> Phi Window
-createPanelWindow rect = do
-  disp <- gets phiDisplay
-  let screen = defaultScreen disp
-      depth = defaultDepth disp screen
-      visual = defaultVisual disp screen
-      colormap = defaultColormap disp screen
-      rootwin = defaultRootWindow disp
-      mask = cWEventMask.|.cWColormap.|.cWBackPixel.|.cWBorderPixel
-
-  liftIO $ allocaSetWindowAttributes $ \attr -> do
-    set_colormap attr colormap
-    set_background_pixel attr 0
-    set_border_pixel attr 0
-    set_event_mask attr exposureMask
-    withRectangle rect (createWindow disp rootwin) 0 depth inputOutput visual mask attr
-
-
-setPanelProperties :: PanelState -> Phi ()
-setPanelProperties panel = do
-  disp <- gets phiDisplay
-  liftIO $ do
-    atom_NET_WM_WINDOW_TYPE <- internAtom disp "_NET_WM_WINDOW_TYPE" False
-    atom_NET_WM_WINDOW_TYPE_DOCK <- internAtom disp "_NET_WM_WINDOW_TYPE_DOCK" False
-    
-    atom_NET_WM_DESKTOP <- internAtom disp "_NET_WM_DESKTOP" False
-    
-    atom_NET_WM_STATE <- internAtom disp "_NET_WM_STATE" False
-    atom_NET_WM_STATE_SKIP_PAGER <- internAtom disp "_NET_WM_STATE_SKIP_PAGER" False
-    atom_NET_WM_STATE_SKIP_TASKBAR <- internAtom disp "_NET_WM_STATE_SKIP_TASKBAR" False
-    atom_NET_WM_STATE_STICKY <- internAtom disp "_NET_WM_STATE_STICKY" False
-    atom_NET_WM_STATE_BELOW <- internAtom disp "_NET_WM_STATE_BELOW" False
-    
-    atom_MOTIF_WM_HINTS <- internAtom disp "_MOTIF_WM_HINTS" False
-    
-    storeName disp (panelWindow panel) "Phi"
-    changeProperty32 disp (panelWindow panel) atom_NET_WM_WINDOW_TYPE aTOM propModeReplace [fromIntegral atom_NET_WM_WINDOW_TYPE_DOCK]
-    changeProperty32 disp (panelWindow panel) atom_NET_WM_DESKTOP cARDINAL propModeReplace [0xFFFFFFFF]
-    changeProperty32 disp (panelWindow panel) atom_NET_WM_STATE aTOM propModeReplace [ fromIntegral atom_NET_WM_STATE_SKIP_PAGER
-                                                                                     , fromIntegral atom_NET_WM_STATE_SKIP_TASKBAR
-                                                                                     , fromIntegral atom_NET_WM_STATE_STICKY
-                                                                                     , fromIntegral atom_NET_WM_STATE_BELOW]
-    setWMHints disp (panelWindow panel) WMHints { wmh_flags = fromIntegral inputHintBit
-                                                , wmh_input = False
-                                                , wmh_initial_state = 0
-                                                , wmh_icon_pixmap = 0
-                                                , wmh_icon_window = 0
-                                                , wmh_icon_x = 0
-                                                , wmh_icon_y = 0
-                                                , wmh_icon_mask = 0
-                                                , wmh_window_group = 0
-                                                }
-    changeProperty32 disp (panelWindow panel) atom_MOTIF_WM_HINTS atom_MOTIF_WM_HINTS propModeReplace [ 2, 0, 0, 0, 0 ]
-  setStruts panel
-
-
-setStruts :: PanelState -> Phi ()
-setStruts panel = do
-  disp <- gets phiDisplay
-  config <- gets phiXConfig
-  let rootwin = defaultRootWindow disp
-      position = phiPanelPosition config
-      area = panelArea panel
-  (_, _, _, _, rootHeight, _, _) <- liftIO $ getGeometry disp rootwin
-  
-  let struts = case position of
-        PanelPositionTop -> [ 0
-                            , 0
-                            , (fromIntegral $ rect_y area) + (fromIntegral $ rect_height area)
-                            , 0
-                            , 0
-                            , 0
-                            , 0
-                            , 0
-                            , (fromIntegral $ rect_x area)
-                            , (fromIntegral $ rect_x area) + (fromIntegral $ rect_width area) - 1
-                            , 0
-                            , 0
-                            ]
-        PanelPositionBottom -> [ 0
-                               , 0
-                               , 0
-                               , (fromIntegral rootHeight) - (fromIntegral $ rect_y area)
-                               , 0
-                               , 0
-                               , 0
-                               , 0
-                               , 0
-                               , 0
-                               , (fromIntegral $ rect_x area)
-                               , (fromIntegral $ rect_x area) + (fromIntegral $ rect_width area) - 1
-                               ]
-  
-  liftIO $ do
-    atom_NET_WM_STRUT <- internAtom disp "_NET_WM_STRUT" False
-    atom_NET_WM_STRUT_PARTIAL <- internAtom disp "_NET_WM_STRUT_PARTIAL" False
-    
-    changeProperty32 disp (panelWindow panel) atom_NET_WM_STRUT cARDINAL propModeReplace $ take 4 struts
-    changeProperty32 disp (panelWindow panel) atom_NET_WM_STRUT_PARTIAL cARDINAL propModeReplace struts
-
-
-panelBounds :: PhiXConfig -> Rectangle -> Rectangle
-panelBounds config screenBounds = case phiPanelPosition config of
-  PanelPositionTop -> screenBounds { rect_height = fromIntegral $ phiPanelSize config }
-  PanelPositionBottom -> screenBounds { rect_height = fromIntegral $ phiPanelSize config,
-                                        rect_y = (rect_y screenBounds) + (fromIntegral $ rect_height screenBounds) - (fromIntegral $ phiPanelSize config) }
-
-withRectangle :: Rectangle -> (Position -> Position -> Dimension -> Dimension -> a) -> a
-withRectangle r = withDimension r . withPosition r
-
-withPosition :: Rectangle -> (Position -> Position -> a) -> a
-withPosition r f = f (rect_x r) (rect_y r)
-
-withDimension :: Rectangle -> (Dimension -> Dimension -> a) -> a
-withDimension r f = f (rect_width r) (rect_height r)