Carp/examples/fonts.carp

(load "SDL.carp")
(load "SDL_ttf.carp")

(Project.config "title" "Fonts")

(def font (the (Ptr TTF_Font) NULL))
(def text1 (the (Ptr SDL_Texture) NULL))

(defn shifting-bg-color []
  (SDL.rgb (/ (SDL.get-ticks) 10) 240 220))

(defn draw [app rend state-ref]
  (do (SDL.bg rend &(shifting-bg-color))
      (let [dims (SDL.dimensions text1)]
        (SDL.draw-texture-centered rend text1 &(SDL.point 200 150)))))

(defn change-text [rend]
  (do (when (not (Pointer.eq NULL text1))
        (SDL.destroy-texture text1))
      (set! text1 (TTF.render-text-to-texture rend font &(str* "TICK: " (SDL.get-ticks)) (SDL.rgb 0 0 0)))))

(defn event-handler [app state event]
  (let [et (SDL.Event.type event)]
    (cond
      ;; Quit event
      (= et SDL.Event.quit)
      (SDLApp.stop app)

      ;; Key events
      (= et SDL.Event.key-down)
      (let [key (SDL.Event.keycode event)]
        (cond
          (= key SDL.Keycode.escape) (SDLApp.stop app)
          (= key SDL.Keycode.return) (do (change-text @(SDLApp.renderer app))
                                         state)
          state))

      ;; Other event
      state)))

(defn main []
  (let [app (SDLApp.create "Font Rendering with SDL_ttf" 400 300)
        rend @(SDLApp.renderer &app)]
    (do
      (if (TTF.ok? (TTF.init))
        (do (set! font (TTF.open-font (cstr "resources/Hasklig.otf") 20))
            (set! text1 (TTF.render-text-to-texture rend font "Carp!" (SDL.rgb 0 0 0)))
            (SDLApp.run-with-callbacks &app event-handler id draw 0))
        (println* "Failed to initialize SDL_ttf: " &(from-cstr (TTF.get-error)))))))