Skip to content

Instantly share code, notes, and snippets.

@nakal
Last active Aug 29, 2015
Embed
What would you like to do?
First try for hdm
import System.IO.Error
import System.Posix.Process
import Graphics.X11.Xft
import Graphics.X11.Xlib.Context
import Graphics.X11.Xlib.Display
import Graphics.X11.Xlib.Event
import Graphics.X11.Xlib.Misc
import Graphics.X11.Xlib.Screen
import Graphics.X11.Types
import Graphics.X11.Xlib.Window
import Control.Concurrent
import Control.Monad
loginBoxX = 100
loginBoxY = 100
loginBoxW = 500
loginBoxH = 30
xftFontName = "Sans:size=18";
-- xftFontName = "Sans:size=18:bold";
processEvent dsp ev = do
let scrnum = defaultScreen dsp
scr = defaultScreenOfDisplay dsp
gc = defaultGC dsp scrnum
win = defaultRootWindow dsp
colormap = defaultColormapOfScreen scr
visual = defaultVisualOfScreen scr
fc = "red"
pixmap <- createPixmap dsp win loginBoxW loginBoxH (defaultDepthOfScreen scr)
setForeground dsp gc (whitePixel dsp scrnum)
setBackground dsp gc (whitePixel dsp scrnum)
fillRectangle dsp pixmap gc 0 0 loginBoxW loginBoxH
font <- xftFontOpen dsp scr "Sans:size=18"
withXftDraw dsp pixmap visual colormap $
\draw -> withXftColorName dsp visual colormap fc $
\color -> do
setForeground dsp gc (blackPixel dsp scrnum)
xftDrawString draw color font 2 (loginBoxH - 5) " TEST "
copyArea dsp pixmap win gc 0 0 loginBoxW loginBoxH loginBoxX loginBoxY
flushGC dsp gc
xftFontClose dsp font
freePixmap dsp pixmap
sync dsp False
isKeyEvent :: XEventPtr -> IO Bool
isKeyEvent ev = do
t <- get_EventType ev
return (t == keyPress)
xEventLoop dsp = do
allocaXEvent $ \ev -> forever $ do
putStrLn "waiting for event..."
keyevent <- isKeyEvent ev
if keyevent then
do
processEvent dsp ev
putStrLn "key pressed"
else putStrLn "other event"
nextEvent dsp ev
putStrLn $ "event " ++ (show ev)
xServerDo dsp = do
let scr = defaultScreen dsp
gc = defaultGC dsp scr
win = defaultRootWindow dsp
-- putStrLn $ "opened display " ++ displayString dsp ++ ", having rootwin " ++ show win
-- putStrLn $ "size " ++ (show $ displayWidth dsp scr) ++ "x" ++ (show $ displayHeight dsp scr)
setForeground dsp gc (whitePixel dsp scr)
-- setBackground dsp gc (whitePixel dsp scr)
setFillStyle dsp gc fillSolid
-- fillRectangle dsp win gc loginBoxX loginBoxY loginBoxW loginBoxH
-- setForeground dsp gc (blackPixel dsp scr)
-- drawRectangle dsp win gc loginBoxX loginBoxY loginBoxW loginBoxH
flushGC dsp gc
selectInput dsp win keyPressMask
sync dsp False
xEventLoop dsp
tryXServerConnect server_param = do
ret <- tryIOError $ openDisplay server_param
case ret of
Right dsp -> xServerDo dsp
Left _ -> do
threadDelay 500000
tryXServerConnect server_param
main = do
pid <- forkProcess $ executeFile "Xnest" True [ server_param ] Nothing
tryXServerConnect server_param
where server_param = ":1"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment