1 (in-package #:clnl-gltk)
8 ; This is a small hack for resource loading. It will do until number of resources grows
12 "resources/clnl-gltk/font.dat"
13 (asdf:system-relative-pathname 'clnl-gltk "resources/clnl-gltk/font.dat")
14 (asdf:system-relative-pathname 'clnl-gltk "../../resources/clnl-gltk/font.dat")))
17 (find-if (lambda (loc) (probe-file loc)) font-locs)
18 (error "Couldn't find font location!"))))
20 (str font-loc :element-type 'unsigned-byte)
22 ((seq (make-sequence 'vector (/ (* 4 (file-length str)) 3))))
25 :for r := (read-byte str nil)
26 :for g := (read-byte str nil)
27 :for b := (read-byte str nil)
31 (setf (aref seq (* idx 4)) r)
32 (setf (aref seq (+ (* idx 4) 1)) r)
33 (setf (aref seq (+ (* idx 4) 2)) r)
34 (setf (aref seq (+ (* idx 4) 3)) r)))
37 (defvar *font-width* 7
50 The width of the font used by CLNL-GLTK.
52 This can be used to calculate appropriate sizes of things
53 that may have fonts displayed in them.")
55 (defvar *font-height* 14
68 The height of the font used by CLNL-GLTK.
70 This can be used to calculate appropriate sizes of things
71 that may have fonts displayed in them.")
73 (defun font-print (str)
74 "FONT-PRINT STR => RESULT
78 STR: a string to be printed to screen
83 FONT-PRINT prints STR to the screen.
85 It affirms no assumptions that are required for it to run, in the
86 interest of speed. Those assumptions include that an opengl window
87 has been opened, that all matrices are correct, and that SETUP-FONT
92 (font-print #P\"Hello World\" t) => nil"
93 (gl:enable :texture-2d)
94 (gl:bind-texture :texture-2d *texture*)
96 (gl:call-lists (map 'vector (lambda (c) (- (char-code c) 32)) str))
97 (gl:disable :texture-2d))
100 (setf *texture* (first (gl:gen-textures 1)))
101 (gl:bind-texture :texture-2d *texture*)
102 (gl:tex-parameter :texture-2d :texture-mag-filter :linear)
103 (gl:tex-parameter :texture-2d :texture-min-filter :linear)
104 (gl:tex-image-2d :texture-2d 0 :rgba8 (* *font-width* 224) *font-height* 0 :rgba :unsigned-byte *font-data*)
105 (setf *base* (gl:gen-lists 224))
107 (gl:with-new-list ((+ *base* l) :compile)
109 (gl:tex-coord (/ l 224d0) 1d0)
111 (gl:tex-coord (/ (1+ l) 224d0) 1d0)
112 (gl:vertex *font-width* 0)
113 (gl:tex-coord (/ (1+ l) 224d0) 0d0)
114 (gl:vertex *font-width* *font-height*)
115 (gl:tex-coord (/ l 224d0) 0d0)
116 (gl:vertex 0 *font-height*)
118 (gl:translate *font-width* 0 0))))