diff --git a/core/Interfaces.carp b/core/Interfaces.carp index c3cf7bbc..52cbca34 100644 --- a/core/Interfaces.carp +++ b/core/Interfaces.carp @@ -53,3 +53,5 @@ (defn min [a b] (if (< a b) a b)) + +(defn id [x] x) diff --git a/core/SDLHelper.h b/core/SDLHelper.h index 7af15c5c..d4a95629 100644 --- a/core/SDLHelper.h +++ b/core/SDLHelper.h @@ -52,3 +52,12 @@ SDL_Point SDL_point(int x, int y) { p.y = y; return p; } + +SDL_Color SDL_color(int r, int g, int b) { + SDL_Color p; + p.r = r; + p.g = g; + p.b = b; + p.a = 255; + return p; +} diff --git a/core/SDL_ttf.carp b/core/SDL_ttf.carp new file mode 100644 index 00000000..2f3d8761 --- /dev/null +++ b/core/SDL_ttf.carp @@ -0,0 +1,28 @@ +(system-include "SDL2/SDL_ttf.h") +(add-lib "-lSDL2_ttf") +(Project.config "cflag" "-Wno-incompatible-pointer-types-discards-qualifiers") + +(register-type TTF_Font) + +(defmodule TTF + (register init (Fn [] Int) "TTF_Init") + (register quit (Fn [] ()) "TTF_Quit") + (register get-error (Fn [] (Ptr Char)) "TTF_GetError") + + ;; Loading / unloading + (register open-font (Fn [(Ptr Char) Int] (Ptr TTF_Font)) "TTF_OpenFont") + (register close-font (Fn [(Ptr TTF_Font)] ()) "TTF_CloseFont") + + ;; Styles + ;; int TTF_GetFontStyle(TTF_Font *font) + ;; void TTF_SetFontStyle(TTF_Font *font, int style) + ;; TTF_STYLE_BOLD + ;; TTF_STYLE_ITALIC + ;; TTF_STYLE_UNDERLINE + ;; TTF_STYLE_STRIKETHROUGH + + ;; Render + ;; SDL_Surface *TTF_RenderText_Solid(TTF_Font *font, const char *text, SDL_Color fg) + (register render-text-solid (Fn [(Ptr TTF_Font) (Ptr Char) SDL_Color] (Ptr SDL_Surface)) "TTF_RenderText_Solid") + + ) diff --git a/core/sdl.carp b/core/sdl.carp index 99231aa1..9e42f362 100644 --- a/core/sdl.carp +++ b/core/sdl.carp @@ -14,6 +14,7 @@ (register-type SDL_BlendMode) (register-type SDL_RendererFlip) (register-type SDL_Window) +(register-type SDL_Color) (defmodule SDL ;; Setup and teardown @@ -39,10 +40,6 @@ (register mouse-button-up SDL_EventType "SDL_MOUSEBUTTONUP") (register mouse-wheel SDL_EventType "SDL_MOUSEWHEEL")) - ;; Helpers (not part of SDL) - (register rect (Fn [Int Int Int Int] SDL_Rect)) ;; x y w h - (register point (Fn [Int Int] SDL_Point)) ;; x y - ;; Rendering (register render-present (Fn [(Ptr SDL_Renderer)] ()) "SDL_RenderPresent") (register render-clear (Fn [(Ptr SDL_Renderer)] ()) "SDL_RenderClear") @@ -57,6 +54,17 @@ (register set-render-draw-blend-mode (Fn [(Ptr SDL_Renderer) SDL_BlendMode] ()) "SDL_SetRenderDrawBlendMode") (register blit-surface (Fn [(Ptr SDL_Surface) (Ptr SDL_Rect) (Ptr SDL_Surface) (Ptr SDL_Rect)] ()) "SDL_BlitSurface") ;; src, srcrect, dst, dstrect (register query-texture (Fn [(Ptr SDL_Texture) (Ptr Int) (Ptr Int) (Ptr Int) (Ptr Int)] ()) "SDL_QueryTexture") ;; ? ? w h + (register create-texture-from-surface (Fn [(Ptr SDL_Renderer) (Ptr SDL_Surface)] (Ptr SDL_Texture)) "SDL_CreateTextureFromSurface") + + ;; Helpers (not part of SDL) + (register rect (Fn [Int Int Int Int] SDL_Rect)) ;; x y w h + (register point (Fn [Int Int] SDL_Point)) ;; x y + (register color (Fn [Int Int Int] SDL_Color)) ;; x y + + (defn dimensions [texture] + (let-do [w 0 h 0] + (query-texture texture NULL NULL (address w) (address h)) ;; TODO: Can't qualify 'query-texture' ??! + (SDL.rect 0 0 w h))) ;; Blend modes (register blend-mode-none SDL_BlendMode "SDL_BLENDMODE_NONE") diff --git a/examples/fonts.carp b/examples/fonts.carp new file mode 100644 index 00000000..c9bd2306 --- /dev/null +++ b/examples/fonts.carp @@ -0,0 +1,27 @@ +(load "SDL.carp") +(load "SDL_ttf.carp") + +(def font (the (Ptr TTF_Font) NULL)) +(def texture (the (Ptr SDL_Texture) NULL)) + +(defn draw [app rend state-ref] + (do (SDL.set-render-draw-color rend 240 240 220 255) + (SDL.render-clear rend) + (SDL.render-copy rend + texture + (address (SDL.dimensions texture)) + (address (SDL.rect 100 100 300 300))) + )) + +(defn main [] + (let [app (SDLApp.create "Font Rendering with SDL_ttf" 800 600) + rend @(SDLApp.renderer &app)] + (do + (if (= 0 (TTF.init)) + (do + (set! font (TTF.open-font (cstr "resources/Hasklig.otf") 20)) + (let [surface (TTF.render-text-solid font (cstr "Carp!") (SDL.color 0 0 0))] + (set! texture (SDL.create-texture-from-surface rend surface))) + (SDLApp.run-with-callbacks &app SDLApp.default-event-handler id draw 0)) + (println* "Failed to initialize SDL_ttf: " &(str (TTF.get-error)))) + 0))) diff --git a/examples/game.carp b/examples/game.carp index e8f8231d..81fef882 100644 --- a/examples/game.carp +++ b/examples/game.carp @@ -24,13 +24,6 @@ [img1 (Ptr SDL_Texture) img2 (Ptr SDL_Texture)]) -(defn dimensions [texture] - (let [w 0 - h 0] - (do - (SDL.query-texture texture NULL NULL (address w) (address h)) - (SDL.rect 0 0 w h)))) - (def images (Images.init NULL NULL)) (defn draw [app rend state-ref] @@ -60,7 +53,7 @@ (let [img @(Images.img1 &images)] (SDL.render-copy-ex rend img - (address (dimensions img)) + (address (SDL.dimensions img)) (address (SDL.rect 100 100 300 300)) (* 0.1 (from-int (SDL.get-ticks))) (address (SDL.point 150 150)) diff --git a/resources/Hasklig.otf b/resources/Hasklig.otf new file mode 100644 index 00000000..913fb8c0 Binary files /dev/null and b/resources/Hasklig.otf differ