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

   1 ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3.  See distributed LICENSE.txt.
   2 (in-package #:clnl-gltk)
   3
   4 (defvar *texture*)
   5 (defvar *base*)
   6
   7 (defvar *font-data*
   8  (let*
   9   ; This is a small hack for resource loading.  It will do until number of resources grows
  10   ; to greater than 1.
  11   ((font-locs
  12     (list
  13      "resources/clnl-gltk/font.dat"
  14      (asdf:system-relative-pathname 'clnl-gltk "resources/clnl-gltk/font.dat")
  15      (asdf:system-relative-pathname 'clnl-gltk "../../resources/clnl-gltk/font.dat")))
  16    (font-loc
  17     (or
  18      (find-if (lambda (loc) (probe-file loc)) font-locs)
  19      (error "Couldn't find font location!"))))
  20   (with-open-file
  21    (str font-loc :element-type 'unsigned-byte)
  22    (let
  23     ((seq (make-sequence 'vector (/ (* 4 (file-length str)) 3))))
  24     (loop
  25      :for idx :from 0
  26      :for r := (read-byte str nil)
  27      :for g := (read-byte str nil)
  28      :for b := (read-byte str nil)
  29      :while r
  30      :do
  31      (progn
  32       (setf (aref seq (* idx 4)) r)
  33       (setf (aref seq (+ (* idx 4) 1)) r)
  34       (setf (aref seq (+ (* idx 4) 2)) r)
  35       (setf (aref seq (+ (* idx 4) 3)) r)))
  36     seq))))
  37
  38 (defvar *font-width* 7
  39  "*FONT-WIDTH*
  40
  41 VALUE TYPE:
  42
  43   an integer
  44
  45 INITIAL VALUE:
  46
  47   7.
  48
  49 DESCRIPTION:
  50
  51   The width of the font used by CLNL-GLTK.
  52
  53   This can be used to calculate appropriate sizes of things
  54   that may have fonts displayed in them.")
  55
  56 (defvar *font-height* 14
  57  "*FONT-HEIGHT*
  58
  59 VALUE TYPE:
  60
  61   an integer
  62
  63 INITIAL VALUE:
  64
  65   14
  66
  67 DESCRIPTION:
  68
  69   The height of the font used by CLNL-GLTK.
  70
  71   This can be used to calculate appropriate sizes of things
  72   that may have fonts displayed in them.")
  73
  74 (defun font-print (str)
  75  "FONT-PRINT STR => RESULT
  76
  77 ARGUMENTS AND VALUES:
  78
  79   STR: a string to be printed to screen
  80   RESULT: undefined
  81
  82 DESCRIPTION:
  83
  84   FONT-PRINT prints STR to the screen.
  85
  86   It affirms no assumptions that are required for it to run, in the
  87   interest of speed.  Those assumptions include that an opengl window
  88   has been opened, that all matrices are correct, and that SETUP-FONT
  89   has been run.
  90
  91 EXAMPLES:
  92
  93   (font-print #P\"Hello World\" t) => nil"
  94  (gl:enable :texture-2d)
  95  (gl:bind-texture :texture-2d *texture*)
  96  (gl:list-base *base*)
  97  (gl:call-lists (map 'vector (lambda (c) (- (char-code c) 32)) str))
  98  (gl:disable :texture-2d))
  99
 100 (defun setup-font ()
 101  (setf *texture* (first (gl:gen-textures 1)))
 102  (gl:bind-texture :texture-2d *texture*)
 103  (gl:tex-parameter :texture-2d :texture-mag-filter :linear)
 104  (gl:tex-parameter :texture-2d :texture-min-filter :linear)
 105  (gl:tex-image-2d :texture-2d 0 :rgba8 (* *font-width* 224) *font-height* 0 :rgba :unsigned-byte *font-data*)
 106  (setf *base* (gl:gen-lists 224))
 107  (dotimes (l 224)
 108   (gl:with-new-list ((+ *base* l) :compile)
 109    (gl:begin :quads)
 110    (gl:tex-coord (/ l 224d0) 1d0)
 111    (gl:vertex 0 0)
 112    (gl:tex-coord (/ (1+ l) 224d0) 1d0)
 113    (gl:vertex *font-width* 0)
 114    (gl:tex-coord (/ (1+ l) 224d0) 0d0)
 115    (gl:vertex *font-width* *font-height*)
 116    (gl:tex-coord (/ l 224d0) 0d0)
 117    (gl:vertex 0 *font-height*)
 118    (gl:end)
 119    (gl:translate *font-width* 0 0))))