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
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
Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
What would be the typical game skeleton for a Haskell game, let's say a simple shoot them up for instance?
I am particularly interested on the data structure, and how to manage the update of all the elements in the world, in regards of immutability issue.
Just saying that
new_world=update_world(world)
is a little bit simplistic. For instance, how to deal with multiple interaction that can occurs between element of the world (collisions, reaction to player, etc....) especially when you have a lot of 'independent' elements impacted.
The main concern is about immutability of the world, which makes very difficult to update a "small" part of the world based on another subset of the world.
I love gloss (gloss 2D library. it's very closed to your needs (I think)
A very simple example
import Graphics.Gloss
import Graphics.Gloss.Interface.Pure.Game
-- Your app data
data App = App { mouseX :: Float
, mouseY :: Float
}
-- Draw world using your app data
-- Here thing about *draw* your world (e.g. if radius > MAX then red else blue)
drawWorld (App mousex mousey) = color white $ circle mousex
-- Handle input events and update your app data
-- Here thing about user interaction (e.g. when press button start jump!)
handleEvent
(EventMotion (x, y)) -- current viewport mouse coordinates
(App _ _) = App x y
handleEvent e w = w
-- Without input events you can update your world by time
-- Here thing about time (e.g. if jumping use `t` to compute new position)
handleTime t w = w
runApp =
play
( InWindow "Test" (300, 300) (0, 0) ) -- full screen or in window
black -- background color
20 -- frames per second
( App 0 0 ) -- your initial world
drawWorld -- how to draw the world?
handleEvent -- how app data is updated when IO events?
handleTime -- how app data is updated along the time?
-- enjoy!
main = runApp
One simple example modifying some data structure (a list of circle radius) along the three event handlers (draw, input and time)
import Graphics.Gloss
import Graphics.Gloss.Interface.Pure.Game
import System.IO.Unsafe
data App = App { mouseX :: Float
, mouseY :: Float
, circleList :: [Float]
, lastTime :: Float
, currTime :: Float
}
drawWorld app =
color white $ pictures $ map circle $ circleList app
handleEvent
(EventMotion (x, y)) -- current viewport mouse coordinates
app = app { mouseX = x, mouseY = y,
-- drop circles with radius > mouse **MOVED** position
circleList = filter (<(abs x)) $ circleList app }
handleEvent e app = app
handleTime t app =
app { currTime = currTime', lastTime = lastTime', circleList = circleList' }
where currTime' = currTime app + t
-- create new circle each 1 second
createNew = currTime' - lastTime app > 1
lastTime' = if createNew then currTime' else lastTime app
-- each step, increase all circle radius
circleList' = (if createNew then [0] else []) ++ map (+0.5) (circleList app)
runApp =
play
( InWindow "Test" (300, 300) (0, 0) )
black
20
( App 0 0 [] 0 0 )
drawWorld
handleEvent
handleTime
main = runApp
with result
I'm using OsmDroid on OpenStreetMaps and can make markers and polylines, but I can't find any examples on how I'd make 161m/528ft circles around a marker.
a) How do I make circles?
b) How do I make them 161m/528ft in size?
Thanks to MKer, I got an idea on how to solve the problem and made this piece of code, which works:
oPolygon = new org.osmdroid.bonuspack.overlays.Polygon(this);
final double radius = 161;
ArrayList<GeoPoint> circlePoints = new ArrayList<GeoPoint>();
for (float f = 0; f < 360; f += 1){
circlePoints.add(new GeoPoint(latitude , longitude ).destinationPoint(radius, f));
}
oPolygon.setPoints(circlePoints);
oMap.getOverlays().add(oPolygon);`
I know this can be optimized. I'm drawing 360 points, no matter what the zoom is!
If you want a "graphical" circle, then you can implement easily your own CircleOverlay, using the DirectedLocationOverlay as a very good starting point.
If you want a "geographical" circle (than will appear more or less as an ellipse), then you can use the OSMBonusPack Polygon, that you will define with this array of GeoPoints:
ArrayList<GeoPoint> circlePoints = new ArrayList<GeoPoint>();
iSteps = (radius * 40000)^2;
fStepSize = M_2_PI/iSteps;
for (double f = 0; f < M_2_PI; f += fStepSize){
circlePoints.add(new GeoPoint(centerLat + radius*sin(f), centerLon + radius*cos(f)));
}
(warning: I translated from a Nominatim piece of code in PHP, without testing)
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