Basic support for font rendering (more to come).

core/Interfaces.carp

@@ -53,3 +53,5 @@
 
 (defn min [a b]
   (if (< a b) a b))
+
+(defn id [x] x)

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;
+}

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")
+
+  )

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")

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)))

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))