I was trying to get the width of the string, using XTextWidth() function, but for some reason the returned value is always bigger than the actual displayed length of string. In the following example, the value printed out is 196, while if I measure the width on-screen, it's somewhere around 168 pixels (the following is compilable and runnable example):
import Control.Concurrent
import qualified Graphics.X11.Xlib as X
import qualified Graphics.X11.Xlib.Types as Xt
import qualified Graphics.X11.Types as Xt
main = do
display <- X.openDisplay ""
let dflt = X.defaultScreen display
border = X.blackPixel display dflt
background = X.whitePixel display dflt
rootw <- X.rootWindow display dflt
win <- X.createSimpleWindow display rootw 0 0 500 300 1 border background
X.mapWindow display win
X.moveWindow display win 0 0
updateScreen display win
updateScreen display win = do
gc <- X.createGC display win
bgcolor <- initColor display "white"
fgcolor <- initColor display "black"
X.setBackground display gc bgcolor
X.setForeground display gc fgcolor
font <- X.loadQueryFont display "-misc-fixed-*-*-*-*-14-*-*-*-*-*-*"
let str = "Some reasonably long string."
len = X.textWidth font str
putStrLn $ show len
X.drawImageString display win gc 0 50 str
X.freeFont display font
X.freeGC display gc
threadDelay 100000
updateScreen display win
initColor :: X.Display -> String -> IO X.Pixel
initColor dpy color = do
let colormap = X.defaultColormap dpy (X.defaultScreen dpy)
(apros,_) <- X.allocNamedColor dpy colormap color
return $ X.color_pixel apros
How can I fix it?
You are not displaying with the selected font. Try this:
X.setFont display gc $ X.fontFromFontStruct font
Related
I'm currently working on a tile-based 2d engine for Haskell.
So my current task is to extract(=import) sections of a picture.
I am using from Graphics.Gloss.Data.Picture
bitmapSection :: Rectangle -> BitmapData -> Picture
My Problemm is as Following: I tried multiple diferent convertion methods (see full code below) but none of them yields the result I wish to have.
the base Image is: (size is: 32x32)
what I get is:
Note:I tried every diferent input/conversion method I could think of and drew them side by side...
now the question is: what am I doing wrong?
full sample code:
import Graphics.Gloss.Interface.Pure.Game
( white, Display(InWindow), Event, Picture(Blank), pictures, bitmap, translate)
import Graphics.Gloss.Interface.IO.Game (playIO)
import Graphics.Gloss
( white,
bitmapSection,
Display(InWindow),
Picture(Blank),
bitmapDataOfBMP,
bitmapDataOfByteString,
bitmapOfByteString,
BitmapFormat(BitmapFormat),
PixelFormat(PxRGBA, PxABGR),
RowOrder(TopToBottom, BottomToTop ),
Rectangle (Rectangle),
BitmapData (bitmapSize), bitmapOfBMP, bitmapOfForeignPtr
)
import qualified Data.ByteString as ByteString
main :: IO ()
main = do
state <- read'
playIO
window
background
fps
state
(\state -> return state)
(\event state -> return state)
(\_ state -> return state)
where
background = white
window = InWindow "WindowName" (500,100) (10,10)
fps = 60
read' :: IO Picture
read' = do
file <- ByteString.readFile "rechteck_gruen.bmp"
let
bit_map1 = bitmapDataOfByteString 32 32 (BitmapFormat BottomToTop PxRGBA) file True
bit_map2 = bitmapDataOfByteString 32 32 (BitmapFormat TopToBottom PxRGBA) file True
bit_map3 = bitmapDataOfByteString 32 32 (BitmapFormat BottomToTop PxABGR) file True
bit_map4 = bitmapDataOfByteString 32 32 (BitmapFormat TopToBottom PxABGR) file True
pic1 = bitmapOfByteString 32 32 (BitmapFormat BottomToTop PxRGBA) file True
pic2 = bitmapOfByteString 32 32 (BitmapFormat TopToBottom PxRGBA) file True
pic3 = bitmapOfByteString 32 32 (BitmapFormat BottomToTop PxABGR) file True
pic4 = bitmapOfByteString 32 32 (BitmapFormat TopToBottom PxABGR) file True
{--
Important: bitmapSection with size 32x32 is only for testing purpose...
therefore picFromSection should be equal to picFromByteString ?
--}
picFromSection = map (\bitMap -> bitmapSection (Rectangle (0,0) (32,32)) bitMap)
[bit_map1, bit_map2, bit_map3, bit_map4]
picFromByteString = [pic1, pic2, pic3, pic4]
picFromBitMap = map (\bitMap -> bitmap bitMap)
[bit_map1, bit_map2, bit_map3, bit_map4]
scene = picFromSection ++ picFromByteString ++ picFromBitMap
performTranslate _ [] = []
performTranslate n (x:xs) = translate (n*40-230) 0 x : performTranslate (n+1) xs
return $ pictures $ performTranslate 0 scene
I want to move an object in Haskell Gloss every frame a key is pressed, not just the one frame that the key is started being pressed. (Example: While 'w' key is pressed, accelerate object every frame)
Edit: I tried using the second parameter of EventKey but to no avail.
My code:
--TODO - Holding keys doesn't work yet
handleKeys :: Event -> AsteroidsGame -> AsteroidsGame
handleKeys (EventKey (Char char) _ _ _) game
| char == 'w' = move 0 1
| char == 'a' = move (-1) 0
| char == 's' = move 0 (-1)
| char == 'd' = move 1 0
where move x y = game {player = accelerateObject (player game) x y}
handleKeys _ game = game
accelerateObject :: Object -> Float -> Float -> Object
accelerateObject obj hor ver = obj {vel = (vx + hor, vy + ver)}
where (vx, vy) = vel obj
As OP correctly deduced, gloss gives you input events ("key was just pressed", "mouse was just moved"), rather than input state ("key is currently pressed", "mouse is at x,y"). There doesn't seem to be a built-in way to see input state on each frame, so we'll have to make our own workaround. Thankfully, this isn't too difficult!
For a simple working example, we'll make an incredibly fun "game" where you can watch a counter count upwards while the space bar is pressed. Riveting. This approach generalises to handling any key presses, so it'll be easy to extend to your case.
The first thing we need is our game state:
import qualified Data.Set as S
data World = World
{ keys :: S.Set Key
, counter :: Int }
We keep track of our specific game state (in this case just a counter), as well as state for our workaround (a set of pressed keys).
Handling input events just involves either adding a key to our set of currently pressed keys or removing it:
handleInput :: Event -> World -> World
handleInput (EventKey k Down _ _) world = world { keys = S.insert k (keys world)}
handleInput (EventKey k Up _ _) world = world { keys = S.delete k (keys world)}
handleInput _ world = world -- Ignore non-keypresses for simplicity
This can easily be extended to handle eg. mouse movement, by changing our World type to keep track of the last known coordinates of the cursor, and setting it in this function whenever we see an EventMotion event.
Our frame-to-frame world update function then uses the input state to update the specific game state:
update :: Float -> World -> World
update _ world
| S.member (SpecialKey KeySpace) (keys world) = world { counter = 1 + counter world }
| otherwise = world { counter = 0 }
If the spacebar is currently pressed (S.member (SpecialKey KeySpace) (keys world)), increment the counter - otherwise, reset it to 0. We don't care about how much time as elapsed between frames so we ignore the float argument.
Finally we can render our game and play it:
render :: World -> Picture
render = color white . text . show . counter
main :: IO ()
main = play display black 30 initWorld render handleInput update
where
display = InWindow "test" (800, 600) (0, 0)
initWorld = World S.empty 0
The imageviewer example shows how to display an image in a ScrolledWindow.
What if I want to display the image in the available space, scaling the bitmap as needed?
My google-fu failed me on this one.
edit: I thought I had something with scrolledWindowSetScale, but it looks like it's not going to help here.
Some people pointed me to functions in wxCore, so I could find a solution that works.
The function that does the drawing in the original example is:
onPaint vbitmap dc viewArea
= do mbBitmap <- get vbitmap value
case mbBitmap of
Nothing -> return ()
Just bm -> drawBitmap dc bm pointZero False []
using dcSetUserScale from wxCore, I was able to modify it to scale that way:
( sw is the scrolledWindow )
onPaint sw img dc viewArea = do
mimg <- get img value
case mimg of
Nothing -> return ()
Just bm -> do
bsize <- get bm size
vsize <- get sw size
let scale = calcScale bsize vsize
dcSetUserScale dc scale scale
drawBitmap dc bm pointZero False []
calcScale :: Size -> Size -> Double
calcScale (Size bw bh) (Size vw vh) = min scalew scaleh
where scalew = fromIntegral vw / fromIntegral bw
scaleh = fromIntegral vh / fromIntegral bh
I have a Window with three Entry widgets and one Button. I use the button to remove one of the widgets programmatically. The problem is that the main window doesn't change it's size to fit the new layout after it's been removed.
I can imagine that I need to send some Signal or Event to the main loop which would cause the recalculation but I've been unable to find such functionality.
Here is some example code:
import Graphics.UI.Gtk
import Data.IORef
import qualified Graphics.UI.Gtk as G hiding (Point)
import qualified Graphics.UI.Gtk.Gdk.EventM as E
import qualified Graphics.UI.Gtk.Abstract.Widget as W
import qualified Graphics.Rendering.Cairo as C
makeEntry :: String -> IO Entry
makeEntry str = do e <- entryNew
entrySetText e str
return e
main :: IO ()
main = do
initGUI
window <- windowNew
box <- vBoxNew False 0
G.on window G.keyPressEvent $ E.tryEvent $ do
"Escape" <- E.eventKeyName
C.liftIO $ G.widgetDestroy window
set window [ containerChild := box ]
e1 <- makeEntry "e1"
boxPackStart box e1 PackNatural 0
e2 <- makeEntry "e2"
boxPackStart box e2 PackNatural 0
e3 <- makeEntry "e3"
boxPackStart box e3 PackNatural 0
button <- buttonNew
set button [ buttonLabel := "Remove" ]
boxPackStart box button PackNatural 0
onClicked button (containerRemove box e2)
onDestroy window mainQuit
widgetShowAll window
mainGUI
You can ask your top-level window how big it wants to be, and make it be that big:
refresh window = do
Requisition w h <- widgetSizeRequest window
windowResize window w h
To use this, stick it in the button's click-handler:
onClicked button (containerRemove box e2 >> refresh window)
I want to make a haskell program where some shape is drawn in a window. When I click inside the window the color of the shape should change.
I have come up with this:
testDemo points =
runGraphics $
do
w <- openWindow "Test" (480, 550)
colorRef <- newIORef Green
let
loop0 = do
color <- readIORef colorRef
e <- getWindowEvent w
case e of
Button {pt=pt, isDown=isDown}
| isDown && color == Green -> writeIORef colorRef Red
| isDown && color == Red -> writeIORef colorRef Green
_ -> return ()
color <- readIORef colorRef
drawInWindow w (withColor color (polyline points))
loop0
color <- readIORef colorRef
drawInWindow w (withColor color (polyline points))
loop0
It kinda works.
The problem is, that I think that a window event is triggered almost all the time, so everything is drawn all the time which makes it slow.
How could I make it so, that I only change the drawing when a click is registered?
First of all, getWindowEvent will block until the next event occurs, so everything is drawn only on event. If you think that a window event is triggered too often, then you can print events to the stdout to figure out what event is triggered and just ignore it (e.g. skip drawing on all the events except Button event).
BTW: you don't IORef, you can just pass the current color through the loop.
testDemo points =
runGraphics $
do
w <- openWindow "Test" (480, 550)
let
loop0 color = do
e <- getWindowEvent w
let newColor = case e of
Button {pt=pt, isDown=isDown}
| isDown && color == Green -> Red
| isDown && color == Red -> Green
_ -> color
when (newColor != color) (drawInWindow w (withColor color (polyline points)))
loop0 color
let color = Red
drawInWindow w (withColor color (polyline points))
loop0 color
(The code is not tested with the compiler, so...)
Thanks for the answer.
I modified the code slightly according to my understanding of what it should do.
testDemo points =
runGraphics $
do
w <- openWindow "Test" (480, 550)
let
loop0 color = do
e <- getWindowEvent w
let newColor = case e of
Button {pt=pt, isDown=isDown}
| isDown && color == Green -> Red
| isDown && color == Red -> Green
_ -> color
when (newColor /= color) (drawInWindow w (withColor newColor (polyline points)))
loop0 newColor
let color = Green
drawInWindow w (withColor color (polyline points))
loop0 color
The results are a bit sketchy though. Sometimes the color changes immediately and sometimes it takes a very long time. I believe it could be some update issue, because when I close a window I see an issued color-change happen just before the window is gone.
Any ideas?
It helps if I call clearWindow before I draw the new stuff. I don't really understand why. Does it schedule a redraw of the window maybe?
Would be nice to know, but in general the problem is solved for now.