code.consxy.com Git - clnl/blob - src/main/clnl-gltk/font.lisp

   1 (in-package #:clnl-gltk)
   2
   3 (defvar *texture*)
   4 (defvar *base*)
   5
   6 (defvar *font-data*
   7  (let*
   8   ; This is a small hack for resource loading.  It will do until number of resources grows
   9   ; to greater than 1.
  10   ((font-locs
  11     (list
  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")))
  15    (font-loc
  16     (or
  17      (find-if (lambda (loc) (probe-file loc)) font-locs)
  18      (error "Couldn't find font location!"))))
  19   (with-open-file
  20    (str font-loc :element-type 'unsigned-byte)
  21    (let
  22     ((seq (make-sequence 'vector (/ (* 4 (file-length str)) 3))))
  23     (loop
  24      :for idx :from 0
  25      :for r := (read-byte str nil)
  26      :for g := (read-byte str nil)
  27      :for b := (read-byte str nil)
  28      :while r
  29      :do
  30      (progn
  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)))
  35     seq))))
  36
  37 (defvar *font-width* 7
  38  "*FONT-WIDTH*
  39
  40 VALUE TYPE:
  41
  42   an integer
  43
  44 INITIAL VALUE:
  45
  46   7.
  47
  48 DESCRIPTION:
  49
  50   The width of the font used by CLNL-GLTK.
  51
  52   This can be used to calculate appropriate sizes of things
  53   that may have fonts displayed in them.")
  54
  55 (defvar *font-height* 14
  56  "*FONT-HEIGHT*
  57
  58 VALUE TYPE:
  59
  60   an integer
  61
  62 INITIAL VALUE:
  63
  64   14
  65
  66 DESCRIPTION:
  67
  68   The height of the font used by CLNL-GLTK.
  69
  70   This can be used to calculate appropriate sizes of things
  71   that may have fonts displayed in them.")
  72
  73 (defun font-print (str)
  74  "FONT-PRINT STR => RESULT
  75
  76 ARGUMENTS AND VALUES:
  77
  78   STR: a string to be printed to screen
  79   RESULT: undefined
  80
  81 DESCRIPTION:
  82
  83   FONT-PRINT prints STR to the screen.
  84
  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
  88   has been run.
  89
  90 EXAMPLES:
  91
  92   (font-print #P\"Hello World\" t) => nil"
  93  (gl:enable :texture-2d)
  94  (gl:bind-texture :texture-2d *texture*)
  95  (gl:list-base *base*)
  96  (gl:call-lists (map 'vector (lambda (c) (- (char-code c) 32)) str))
  97  (gl:disable :texture-2d))
  98
  99 (defun setup-font ()
 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))
 106  (dotimes (l 224)
 107   (gl:with-new-list ((+ *base* l) :compile)
 108    (gl:begin :quads)
 109    (gl:tex-coord (/ l 224d0) 1d0)
 110    (gl:vertex 0 0)
 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*)
 117    (gl:end)
 118    (gl:translate *font-width* 0 0))))