Address sanitizer does not complain.

core/SDLHelper.h

@@ -71,18 +71,18 @@ SDL_Color SDL_rgba(int r, int g, int b, int a) {
     return p;
 }
 
-int *SDL_Color_r(SDL_Color *col) {
-    return (int*)&col->r;
+int SDL_Color_r(SDL_Color *col) {
+    return (int)(col->r);
 }
 
-int *SDL_Color_g(SDL_Color *col) {
-    return (int*)&col->g;
+int SDL_Color_g(SDL_Color *col) {
+    return (int)(col->g);
 }
 
-int *SDL_Color_b(SDL_Color *col) {
-    return (int*)&col->b;
+int SDL_Color_b(SDL_Color *col) {
+    return (int)(col->b);
 }
 
-int *SDL_Color_a(SDL_Color *col) {
-    return (int*)&col->a;
+int SDL_Color_a(SDL_Color *col) {
+    return (int)(col->a);
 }

core/SDL_ttf.carp

@@ -38,8 +38,10 @@
   (defn ok? [error-code]
     (= 0 error-code))
 
-  (defn render-to-texture [rend font str]
-    (let [surface (render-text-blended font (cstr str) (SDL.rgb 0 0 0))]
-      (SDL.create-texture-from-surface rend surface)))
+  (defn render-text-to-texture [rend font str]
+    (let [surface (render-text-blended font (cstr str) (SDL.rgb 0 0 0))
+          texture (SDL.create-texture-from-surface rend surface)]
+      (do (SDL.free-surface surface)
+          texture)))
 
   )

core/sdl.carp

@@ -18,10 +18,10 @@
 (register-type SDL_Color)
 
 (defmodule SDL_Color
-  (register r (Fn [&SDL_Color] &Int))
-  (register g (Fn [&SDL_Color] &Int))
-  (register b (Fn [&SDL_Color] &Int))
-  (register a (Fn [&SDL_Color] &Int)))
+  (register r (Fn [&SDL_Color] Int))
+  (register g (Fn [&SDL_Color] Int))
+  (register b (Fn [&SDL_Color] Int))
+  (register a (Fn [&SDL_Color] Int)))
 
 (defmodule SDL
   ;; Setup and teardown
@@ -62,6 +62,7 @@
   (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")
+  (register free-surface (Fn [(Ptr SDL_Surface)] ()) "SDL_FreeSurface")
 
   ;; Blend modes
   (register blend-mode-none SDL_BlendMode "SDL_BLENDMODE_NONE")
@@ -138,9 +139,9 @@
   (defn-do bg [rend color]
     (with Int
           (set-render-draw-color rend
-                                 @(SDL_Color.r color)
-                                 @(SDL_Color.g color)
-                                 @(SDL_Color.b color)
+                                 (SDL_Color.r color)
+                                 (SDL_Color.g color)
+                                 (SDL_Color.b color)
                                  255))
     (render-clear rend))
 

examples/fonts.carp

@@ -1,6 +1,9 @@
 (load "SDL.carp")
 (load "SDL_ttf.carp")
 
+(Debug.sanitize-addresses)
+
+(def font (the (Ptr TTF_Font) NULL))
 (def text1 (the (Ptr SDL_Texture) NULL))
 
 (defn shifting-bg-color []
@@ -12,13 +15,33 @@
             point (SDL.point (- 200 (/ @(SDL_Rect.w &dims) 2)) (- 150 @(SDL_Rect.h &dims)))]
         (SDL.draw-texture-at rend text1 &point))))
 
+(defn change-text [rend]
+  (do (when (not (Pointer.eq NULL text1))
+        (do
+          (IO.println "Destroy texture.")
+          (SDL.destroy-texture text1)))
+      (set! text1 (TTF.render-text-to-texture rend font &(str* "TICK: " (SDL.get-ticks))))
+      ()))
+
+(defn event-handler [app]
+    (let [event (SDL.Event.init)]
+      (while (SDL.Event.poll (address event))
+        (let [et (SDL.Event.type &event)]
+          (cond (= et SDL.Event.quit) (SDLApp.stop app)
+                (= et SDL.Event.key-down) (let [key (SDL.Event.keycode &event)]
+                                            (cond
+                                              (= key SDL.key-escape) (SDLApp.stop app)
+                                              (= key SDL.key-return) (change-text @(SDLApp.renderer app))
+                                              ()))
+                ())))))
+
 (defn main []
   (let [app (SDLApp.create "Font Rendering with SDL_ttf" 400 300)
         rend @(SDLApp.renderer &app)]
     (do
       (if (TTF.ok? (TTF.init))
-        (let-do [font (TTF.open-font (cstr "resources/Hasklig.otf") 20)]
-          (set! text1 (TTF.render-to-texture rend font "Carp!"))
-          (SDLApp.run-with-callbacks &app SDLApp.default-event-handler id draw 0))
+        (do (set! font (TTF.open-font (cstr "resources/Hasklig.otf") 20))
+            (set! text1 (TTF.render-text-to-texture rend font "Carp!"))
+            (SDLApp.run-with-callbacks &app event-handler id draw 0))
         (println* "Failed to initialize SDL_ttf: " &(str (TTF.get-error))))
       0)))

src/StartingEnv.hs

@@ -56,7 +56,7 @@ arrayModule = Env { envBindings = bindings, envParent = Nothing, envModuleName =
 -- | The Pointer module contains functions for dealing with pointers.
 pointerModule :: Env
 pointerModule = Env { envBindings = bindings, envParent = Nothing, envModuleName = Just "Pointer", envUseModules = [], envMode = ExternalEnv }
-  where bindings = Map.fromList [ templatePointerCopy ]
+  where bindings = Map.fromList [ templatePointerCopy, templatePointerEqual ]
 
 -- | A template function for copying (= deref:ing) any pointer.
 templatePointerCopy :: (String, Binder)
@@ -69,6 +69,16 @@ templatePointerCopy = defineTemplate
                         ,"}"])
   (const [])
 
+templatePointerEqual = defineTemplate
+  (SymPath ["Pointer"] "eq")
+  (FuncTy [(PointerTy (VarTy "p")), (PointerTy (VarTy "p"))] BoolTy)
+  (toTemplate "bool $NAME ($p *p1, $p *p2)")
+  (toTemplate $ unlines ["$DECL {"
+                        ,"    return p1 == p2;"
+                        ,"}"])
+  (const [])
+
+
 -- | The System module contains functions for various OS related things like timing and process control.
 systemModule :: Env
 systemModule = Env { envBindings = bindings, envParent = Nothing, envModuleName = Just "System", envUseModules = [], envMode = ExternalEnv }