module Command(module Command,DrawCommand,Drawable(..)) where
import Event(XEvent)
import Direction() -- for hbc
import Path(Path(..))
import Geometry
--import LayoutRequest(LayoutMessage(..))
import Xtypes
import DrawTypes
--import DialogueIO(Request)
import ShowFun()

-- Same order as in .../lml/src/lib/xlib/xlib.h
data XCommand -- X commands
  = CloseDisplay Display
  | DestroyWindow
  | MapRaised
  | LowerWindow
  | UnmapWindow
  | Draw Drawable GCId DrawCommand
  | DrawMany Drawable [(GCId,[DrawCommand])] -- use instead of XDoCommands
  | ClearArea Rect Bool
  | ClearWindow
  | ChangeGC GCId GCAttributeList
  | FreeGC GCId
  | ChangeWindowAttributes [WindowAttributes]
  | ConfigureWindow [WindowChanges]
  | StoreName String
  | SetNormalHints Point
  | SetWMHints Bool -- input
  | UngrabPointer
  | GrabButton Bool Button ModState [EventMask]
  | UngrabButton Button ModState
  | Flush
  | FreePixmap PixmapId
  | ShapeCombineMask ShapeKind Point PixmapId ShapeOperation
  | ShapeCombineRectangles ShapeKind Point [Rect] ShapeOperation Ordering'
  | ShapeCombineShape ShapeKind Point PixmapId ShapeKind ShapeOperation
  | RmDestroyDatabase RmDatabase
  | RmCombineDatabase RmDatabase RmDatabase Bool
  | RmPutLineResource RmDatabase String
  | SetWMProtocols [Atom]
  | SendEvent Window Bool [EventMask] XEvent
  | SetSelectionOwner Bool Atom
  | ConvertSelection Selection
  | ChangeProperty Window Atom Atom Int PropertyMode String
  | FreeColors ColormapId [Pixel] Pixel{-planes-}
  | ReparentWindow Window {- parent -}
  | WarpPointer Point
  | SetRegion GCId Rect -- !!! modifies a GC -- cache problems!
  | AddToSaveSet
  | RemoveFromSaveSet
  | Bell Int
  | SetGCWarningHack {XCommand -> PixmapId
gcon,XCommand -> PixmapId
gcoff::PixmapId}
-- ONLY Pseudo commands below, add new Xlib command above this line !!!
  | GrabEvents Bool
  | UngrabEvents
  | TranslateEvent (XEvent -> Maybe XEvent) [EventMask]
  | ReparentToMe Path Window
  | GetWindowId -- move to XRequest?
  | SelectWindow Window
-- Layout pseudo commands
--  | LayoutMsg LayoutMessage
-- An I/O request to be passed through the top level (not anymore)
--  | DoIO Request
--  | DoXRequest XRequest
--
--  | DoXCommands [XCommand]
		-- Drawing speed hack, bypasses caches and resource management.
		-- Do not put any Alloc/Free, Create/Destroy, Grab/Ungrab type
		-- of commands inside DoXCommands!
--
  | MeButtonMachine -- tells menuPopupF where the buttons are
  deriving (Int -> XCommand -> ShowS
[XCommand] -> ShowS
XCommand -> String
(Int -> XCommand -> ShowS)
-> (XCommand -> String) -> ([XCommand] -> ShowS) -> Show XCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XCommand] -> ShowS
$cshowList :: [XCommand] -> ShowS
show :: XCommand -> String
$cshow :: XCommand -> String
showsPrec :: Int -> XCommand -> ShowS
$cshowsPrec :: Int -> XCommand -> ShowS
Show,ReadPrec [XCommand]
ReadPrec XCommand
Int -> ReadS XCommand
ReadS [XCommand]
(Int -> ReadS XCommand)
-> ReadS [XCommand]
-> ReadPrec XCommand
-> ReadPrec [XCommand]
-> Read XCommand
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XCommand]
$creadListPrec :: ReadPrec [XCommand]
readPrec :: ReadPrec XCommand
$creadPrec :: ReadPrec XCommand
readList :: ReadS [XCommand]
$creadList :: ReadS [XCommand]
readsPrec :: Int -> ReadS XCommand
$creadsPrec :: Int -> ReadS XCommand
Read)

-- layoutRequestCmd = LayoutMsg . LayoutRequest

