diff --git a/examples/ARIAL.TTF b/examples/ARIAL.TTF new file mode 100644 Binary files /dev/null and b/examples/ARIAL.TTF differ diff --git a/examples/font_test.c b/examples/font_test.c new file mode 100644 --- /dev/null +++ b/examples/font_test.c @@ -0,0 +1,46 @@ +#include "SDL2/SDL.h" +#include "SDL2/SDL_video.h" +#include "SDL2/SDL_ttf.h" + +int handle_event() +{ + SDL_Event event; + while (SDL_PollEvent(&event)) { + if (event.type == SDL_QUIT) { + return -1; + } + } + return 0; +} + +int main() +{ + SDL_Init(SDL_INIT_EVERYTHING); + TTF_Init(); + + SDL_Window *window = SDL_CreateWindow("test", 100, 100, 640, 480, SDL_WINDOW_SHOWN); + SDL_Renderer *renderer = SDL_CreateRenderer(window, -1, SDL_RENDERER_ACCELERATED); + + TTF_Font *font = TTF_OpenFont("/usr/share/fonts/truetype/DroidSans.ttf", 13); + if (font == NULL) + printf("null font\n"); + + SDL_Color color = {255, 255, 255}; + SDL_Surface *textSurface = TTF_RenderText_Solid(font, "some text", color); + if (textSurface == NULL) + printf("null text surface\n"); + + SDL_Texture *textTexture = SDL_CreateTextureFromSurface(renderer, textSurface); + if (textTexture == NULL) + printf("null text texture\n"); + + SDL_Rect rect = { 0, 0, 640, 480 }; + + while (handle_event() == 0) { + SDL_RenderClear(renderer); + SDL_RenderCopy(renderer, textTexture, &rect, &rect); + SDL_RenderPresent(renderer); + } + + return 0; +} diff --git a/examples/font_test.hs b/examples/font_test.hs new file mode 100644 --- /dev/null +++ b/examples/font_test.hs @@ -0,0 +1,62 @@ +module Main where + +import qualified Graphics.UI.SDL.TTF as TTF +import qualified SDL.Raw as SDL + +import Foreign.C.String (withCAString) +import Foreign (peek,alloca,with,maybePeek,nullPtr) + +arial :: String +arial = "./examples/ARIAL.TTF" + +main :: IO () +main = do + _ <- SDL.init SDL.SDL_INIT_VIDEO + window <- createWindow + renderer <- createRenderer window + + TTF.withInit $ do + font <- TTF.openFont arial 150 -- Pt size for retina screen. :< + textSurface <- TTF.renderUTF8Solid font "some text" (SDL.Color 255 255 255 0) + textTexture <- SDL.createTextureFromSurface renderer textSurface + SDL.freeSurface textSurface + loop window renderer textTexture + + TTF.closeFont font + SDL.destroyRenderer renderer + SDL.destroyWindow window + SDL.quit + +createRenderer :: SDL.Window -> IO (SDL.Renderer) +createRenderer w = SDL.createRenderer w (-1) 0 + +createWindow :: IO (SDL.Window) +createWindow = withCAString "test" $ \t -> + SDL.createWindow t + SDL.SDL_WINDOWPOS_UNDEFINED + SDL.SDL_WINDOWPOS_UNDEFINED + 640 480 + SDL.SDL_WINDOW_SHOWN + +loop :: t -> SDL.Renderer -> SDL.Texture -> IO () +loop window renderer textTexture = do + let loc = SDL.Rect 320 240 150 100 + _ <- SDL.renderClear renderer + _ <- with loc $ \loc' -> + SDL.renderCopy renderer textTexture nullPtr loc' + SDL.renderPresent renderer + handleEvents window renderer textTexture + +pollEvent :: IO (Maybe SDL.Event) +pollEvent = alloca $ \ptr -> do + status <- SDL.pollEvent ptr + if status == 1 + then maybePeek peek ptr + else return Nothing + +handleEvents :: t -> SDL.Renderer -> SDL.Texture -> IO () +handleEvents window renderer textTexture = do + mbEvent <- pollEvent + case mbEvent of + Just (SDL.QuitEvent _ _) -> return () + _ -> loop window renderer textTexture diff --git a/sdl2-ttf.cabal b/sdl2-ttf.cabal --- a/sdl2-ttf.cabal +++ b/sdl2-ttf.cabal @@ -1,6 +1,6 @@ -Cabal-Version: >= 1.8 +Cabal-Version: >= 1.10 Name: sdl2-ttf -Version: 0.2.1 +Version: 0.2.2 Maintainer: Sean Chalmers (sclhiannan@gmail.com) Author: Ömer Sinan Ağacan (omeragacan@gmail.com) License-File: LICENSE @@ -11,26 +11,29 @@ Description: Haskell bindings to the sdl2-ttf C++ library . Data-files: extra-source-files: cbits/rendering.h + examples/ARIAL.TTF + examples/font_test.c Library - Hs-source-dirs: src - Build-Depends: base >= 3 && < 5, sdl2 - Extensions: ForeignFunctionInterface - Exposed-Modules: Graphics.UI.SDL.TTF.Types, - Graphics.UI.SDL.TTF.FFI - Graphics.UI.SDL.TTF - GHC-Options: -Wall - include-dirs: cbits - C-sources: cbits/rendering.c - extra-libraries: SDL2, SDL2_ttf + Hs-source-dirs: src + Build-Depends: base >= 3 && < 5, sdl2 + default-extensions: ForeignFunctionInterface + Exposed-Modules: Graphics.UI.SDL.TTF.Types, + Graphics.UI.SDL.TTF.FFI + Graphics.UI.SDL.TTF + GHC-Options: -Wall + include-dirs: cbits + C-sources: cbits/rendering.c + extra-libraries: SDL2, SDL2_ttf + default-language: Haskell2010 -test-suite test - type: exitcode-stdio-1.0 +executable font-test main-is: font_test.hs - hs-source-dirs: test + hs-source-dirs: examples build-depends: base >= 3 && <5, sdl2, sdl2-ttf GHC-Options: -Wall - + default-language: Haskell2010 + source-repository head type: git location: https://github.com/mankyKitty/sdl2-ttf diff --git a/src/Graphics/UI/SDL/TTF.hsc b/src/Graphics/UI/SDL/TTF.hsc --- a/src/Graphics/UI/SDL/TTF.hsc +++ b/src/Graphics/UI/SDL/TTF.hsc @@ -38,7 +38,7 @@ import qualified Graphics.UI.SDL.TTF.FFI as FFI import Graphics.UI.SDL.TTF.Types -import Graphics.UI.SDL.Types +import SDL.Raw.Types import Prelude hiding (init) diff --git a/src/Graphics/UI/SDL/TTF/FFI.hsc b/src/Graphics/UI/SDL/TTF/FFI.hsc --- a/src/Graphics/UI/SDL/TTF/FFI.hsc +++ b/src/Graphics/UI/SDL/TTF/FFI.hsc @@ -4,8 +4,8 @@ import Foreign.C import Foreign.Ptr -import qualified Graphics.UI.SDL.Types as SDL -import Graphics.UI.SDL.Types (Color) +import qualified SDL.Raw.Types as SDL +import SDL.Raw.Types (Color) type TTFFont = Ptr () diff --git a/test/font_test.hs b/test/font_test.hs deleted file mode 100644 --- a/test/font_test.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Main where - -import qualified Graphics.UI.SDL.TTF as TTF -import qualified Graphics.UI.SDL as SDL - -import Foreign.C.String (withCAString) -import Foreign (peek,alloca,with,maybePeek,nullPtr) - -arial :: String -arial = "./test/ARIAL.TTF" - -main :: IO () -main = do - _ <- SDL.init SDL.SDL_INIT_VIDEO - window <- createWindow - renderer <- createRenderer window - - TTF.withInit $ do - font <- TTF.openFont arial 150 -- Pt size for retina screen. :< - textSurface <- TTF.renderUTF8Solid font "some text" (SDL.Color 255 255 255 0) - textTexture <- SDL.createTextureFromSurface renderer textSurface - SDL.freeSurface textSurface - loop window renderer textTexture - - TTF.closeFont font - SDL.destroyRenderer renderer - SDL.destroyWindow window - SDL.quit - -createRenderer :: SDL.Window -> IO (SDL.Renderer) -createRenderer w = SDL.createRenderer w (-1) 0 - -createWindow :: IO (SDL.Window) -createWindow = withCAString "test" $ \t -> - SDL.createWindow t - SDL.SDL_WINDOWPOS_UNDEFINED - SDL.SDL_WINDOWPOS_UNDEFINED - 640 480 - SDL.SDL_WINDOW_SHOWN - -loop :: t -> SDL.Renderer -> SDL.Texture -> IO () -loop window renderer textTexture = do - let loc = SDL.Rect 320 240 150 100 - _ <- SDL.renderClear renderer - _ <- with loc $ \loc' -> - SDL.renderCopy renderer textTexture nullPtr loc' - SDL.renderPresent renderer - - handleEvents window renderer textTexture - -pollEvent :: IO (Maybe SDL.Event) -pollEvent = alloca $ \ptr -> do - status <- SDL.pollEvent ptr - if status == 1 - then maybePeek peek ptr - else return Nothing - -handleEvents :: t -> SDL.Renderer -> SDL.Texture -> IO () -handleEvents window renderer textTexture = do - mbEvent <- pollEvent - case mbEvent of - Just (SDL.QuitEvent _ _) -> return () - _ -> loop window renderer textTexture - -