(ql:quickload '(qtools qtcore qtgui))
(named-readtables:in-readtable :qtools)
(in-package #:cl+qt)

(defun traverse-files (function directory &key (test #'identity))
  (dolist (file (directory (merge-pathnames "*.*" directory)))
    (if (or (pathname-type file)
            (pathname-name file))
        (funcall function file)
        (when (funcall test file)
          (traverse-files function file :test test)))))

(defun ignored-file-p (file)
  (char= #\. (char (car (last (pathname-directory file))) 0)))

(defun file-line-lengths (file)
  (with-open-file (stream file :direction :input)
    (loop for line = (read-line stream NIL)
          while line
          collect (length line))))

(defun compute-length-freq-array (directory &key (file-types '("lisp" "lsp" "cl" "asd")))
  (let ((table (make-hash-table :test 'eql))
        (max 0))
    (traverse-files
     (lambda (file)
       (when (find (pathname-type file) file-types :test #'equalp)
         (dolist (length (cl-user::file-line-lengths file))
           (incf (gethash length table 0))
           (when (< max length) (setf max length)))))
     directory :test (complement #'ignored-file-p))
    (let ((array (make-array (1+ max) :element-type '(unsigned-byte 32))))
      (loop for i being the hash-keys of table
            for c being the hash-values of table
            do (setf (aref array i) c))
      array)))

(define-widget stats (QWidget)
  ((line-stats :initform #() :accessor line-stats)))

(defmethod initialize-instance :after ((stats stats) &key directory)
  (setf (line-stats stats) (compute-length-freq-array directory)))

(define-override (stats paint-event) (ev)
  (with-finalizing* ((painter (q+:make-qpainter stats))
                     (brush (q+:make-qbrush (q+:make-qcolor 30 150 30)))
                     (metrics (q+:make-qfontmetrics (q+:font painter))))
    (let* ((xmax (length line-stats))
           (ymax (loop for x across line-stats maximize x))
           (xstretch 5) (xdist 10) (xoff 50)
           (ystretch 0.1) (ydist 200))
      (q+:erase-rect painter (q+:rect stats))
      (loop for i from 0 below xmax
            for c = (aref line-stats i)
            do (q+:fill-rect painter (round (+ 50 (* xstretch i))) 20 5 (round (* ystretch c)) brush))
      ;; X axis (char count)
      (loop for i from 0 below xmax by xdist
            for width = (q+:width metrics (princ-to-string i))
            do (q+:draw-text painter (round (+ 50 (* xstretch i) (/ width -2))) 15 (princ-to-string i)))
      ;; Y axis (occurrence count)
      (loop for i from 0 below ymax by ydist
            for height = (q+:height metrics)
            do (q+:draw-text painter 0 (round (+ 20 (* ystretch i) (/ height 2))) (princ-to-string i))))))

(defun launch (directory)
  (with-main-window (w (make-instance 'stats :directory directory))))