├── .gitignore ├── src ├── spec │ └── SDL_ttf.h ├── library.lisp ├── package.lisp ├── autowrap.lisp ├── conditions.lisp ├── size.lisp ├── helpers.lisp ├── style.lisp ├── general.lisp └── render.lisp ├── .gitattributes ├── examples ├── PROBE_10PX_OTF.otf ├── package.lisp ├── texture-fragment-shader.glsl ├── texture-vertex-shader.glsl ├── basic.lisp └── gl-example.lisp ├── sdl2-ttf-examples.asd ├── sdl2-ttf.asd └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | -------------------------------------------------------------------------------- /src/spec/SDL_ttf.h: -------------------------------------------------------------------------------- 1 | #include 2 | -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | /src/spec/*.spec linguist-generated=true 2 | -------------------------------------------------------------------------------- /examples/PROBE_10PX_OTF.otf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Failproofshark/cl-sdl2-ttf/HEAD/examples/PROBE_10PX_OTF.otf -------------------------------------------------------------------------------- /examples/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | 3 | (defpackage :ttf-examples 4 | (:use #:cl 5 | #:alexandria 6 | #:tg 7 | #:cffi 8 | #:sdl2) 9 | (:export :basic-example 10 | :gl-example)) 11 | -------------------------------------------------------------------------------- /src/library.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sdl2-ttf) 2 | 3 | (cffi:define-foreign-library libsdl2-ttf 4 | (:darwin (:or (:framework "SDL2_ttf") (:default "libSDL2_ttf"))) 5 | (:unix (:or "libSDL2_ttf-2.0.so.0" "libSDL2_ttf")) 6 | (:windows "SDL2_ttf.dll")) 7 | 8 | (cffi:use-foreign-library libsdl2-ttf) 9 | -------------------------------------------------------------------------------- /examples/texture-fragment-shader.glsl: -------------------------------------------------------------------------------- 1 | #version 150 2 | 3 | in vec2 tex_output; 4 | in vec3 color_output; 5 | 6 | out vec4 final_color; 7 | 8 | /* We are using the default texture unit since we only have one texture */ 9 | uniform sampler2D tex; 10 | 11 | void main() 12 | { 13 | final_color = texture(tex, tex_output) * vec4(color_output, 1.0); 14 | } 15 | -------------------------------------------------------------------------------- /examples/texture-vertex-shader.glsl: -------------------------------------------------------------------------------- 1 | #version 150 2 | in vec2 position; 3 | in vec2 tex_coord; 4 | 5 | in vec3 input_color; 6 | 7 | out vec3 color_output; 8 | out vec2 tex_output; 9 | 10 | uniform mat4 mvp; 11 | 12 | void main() 13 | { 14 | tex_output = tex_coord; 15 | color_output = input_color; 16 | gl_Position = mvp * vec4(position, 0.0, 1.0); 17 | } 18 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (uiop:define-package :sdl2-ttf 3 | (:use #:cl 4 | #:alexandria 5 | #:autowrap.minimal 6 | #:plus-c 7 | #:sdl2-ffi.functions) 8 | (:export #:init 9 | #:linked-version 10 | #:was-init 11 | #:quit 12 | #:open-font 13 | #:close-font 14 | #:bold #:italic #:underline #:strike-through)) 15 | -------------------------------------------------------------------------------- /sdl2-ttf-examples.asd: -------------------------------------------------------------------------------- 1 | (defpackage :sdl2-ttf-examples.asdf 2 | (:use #:cl 3 | #:asdf)) 4 | 5 | (in-package :sdl2-ttf-examples.asdf) 6 | 7 | (defsystem :sdl2-ttf-examples 8 | :description "A few examples" 9 | :author "Bryan Baraoidan" 10 | :license "MIT" 11 | :version "1.0" 12 | :depends-on (:alexandria :sdl2 :sdl2-ttf :cl-opengl :mathkit) 13 | :pathname "examples" 14 | :components ((:file "package") 15 | (:file "basic" :depends-on ("package")) 16 | (:file "gl-example" :depends-on ("package")))) 17 | -------------------------------------------------------------------------------- /src/autowrap.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sdl2-ffi) 2 | 3 | (autowrap:c-include '(sdl2-ttf autowrap-spec "SDL2_ttf.h") 4 | :function-package :sdl2-ffi.functions 5 | :spec-path '(sdl2-ttf autowrap-spec) 6 | :exclude-sources ("/usr/include/") 7 | :include-sources ("SDL_ttf.h") 8 | :symbol-exceptions (("SDL_RWops" . "SDL-RWOPS")) 9 | :exclude-constants ("^+__") 10 | :exclude-definitions ("_inline$" 11 | "^_mm_" 12 | "^__" 13 | "va_list" 14 | "_gnuc_va_list") 15 | ;;We're mostly dealing with SDL-surface which contains accessors in the main cl-sdl2 library 16 | :no-accessors cl:t 17 | :release-p cl:t) 18 | -------------------------------------------------------------------------------- /sdl2-ttf.asd: -------------------------------------------------------------------------------- 1 | (defpackage :sdl2-ttf.asdf 2 | (:use #:cl #:asdf)) 3 | 4 | (in-package :sdl2-ttf.asdf) 5 | 6 | (defsystem :sdl2-ttf 7 | :description "Bindings for sdl2_ttf using autowrap" 8 | :author "Bryan Baraoidan" 9 | :license "MIT" 10 | :version "1.0" 11 | :depends-on (:alexandria :defpackage-plus :cl-autowrap :sdl2 :cffi-libffi :trivial-garbage) 12 | :pathname "src" 13 | :serial t 14 | :components ((:file "package") 15 | (:file "library") 16 | (:file "autowrap") 17 | (:file "helpers") 18 | (:file "conditions") 19 | (:file "render") 20 | (:file "size") 21 | (:file "general") 22 | (:file "style") 23 | (:module autowrap-spec 24 | :pathname "spec" 25 | :components ((:static-file "SDL2_ttf.h"))))) 26 | -------------------------------------------------------------------------------- /src/conditions.lisp: -------------------------------------------------------------------------------- 1 | ;;; This file is adapted from almostly completely verbatim from cl-sdl2-mixer as I needed the same functionality for font loading, originally written by the lispgames group (https://github.com/lispgames) 2 | (in-package :sdl2-ttf) 3 | 4 | (define-condition sdl-ttf-error (sdl2::sdl-rc-error) ()) 5 | 6 | (defmacro check-rc (form) 7 | (with-gensyms (rc) 8 | `(let ((,rc ,form)) 9 | (when (< ,rc 0) 10 | (error 'sdl-ttf-error :rc ,rc :string (sdl-get-error))) 11 | ,rc))) 12 | 13 | (defmacro check-non-zero (form) 14 | (with-gensyms (rc) 15 | `(let ((,rc ,form)) 16 | (unless (/= ,rc 0) 17 | (error 'sdl-ttf-error :rc ,rc :string (sdl-get-error))) 18 | ,rc))) 19 | 20 | (defmacro check-true (form) 21 | (with-gensyms (rc) 22 | `(let ((,rc ,form)) 23 | (unless (sdl-true-p ,rc) 24 | (error 'sdl-ttf-error :rc ,rc :string (sdl-get-error))) 25 | ,rc))) 26 | 27 | (defmacro check-null (form) 28 | (with-gensyms (wrapper) 29 | `(let ((,wrapper ,form)) 30 | (if (cffi:null-pointer-p (autowrap:ptr ,wrapper)) 31 | (error 'sdl-ttf-error :rc ,wrapper :string (sdl-get-error)) 32 | ,wrapper)))) 33 | -------------------------------------------------------------------------------- /src/size.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sdl2-ttf) 2 | 3 | (defmacro define-size-function (encoding) 4 | (let* ((foreign-function-name (format 'nil "TTF_Size~a" encoding)) 5 | (wrapper-function-name (function-symbol "size-" encoding)) 6 | (low-level-lisp-name (function-symbol "%sdl-" wrapper-function-name))) 7 | `(define-function ,foreign-function-name ,wrapper-function-name ,low-level-lisp-name 8 | :int 9 | ((font :pointer) (text :string) (x :pointer) (y :pointer)) 10 | (font text) 11 | ;;TODO Is it there any better way than allocating memory to reference a pointer? 12 | "Calculate the resulting surface size, returns (values width height)." 13 | (let ((data (cffi:foreign-alloc :int :count 2))) 14 | (check-rc (,low-level-lisp-name (autowrap:ptr font) 15 | text 16 | data 17 | (cffi:inc-pointer data 4))) ; 4 is sizeof(int) 18 | (let ((x (cffi:mem-aref data :int 0)) 19 | (y (cffi:mem-aref data :int 1))) 20 | (cffi:foreign-free data) 21 | (values x y)))))) 22 | 23 | (define-size-function "Text") 24 | (define-size-function "UTF8") 25 | (define-size-function "UNICODE") 26 | -------------------------------------------------------------------------------- /src/helpers.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sdl2-ttf) 2 | 3 | (defun function-symbol (&rest strings) 4 | (values (intern (string-upcase (apply #'concatenate 5 | (cons 'string (mapcar #'string strings))))))) 6 | 7 | (defmacro define-function (foreign-name wrapper-name low-level-name 8 | cffi-return cffi-arguments lisp-arguments &body body) 9 | `(progn 10 | (cffi:defcfun (,foreign-name ,low-level-name) 11 | ,cffi-return 12 | ,@cffi-arguments) 13 | (defun ,wrapper-name ,lisp-arguments 14 | ,@body) 15 | (export ',wrapper-name))) 16 | 17 | (defmacro unpack-bitwise (bitwise &body pairs) 18 | (let ((pack (gensym "PACK")) 19 | (value (gensym "VALUE"))) 20 | `(let ((,pack nil) (,value ,bitwise)) 21 | ,@(mapcar (lambda (pair) 22 | `(when (plusp (logand ,(first pair) ,value)) 23 | (push ',(second pair) ,pack))) 24 | (nreverse pairs)) 25 | ,pack))) 26 | 27 | (defmacro pack-to-bitwise (packed &body pairs) 28 | (let ((bitwise (gensym "BITWISE")) 29 | (value (gensym "VALUE"))) 30 | `(let ((,bitwise 0)) 31 | (dolist (,value ,packed) 32 | (case ,value 33 | ,@(mapcar (lambda (pair) 34 | `(,(second pair) (incf ,bitwise ,(first pair)))) 35 | pairs) 36 | (otherwise "Unknown symbol."))) ; Improve this message 37 | ,bitwise))) 38 | -------------------------------------------------------------------------------- /src/style.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sdl2-ttf) 2 | 3 | (defconstant +style-bold+ #x1) 4 | (defconstant +style-italic+ #x2) 5 | (defconstant +style-underline+ #x4) 6 | (defconstant +style-strike-through+ #x8) 7 | 8 | (defmacro define-function-get-style (foreign-name wrapper-name low-level-name) 9 | `(define-function ,foreign-name ,wrapper-name ,low-level-name 10 | :int ((font :pointer)) (font) 11 | (unpack-bitwise (,low-level-name (autowrap:ptr font)) 12 | (+style-bold+ bold) 13 | (+style-italic+ italic) 14 | (+style-underline+ underline) 15 | (+style-strike-through+ strike-through)))) 16 | 17 | (defmacro define-function-set-style (foreign-name wrapper-name low-level-name) 18 | `(define-function ,foreign-name ,wrapper-name ,low-level-name 19 | :void ((font :pointer) (style :int)) (font style) 20 | (,low-level-name (autowrap:ptr font) 21 | (pack-to-bitwise style 22 | (+style-bold+ bold) 23 | (+style-italic+ italic) 24 | (+style-underline+ underline) 25 | (+style-strike-through+ strike-through))) 26 | style)) 27 | 28 | (define-function-get-style "TTF_GetFontStyle" font-style %sdl2-ttf-get-font-style) 29 | (define-function-get-style "TTF_GetFontOutline" font-outline %sdl2-ttf-get-font-outline) 30 | 31 | (define-function-set-style "TTF_SetFontStyle" set-font-style %sdl2-ttf-set-font) 32 | (define-function-set-style "TTF_SetFontOutline" set-font-outline %sdl2-ttf-set-font-outline) 33 | 34 | (defsetf font-style set-font-style) 35 | (defsetf font-outline set-font-outline) 36 | -------------------------------------------------------------------------------- /src/general.lisp: -------------------------------------------------------------------------------- 1 | (in-package :sdl2-ttf) 2 | 3 | (require 'sdl2) 4 | 5 | (defvar *fonts* (list) "List of weak refs to fonts.") 6 | 7 | (defun init () 8 | "Initialize the sdl trutype font API. Does not require a call to sdl-init prior to calling this function. Returns 0 if succesful -1 otherwise" 9 | (check-rc (ttf-init))) 10 | 11 | (defun linked-version () 12 | "Returns the linked version Major Minor and Patch. Useful for debugging" 13 | (c-let ((version sdl2-ffi:sdl-version :from (ttf-linked-version))) 14 | (values (version :major) (version :minor) (version :patch)))) 15 | 16 | (defun was-init () 17 | "Returns 1 if initialized zero otherwise." 18 | (ttf-was-init)) 19 | 20 | (defun quit () 21 | (dolist (pointer *fonts*) 22 | (let ((ttf-font-struct (tg:weak-pointer-value pointer))) 23 | (when ttf-font-struct (close-font ttf-font-struct)))) 24 | (ttf-quit)) 25 | 26 | (defun open-font (path-to-font point-size) 27 | "Open a font specified by the path specifier path-to-font sized to integer point-size (based on 72DPI). Returns a ttf-font struct and null on errors" 28 | (let ((font (autocollect (ptr) 29 | (check-null (ttf-open-font (namestring path-to-font) point-size)) 30 | (ttf-close-font ptr)))) 31 | (push (tg:make-weak-pointer font) *fonts*) 32 | font)) 33 | 34 | (defun close-font (ttf-font-struct) 35 | "Frees the memory used by the ttf-font-struct" 36 | (tg:cancel-finalization ttf-font-struct) 37 | (setf *fonts* 38 | (remove ttf-font-struct *fonts* 39 | :key #'tg:weak-pointer-value 40 | :test #'(lambda (l r) 41 | (cffi:pointer-eq (autowrap:ptr l) (autowrap:ptr r))))) 42 | (ttf-close-font ttf-font-struct) 43 | (autowrap:invalidate ttf-font-struct)) 44 | -------------------------------------------------------------------------------- /examples/basic.lisp: -------------------------------------------------------------------------------- 1 | (in-package :ttf-examples) 2 | 3 | (require 'sdl2-ttf) 4 | 5 | (defun basic-example () 6 | (with-init (:everything) 7 | ;;Technically speaking sdl2-ttf can be initialized without sdl2 8 | (sdl2-ttf:init) 9 | (with-window (the-window :title "Basic Font Example" :w 300 :h 300 :flags '(:shown)) 10 | (with-renderer (my-renderer the-window :flags '(:accelerated)) 11 | (let* ((font (sdl2-ttf:open-font (asdf:system-relative-pathname 'sdl2-ttf-examples "examples/PROBE_10PX_OTF.otf") 10)) 12 | (hello-text (let* ((surface (sdl2-ttf:render-text-solid font 13 | "hello world" 14 | 255 15 | 255 16 | 255 17 | 0)) 18 | (texture (create-texture-from-surface my-renderer 19 | surface))) 20 | (free-surface surface) 21 | texture)) 22 | (destination-rect (make-rect (round (- 150 (/ (texture-width hello-text) 2.0))) 23 | (round (- 150 (/ (texture-height hello-text) 2.0))) 24 | (texture-width hello-text) 25 | (texture-height hello-text)))) 26 | (flet ((text-renderer (renderer) 27 | (render-copy renderer 28 | hello-text 29 | :source-rect (cffi:null-pointer) 30 | :dest-rect destination-rect)) 31 | (clear-renderer (renderer) 32 | (set-render-draw-color renderer 0 0 0 255) 33 | (render-clear renderer))) 34 | (with-event-loop (:method :poll) 35 | (:idle () 36 | (clear-renderer my-renderer) 37 | (text-renderer my-renderer) 38 | (render-present my-renderer)) 39 | (:quit () 40 | (when (> (sdl2-ttf:was-init) 0) 41 | (sdl2-ttf:close-font font) 42 | (destroy-texture hello-text) 43 | (sdl2-ttf:quit)) 44 | t)))))))) 45 | -------------------------------------------------------------------------------- /src/render.lisp: -------------------------------------------------------------------------------- 1 | ;;This file contains function definitions that could not be correctly wrapped by cl-autowrap 2 | ;;(mainly due to no support for pass by value as of writing 6-22-2015) 3 | 4 | (in-package :sdl2-ttf) 5 | 6 | (cffi:defcstruct (sdl-color) 7 | (r :uint8) 8 | (g :uint8) 9 | (b :uint8) 10 | (a :uint8)) 11 | 12 | (defun create-sdl-color-list (red green blue alpha) 13 | `(r ,red 14 | g ,green 15 | b ,blue 16 | a ,alpha)) 17 | 18 | (defmacro define-render-function (style encoding) 19 | (let* ((foreign-function-name (format 'nil "TTF_Render~a_~a" encoding style)) 20 | (wrapper-function-name (function-symbol "render-" encoding "-" style)) 21 | (low-level-lisp-name (function-symbol "%sdl-" wrapper-function-name))) 22 | `(define-function ,foreign-function-name ,wrapper-function-name ,low-level-lisp-name 23 | :pointer 24 | ((font :pointer) (text :string) (color (:struct sdl-color))) 25 | (font text red green blue alpha) 26 | (autocollect (ptr) 27 | ;;We need to wrap this manually since we are providing the function ourselves 28 | (check-null (sdl2-ffi::make-sdl-surface 29 | :ptr (,low-level-lisp-name (autowrap:ptr font) 30 | text 31 | (create-sdl-color-list red 32 | green 33 | blue 34 | alpha)))) 35 | (sdl-free-surface ptr))))) 36 | 37 | ;;Shaded functions require a separate macro because issue #2 (bg and fg colors) 38 | ;;There is some repeated code here 39 | (defmacro define-shaded-render-function (encoding) 40 | (let* ((style "Shaded") 41 | (foreign-function-name (format 'nil "TTF_Render~a_~a" encoding style)) 42 | (wrapper-function-name (function-symbol "render-" encoding "-" style)) 43 | (low-level-lisp-name (function-symbol "%sdl-" wrapper-function-name))) 44 | `(define-function ,foreign-function-name ,wrapper-function-name ,low-level-lisp-name 45 | :pointer 46 | ((font :pointer) (text :string) (fg (:struct sdl-color)) (bg (:struct sdl-color))) 47 | (font text fg-red fg-green fg-blue fg-alpha bg-red bg-green bg-blue bg-alpha) 48 | (autocollect (ptr) 49 | (check-null (sdl2-ffi::make-sdl-surface 50 | :ptr (,low-level-lisp-name (autowrap:ptr font) 51 | text 52 | (create-sdl-color-list fg-red 53 | fg-green 54 | fg-blue 55 | fg-alpha) 56 | (create-sdl-color-list bg-red 57 | bg-green 58 | bg-blue 59 | bg-alpha)))) 60 | (sdl-free-surface ptr))))) 61 | 62 | (define-render-function "Solid" "Text") 63 | (define-render-function "Solid" "UTF8") 64 | (define-render-function "Solid" "UNICODE") 65 | (define-render-function "Solid" "Glyph") 66 | 67 | (define-render-function "Blended" "UTF8") 68 | (define-render-function "Blended" "Text") 69 | (define-render-function "Blended" "UNICODE") 70 | (define-render-function "Blended" "Glyph") 71 | 72 | (define-shaded-render-function "Text") 73 | (define-shaded-render-function "UTF8") 74 | (define-shaded-render-function "UNICODE") 75 | (define-shaded-render-function "Glyph") 76 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # CL-SDL2-TTF 2 | 3 | This is a wrapper for the SDL2_TTF library used for loading fonts and creating text assets. The library, in it's current state, can load TTF and OTF fonts and render fonts with the [three different rendering modes](https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC42) provided by the C library (solid, shaded, and blended). While Latin text, UTF8, UNICODE, and Glyph text rendering is available only Latin text has been tested (as shown in the examples). Functions dealing with font/text attributes (e.g. querying font size, font outline, font style) are not provided yet however, if you do need them leave an issue, or if you're feeling generous, feel free to help out and send a pull request. 4 | 5 | ## Usage 6 | ### Management Functions 7 | * `(sdl2-ttf:init)`: Initializes the SDL TTF module. While this needs to be called prior to any subsequent SDL TTF function calls, (with the exception of was-init or linked-version), it does *not* require the main SDL library to be initialized first. Calls [TTF_Init](https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC6) 8 | * `(sdl2-ttf:was-init)`: Returns 1 if initialized zero otherwise. Calls [TTF_WasInit](https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC9) 9 | * `(sdl2-ttf:linked-version)`: Returns the linked version Major Minor and Patch. Useful for debugging. Calls [TTF_Linked_Version](https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC7) 10 | * `(sdl2-ttf:quit)`: Cleans up the TTF API. Calls [TTF_Quit](https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC10) 11 | * `(sdl2-ttf:open-font path-to-font point-size)`: Open a font specified by the path specifier path-to-font sized to integer point-size (based on 72DPI). Returns a ttf-font struct and null on errors. Calls [TTF_OpenFont](https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC14) 12 | * `(sdl2-ttf:close-font ttf-font-struct)`: Frees the memory associated with a given font struct. Calls [TTF_CloseFont](https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC18) 13 | 14 | ### Rendering functions. 15 | 16 | #### How SDL TTF renders fonts 17 | Text is rendered by calling one of 12 methods, each one specifying a type of text 18 | 19 | * Text which refers to LATIN1 encoding 20 | * UTF8 which refers to UTF8 encoding 21 | * UNICODE which refers to unicode encoding (text) 22 | * Glyph, which is unicode encoding (glyphs) 23 | 24 | as well as specfying one rendering method 25 | 26 | * Solid 27 | * Shaded 28 | * Blended 29 | 30 | For example, solid LATIN1 text is `TTF_RenderText_Solid`, while blended UTF8 text is `TTF_RenderUTF8_Blended`. This library follows a more traditional Lisp function name structure and omits the TTF before every function. So the above two functions are `render-text-solid` and `render-utf8-blended` respectively. Each method takes the font, created with `open-font`, the text should be rendered in, the text to be rendered, and the red, green blue and alpha components of the color to render in. More in-depth coverage about the rendering methods and the functions themselves are detailed [here](https://www.libsdl.org/projects/SDL_ttf/docs/SDL_ttf.html#SEC42). Below is a list of functions provided by the wrapper 31 | 32 | * render-text-solid 33 | * render-utf8-solid 34 | * render-unicode-solid 35 | * render-glyph-solid 36 | * render-text-shaded 37 | * render-utf8-shaded 38 | * render-unicode-shaded 39 | * render-glyph-shaded 40 | * render-text-blended 41 | * render-utf8-blended 42 | * render-unicode-blended 43 | * render-glyph-blended 44 | 45 | #### Usage with Open GL 46 | Each of the rendering functions returns a surface, however the only one useful for rendering in Open GL are the blended methods, as they produce an ARGB surface. Solid and blended provide a rather strange RGB formatted surface that does something with the alpha you pass in during the rendering call, which does some calculation that my lead to unexpected behavior (if you find otherwise please, let me know). Once you have obtained a surface simply use `surface-pixels` to obtain the raw pixel data to texture your surface. Note in order for the colors to be correct please be sure to enable blending and chose an appropriate blending function. 47 | 48 | ## Examples 49 | There are two example one using sdl renderers while the other uses OpenGL. To run it load the `sdl2-ttf-examples` package and run `(ttf-examples:basic-example)` or `(ttf-examples:gl-example)` 50 | 51 | 52 | ##Credits 53 | * Latin font test: [Probe 10px otf regular](http://openfontlibrary.org/en/font/probe-10px-otf-regular) by Andrew Sigurow. No modifications were made to this font, however I simply included the .otf file distributed in the zip linked above 54 | 55 | ## Issues 56 | if you cannot load `cl-sdl-ttf`, please ensure you have SDL_TTF 2.0 installed and not just 1.2. 57 | 58 | If you are sure all of this is correct, and it still will not load, please file an issue and specify 59 | * Your platform and architecture 60 | * Your Common Lisp implementation 61 | * The absolute path to your installed .so, .dylib, .dll, or appropriate OSX framework 62 | -------------------------------------------------------------------------------- /examples/gl-example.lisp: -------------------------------------------------------------------------------- 1 | (in-package :ttf-examples) 2 | 3 | (require :cl-opengl) 4 | (require :sdl2-ttf) 5 | (require :mathkit) 6 | 7 | (defun create-gl-array (type lisp-array) 8 | (let ((gl-array (gl:alloc-gl-array type (length lisp-array)))) 9 | (dotimes (i (length lisp-array)) 10 | (setf (gl:glaref gl-array i) (aref lisp-array i))) 11 | gl-array)) 12 | 13 | (defun gl-example () 14 | (with-init (:everything) 15 | (sdl2-ttf:init) 16 | (with-window (my-window :title "Text in OpenGL Example" :flags '(:shown :opengl) :w 300 :h 300) 17 | (with-gl-context (gl-context my-window) 18 | (gl-make-current my-window gl-context) 19 | (gl:viewport 0 0 300 300) 20 | ;;the texture-surface is the actual loaded image object 21 | (let* ((vertex-color-texture-array (create-gl-array :float #(1.0 1.0 1.0 0.0 0.0 22 | 1.0 1.0 1.0 1.0 0.0 23 | 1.0 1.0 1.0 0.0 1.0 24 | 1.0 1.0 1.0 1.0 1.0))) 25 | (element-attribute-array (create-gl-array :unsigned-short #(0 1 2 3))) 26 | (projection-matrix (kit.math:ortho-matrix 0 300 300 0 -10 10)) 27 | (translation-matrix (sb-cga:translate* 150.0 150.0 0.0)) 28 | (font (sdl2-ttf:open-font (asdf:system-relative-pathname 'sdl2-ttf-examples "examples/PROBE_10PX_OTF.otf") 29 | 10)) 30 | (texture-surface (sdl2-ttf:render-text-blended font 31 | "hello world" 32 | 255 33 | 255 34 | 255 35 | 0)) 36 | ;;The first buffer is our verticies, the second is our elements 37 | (buffers (gl:gen-buffers 3)) 38 | (vao (car (gl:gen-vertex-arrays 1))) 39 | (texture (car (gl:gen-textures 1))) 40 | (vertex-shader (gl:create-shader :vertex-shader)) 41 | (fragment-shader (gl:create-shader :fragment-shader)) 42 | (shader-program (gl:create-program))) 43 | 44 | (gl:enable :blend) 45 | (gl:blend-func :src-alpha :one-minus-src-alpha) 46 | 47 | (gl:shader-source vertex-shader (read-file-into-string (asdf:system-relative-pathname 'sdl2-ttf-examples 48 | "examples/texture-vertex-shader.glsl"))) 49 | (gl:compile-shader vertex-shader) 50 | 51 | (gl:shader-source fragment-shader (read-file-into-string (asdf:system-relative-pathname 'sdl2-ttf-examples 52 | "examples/texture-fragment-shader.glsl"))) 53 | (gl:compile-shader fragment-shader) 54 | 55 | (gl:attach-shader shader-program vertex-shader) 56 | (gl:attach-shader shader-program fragment-shader) 57 | 58 | (gl:link-program shader-program) 59 | (gl:use-program shader-program) 60 | 61 | (let* ((width (/ (surface-width texture-surface) 2.0)) 62 | (height (/ (surface-height texture-surface) 2.0)) 63 | (vertex-position-array (create-gl-array :float (make-array 8 64 | :initial-contents `(,(- width) ,(- height) 65 | ,width ,(- height) 66 | ,(- width) ,height 67 | ,width ,height))))) 68 | (gl:bind-vertex-array vao) 69 | 70 | (gl:bind-buffer :array-buffer (first buffers)) 71 | (gl:buffer-data :array-buffer :static-draw vertex-position-array) 72 | (gl:free-gl-array vertex-position-array) 73 | (gl:vertex-attrib-pointer (gl:get-attrib-location shader-program "position") 74 | 2 75 | :float 76 | :false 77 | (* 2 (cffi:foreign-type-size :float)) 78 | (cffi:null-pointer)) 79 | (gl:enable-vertex-attrib-array (gl:get-attrib-location shader-program "position")) 80 | 81 | (gl:bind-buffer :array-buffer (second buffers)) 82 | (gl:buffer-data :array-buffer :static-draw vertex-color-texture-array) 83 | (gl:free-gl-array vertex-color-texture-array) 84 | 85 | (gl:vertex-attrib-pointer (gl:get-attrib-location shader-program "input_color") 86 | 3 87 | :float 88 | :false 89 | (* 5 (cffi:foreign-type-size :float)) 90 | (cffi:null-pointer)) 91 | (gl:enable-vertex-attrib-array (gl:get-attrib-location shader-program "input_color")) 92 | 93 | ;;Texture coordinates 94 | (gl:vertex-attrib-pointer (gl:get-attrib-location shader-program "tex_coord") 95 | 2 96 | :float 97 | :false 98 | (* 5 (cffi:foreign-type-size :float)) 99 | (* 3 (cffi:foreign-type-size :float))) 100 | (gl:enable-vertex-attrib-array (gl:get-attrib-location shader-program "tex_coord")) 101 | 102 | ;;Bind the projection matrix 103 | (gl:uniform-matrix (gl:get-uniform-location shader-program "mvp") 104 | 4 105 | (vector (sb-cga:matrix* projection-matrix translation-matrix)) 106 | 'nil) 107 | 108 | ;;Binding the texture object for configuration 109 | (gl:bind-texture :texture-2d texture) 110 | (gl:tex-parameter :texture-2d :texture-wrap-s :clamp-to-border) 111 | (gl:tex-parameter :texture-2d :texture-wrap-t :clamp-to-border) 112 | (gl:generate-mipmap :texture-2d) 113 | (gl:tex-parameter :texture-2d :texture-min-filter :linear) 114 | (gl:tex-parameter :texture-2d :texture-mag-filter :linear) 115 | (gl:tex-image-2d :texture-2d 116 | 0 117 | :rgba 118 | (surface-width texture-surface) 119 | (surface-height texture-surface) 120 | 0 121 | :rgba 122 | :unsigned-byte 123 | ;;Note this does NOT need to be freed because it's a dereferenced pointer belonging to struct, not a pointer to a pointer! It will be freed when free-surface is called later 124 | (surface-pixels texture-surface)) 125 | (gl:bind-buffer :element-array-buffer (third buffers)) 126 | (gl:buffer-data :element-array-buffer :static-draw element-attribute-array) 127 | (gl:free-gl-array element-attribute-array) 128 | 129 | (with-event-loop (:method :poll) 130 | (:idle () 131 | (gl:clear-color 0.0 0.0 0.0 0.0) 132 | (gl:clear :color-buffer) 133 | (gl:draw-elements :triangle-strip 134 | (gl:make-null-gl-array :unsigned-short) 135 | :count 4) 136 | (gl-swap-window my-window)) 137 | (:quit () 138 | (when (> (sdl2-ttf:was-init) 0) 139 | (sdl2-ttf:close-font font) 140 | (free-surface texture-surface) 141 | (sdl2-ttf:quit)) 142 | (gl:delete-vertex-arrays `(,vao)) 143 | (gl:delete-textures `(,texture)) 144 | (gl:delete-shader vertex-shader) 145 | (gl:delete-shader fragment-shader) 146 | (gl:delete-program shader-program) 147 | (gl:delete-buffers buffers) 148 | t)))))))) 149 | --------------------------------------------------------------------------------