neocturne/phi
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Added basic rendering functions

Browse source
This commit is contained in:
Matthias Schiffer 2011-07-13 02:13:01 +02:00
parent 982bcffcfe
commit 5c9c99b41c
8 changed files with 194 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

1
lib/Phi/X11/AtomList.hs
View file

@ -15,4 +15,3 @@ atoms = [ "_XROOTPMAP_ID"
, "_NET_WM_STRUT"
, "_NET_WM_STRUT_PARTIAL"
]

11
lib/Phi/X11/Atoms.hs
View file

@ -11,17 +11,15 @@ import Graphics.X11
import Phi.X11.AtomList
$(do
let atomsName = mkName "Atoms"
atomNames = map (\atom -> (atom, mkName ("atom" ++ atom))) atoms
fields = map (\(_, name) -> (name, IsStrict, ConT ''Atom)) atomNames
return [DataD [] atomsName [] [RecC atomsName fields] []]
$(let atomsName = mkName "Atoms"
atomNames = map (\atom -> (atom, mkName ("atom" ++ atom))) atoms
fields = map (\(_, name) -> (name, IsStrict, ConT ''Atom)) atomNames
in return [DataD [] atomsName [] [RecC atomsName fields] []]
)
initAtoms :: Display -> IO Atoms
initAtoms display =
$(do
let atomsName = mkName "Atoms"
atomNames <- mapM (\atom -> do
varName <- newName ('_':atom)
return (atom, mkName ("atom" ++ atom), varName)
@ -30,6 +28,7 @@ initAtoms display =
\(atom, _, varName) -> liftM (BindS (VarP varName)) [| internAtom display atom False |]
let atomFieldExps = map (\(_, atomName, varName) -> (atomName, VarE varName)) atomNames
atomsName = mkName "Atoms"
atomsContruction = NoBindS $ AppE (VarE 'return) $ RecConE atomsName atomFieldExps
return $ DoE $ atomInitializers ++ [atomsContruction]