module Graphics.UI.LUI.Image
(
Image
,text
,textSize
,rect
,move
,crop
,cropRect
,render
) where
import qualified Graphics.UI.HaskGame as HaskGame
import qualified Graphics.UI.HaskGame.Font as Font
import qualified Graphics.UI.HaskGame.Rect as Rect
import Graphics.UI.HaskGame(Surface)
import Graphics.UI.HaskGame.Vector2(Vector2(..))
import Graphics.UI.HaskGame.Color(Color)
import Graphics.UI.HaskGame.Font(Font)
import Graphics.UI.HaskGame.Rect(Rect(..))
import Data.Monoid(Monoid(..))
type BBox = Maybe Rect
intersectBBox :: BBox -> BBox -> BBox
Nothing `intersectBBox` b2 = b2
b1 `intersectBBox` Nothing = b1
(Just r1) `intersectBBox` (Just r2) = Just $ r1 `Rect.intersect` r2
data Image = Image { imageDraw :: Surface -> Vector2 Int -> BBox -> IO () }
render :: Image -> Surface -> Vector2 Int -> IO ()
render image surface pos = imageDraw image surface pos Nothing
instance Monoid Image where
mempty = Image (const . const . const . return $ ())
Image xdraw `mappend` Image ydraw = Image draw
where
draw surface pos bbox = xdraw surface pos bbox >>
ydraw surface pos bbox
textSize :: Font -> String -> Vector2 Int
textSize = Font.textSize
cropBlit :: Surface -> Vector2 Int -> Rect -> Surface -> IO ()
cropBlit dest destPos destCropRect src =
HaskGame.blitPart dest finalTopLeft src srcRect
where
srcRect = Rect.make (finalTopLeft requestedTopLeft) (Rect.getSize finalDest)
finalTopLeft = Rect.getTopLeft finalDest
finalDest = requestedDest `Rect.intersect` destCropRect
requestedTopLeft = Rect.getTopLeft requestedDest
requestedDest = Rect.make destPos srcSize
srcSize = HaskGame.surfaceSize src
text :: Color -> Font -> String -> Image
text color font str = Image draw
where
draw surface pos bbox = do
textSurface <- Font.renderText font str color
maybe (HaskGame.blit surface pos)
(cropBlit surface pos) bbox $ textSurface
rect :: Color -> Vector2 Int -> Image
rect color size = Image draw
where
draw surface pos bbox =
let origRect = Rect.make pos size
finalRect = Rect.trunc $ maybe origRect (origRect `Rect.intersect`) bbox
in HaskGame.fillRect surface finalRect color
move :: Vector2 Int -> Image -> Image
move delta (Image xdraw) = Image draw
where
draw surface pos = xdraw surface (delta + pos)
cropRect :: Rect -> Image -> Image
cropRect r = move topLeft .
crop size .
move (topLeft)
where
(topLeft, size) = Rect.toVectors r
crop :: Vector2 Int -> Image -> Image
crop cropSize (Image xdraw) = Image draw
where
draw surface pos bbox = xdraw surface pos $
Just (Rect.make pos cropSize) `intersectBBox` bbox