glrepl.lisp

   1
   2 (in-package :glrepl)
   3
   4
   5 (defclass glrepl-font ()
   6   ((height :initform 128 :reader bitmap-height-of) ;; 15 up
   7    (width :initform 128  :reader bitmap-width-of)         ;; 16 across
   8    (pathname :initform (merge-pathnames #P"VeraMono.ttf") :initarg :pathname :reader pathname-of)
   9    (images :initform (make-array 128) :reader images-of)))
  10
  11
  12 (defparameter *bitmap-height* 128) ;; 15 up
  13 (defparameter *bitmap-width* 128)  ;; 16 across
  14 (defparameter *font-pathname* (merge-pathnames #P"VeraMono.ttf"))
  15 (defparameter *font-images* (make-array 128))
  16
  17 ;; note that these are 7 bit fonts since I'm avoiding the horrors of encoding for now
  18 ;; probably the correct way to do this is to decode on the fly and cache font textures
  19 ;; but deadlines are DEADlines...
  20
  21
  22 (defun make-font (font-pathname)
  23   (let ((result (make-instance 'glrepl-font :pathname font-pathname)))
  24         (iterate
  25          (for i from 0 below 128)
  26          (vecto:with-canvas (:width (bitmap-width-of result) :height (bitmap-height-of result))
  27            (let ((repl-font (vecto:get-font (pathname-of result)))
  28                          (repl-letter (string (code-char i))))
  29                  (vecto:set-font repl-font 12)
  30                  (when (zpb-ttf:glyph-exists-p (code-char i) repl-font)
  31                    (handler-case
  32                            (progn
  33                                  (vecto:set-rgba-fill 0.0 0.0 0.0 0.0)
  34                                  (vecto:clear-canvas)
  35                                  (vecto:set-rgba-fill 1.0 1.0 1.0 1.0)
  36                                  (vecto:translate 52 24) ;; to do -- these are magic numbers -- should be computed from bitmap width & height
  37                                  (vecto:scale 12 8)
  38                                  (vecto:draw-centered-string 0 0 repl-letter)
  39                  (when (alpha-char-p (code-char i))
  40                    (vecto:save-png (merge-pathnames  (concatenate 'string (string (code-char i)) ".png"))))
  41                                  (vecto:with-graphics-state
  42                                          (setf (aref (images-of result) i)
  43                                                    (make-instance 'rgba-image :width (bitmap-width-of result) :height (bitmap-height-of result)))
  44                                    (iterate
  45                     (for x from 0 below (bitmap-width-of result))
  46                     (iterate
  47                                          (for y from 0 below (bitmap-height-of result))
  48                                          (setf (pixel-xy (aref (images-of result) i) x y) ;;  #XFF000000
  49                                                    (pixval
  50                                                         (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 0)
  51                                                         (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 1)
  52                                                         (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 2)
  53                                                         (aref (zpng::data-array (vecto::image vecto::*graphics-state*)) y x 3))
  54                                                    )))
  55                                    (update-image (aref (images-of result) i))))
  56                          (error () (format t  "Skipping char ~A~&" i)))))))
  57     result))
  58
  59 (defun destroy-font (font)
  60   (iterate
  61    (for i from 0 below 128)
  62    (when (typep (aref (images-of font) i) 'rgba-image)
  63          (destroy-image (aref (images-of font) i))
  64          (setf (aref (images-of font) i) NIL))))
  65
  66 ;; to do -- check bounding boxes are all sane..
  67
  68
  69
  70 ;; (zpb-ttf:with-font-loader  (fnt (merge-pathnames #P"VeraMono.ttf"))
  71 ;;   (format t "Font Bounding box ~A~%" (zpb-ttf::bounding-box fnt))
  72 ;;   (iterate
  73 ;;     (for i from 0 to 128)
  74 ;;     (format t "~A ~A~%"
  75 ;;             (if (zpb-ttf:glyph-exists-p (code-char i) fnt) "Exists" "Nonexistent")
  76 ;;             (zpb-ttf::string-bounding-box (string (code-char i)) fnt))))