;;; -*- Mode:Common-Lisp; Package:VECTOR-FONT; Base:10 -*-




(defun find-height-for-width (string vector-font target-width &optional (ratio 1))
  (let* ((max 2000)
	 (min 0)
	 (n 1000))
    (loop
      (let* ((width (vector-string-width string vector-font n ratio)))
	(cond ((or (< (abs (- width target-width)) 1)
		   (= max min))
	       (return n))
	      ((< width target-width)
	       (setq min n))
	      ((> width target-width)
	       (setq max n)))
	(setq n (+ min (float (/ (- max min) 2))))))))


(defun zoom (string window &optional (delay 0) (forward-p t) (ratio 1))
  (let* ((width (tv:sheet-inside-width window))
	 (height (tv:sheet-inside-height window))
	 (mid-x (round width 2))
	 (mid-y (round height 2))
	 (string-height (if forward-p 1 (find-height-for-width string *vector-font* (* 0.9 width) ratio)))
	 (color w:red)
	 (erase-aluf (send window :erase-aluf))
	 last-x last-y last-height
	 )
    (send window :clear-screen)
    (loop
      (when last-x
	(draw-vector-string window string *vector-font* last-x last-y last-height erase-aluf ratio color))
      (let* ((string-width (vector-string-width string *vector-font* string-height ratio))
	     (x (- mid-x (round string-width 2)))
	     (y (+ mid-y (round string-height 2))))
	(draw-vector-string window string *vector-font* x y string-height TV:ALU-TRANSP ratio color)
	(sleep delay)
	(setq last-x x last-y y last-height string-height)
	(cond (forward-p
	       (setq string-height (* 1.2 string-height))
	       (when (>= string-width (* .9 width)) (return)))
	      (t
	       (setq string-height (* .8 string-height))
	       (when (<= string-height 1) (return))))
	))
    string-height))


(defun shrug (string window string-height &optional (delay 0) (limit 30) (ratio 1) (forward-p t))
  (let* ((width (tv:sheet-inside-width window))
	 (height (tv:sheet-inside-height window))
	 (mid-x (round width 2))
	 (mid-y (round height 2))
	 (color w:red)
	 (erase-aluf (send window :erase-aluf))
	 last-x last-y last-ratio
	 )
    (send window :clear-screen)
    (loop
      (when last-x
	(draw-vector-string window string *vector-font* last-x last-y string-height erase-aluf last-ratio color))
      (let* ((string-width (vector-string-width string *vector-font* string-height ratio))
	     (x (- mid-x (round string-width 2)))
	     (y (+ mid-y (round string-height 2))))
	(draw-vector-string window string *vector-font* x y string-height TV:ALU-TRANSP ratio color)
	(sleep delay)
	(setq last-x x last-y y last-ratio ratio)
	(cond (forward-p
	       (setq ratio (* 1.1 ratio))
	       (when (> string-width limit) (return)))
	      (t
	       (setq ratio (* .9 ratio))
	       (when (< string-width limit) (return))))
	)))
  ratio)



(defun yo (string &optional (delay 0))
  (let* (h r)
    (setq h (zoom string tv:selected-window delay t))
    (setq r (shrug string tv:selected-window h 0 100 1 nil))
    (setq r (shrug string tv:selected-window h 0 500 r t))
    (setq h (zoom string tv:selected-window delay nil r))))




(defun lucas (list-of-strings)
  (let* ((nlines (length list-of-strings))
	 (w (tv:sheet-inside-width tv:selected-window))
	 (h (tv:sheet-inside-height tv:selected-window))
	 (hh 20)
	 (delta 1.2)
	 (y 100)
	 )
    (dolist (string list-of-strings)
      (let* ((ww (vector-string-width string *vector-font* hh))
	     (xoff (- (round w 2) (round ww 2))))
	(draw-hollow-vector-string tv:selected-window string *vector-font* xoff y hh)
	(setq hh (* delta hh))
	(incf y hh)))))


(setq foo (make-instance 'w:window :edges-from ':mouse))

(defun dump ()
  (fresh-line)
  (dotimes (i 3)
    (dotimes (j 3)
      (princ (aref (send foo :transform) j i))
      (princ #\Space))
    (terpri)))

(defun test ()
  (progn
    (send foo :clear-input)
    (send foo :select)
    (send foo :draw-line 20  20  20  200)
    (send foo :draw-line 20  20  300 20)
    (send foo :draw-line 20  200 300 200)
    (send foo :draw-line 300 20  300 200)
    (read-char foo)
    (send *terminal-io* :select)
    ))