(ql:quickload 'mcclim/looks)

(cl:in-package :cl-user)
(defpackage :leland-ttf
  (:use :cl :zpb-ttf :clim :mcclim-truetype)
  (:shadowing-import-from :clim-lisp :interactive-stream-p))
(in-package :leland-ttf)

(defvar *leland-ttf-filename*
  (find-fontconfig-font "Leland"))

(defun truetype-full-report (&key (output *standard-output*)
			       (filename *leland-ttf-filename*))
  "Returns info on the font loader."
  (flet ((rpt (ctrl-string &rest fmt-args)
	   (apply #'format
		  output
		  (concatenate 'string "~&" ctrl-string)
		  fmt-args)))
    (with-font-loader (fonzie filename)
      (rpt "Examining TTF file: ~S" filename)
      (rpt "Total Glyphs: ~D" (glyph-count fonzie))
      (rpt "Collection Font Count: ~D" (collection-font-count fonzie))
      (rpt "Collection Font Index: ~D" (collection-font-index fonzie))
      (loop for name across zpb-ttf::*name-identifiers*
	    do (rpt "Name-entry: ~S = ~S"
		    name
		    (name-entry-value name fonzie)))
      (rpt "Italic-angle: ~D" (italic-angle fonzie))
      (rpt "Underline thickness: ~D" (underline-thickness fonzie))
      (rpt "Underline position: ~D" (underline-position fonzie))
      (rpt "Fixed pitch? ~:[Yes~;No~]" (fixed-pitch-p fonzie))
      (rpt "Units/em: ~D" (units/em fonzie))
      (rpt "Ascender: ~D" (ascender fonzie))
      (rpt "Descender: ~D" (descender fonzie))
      (rpt "Line gap: ~D" (line-gap fonzie))
      (rpt "Font Loader Postscript Name: ~S" (postscript-name fonzie))
      (rpt "Font Loader Full Name: ~S" (full-name fonzie))
      (rpt "Font Loader Subfamily Name: ~S" (subfamily-name fonzie))
      (rpt "Font Loader All Kerning Pairs: ~S" (all-kerning-pairs fonzie)))))

(defun scan-truetype-font-for-all-glyphs (&optional
					    (filename *leland-ttf-filename*))
  "Returns a list of all glyphs contained in a ttf file."
  (with-font-loader (fonzie filename)
    (loop for i from 0 to (1- (glyph-count fonzie))
	  collecting (index-glyph i fonzie))))

;; Now that we know we can load the TTF and some attributes about it, let's
;; get CLIM going.

(defun display-leland (frame pane)
  (with-text-style (pane (clim:make-device-font-text-style (port frame)
							   (list *leland-ttf-filename*
								 :size 20)))

    (loop for glyph in (scan-truetype-font-for-all-glyphs)
	  do (format pane "~C " (code-char (code-point glyph))))))

(define-application-frame leland-ttf-example ()
  ()
  (:panes 
   (ttf-demo (make-pane :application :display-function 'display-leland)))
  (:layouts
   (default (labelling (:width 900 :height 500) ttf-demo)))
  (:default-initargs :pretty-name "Leland TTF Display Pane"))

(defun leland-ttf-example ()
  (run-frame-top-level (make-application-frame 'leland-ttf-example)))