Habemus XMobar! was Re: [Xmonad] [dzen] release 0.5.0
Andrea Rossato
mailing_list at istitutocolli.org
Tue Jun 19 02:26:56 EDT 2007
On Thu, Jun 14, 2007 at 09:21:44PM +0200, Robert Manea wrote:
> Well, i did not want to do too much parsing and tokenizing. Though the
> idea is a good one, patches welcome :).
>
well, this is not a patch, but hope it will give you an Idea of what I
have in mind.
I've called it xmobar, but it's just a joke... I asked to myself, why
doesn't Robert rewrite dzen2 in haskell? I'll be delighted to help. As
I said I don't get C...
dear haskellelers,
do not start talking bad at me because the code is not so nice, etc.
etc. I just wanted a code that was clear to read also for the novice
(still I belong to this category) of hakell.
I'm thinking to use it as a tutorial for the Xlib library (for the
haskell wiki): as you know I'm far better at writing tutorials on
difficult stuff than simple code.
Who knows, perhaps someone is going to take the challenge and write an
xmonad status bar...
BTW, here's the usual ugly screen shot:
http://gorgias.mine.nu/xmobar/xmobar.jpg
here you'll fine more stuff (included binaries, hopefully working):
http://gorgias.mine.nu/xmobar/
Attached you'll find xmobar.hs, the main file (compile with
ghc --make xmobar.hs -o xmobar).
Use like this:
1. from a terminal write:
./xmobar xmobar.config
if you do not give a configuration file xmobar will use the default
configuration.
2. After that nothing is going to happen. You need to type, something
like:
^#ff0000Ciao ciao, my name is ^#00FF00Andrea!
3. Ok, you may now press enter. Something is supposed to happen. If it
doesn't, well, that's better than you may think.
In the screen shot I use it with mymon:
ghc --make monitor.hs -o mymon
monitor.hs is attached.
I found it here, but I modified it:
http://blog.csdn.net/danranx/archive/2007/06/10/1646608.aspx
I've put, in my .xinitrc:
while true ; do /path/to/mymon; sleep 5 ; done \
| /path/to/xmobar &
do not forget the last & otherwise xmonad will not start, I think.
Let me know if you like the bits. That would reinforce my ego.
;-)
ciao
andrea
ps: I have the feeling that the parser actually sucks.
-------------- next part --------------
module Main where
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Misc
import Graphics.X11.Xlib.Extras
import Text.ParserCombinators.Parsec
import Control.Concurrent
import Control.Monad
import Data.Bits
import System
data Config =
Config { fonts :: String
, bgColor :: String
, fgColor :: String
, xPos :: Int
, yPos :: Int
, width :: Int
, hight :: Int
} deriving (Eq, Show, Read, Ord)
defaultConfig :: Config
defaultConfig =
Config { fonts = "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*"
, bgColor = "#000000"
, fgColor = "#ffffff"
, xPos = 0
, yPos = 0
, width = 1024
, hight = 15
}
main :: IO ()
main =
do args <- getArgs
config <-
if length args /= 1
then do putStrLn ("No configuration file specified. Using default settings")
return defaultConfig
else readConfig (args!!0)
eventLoop config
eventLoop :: Config -> IO ()
eventLoop c =
do a <- getLine
b <- stringParse c a
runWin c b
runWin :: Config -> [(String, String)] -> IO ()
runWin config str = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
win <- mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw
(fromIntegral $ xPos config)
(fromIntegral $ yPos config)
(fromIntegral $ width config)
(fromIntegral $ hight config) 0
mapWindow dpy win
-- get default colors
bgcolor <- initColor dpy $ bgColor config
fgcolor <- initColor dpy $ fgColor config
-- window background
gc <- createGC dpy win
setForeground dpy gc bgcolor
fillRectangle dpy win gc 0 0
(fromIntegral $ width config)
(fromIntegral $ hight config)
-- let's get the fonts
fontst <- loadQueryFont dpy (fonts config)
setFont dpy gc (fontFromFontStruct fontst)
-- print what you need to print
let strWithLenth = map (\(s,c) -> (s,c,textWidth fontst s)) str
printStrings dpy win gc fontst 1 strWithLenth
-- refreesh, fre, resync... do what you gotta do
freeGC dpy gc
sync dpy True
-- back again: we are never ending
eventLoop config
{- $print
An easy way to print the stuff we need to print
-}
printStrings _ _ _ _ _ [] = return ()
printStrings dpy win gc fontst offset (x@(s,c,l):xs) =
do let (_,asc,desc,_) = textExtents fontst s
color <- initColor dpy c
setForeground dpy gc color
drawString dpy win gc offset asc s
printStrings dpy win gc fontst (offset + l) xs
{- $parser
This is suppose do be a parser. Don't trust him.
-}
stringParse :: Config -> String -> IO [(String, String)]
stringParse config s =
case (parse (stringParser config) "" s) of
Left err -> return [("Sorry, if I were a decent parser you now would be starting at something meaningful...",(fgColor config))]
Right x -> return x
stringParser :: Config -> Parser [(String, String)]
stringParser c = manyTill (choice [colorsAndText c,defaultColors c]) eof
defaultColors :: Config -> Parser (String, String)
defaultColors config =
do { s <- many $ noneOf "^"
; notFollowedBy (char '#')
; return (s,(fgColor config))
}
<|> colorsAndText config
colorsAndText :: Config -> Parser (String, String)
colorsAndText config =
do { string "^#"
; n <- count 6 hexDigit
; s <- many $ noneOf "^"
; notFollowedBy (char '#')
; return (s,"#"++n)
}
<|> defaultColors config
{- $unmanwin
This is a way to create unmamaged window. It was a mistery in haskell.
Till I've found out...;-)
-}
mkUnmanagedWindow :: Display
-> Screen
-> Window
-> Position
-> Position
-> Dimension
-> Dimension
-> Pixel
-> IO Window
mkUnmanagedWindow dpy scr rw x y w h bgcolor = do
let visual = defaultVisualOfScreen scr
attrmask = cWOverrideRedirect
window <- allocaSetWindowAttributes $
\attributes -> do
set_override_redirect attributes True
createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr)
inputOutput visual attrmask attributes
return window
{- $utility
Utilitis, aka stollen without givin' credit stuff.
-}
readConfig :: FilePath -> IO Config
readConfig f =
do s <- readFile f
case reads s of
[(config, str)] -> return config
[] -> error ("corrupt config file: " ++ f)
-- | Get the Pixel value for a named color
initColor :: Display -> String -> IO Pixel
initColor dpy c = (color_pixel . fst) `liftM` allocNamedColor dpy colormap c
where colormap = defaultColormap dpy (defaultScreen dpy)
-------------- next part --------------
Config { fonts = "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*"
, bgColor = "#000000"
, fgColor = "#00ff00"
, xPos = 0
, yPos = 0
, width = 1024
, hight = 15
}
-------------- next part --------------
#! /usr/bin/env runhaskell
import Data.Time (getZonedTime)
import Text.Printf (printf)
import System.Process (runInteractiveCommand)
import Data.List
import System.IO (hGetContents)
getOutput :: String -> IO String
getOutput cmd = do
(_, out, _, _) <- runInteractiveCommand cmd
hGetContents out
memParse :: String -> String
memParse file =
let content = map words $ take 4 $ lines file
[total, free, buffer, cache] = map (\line -> (read $ line !! 1 :: Float) / 1024) content
rest = free + buffer + cache
used = total - rest
usedratio = used * 100 / total
realused = if usedratio > 50 then "^#FF0000"++show used++"^#FFFFFF"
else "^#FF00FF"++show used++"^#FFFFFF"
in
printf "MEM: %sM %.1f%% used %.0fM rest" realused usedratio rest
mem :: IO String
mem = do
file <- readFile "/proc/meminfo"
return $ memParse file
time :: IO String
time = do
now <- getZonedTime
return $ take 16 $ show now
temp :: IO String
temp = do
file <- readFile "/proc/acpi/thermal_zone/THRM/temperature"
let t = (words file) !! 1
f t | read t > 60 = "^#FF0000"++t++"^#FFFFFF"
| otherwise = "^#00FF00"++t++"^#FFFFFF"
return $ "TEMP: " ++ (f t) ++ "C"
takeTail :: Int -> [a] -> [a]
takeTail n xs =
let len = length xs in
drop (len-n) xs
load :: IO String
load = do
content <- getOutput "uptime"
let l = map (delete ',') $ takeTail 3 $ words content
return $ unwords $ "LOAD:" : l
sep :: IO String
sep = return " "
main = do
putStr ""
mapM_ (>>=putStr) $ intersperse sep [load, temp, mem, time]
putChar '\n'
More information about the Xmonad
mailing list