data XRequest
  = OpenDisplay DisplayName
  | CreateSimpleWindow Path Rect
  | CreateRootWindow Rect String -- resource name
  | CreateGC Drawable GCId GCAttributeList
  | LoadFont FontName
  | CreateFontCursor Int
  | GrabPointer Bool [EventMask]
  | LMLQueryFont FontId -- doesn't work in Haskell
  | AllocNamedColor ColormapId ColorName
  | AllocColor ColormapId RGB
  | CreatePixmap Size Depth
  | ReadBitmapFile FilePath
  | CreateBitmapFromData BitmapData
  | RmGetStringDatabase String
  | RmGetResource RmDatabase String String
  | TranslateCoordinates
  | InternAtom String Bool
  | GetAtomName Atom
  | GetWindowProperty Int Atom Bool Atom
  | QueryPointer
  | QueryFont FontId
  | LoadQueryFont FontName
  | QueryColor ColormapId Pixel
  | QueryTree
  | DefaultRootWindow
  | GetGeometry
  | DefaultVisual
  | Sync Bool -- discard::Bool
  | QueryTextExtents16 FontId String
  | ListFonts FontName Int -- pattern, maxnames
  | ListFontsWithInfo FontName Int -- pattern, maxnames
  | GetResource RmSpec
  | DbeQueryExtension
  | DbeAllocateBackBufferName SwapAction
  | DbeSwapBuffers SwapAction -- applies only to the fudget's own window.
  -- ONLY Pseudo requests below:
  | CreateMyWindow Rect
  deriving (XRequest -> XRequest -> Bool
(XRequest -> XRequest -> Bool)
-> (XRequest -> XRequest -> Bool) -> Eq XRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XRequest -> XRequest -> Bool
$c/= :: XRequest -> XRequest -> Bool
== :: XRequest -> XRequest -> Bool
$c== :: XRequest -> XRequest -> Bool
Eq, Eq XRequest
Eq XRequest
-> (XRequest -> XRequest -> Ordering)
-> (XRequest -> XRequest -> Bool)
-> (XRequest -> XRequest -> Bool)
-> (XRequest -> XRequest -> Bool)
-> (XRequest -> XRequest -> Bool)
-> (XRequest -> XRequest -> XRequest)
-> (XRequest -> XRequest -> XRequest)
-> Ord XRequest
XRequest -> XRequest -> Bool
XRequest -> XRequest -> Ordering
XRequest -> XRequest -> XRequest
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: XRequest -> XRequest -> XRequest
$cmin :: XRequest -> XRequest -> XRequest
max :: XRequest -> XRequest -> XRequest
$cmax :: XRequest -> XRequest -> XRequest
>= :: XRequest -> XRequest -> Bool
$c>= :: XRequest -> XRequest -> Bool
> :: XRequest -> XRequest -> Bool
$c> :: XRequest -> XRequest -> Bool
<= :: XRequest -> XRequest -> Bool
$c<= :: XRequest -> XRequest -> Bool
< :: XRequest -> XRequest -> Bool
$c< :: XRequest -> XRequest -> Bool
compare :: XRequest -> XRequest -> Ordering
$ccompare :: XRequest -> XRequest -> Ordering
$cp1Ord :: Eq XRequest
Ord, Int -> XRequest -> ShowS
[XRequest] -> ShowS
XRequest -> String
(Int -> XRequest -> ShowS)
-> (XRequest -> String) -> ([XRequest] -> ShowS) -> Show XRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XRequest] -> ShowS
$cshowList :: [XRequest] -> ShowS
show :: XRequest -> String
$cshow :: XRequest -> String
showsPrec :: Int -> XRequest -> ShowS
$cshowsPrec :: Int -> XRequest -> ShowS
Show, ReadPrec [XRequest]
ReadPrec XRequest
Int -> ReadS XRequest
ReadS [XRequest]
(Int -> ReadS XRequest)
-> ReadS [XRequest]
-> ReadPrec XRequest
-> ReadPrec [XRequest]
-> Read XRequest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XRequest]
$creadListPrec :: ReadPrec [XRequest]
readPrec :: ReadPrec XRequest
$creadPrec :: ReadPrec XRequest
readList :: ReadS [XRequest]
$creadList :: ReadS [XRequest]
readsPrec :: Int -> ReadS XRequest
$creadsPrec :: Int -> ReadS XRequest
Read)

