glrepl.lisp

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