(defpackage #:net.hexapodia.hexes
  (:use #:common-lisp)
  (:export #:make-hexes #:*paper-type*))

(in-package #:net.hexapodia.hexes)

(defvar *paper-type* :a4)

(defvar *paper-sizes* nil)

(defun initialize ()
  (unless *paper-sizes*
    (setf *paper-sizes* (make-hash-table))
    (setf (gethash :a4 *paper-sizes*) (list 842 595))
    (setf (gethash :a5 *paper-sizes*) (list 595 420))
    (setf (gethash :letter *paper-sizes*) (list 792 612))))

(defun paper-width ()
  (let ((pspec (gethash *paper-type* *paper-sizes*)))
    (second pspec)))

(defun paper-height ()
  (let ((pspec (gethash *paper-type* *paper-sizes*)))
    (first pspec)))

(defun emit-hex-def (stream radius)
  ;; Hex is drawn with top/bottom parallel to top/bottom of page,
  ;; cursor starting at leftmost corner.
  ;; Feed x y coordinates on stack
  (let ((vert (truncate (* radius (sqrt 0.75))))
	(half (truncate radius 2)))
    (format stream "/vert ~D def~%/half ~D def~%/radius ~D def~%" vert half radius)
    (format stream "/hex {newpath moveto half vert rlineto radius 0 rlineto half vert -1 mul rlineto -1 half mul vert -1 mul rlineto -1 radius mul 0 rlineto closepath stroke} def~%")))

(defun make-hexes (outfile &key (paper *paper-type*) (margin 20) (radius 10))
  "(make-hexes <outfile> & key paper margin

   paper defaults to *PAPER-TYPE*
   margin is measured in mm and defaults to 20
   radius is measured in mm and defaults to 10"
  (initialize)
  (let ((margin (truncate (/ (* margin 72) 25.4)))
	(radius (truncate (/ (* radius 72) 25.4)))
	(*paper-type* paper))
    (with-open-file (of outfile :if-exists :overwrite
			:if-does-not-exist :create
			:direction :output)
      (emit-hex-def of radius)
      (format of "/margin ~d def~%" margin)
      (format of "gsave~%")
      (loop for x from margin below (- (paper-width) margin radius)
	        by (* 3/2 radius)
	    for ix from 0
	    do (loop for y from 0
		     while (<= (+ margin margin
				  (* (+ 1 y y ) radius (sqrt 0.75)))
			       (paper-height))
		     do (format
			 of
			 "~d ~a margin vert 2 ~d mul mul add add hex~%"
			  x
			 (if (oddp ix) "0" "vert") y)))
      (format of "showpage~%grestore~%"))))