mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
Basic support for font rendering (more to come).
This commit is contained in:
parent
35719a3d55
commit
99132e3926
@ -53,3 +53,5 @@
|
||||
|
||||
(defn min [a b]
|
||||
(if (< a b) a b))
|
||||
|
||||
(defn id [x] x)
|
||||
|
@ -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;
|
||||
}
|
||||
|
28
core/SDL_ttf.carp
Normal file
28
core/SDL_ttf.carp
Normal file
@ -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")
|
||||
|
||||
)
|
@ -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")
|
||||
|
27
examples/fonts.carp
Normal file
27
examples/fonts.carp
Normal file
@ -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)))
|
@ -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))
|
||||
|
BIN
resources/Hasklig.otf
Normal file
BIN
resources/Hasklig.otf
Normal file
Binary file not shown.
Loading…
Reference in New Issue
Block a user