glrepl.lisp

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