diff options
Diffstat (limited to 'highway/Main.hs')
| -rw-r--r-- | highway/Main.hs | 32 |
1 files changed, 16 insertions, 16 deletions
diff --git a/highway/Main.hs b/highway/Main.hs index 3ac2152..8f6bcd6 100644 --- a/highway/Main.hs +++ b/highway/Main.hs @@ -7,24 +7,24 @@ import Data.Data (Typeable) import Control.Monad (void, when) import Control.Monad.Trans (liftIO) import System.Posix.Signals (sigINT) -import qualified Wayland.Protocols.Core.WLOutput as WLOutput +import qualified Wayland.Protocols.Core.WlOutput as WlOutput import qualified Data.Map as M import Data.Time (secondsToDiffTime) -geometry :: WLOutput.Geometry -geometry = WLOutput.Geometry { WLOutput.x = 0 - , WLOutput.y = 0 - , WLOutput.physicalWidth = 623 - , WLOutput.physicalHeight = 583 - , WLOutput.subpixel = WLOutput.SubpixelNone - , WLOutput.make = "Apple" - , WLOutput.model = "Studio Display" - , WLOutput.transform = WLOutput.TransformNormal +geometry :: WlOutput.Geometry +geometry = WlOutput.Geometry { WlOutput.geometryX = 0 + , WlOutput.geometryY = 0 + , WlOutput.geometryPhysicalWidth = 623 + , WlOutput.geometryPhysicalHeight = 583 + , WlOutput.geometrySubpixel = WlOutput.SubpixelNone + , WlOutput.geometryMake = "Apple" + , WlOutput.geometryModel = "Studio Display" + , WlOutput.geometryTransform = WlOutput.TransformNormal } data CustomMessage - = MsgBindOutput Global (NewObject WLOutput.WLOutput) - | MsgDestroyOutput WLOutput.WLOutput + = MsgBindOutput Global (NewObject WlOutput.Object) + | MsgDestroyOutput WlOutput.Object | MsgSIGINT SignalSource | MsgTimer TimerSource deriving (Typeable, Show) @@ -34,7 +34,7 @@ instance MessageClass CustomMessage data Output = Output deriving (Show) -data State = State { _outputs :: M.Map WLOutput.WLOutput Output +data State = State { _outputs :: M.Map WlOutput.Object Output , _interruptedCount :: Int } deriving (Show) @@ -43,11 +43,11 @@ makeLenses ''State handleMessage :: Message -> DisplayM State () handleMessage m - | Just (WLOutput.ReqRelease o) <- fromMessage m = destroyObject o + | Just (WlOutput.ReqRelease o) <- fromMessage m = destroyObject o | Just (MsgBindOutput _ o) <- fromMessage m = do output <- createObject o MsgDestroyOutput outs <- outputs <%= M.insert output Output - sendEvent output $ WLOutput.EvGeometry geometry - sendEvent output $ WLOutput.EvDone + sendEvent output $ WlOutput.EvGeometry geometry + sendEvent output $ WlOutput.EvDone liftIO $ putStrLn $ "Output created, outputs: " ++ show outs flushEvents | Just (MsgDestroyOutput o) <- fromMessage m = do outputs %= M.delete o |