(defconstant +target-frames-per-second+ 60)
(defconstant +degrees-per-second+ 9)
(defconstant +steps+ 10)

(defclass gl-font-window (glut:window)
  ((font-loader :initarg :font :initform (error "Must give a font"))
   (string      :initarg :string)
   (paused      :initform nil)
   (angle       :initform 0)
   (fps         :initform "")
   (frame-count :initform 0)
   (start-time  :initform 0))
  (:default-initargs :width 640
                     :height 480
		     :title "Font Test"
		     :string "Font Test"
		     :mode '(:single :rgb :stencil)))

(defmethod glut:display-window :before ((w gl-font-window))
  (with-slots (fps frame-count start-time) w
    (setf fps ""
	  frame-count 0
	  start-time (get-internal-real-time)))
  (gl:clear-color 1 1 0.7 0)
  (glut:enable-tick w (round (/ 1000 +target-frames-per-second+))))

(defmethod glut:display ((w gl-font-window))
  (gl:clear :color-buffer-bit)
  (gl:load-identity)
  (with-slots (fps angle font-loader string) w
    (gl:color 0 0 1 1)
    (gl:with-pushed-matrix
      (gl:translate 240 180 0)
      (draw-string font-loader fps :size 8 :filled t))
    (gl:color 0 0 0 1)
    (gl:rotate angle 0 2 1)
    (loop :for ii :from 1 :to +steps+
       :do (gl:color 0 0 0 (/ ii +steps+))
           (gl:rotate 5 0 2 1)
           (draw-string font-loader string :size 153 :filled t)))
  (gl:flush))

(defmethod glut:tick ((w gl-font-window))
  (with-slots (paused angle fps frame-count start-time) w
    (unless paused
      (when (<= 10 (incf frame-count))
	(let ((cur (get-internal-real-time)))
	  (setf fps (format nil "~,1F fps"
			    (/ (* frame-count
				  internal-time-units-per-second)
			       (- cur start-time)))
		frame-count 0
		start-time cur)))
      (incf angle (/ +degrees-per-second+ +target-frames-per-second+)))
    (glut:post-redisplay)))

(defmethod glut:mouse ((w gl-font-window) button state x y)
  (declare (ignore button x y))
  (when (eql state :down)
    (with-slots (paused fps frame-count start-time) w
      (setf paused (not paused))
      (unless paused
	(setf fps ""
	      frame-count 0
	      start-time (get-internal-real-time))))
    (glut:post-redisplay)))

(defmethod glut:reshape ((w gl-font-window) width height)
  (gl:viewport 0 0 width height)
  (gl:matrix-mode :projection)
  (gl:load-identity)
  (gl:ortho -320 320 -240 240 -320 320)
  (gl:matrix-mode :modelview))