type Command = XCommand

data BitmapData = BitmapData Size (Maybe Point) [Int] 
                  deriving (BitmapData -> BitmapData -> Bool
(BitmapData -> BitmapData -> Bool)
-> (BitmapData -> BitmapData -> Bool) -> Eq BitmapData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitmapData -> BitmapData -> Bool
$c/= :: BitmapData -> BitmapData -> Bool
== :: BitmapData -> BitmapData -> Bool
$c== :: BitmapData -> BitmapData -> Bool
Eq, Eq BitmapData
Eq BitmapData
-> (BitmapData -> BitmapData -> Ordering)
-> (BitmapData -> BitmapData -> Bool)
-> (BitmapData -> BitmapData -> Bool)
-> (BitmapData -> BitmapData -> Bool)
-> (BitmapData -> BitmapData -> Bool)
-> (BitmapData -> BitmapData -> BitmapData)
-> (BitmapData -> BitmapData -> BitmapData)
-> Ord BitmapData
BitmapData -> BitmapData -> Bool
BitmapData -> BitmapData -> Ordering
BitmapData -> BitmapData -> BitmapData
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BitmapData -> BitmapData -> BitmapData
$cmin :: BitmapData -> BitmapData -> BitmapData
max :: BitmapData -> BitmapData -> BitmapData
$cmax :: BitmapData -> BitmapData -> BitmapData
>= :: BitmapData -> BitmapData -> Bool
$c>= :: BitmapData -> BitmapData -> Bool
> :: BitmapData -> BitmapData -> Bool
$c> :: BitmapData -> BitmapData -> Bool
<= :: BitmapData -> BitmapData -> Bool
$c<= :: BitmapData -> BitmapData -> Bool
< :: BitmapData -> BitmapData -> Bool
$c< :: BitmapData -> BitmapData -> Bool
compare :: BitmapData -> BitmapData -> Ordering
$ccompare :: BitmapData -> BitmapData -> Ordering
$cp1Ord :: Eq BitmapData
Ord, Int -> BitmapData -> ShowS
[BitmapData] -> ShowS
BitmapData -> String
(Int -> BitmapData -> ShowS)
-> (BitmapData -> String)
-> ([BitmapData] -> ShowS)
-> Show BitmapData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitmapData] -> ShowS
$cshowList :: [BitmapData] -> ShowS
show :: BitmapData -> String
$cshow :: BitmapData -> String
showsPrec :: Int -> BitmapData -> ShowS
$cshowsPrec :: Int -> BitmapData -> ShowS
Show, ReadPrec [BitmapData]
ReadPrec BitmapData
Int -> ReadS BitmapData
ReadS [BitmapData]
(Int -> ReadS BitmapData)
-> ReadS [BitmapData]
-> ReadPrec BitmapData
-> ReadPrec [BitmapData]
-> Read BitmapData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BitmapData]
$creadListPrec :: ReadPrec [BitmapData]
readPrec :: ReadPrec BitmapData
$creadPrec :: ReadPrec BitmapData
readList :: ReadS [BitmapData]
$creadList :: ReadS [BitmapData]
readsPrec :: Int -> ReadS BitmapData
$creadsPrec :: Int -> ReadS BitmapData
Read)

type DisplayName = String

-- Convenient abbreviations:
moveWindow :: Point -> XCommand
moveWindow (Point Int
x Int
y) = [WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWX Int
x, Int -> WindowChanges
CWY Int
y]
resizeWindow :: Point -> XCommand
resizeWindow (Point Int
w Int
h) = [WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWWidth Int
w, Int -> WindowChanges
CWHeight Int
h]
moveResizeWindow :: Rect -> XCommand
moveResizeWindow (Rect (Point Int
x Int
y) (Point Int
w Int
h)) =
    [WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWX Int
x, Int -> WindowChanges
CWY Int
y, Int -> WindowChanges
CWWidth Int
w, Int -> WindowChanges
CWHeight Int
h]

clearWindowExpose :: XCommand
clearWindowExpose = Rect -> Bool -> XCommand
ClearArea (Int -> Int -> Int -> Int -> Rect
rR Int
0 Int
0 Int
0 Int
0) Bool
True
                    -- Clears the window and generates appropriate
		    -- exposure events.See man page for XClearArea.