├── screenshot.gif ├── t ├── Ubuntu-R.ttf ├── mplus-1m-regular.ttf ├── LICENSE_E ├── glisph.lisp └── LICENCE.txt ├── .gitignore ├── benchmark ├── .gitignore ├── glisph-benchmark.asd └── src │ └── glisph-benchmark.lisp ├── glisph-test.asd ├── LICENSE.txt ├── glisph.asd ├── src ├── shader.lisp └── glisph.lisp └── README.markdown /screenshot.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tamamu/glisph/HEAD/screenshot.gif -------------------------------------------------------------------------------- /t/Ubuntu-R.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tamamu/glisph/HEAD/t/Ubuntu-R.ttf -------------------------------------------------------------------------------- /t/mplus-1m-regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/tamamu/glisph/HEAD/t/mplus-1m-regular.ttf -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* -------------------------------------------------------------------------------- /benchmark/.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* -------------------------------------------------------------------------------- /t/LICENSE_E: -------------------------------------------------------------------------------- 1 | M+ FONTS Copyright (C) 2002-2016 M+ FONTS PROJECT 2 | 3 | - 4 | 5 | LICENSE_E 6 | 7 | 8 | 9 | 10 | These fonts are free software. 11 | Unlimited permission is granted to use, copy, and distribute them, with 12 | or without modification, either commercially or noncommercially. 13 | THESE FONTS ARE PROVIDED "AS IS" WITHOUT WARRANTY. 14 | 15 | 16 | http://mplus-fonts.sourceforge.jp/mplus-outline-fonts/ 17 | -------------------------------------------------------------------------------- /glisph-test.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of glisph project. 3 | Copyright (c) 2016 Tamamu 4 | |# 5 | 6 | (in-package :cl-user) 7 | (defpackage glisph-test-asd 8 | (:use :cl :asdf)) 9 | (in-package :glisph-test-asd) 10 | 11 | (defsystem glisph-test 12 | :author "Tamamu" 13 | :license "MIT" 14 | :depends-on (:glisph 15 | :prove 16 | :cl-glut) 17 | :components ((:module "t" 18 | :components 19 | ((:test-file "glisph")))) 20 | :description "Test system for glisph" 21 | 22 | :defsystem-depends-on (:prove-asdf) 23 | :perform (test-op :after (op c) 24 | (funcall (intern #.(string :run-test-system) :prove-asdf) c) 25 | (asdf:clear-system c))) 26 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Tamamu 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 8 | -------------------------------------------------------------------------------- /benchmark/glisph-benchmark.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of glisph-benchmark project. 3 | Copyright (c) 2016 tamamu 4 | |# 5 | 6 | #| 7 | Author: tamamu 8 | |# 9 | 10 | (in-package :cl-user) 11 | (defpackage glisph-benchmark-asd 12 | (:use :cl :asdf)) 13 | (in-package :glisph-benchmark-asd) 14 | 15 | (defsystem glisph-benchmark 16 | :version "0.1" 17 | :author "tamamu" 18 | :license "MIT" 19 | :depends-on (:glisph 20 | :cl-glut) 21 | :components ((:module "src" 22 | :components 23 | ((:file "glisph-benchmark")))) 24 | :description "" 25 | :long-description 26 | #.(with-open-file (stream (merge-pathnames 27 | #p"README.markdown" 28 | (or *load-pathname* *compile-file-pathname*)) 29 | :if-does-not-exist nil 30 | :direction :input) 31 | (when stream 32 | (let ((seq (make-array (file-length stream) 33 | :element-type 'character 34 | :fill-pointer t))) 35 | (setf (fill-pointer seq) (read-sequence seq stream)) 36 | seq))) 37 | :in-order-to ((test-op (test-op glisph-benchmark-test)))) 38 | -------------------------------------------------------------------------------- /glisph.asd: -------------------------------------------------------------------------------- 1 | #| 2 | This file is a part of glisph project. 3 | Copyright (c) 2016 Tamamu 4 | |# 5 | 6 | #| 7 | Author: Tamamu 8 | |# 9 | 10 | (in-package :cl-user) 11 | (defpackage glisph-asd 12 | (:use :cl :asdf)) 13 | (in-package :glisph-asd) 14 | 15 | (defsystem glisph 16 | :version "0.1" 17 | :author "Tamamu" 18 | :license "MIT" 19 | :depends-on (:cl-annot 20 | :cl-opengl 21 | :cl-glu 22 | :cl-reexport 23 | :zpb-ttf) 24 | :components ((:module "src" 25 | :components 26 | ((:file "glisph" :depends-on ("shader")) 27 | (:file "shader")))) 28 | :description "Glyph rendering engine using OpenGL shading language" 29 | :long-description 30 | #.(with-open-file (stream (merge-pathnames 31 | #p"README.markdown" 32 | (or *load-pathname* *compile-file-pathname*)) 33 | :if-does-not-exist nil 34 | :direction :input) 35 | (when stream 36 | (let ((seq (make-array (file-length stream) 37 | :element-type 'character 38 | :fill-pointer t))) 39 | (setf (fill-pointer seq) (read-sequence seq stream)) 40 | seq))) 41 | :in-order-to ((test-op (test-op glisph-test)))) 42 | -------------------------------------------------------------------------------- /src/shader.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage glisph.shader 3 | (:use :cl) 4 | (:export :+glyph-vs+ 5 | :+glyph-fs+ 6 | :+bounding-box-vs+ 7 | :+bounding-box-fs+)) 8 | (in-package :glisph.shader) 9 | 10 | ;; Glyph vertex 11 | (defvar +glyph-vs+ "#version 130 12 | precision mediump float; 13 | attribute vec2 vertex; 14 | attribute vec2 attrib; 15 | uniform mat4 translationMatrix; 16 | uniform mat4 scaleMatrix; 17 | uniform mat4 rotateMatrix; 18 | varying vec2 p; 19 | void main(void) { 20 | gl_Position = scaleMatrix * translationMatrix * rotateMatrix * vec4(vertex.x, 1.0-vertex.y, 0.0, 1.0); 21 | p = attrib; 22 | } 23 | ") 24 | 25 | (defvar +glyph-fs+ "#version 130 26 | precision mediump float; 27 | varying vec2 p; 28 | void main(void) { 29 | vec2 px = dFdx(p); 30 | vec2 py = dFdy(p); 31 | float fx = (2.0*p.x)*px.x - px.y; 32 | float fy = (2.0*p.x)*py.x - py.y; 33 | float sd = (p.x*p.x - p.y)/sqrt(fx*fx + fy*fy); 34 | float alpha = 0.5 - sd; 35 | if (alpha > 1.0) { 36 | // inside 37 | gl_FragColor = vec4(1.0); 38 | } else if (alpha < 0.0) { 39 | // outside 40 | discard; 41 | } else { 42 | // near boundary 43 | gl_FragColor = vec4(alpha); 44 | } 45 | }") 46 | 47 | ;; Bounding box 48 | (defvar +bounding-box-vs+ "#version 130 49 | precision mediump float; 50 | attribute vec2 vertex; 51 | uniform mat4 translationMatrix; 52 | uniform mat4 scaleMatrix; 53 | uniform mat4 rotateMatrix; 54 | void main(void) { 55 | gl_Position = scaleMatrix * translationMatrix * rotateMatrix * vec4(vertex.x, 1.0-vertex.y, 0.0, 1.0); 56 | } 57 | ") 58 | 59 | (defvar +bounding-box-fs+ "#version 130 60 | uniform vec4 color; 61 | void main(void) { 62 | gl_FragColor = color; 63 | } 64 | ") 65 | 66 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | # GLisph 2 | 3 | [![Quicklisp](http://quickdocs.org/badge/glisph.svg)](http://quickdocs.org/glisph/) 4 | 5 | ![Screen Shot](screenshot.gif) 6 | 7 | GLisph is a glyph rendering engine using OpenGL shader language. The engine draws string clearly by vector based font rendering on an OpenGL context. TrueType (TTF) is the only drawable format currently. 8 | 9 | ## Usage 10 | 11 | Initialize the engine as below first. 12 | 13 | ```lisp 14 | (gli:init 800 600) 15 | ``` 16 | 17 | Load TrueType font file and make glyph table. Glyph table manages the contour points of the glyphs. 18 | 19 | ```lisp 20 | (defvar *font* (gli:open-font-loader "/path/to/display-font.ttf") 21 | (defvar *glyph-table* (gli:make-glyph-table *font*)) 22 | ``` 23 | 24 | Then you can regist and draw glyphs! 25 | 26 | ```lisp 27 | ;;; For CL-GLUT, you should require these display mode keywords before display-window section. 28 | (glut:set-display-mode :stencil :multisample) 29 | 30 | ;; Before draw section 31 | (defvar *text-buffer* 32 | (gli:draw *glyph-table* 33 | '(:x 120 :y 40 :size 20 34 | :text "Hello World!" 35 | :y 64 36 | :text "Common Lisp"))) 37 | 38 | ;;; In draw section, you can set some parameters to draw for GLisph context. 39 | (gli:gcolor 0.8 0.2 0.5) 40 | 41 | ;;; This is rotation example. 42 | (gli:grotate 0.0 0.0 0.5) 43 | 44 | ;; Render 45 | (gli:render *text-buffer*) 46 | 47 | ``` 48 | 49 | ## Dependencies 50 | 51 | * cl-annot 52 | * cl-opengl 53 | * cl-glu 54 | * zpb-ttf 55 | * cl-glut (optional - only required when you test GLisph) 56 | 57 | ## Installation 58 | 59 | * Quicklisp 60 | 61 | ```lisp 62 | (ql:quickload :glisph) 63 | ``` 64 | 65 | * Roswell 66 | 67 | ```bash 68 | $ ros install glisph 69 | ``` 70 | 71 | * Test 72 | 73 | ```lisp 74 | (asdf:test-system :glisph) 75 | ``` 76 | 77 | ## Author 78 | 79 | * Tamamu 80 | 81 | ## Copyright 82 | 83 | Copyright (c) 2017 Tamamu 84 | 85 | ## License 86 | 87 | Licensed under the MIT License. 88 | -------------------------------------------------------------------------------- /benchmark/src/glisph-benchmark.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage glisph-benchmark 3 | (:use :cl) 4 | (:export :window-main)) 5 | (in-package :glisph-benchmark) 6 | 7 | ;; Not working, work in progress! 8 | 9 | (defparameter +text+ "A Quick Brown Fox Jumps Over The Lazy Dog 0123456789 A Quick Brown Fox Jumps Over The Lazy Dog 0123456789 ") 10 | (defvar *line-count* 42) 11 | (defvar *font* nil) 12 | (defvar *glyph-table* nil) 13 | (defvar *text-object* nil) 14 | (defvar *frame* 0) 15 | (defvar *count* 0) 16 | (defvar *last* 0) 17 | (defvar *now* 0) 18 | (defvar *delta* 0) 19 | 20 | (defclass benchmark-window (glut:window) 21 | () 22 | (:default-initargs :title "GLisph Benchmark" 23 | :width 800 :height 600 24 | :mode '(:stencil :multisample) 25 | :tick-interval 0)) 26 | 27 | (defmethod glut:display-window :before ((w benchmark-window)) 28 | (setf *font* (gli:open-font-loader "/usr/share/fonts/TTF/DroidSans.ttf")) 29 | ; (setf *font* (gli:open-font-loader "/path/to/freetype-gl/fonts/VeraMono.ttf")) 30 | (setf *glyph-table* (gli:make-glyph-table *font*)) 31 | (gli:regist-glyphs *glyph-table* +text+) 32 | (gli:init) 33 | (setf *text-object* (gli:new-vstring *glyph-table* +text+ 0.0)) 34 | (gli:gscale 400 -300 1.0) 35 | (gl:clear-color 1.0 1.0 1.0 1.0) 36 | (setf *last* (glut:get :elapsed-time))) 37 | 38 | 39 | (defmethod glut:display ((w benchmark-window)) 40 | (gl:clear :color-buffer-bit :stencil-buffer-bit) 41 | (when (= 0 *count* *frame*) 42 | (format t "Computing FPS with text rendering at each frame...~%") 43 | (format t "Number of glyphs: ~D~%" (* (length +text+) *line-count*))) 44 | 45 | (incf *frame*) 46 | (setf *now* (glut:get :elapsed-time)) 47 | (setf *delta* (float (/ (- *now* *last*) 1000))) 48 | (when (> *delta* 2.5) 49 | (format t "FPS : ~,2F (~D frames in ~,2F second, ~,1F glyph/second)~%" 50 | (/ *frame* *delta*) *frame* *delta* 51 | (* (/ *frame* *delta*) (length +text+) *line-count*)) 52 | (setf *last* (glut:get :elapsed-time)) 53 | (setf *frame* 0) 54 | (incf *count*) 55 | (when (> *count* 5) 56 | (glut:leave-main-loop))) 57 | (let ((x -390.0) 58 | (y -300.0)) 59 | (dotimes (i *line-count*) 60 | (gli:draw-string *text-object* x y 0.0 12.0) 61 | (incf y 14)) 62 | (gl:flush))) 63 | 64 | (defmethod glut:reshape ((w benchmark-window) width height) 65 | (gl:viewport 0 0 width height) 66 | (gl:matrix-mode :projection) 67 | (gl:load-identity) 68 | (gl:ortho 0 width height 0 -1 1) 69 | (gl:matrix-mode :modelview) 70 | (gl:load-identity)) 71 | 72 | (defmethod glut:tick ((w benchmark-window)) 73 | (glut:post-redisplay)) 74 | 75 | (defun window-main () 76 | (glut:display-window (make-instance 'benchmark-window))) 77 | -------------------------------------------------------------------------------- /t/glisph.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage glisph-test 3 | (:use :cl 4 | :prove)) 5 | (in-package :glisph-test) 6 | 7 | ;; NOTE: To run this test file, execute `(asdf:test-system :glisph)' in your Lisp. 8 | 9 | (defvar *width* 800) 10 | (defvar *height* 600) 11 | (defvar *font-en*) 12 | (defvar *font-ja*) 13 | (defvar *glyph-table-en*) 14 | (defvar *glyph-table-ja*) 15 | (defvar *origin-x* 0.0) 16 | (defvar *origin-y* 0.0) 17 | (defvar *display-x* 0.0) 18 | (defvar *display-y* 0.0) 19 | (defvar *zoom* 1.0) 20 | (defvar *frame-count* 0) 21 | (defvar *text-en* #("Hello World!" 22 | "The Quick Brown Fox Jumps Over The Lazy Dog." 23 | "0123456789")) 24 | (defvar *text-ja* #("色はにほへど　散りぬるを" 25 | "我が世たれぞ　常ならむ" 26 | "有為の奥山　　今日越えて" 27 | "浅き夢見じ　　酔ひもせず")) 28 | 29 | (defclass test-window (glut:window) 30 | () 31 | (:default-initargs :title "GLisphTest" 32 | :width *width* :height *height* 33 | :mode '(:stencil :multisample) 34 | :tick-interval (round (/ 1000 60)))) 35 | 36 | (defmethod glut:mouse ((w test-window) button state x y) 37 | (declare (ignore w state)) 38 | (case button 39 | (:left-button 40 | (setf *origin-x* (- x *display-x*) 41 | *origin-y* (- y *display-y*))) 42 | (:wheel-down 43 | (setf *zoom* (* *zoom* 1.2)) 44 | (glut:post-redisplay)) 45 | (:wheel-up 46 | (setf *zoom* (/ *zoom* 1.2)) 47 | (glut:post-redisplay)))) 48 | 49 | (defmethod glut:motion ((w test-window) x y) 50 | (setf *display-x* (- x *origin-x*) 51 | *display-y* (- y *origin-y*)) 52 | (glut:post-redisplay)) 53 | 54 | (defmethod glut:reshape ((w test-window) width height) 55 | (gl:viewport 0 0 width height) 56 | (gl:matrix-mode :projection) 57 | (gl:load-identity) 58 | (gl:ortho 0 width height 0 -1 1) 59 | (gl:matrix-mode :modelview) 60 | (gl:load-identity) 61 | (setf *width* width 62 | *height* height)) 63 | 64 | (defmethod glut:display-window :before ((w test-window)) 65 | (gli:init *width* *height*) 66 | (pass "Success: init") 67 | (setf *font-en* (gli:open-font-loader 68 | (merge-pathnames "Ubuntu-R.ttf" *load-truename*)) 69 | *font-ja* (gli:open-font-loader 70 | (merge-pathnames "mplus-1m-regular.ttf" *load-truename*))) 71 | (setf *glyph-table-en* (gli:make-glyph-table *font-en*) 72 | *glyph-table-ja* (gli:make-glyph-table *font-ja*)) 73 | (pass "Success: make-glyph-table") 74 | (loop for text across *text-en* 75 | do (gli:regist-glyphs *glyph-table-en* text)) 76 | (loop for text across *text-ja* 77 | do (gli:regist-glyphs *glyph-table-ja* text)) 78 | (pass "Success: regist-glyphs") 79 | (setf *text-en* 80 | (gli:draw *glyph-table-en* 81 | '(:size 20 :x 0 :y 0 82 | :text (aref *text-en* 0) 83 | :size 30 :x 0 :y 24 84 | :text (aref *text-en* 1) 85 | :size 40 :x 0 :y 60 86 | :text (aref *text-en* 2)))) 87 | (setf *text-ja* 88 | (gli:draw *glyph-table-ja* 89 | `(:size 24 :x 200 90 | ,@(loop for idx from 0 below (length *text-ja*) 91 | append (list :spacing (* idx 4) 92 | :y (+ 200 (* idx 60)) 93 | :text (aref *text-ja* idx)))))) 94 | (pass "Success: draw") 95 | (ok t)) 96 | 97 | (defmethod glut:tick ((w test-window)) 98 | (incf *frame-count*) 99 | (when (>= *frame-count* 360) 100 | (setf *frame-count* 0)) 101 | (glut:post-redisplay)) 102 | 103 | (defmethod glut:display ((w test-window)) 104 | (gl:viewport 0 0 *width* *height*) 105 | (gl:clear-color 0 0 0 1) 106 | (gl:clear-stencil 0) 107 | (gl:clear :color-buffer-bit :stencil-buffer-bit) 108 | (gl:color 0.5 0.0 0.0 1.0) 109 | (gl:with-primitive :quads 110 | (gl:vertex 0 0) 111 | (gl:vertex 300 0) 112 | (gl:vertex 300 300) 113 | (gl:vertex 0 300)) 114 | (let* ((rad (* (coerce pi 'single-float) (/ *frame-count* 180))) 115 | (cosr (cos rad))) 116 | 117 | ;; Currently, because of #2, it has no effect in this context. 118 | (gli:gcolor 1.0 1.0 1.0 1.0) 119 | 120 | (gli:render *text-en*) 121 | 122 | ;; #2 It overwrites the color drawn before. 123 | (gli:gcolor cosr 1.0 1.0 1.0) 124 | 125 | (gli:render *text-ja*) 126 | (gl:flush))) 127 | 128 | (defmethod glut:close ((w test-window)) 129 | (gli:delete-glyph-table *glyph-table-en*) 130 | (gli:delete-glyph-table *glyph-table-ja*) 131 | (gli:finalize) 132 | (format t "close~%")) 133 | 134 | (plan 5) 135 | 136 | (glut:display-window (make-instance 'test-window)) 137 | 138 | (finalize) 139 | -------------------------------------------------------------------------------- /t/LICENCE.txt: -------------------------------------------------------------------------------- 1 | ------------------------------- 2 | UBUNTU FONT LICENCE Version 1.0 3 | ------------------------------- 4 | 5 | PREAMBLE 6 | This licence allows the licensed fonts to be used, studied, modified and 7 | redistributed freely. The fonts, including any derivative works, can be 8 | bundled, embedded, and redistributed provided the terms of this licence 9 | are met. The fonts and derivatives, however, cannot be released under 10 | any other licence. The requirement for fonts to remain under this 11 | licence does not require any document created using the fonts or their 12 | derivatives to be published under this licence, as long as the primary 13 | purpose of the document is not to be a vehicle for the distribution of 14 | the fonts. 15 | 16 | DEFINITIONS 17 | "Font Software" refers to the set of files released by the Copyright 18 | Holder(s) under this licence and clearly marked as such. This may 19 | include source files, build scripts and documentation. 20 | 21 | "Original Version" refers to the collection of Font Software components 22 | as received under this licence. 23 | 24 | "Modified Version" refers to any derivative made by adding to, deleting, 25 | or substituting -- in part or in whole -- any of the components of the 26 | Original Version, by changing formats or by porting the Font Software to 27 | a new environment. 28 | 29 | "Copyright Holder(s)" refers to all individuals and companies who have a 30 | copyright ownership of the Font Software. 31 | 32 | "Substantially Changed" refers to Modified Versions which can be easily 33 | identified as dissimilar to the Font Software by users of the Font 34 | Software comparing the Original Version with the Modified Version. 35 | 36 | To "Propagate" a work means to do anything with it that, without 37 | permission, would make you directly or secondarily liable for 38 | infringement under applicable copyright law, except executing it on a 39 | computer or modifying a private copy. Propagation includes copying, 40 | distribution (with or without modification and with or without charging 41 | a redistribution fee), making available to the public, and in some 42 | countries other activities as well. 43 | 44 | PERMISSION & CONDITIONS 45 | This licence does not grant any rights under trademark law and all such 46 | rights are reserved. 47 | 48 | Permission is hereby granted, free of charge, to any person obtaining a 49 | copy of the Font Software, to propagate the Font Software, subject to 50 | the below conditions: 51 | 52 | 1) Each copy of the Font Software must contain the above copyright 53 | notice and this licence. These can be included either as stand-alone 54 | text files, human-readable headers or in the appropriate machine- 55 | readable metadata fields within text or binary files as long as those 56 | fields can be easily viewed by the user. 57 | 58 | 2) The font name complies with the following: 59 | (a) The Original Version must retain its name, unmodified. 60 | (b) Modified Versions which are Substantially Changed must be renamed to 61 | avoid use of the name of the Original Version or similar names entirely. 62 | (c) Modified Versions which are not Substantially Changed must be 63 | renamed to both (i) retain the name of the Original Version and (ii) add 64 | additional naming elements to distinguish the Modified Version from the 65 | Original Version. The name of such Modified Versions must be the name of 66 | the Original Version, with "derivative X" where X represents the name of 67 | the new work, appended to that name. 68 | 69 | 3) The name(s) of the Copyright Holder(s) and any contributor to the 70 | Font Software shall not be used to promote, endorse or advertise any 71 | Modified Version, except (i) as required by this licence, (ii) to 72 | acknowledge the contribution(s) of the Copyright Holder(s) or (iii) with 73 | their explicit written permission. 74 | 75 | 4) The Font Software, modified or unmodified, in part or in whole, must 76 | be distributed entirely under this licence, and must not be distributed 77 | under any other licence. The requirement for fonts to remain under this 78 | licence does not affect any document created using the Font Software, 79 | except any version of the Font Software extracted from a document 80 | created using the Font Software may only be distributed under this 81 | licence. 82 | 83 | TERMINATION 84 | This licence becomes null and void if any of the above conditions are 85 | not met. 86 | 87 | DISCLAIMER 88 | THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 89 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF 90 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT OF 91 | COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE 92 | COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 93 | INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL 94 | DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 95 | FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM OTHER 96 | DEALINGS IN THE FONT SOFTWARE. 97 | -------------------------------------------------------------------------------- /src/glisph.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (eval-when (:compile-toplevel :load-toplevel :execute) 3 | (unless (find-package :glisph) 4 | (defpackage glisph (:nicknames :gli) 5 | (:documentation "Glyph rendering engine using OpenGL shading language") 6 | (:use :cl) 7 | (:import-from :glisph.shader 8 | :+glyph-vs+ 9 | :+glyph-fs+ 10 | :+bounding-box-vs+ 11 | :+bounding-box-fs+) 12 | (:export :init 13 | :finalize 14 | :set-render-size 15 | :make-glyph-table 16 | :regist-glyphs 17 | :gcolor 18 | :gtrans 19 | :gscale 20 | :grotate 21 | :draw 22 | :render 23 | :delete-glyph-table)))) 24 | (in-package :glisph) 25 | 26 | (cl-reexport:reexport-from :zpb-ttf 27 | :include '(:open-font-loader)) 28 | (annot:enable-annot-syntax) 29 | 30 | (defvar *render-width* 640.0) 31 | (defvar *render-height* 480.0) 32 | 33 | (defvar *glyph-program* nil) 34 | (defvar *glyph-translation* nil) 35 | (defvar *glyph-scale* nil) 36 | (defvar *glyph-rotate* nil) 37 | (defvar +glyph-vertex-loc+ nil) 38 | (defvar +glyph-attrib-loc+ nil) 39 | (defvar *bounding-box-program* nil) 40 | (defvar *bounding-box-color* nil) 41 | (defvar *bounding-box-translation* nil) 42 | (defvar *bounding-box-scale* nil) 43 | (defvar *bounding-box-rotate* nil) 44 | (defvar +bounding-box-vertex-loc+ nil) 45 | 46 | ; Glyph-table 47 | ; :font := zpb-ttf:font 48 | ; :em := zpb-ttf:units/em font 49 | ; #\a := vglyph 50 | 51 | (defstruct vglyph 52 | (source nil :type zpb-ttf::glyph) 53 | (xmin 0.0 :type single-float) 54 | (ymin 0.0 :type single-float) 55 | (xmax 1.0 :type single-float) 56 | (ymax 1.0 :type single-float) 57 | (vertex nil :type array) 58 | (count 0 :type fixnum)) 59 | 60 | (defstruct context 61 | (glyph-table nil :type hash-table) 62 | (vertex (make-array 0 :element-type 'single-float :fill-pointer 0 :adjustable t) :type array) 63 | (x 0 :type fixnum) 64 | (y 0 :type fixnum) 65 | (size 10 :type fixnum) 66 | (letter-spacing 0 :type fixnum) 67 | (count 0 :type fixnum)) 68 | 69 | (defstruct text-buffer 70 | (width 0.0 :type float) 71 | (height 0.0 :type float) 72 | (polygon-buffer nil) 73 | (fill-buffer nil) 74 | (count 0 :type fixnum)) 75 | 76 | (defun create-program (vsource fsource) 77 | "Create GLSL program." 78 | (let ((program (gl:create-program)) 79 | (vs (gl:create-shader :vertex-shader)) 80 | (fs (gl:create-shader :fragment-shader))) 81 | (gl:shader-source vs vsource) 82 | (gl:compile-shader vs) 83 | (gl:shader-source fs fsource) 84 | (gl:compile-shader fs) 85 | (let ((vs-log (gl:get-shader-info-log vs)) 86 | (fs-log (gl:get-shader-info-log fs))) 87 | (when (> (length vs-log) 0) 88 | (format t "Vertex shader: ~A~%" vs-log)) 89 | (when (> (length fs-log) 0) 90 | (format t "Fragment shader: ~A~%" fs-log))) 91 | (gl:attach-shader program vs) 92 | (gl:attach-shader program fs) 93 | (gl:link-program program) 94 | (let ((program-log (gl:get-program-info-log program))) 95 | (when (> (length program-log) 0) 96 | (format t "Program log: ~A~%" program-log))) 97 | program)) 98 | 99 | (defun matrix4f (a b c d e f g h i j k l m n o p) 100 | (make-array 16 :element-type 'single-float 101 | :initial-contents `(,a ,b ,c ,d 102 | ,e ,f ,g ,h 103 | ,i ,j ,k ,l 104 | ,m ,n ,o ,p))) 105 | 106 | (defun init (&optional (width 640) (height 480)) 107 | "Initialize GLisph engine. 108 | Please call this function before draw glyphs." 109 | (let ((imat (matrix4f 1.0 0.0 0.0 0.0 110 | 0.0 1.0 0.0 0.0 111 | 0.0 0.0 1.0 0.0 112 | 0.0 0.0 0.0 1.0))) 113 | (setf *glyph-program* (create-program +glyph-vs+ +glyph-fs+)) 114 | (gl:use-program *glyph-program*) 115 | (setf +glyph-vertex-loc+ (gl:get-attrib-location *glyph-program* "vertex") 116 | +glyph-attrib-loc+ (gl:get-attrib-location *glyph-program* "attrib")) 117 | (setf *glyph-translation* (gl:get-uniform-location *glyph-program* "translationMatrix")) 118 | (gl:uniform-matrix-4fv *glyph-translation* imat) 119 | (setf *glyph-scale* (gl:get-uniform-location *glyph-program* "scaleMatrix")) 120 | (gl:uniform-matrix-4fv *glyph-scale* imat) 121 | (setf *glyph-rotate* (gl:get-uniform-location *glyph-program* "rotateMatrix")) 122 | (gl:uniform-matrix-4fv *glyph-rotate* imat) 123 | (gl:enable-vertex-attrib-array +glyph-vertex-loc+) 124 | (gl:enable-vertex-attrib-array +glyph-attrib-loc+) 125 | (gl:use-program 0) 126 | 127 | (setf *bounding-box-program* (create-program +bounding-box-vs+ +bounding-box-fs+)) 128 | (gl:use-program *bounding-box-program*) 129 | (setf +bounding-box-vertex-loc+ (gl:get-attrib-location *bounding-box-program* "vertex")) 130 | (setf *bounding-box-color* (gl:get-uniform-location *bounding-box-program* "color")) 131 | (gl:uniformf *bounding-box-color* 0.0 0.0 0.0 1.0) 132 | (setf *bounding-box-translation* (gl:get-uniform-location *bounding-box-program* "translationMatrix")) 133 | (gl:uniform-matrix-4fv *bounding-box-translation* imat) 134 | (setf *bounding-box-scale* (gl:get-uniform-location *bounding-box-program* "scaleMatrix")) 135 | (gl:uniform-matrix-4fv *bounding-box-scale* imat) 136 | (setf *bounding-box-rotate* (gl:get-uniform-location *bounding-box-program* "rotateMatrix")) 137 | (gl:uniform-matrix-4fv *bounding-box-rotate* imat) 138 | (gl:enable-vertex-attrib-array +bounding-box-vertex-loc+) 139 | 140 | (gl:use-program 0) 141 | (set-render-size width height) 142 | t)) 143 | 144 | (defun finalize () 145 | "Delete GLisph shader programs. 146 | Please call this function before exit program." 147 | (gl:delete-program *glyph-program*) 148 | (gl:delete-program *bounding-box-program*)) 149 | 150 | (defun set-render-size (width height) 151 | (setf *render-width* (float width) 152 | *render-height* (float height)) 153 | (gscale 1 1 1) 154 | (gtrans 0.0 0.0 0.0)) 155 | 156 | (defmacro make-gl-array (data) 157 | `(let* ((len (length ,data)) 158 | (glarr (gl:alloc-gl-array :float len))) 159 | (dotimes (i len) 160 | (setf (gl:glaref glarr i) (aref ,data i))) 161 | glarr)) 162 | 163 | (defmacro vector-push-extend-to (vec &rest rest) 164 | `(loop for e in (list ,@rest) 165 | do (vector-push-extend e ,vec))) 166 | 167 | (defun vertex-fill (glyph scale) 168 | "Make vertex of filled region of the glyph." 169 | (let ((polygon (make-array 0 :element-type 'single-float :fill-pointer 0 :adjustable t)) 170 | (curve (make-array 0 :element-type 'single-float :fill-pointer 0 :adjustable t))) 171 | (zpb-ttf:do-contours (contour glyph) 172 | (let ((contour (zpb-ttf:explicit-contour-points contour))) 173 | (loop for i from 1 below (- (length contour) 1) 174 | for cp = (aref contour i) 175 | when (not (zpb-ttf:on-curve-p cp)) 176 | do (let ((bp (aref contour (1- i))) 177 | (np (aref contour (1+ i)))) 178 | (vector-push-extend-to curve 179 | (float (/ (zpb-ttf:x bp) scale)) (float (/ (zpb-ttf:y bp) scale)) 0.0 0.0 180 | (float (/ (zpb-ttf:x cp) scale)) (float (/ (zpb-ttf:y cp) scale)) 0.5 0.0 181 | (float (/ (zpb-ttf:x np) scale)) (float (/ (zpb-ttf:y np) scale)) 1.0 1.0))) 182 | (let ((pv (make-array 0 :element-type 'single-float :fill-pointer 0 :adjustable t))) 183 | (loop for p across contour 184 | when (zpb-ttf:on-curve-p p) 185 | do (vector-push-extend-to pv 186 | (float (/ (zpb-ttf:x p) scale)) (float (/ (zpb-ttf:y p) scale)))) 187 | (let ((ox (aref pv 0)) 188 | (oy (aref pv 1))) 189 | (loop for i from 2 below (- (length pv) 2) by 2 190 | do (vector-push-extend-to polygon 191 | ox oy 0.5 0.5 192 | (aref pv i) (aref pv (+ i 1)) 0.5 0.5 193 | (aref pv (+ i 2)) (aref pv (+ i 3)) 0.5 0.5)))))) 194 | (concatenate 'vector polygon curve))) 195 | 196 | @export 197 | (defmacro %set-glyph-table (context table) 198 | `(setf (context-source ,context) ,table)) 199 | 200 | (defun %calc-kerning (context vglyph-1 vglyph-2) 201 | "Calc offsets of kerning and advance width between two glyphs." 202 | (let* ((tbl (context-glyph-table context)) 203 | (font (gethash :font tbl)) 204 | (em (gethash :em tbl))) 205 | (float (/ (- (zpb-ttf:kerning-offset (vglyph-source vglyph-1) 206 | (vglyph-source vglyph-2) 207 | font)) 208 | em)))) 209 | 210 | (defun %calc-advance-width (context glyph) 211 | (float (/ (zpb-ttf:advance-width (vglyph-source glyph)) 212 | (gethash :em (context-glyph-table context))))) 213 | 214 | (defun %add-glyph (context vglyph x y) 215 | (let* ((cv (context-vertex context)) 216 | (size (context-size context)) 217 | (gv (vglyph-vertex vglyph)) 218 | (gcnt (vglyph-count vglyph))) 219 | (loop for i from 0 below gcnt by 4 220 | do (vector-push-extend-to cv 221 | (+ (* size (aref gv i)) x) 222 | (+ (* size (- 1.0 (aref gv (+ i 1)))) y) 223 | (aref gv (+ i 2)) 224 | (aref gv (+ i 3)))) 225 | (incf (context-count context) gcnt))) 226 | 227 | @export 228 | (defun %draw-string (context str) 229 | (let ((tbl (context-glyph-table context)) 230 | (x (float (context-x context))) 231 | (y (float (context-y context))) 232 | (size (float (context-size context))) 233 | (ls (float (context-letter-spacing context)))) 234 | (loop for ch across str 235 | for vg = (gethash ch tbl) 236 | for pvg = nil then vg 237 | with aw = 0 238 | when pvg do (incf aw (* size (%calc-kerning context vg pvg))) 239 | do (%add-glyph context vg (+ x aw) y) 240 | (incf aw (+ ls (* size (%calc-advance-width context vg))))))) 241 | 242 | @export 243 | (defmacro %set-x (context x) 244 | `(setf (context-x ,context) ,x)) 245 | 246 | @export 247 | (defmacro %set-y (context y) 248 | `(setf (context-y ,context) ,y)) 249 | 250 | @export 251 | (defmacro %set-size (context size) 252 | `(setf (context-size ,context) ,size)) 253 | 254 | @export 255 | (defmacro %set-letter-spacing (context width) 256 | `(setf (context-letter-spacing ,context) ,width)) 257 | 258 | @export 259 | (defmacro draw (glyph-table proc-list) 260 | (let ((proc (list))) 261 | (loop for e in (eval proc-list) 262 | with cmd = nil 263 | if (and (keywordp e) 264 | (not (null cmd))) 265 | do (push (reverse cmd) proc) 266 | (setf cmd nil) 267 | if (keywordp e) 268 | do (push (case e 269 | (:x '%set-x) 270 | (:y '%set-y) 271 | (:size '%set-size) 272 | (:spacing '%set-letter-spacing) 273 | (:glyph-table '%set-glyph-table) 274 | (:text '%draw-string)) 275 | cmd) 276 | (push '%context cmd) 277 | else 278 | do (push e cmd) 279 | (push (macroexpand (reverse cmd)) proc) 280 | (setf cmd nil) 281 | finally (unless (null cmd) (push (reverse cmd) proc))) 282 | `(let ((%context (make-context :glyph-table ,glyph-table))) 283 | ,@(reverse proc) 284 | (let ((xmax *render-width*) 285 | (ymax *render-height*) 286 | (polygon-buffer (gl:gen-buffer)) 287 | (fill-buffer (gl:gen-buffer))) 288 | (gl:bind-buffer :array-buffer polygon-buffer) 289 | (gl:buffer-data :array-buffer :static-draw 290 | (make-gl-array (context-vertex %context))) 291 | (gl:bind-buffer :array-buffer 0) 292 | (gl:bind-buffer :array-buffer fill-buffer) 293 | (gl:buffer-data :array-buffer :static-draw 294 | (make-gl-array (vector 0.0 ymax 0.0 0.0 xmax ymax xmax 0.0))) 295 | (gl:bind-buffer :array-buffer 0) 296 | (make-text-buffer :polygon-buffer polygon-buffer 297 | :fill-buffer fill-buffer 298 | :width *render-width* 299 | :height *render-height* 300 | :count (/ (context-count %context) 4)))))) 301 | 302 | (defmacro make-glyph-table (font) 303 | "Make glyphs cache table." 304 | `(let ((tbl (make-hash-table :test 'eq))) 305 | (setf (gethash :font tbl) ,font 306 | (gethash :em tbl) (zpb-ttf:units/em ,font)) 307 | tbl)) 308 | 309 | (defmacro regist-glyph-helper (table ch) 310 | `(let* ((glyph (zpb-ttf:find-glyph ,ch (gethash :font ,table))) 311 | (bbox (zpb-ttf:bounding-box glyph)) 312 | (em (gethash :em ,table)) 313 | (vertex (vertex-fill glyph em)) 314 | (xmin (float (/ (zpb-ttf:xmin bbox) em))) 315 | (ymin (float (/ (zpb-ttf:ymin bbox) em))) 316 | (xmax (float (/ (zpb-ttf:xmax bbox) em))) 317 | (ymax (float (/ (zpb-ttf:ymax bbox) em)))) 318 | (setf (gethash ,ch ,table) (make-vglyph :source glyph 319 | :vertex vertex 320 | :xmin xmin 321 | :ymin ymin 322 | :xmax xmax 323 | :ymax ymax 324 | :count (length vertex))))) 325 | 326 | (defmacro regist-glyphs (table str) 327 | "Regist glyphs of the string to the glyph table." 328 | `(loop for ch across ,str 329 | when (null (gethash ch ,table)) 330 | do (regist-glyph-helper ,table ch))) 331 | 332 | (defun delete-glyph-table (table) 333 | "Delete font data from the glyph table." 334 | (zpb-ttf:close-font-loader (gethash :font table)) 335 | #| 336 | (loop for key being each hash-key of table 337 | using (hash-value vg) 338 | when (typep key 'character) 339 | do (gl:delete-buffer (vglyph-buffer vg)) 340 | (gl:delete-buffer (vglyph-box-buffer vg)) 341 | |#) 342 | 343 | (defun gcolor (r g b a) 344 | "Set render color of glyphs." 345 | (gl:use-program *bounding-box-program*) 346 | (gl:uniformf *bounding-box-color* r g b a) 347 | (gl:use-program 0)) 348 | 349 | 350 | (defvar *glyph-trans-mat* 351 | (matrix4f 1.0 0.0 0.0 0.0 352 | 0.0 1.0 0.0 0.0 353 | 0.0 0.0 1.0 0.0 354 | 0.0 0.0 0.0 1.0)) 355 | (defun gtrans (x y z) 356 | "Set the translation matrix of glyphs." 357 | (setf (aref *glyph-trans-mat* 3) (+ (float (- (/ *render-width* 2))) x) 358 | (aref *glyph-trans-mat* 7) (- (float (/ *render-height* 2)) y) 359 | (aref *glyph-trans-mat* 11) z) 360 | (gl:use-program *glyph-program*) 361 | (gl:uniform-matrix-4fv *glyph-translation* *glyph-trans-mat*) 362 | (gl:use-program 0) 363 | (gl:use-program *bounding-box-program*) 364 | (gl:uniform-matrix-4fv *bounding-box-translation* *glyph-trans-mat*) 365 | (gl:use-program 0)) 366 | 367 | (defvar *glyph-scale-mat* 368 | (matrix4f 1.0 0.0 0.0 0.0 369 | 0.0 1.0 0.0 0.0 370 | 0.0 0.0 1.0 0.0 371 | 0.0 0.0 0.0 1.0)) 372 | (defun gscale (x y z) 373 | "Set the scale matrix of glyphs." 374 | (setf (aref *glyph-scale-mat* 0) (float (/ 1 (* x (/ *render-width* 2)))) 375 | (aref *glyph-scale-mat* 5) (float (/ 1 (* y (/ *render-height* 2)))) 376 | (aref *glyph-scale-mat* 10)(float (/ 1 z))) 377 | (gl:use-program *glyph-program*) 378 | (gl:uniform-matrix-4fv *glyph-scale* *glyph-scale-mat*) 379 | (gl:use-program 0) 380 | (gl:use-program *bounding-box-program*) 381 | (gl:uniform-matrix-4fv *bounding-box-scale* *glyph-scale-mat*) 382 | (gl:use-program 0)) 383 | 384 | (defvar *glyph-rotate-mat* 385 | (matrix4f 1.0 0.0 0.0 0.0 386 | 0.0 1.0 0.0 0.0 387 | 0.0 0.0 1.0 0.0 388 | 0.0 0.0 0.0 1.0)) 389 | (defun grotate (x y z) 390 | "Set the rotate matrix of glyphs." 391 | (setf (aref *glyph-rotate-mat* 0) (* (cos y) (cos z)) 392 | (aref *glyph-rotate-mat* 1) (- (sin z)) 393 | (aref *glyph-rotate-mat* 2) (sin y) 394 | (aref *glyph-rotate-mat* 4) (sin z) 395 | (aref *glyph-rotate-mat* 5) (* (cos x) (cos z)) 396 | (aref *glyph-rotate-mat* 6) (- (sin x)) 397 | (aref *glyph-rotate-mat* 8) (- (sin y)) 398 | (aref *glyph-rotate-mat* 9) (sin x) 399 | (aref *glyph-rotate-mat* 10) (* (cos x) (cos y))) 400 | (gl:use-program *glyph-program*) 401 | (gl:uniform-matrix-4fv *glyph-rotate* *glyph-rotate-mat*) 402 | (gl:use-program 0) 403 | (gl:use-program *bounding-box-program*) 404 | (gl:uniform-matrix-4fv *bounding-box-rotate* *glyph-rotate-mat*) 405 | (gl:use-program 0)) 406 | 407 | (defun render (buffer) 408 | "Render the text buffer." 409 | @type text-buffer buffer 410 | @optimize (speed 3) 411 | @optimize (safety 0) 412 | @optimize (debug 0) 413 | (gl:enable :stencil-test) 414 | (gl:enable :sample-alpha-to-coverage) 415 | (gl:stencil-func :always 0 1) 416 | (gl:stencil-op :keep :invert :invert) 417 | (gl:color-mask nil nil nil nil) 418 | (gl:use-program *glyph-program*) 419 | ; (gl:enable-vertex-attrib-array 0) 420 | ; (gl:enable-vertex-attrib-array 1) 421 | (gl:bind-buffer :array-buffer (text-buffer-polygon-buffer buffer)) 422 | (gl:vertex-attrib-pointer +glyph-vertex-loc+ 2 :float nil 16 0) 423 | (gl:vertex-attrib-pointer +glyph-attrib-loc+ 2 :float nil 16 8) 424 | (gl:draw-arrays :triangles 0 (text-buffer-count buffer)) 425 | ; (gl:disable-vertex-attrib-array 0) 426 | ; (gl:disable-vertex-attrib-array 1) 427 | ;(gl:use-program 0) 428 | (gl:disable :sample-alpha-to-coverage) 429 | (gl:stencil-func :notequal 0 1) 430 | (gl:stencil-op :keep :keep :keep) 431 | (gl:color-mask t t t t) 432 | (gl:use-program *bounding-box-program*) 433 | ; (gl:enable-vertex-attrib-array 0) 434 | (gl:bind-buffer :array-buffer (text-buffer-fill-buffer buffer)) 435 | (gl:vertex-attrib-pointer +bounding-box-vertex-loc+ 2 :float nil 0 0) 436 | (gl:draw-arrays :triangle-strip 0 4) 437 | ; (gl:disable-vertex-attrib-array 0) 438 | (gl:use-program 0) 439 | (gl:disable :stencil-test)) 440 | 441 | --------------------------------------------------------------------------------