;;; cl-pdf copyright 2002 Marc Battyani see license.txt for details of the BSD style license
;;; You can reach me at marc.battyani@fractalconcept.com or marc@battyani.net
;;; The homepage of cl-pdf is here: http://www.fractalconcept.com/asp/html/cl-pdf.html

(defun example1 (&optional (file #P"/tmp/ex1.pdf"))
  (pdf:with-document ()
    (pdf:with-page ()
      (pdf:with-outline-level ("Example" (pdf:register-page-reference))
	(let ((helvetica (pdf:get-font "Helvetica")))
	  (pdf:in-text-mode
	   (pdf:set-font helvetica 36.0)
	   (pdf:move-text 100 800)
	   (pdf:draw-text "cl-pdf: Example 1"))
	  (pdf:translate 230 500)
	  (loop repeat 101
	    for i = 0.67 then (* i 1.045)
	    do (pdf:in-text-mode
		(pdf:set-font helvetica i)
		(pdf:move-text (* i 3) 0)
		(pdf:draw-text "rotation"))
	    (pdf:rotate 18)))))
    (pdf:write-document file)))

(defun example2 (&optional (file #P"/tmp/ex2.pdf"))
  (pdf:with-document ()
    (pdf:with-page ()
      (pdf:with-outline-level ("Example" (pdf:register-page-reference))
	(let ((helvetica (pdf:get-font "Helvetica")))
	  (pdf:in-text-mode
	   (pdf:set-font helvetica 36.0)
	   (pdf:move-text 100 800)
	   (pdf:draw-text "cl-pdf: Example 2"))
	  (pdf:move-to (+ 10 (random 500))(+ 10 (random 400)))
	  (pdf:set-gray-fill 0.5)
	  (dotimes (i 50)
	    (pdf:line-to (+ 50 (random 500)) (+ 50 (random 400))))
	  (pdf:close-even-odd-fill-and-stroke)
	  (pdf:move-to (+ 50 (random 500))(+ 400 (random 400)))
	  (pdf:set-rgb-fill 0.5 0.5 0.8)
	  (pdf:set-rgb-stroke 0.9 0.5 0.1)
	  (dotimes (i 50)
	    (pdf:bezier2-to (+ 50 (random 500)) (+ 400 (random 400))
			    (+ 50 (random 500)) (+ 400 (random 400))))
	  (pdf:close-even-odd-fill-and-stroke))))
    (pdf:write-document file)))

(defun gen-image-bits ()
  (with-output-to-string (s)
     (loop for x from -10 to 10 by 1/10
	   do (loop for y from -10 to 10 by 1/10
		    do (format s "~2,'0x~2,'0x~2,'0x"
			  (round (+ 200 (* 55 (sin x))))
			  (round (+ 200 (* 55 (cos y))))
			  (round (+ 200 (* 55 (sin (+ x y))))))))))

(defun example3 (&optional (file #P"/tmp/ex3.pdf"))
  (pdf:with-document ()
    (pdf:with-page ()
      (pdf:with-outline-level ("Example" (pdf:register-page-reference))
	(let* ((helvetica (pdf:get-font "Helvetica"))
	       (image (make-instance 'pdf:image
				     :bits (gen-image-bits) 
				     :width 201 :height 201)))
	  (pdf:draw-bar-code128 "30A0033111436" 20 100)
	  (pdf:add-images-to-page image)
	  (pdf:in-text-mode
	   (pdf:set-font helvetica 36.0)
	   (pdf:move-text 100 800)
	   (pdf:draw-text "cl-pdf: Example 3"))
	  (pdf:with-saved-state
	      (pdf:translate 102 550)
	    (pdf:rotate 20)
	    (pdf:scale 200 125)
	    (pdf:paint-image image))
	  (pdf:with-saved-state
	      (pdf:translate 100 540)
	    (pdf:rotate -70)
	    (pdf:scale 300 200)
	    (pdf:paint-image image)))))
    (pdf:write-document file)))


;; logo

(defparameter *fractal-ratio* 0.8)
(defconstant +sin60+ (sin (/ pi 3)))
(defconstant +cos60+ (cos (/ pi 3)))
(defconstant +tg30+ (tan (/ pi 6)))
(defconstant +tg60-tg30+ (- (tan (/ pi 3))(tan (/ pi 6))))

(defun %fractal (x y dx dy level)
  (if (zerop level)
    (let ((dx/2 (* dx 0.5))
	  (dy/2 (* dy 0.5)))
      (pdf:move-to (- x dx/2) (- y dy/2))
      (pdf:line-to x (+ y dy/2))
      (pdf:line-to (+ x dx/2) (- y dy/2))
      (pdf:close-fill-and-stroke))
    (let* ((delta (- 1 *fractal-ratio*))
	   (delta05 (* 0.5 delta))
	   (ratio2 (- 1 delta05))
	   (deltax (* dx 0.25 (+ 1 (* 0.5 +sin60+ (- 1 ratio2)))))
	   (deltay (* dy 0.25 (+ 1 delta05)))
	   (dyf2 (* dy 0.5 (+ 1 delta05 )))
	   (dxf2 (* dx 0.5 (+ 1 delta05 ))))
      (decf level)
      (setf dx (* dx 0.5))
      (setf dy (* dy 0.5))
      (%down-fractal x (- y (* 1 dy)(* dx +tg30+ -1)(* 0.125 +tg60-tg30+ dxf2)) dxf2 dyf2 level)
      (%fractal x      (+ y (* dy 0.5)) (* dx *fractal-ratio*) (* dy *fractal-ratio*) level)
      (%fractal (+ x deltax)(- y deltay)(* dx *fractal-ratio*) (* dy *fractal-ratio*) level)
      (%fractal (- x deltax)(- y deltay)(* dx *fractal-ratio*) (* dy *fractal-ratio*) level)
      )))

(defun %down-fractal (x y dx dy level)
  (setf level 0) 
  (if (zerop level)
    (let ((dx/2 (* dx 0.5))
	  (dy/2 (* dy 0.5)))
      (pdf:move-to (- x dx/2) (+ y dy/2))
      (pdf:line-to x (- y dy/2))
      (pdf:line-to (+ x dx/2)(+ y dy/2))
      (pdf:close-fill-and-stroke))
    (let* ((delta (- 1 *fractal-ratio*))
	   (delta05 (* 0.5 delta))
	   (ratio2 (- 1 delta05))
	   (deltax (* dx 0.25 (+ 1 (* 0.5 +sin60+ (- 1 ratio2)))))
	   (deltay (* dy 0.25 (+ 1 delta05)))
	   (dyf2 (* dy 0.5 (+ 1 delta05 )))
	   (dxf2 (* dx 0.5 (+ 1 delta05 ))))
      (decf level)
      (setf dx (* dx 0.5))
      (setf dy (* dy 0.5))
      (%fractal x (+ y (* 1 dy)(* dx +tg30+ -1)(* 0.125 +tg60-tg30+ dxf2)) dxf2 dyf2 level)
      (%down-fractal x      (- y (* dy 0.5)) (* dx *fractal-ratio*) (* dy *fractal-ratio*) level)
      (%down-fractal (+ x deltax)(+ y deltay)(* dx *fractal-ratio*) (* dy *fractal-ratio*) level)
      (%down-fractal (- x deltax)(+ y deltay)(* dx *fractal-ratio*) (* dy *fractal-ratio*) level)
      )
    ))

(defun fractal (x y l level)
  (let ((dx l)
	(dy (* l +sin60+)))
  (%fractal x y dx dy level)))

;the logo
(defun example4 (&optional (file #P"/tmp/ex4.pdf"))
  (pdf:with-document ()
    (loop for i from 1 to 7
	  do (pdf:with-page ()
	       (pdf:with-outline-level ((format nil "Page ~d" i)(pdf:register-page-reference))
		 (let* ((helvetica (pdf:get-font "Helvetica")))
		   (pdf:in-text-mode
		    (pdf:set-font helvetica 36.0)
		    (pdf:move-text 100 800)
		    (pdf:draw-text (format nil "cl-pdf: Example 4    page ~d" i)))
		   (pdf:set-rgb-stroke 1.0 1.0 1.0)
		   (pdf:set-rgb-fill 0.4 0.4 0.9)
		   (pdf:set-line-width 0.2)
		   (fractal 298 530 600 i)))))
    (pdf:write-document file)))

(defvar *dx* #(1 0 -1 0))
(defvar *dy* #(0 1 0 -1))

;make-maze
(defun example5 (nx ny &key (size 10) (file #P"/tmp/ex5.pdf"))
  (let ((x-stack '())
	(y-stack '())
	(visited (make-array (list nx ny) :initial-element nil))
	(v-walls (make-array (list nx ny) :initial-element t))
	(h-walls (make-array (list nx ny) :initial-element t))
	(x (random nx))
	(y (random ny))
	next-x next-y)
    (flet ((find-cell ()
	       (let ((tested (vector nil nil nil nil))
		     (nb-tested 0))
		 (loop while (< nb-tested 4)
		       for test = (random 4)
		       unless (svref tested test)
		       do (incf nb-tested)
		       (setf (svref tested test) t)
		       (setf next-x (+ x (svref *dx* test)))
		       (setf next-y (+ y (svref *dy* test)))
		       (when (and (>= next-x 0)(< next-x nx)(>= next-y 0)(< next-y ny)
				  (not (aref visited next-x next-y)))
			 (return-from find-cell t)))
		 nil)))
      (setf (aref visited x y) t)
      (loop with nb-visited = 1 and total-cells = (* nx ny)
	    while (< nb-visited total-cells)
	    do (if (find-cell)
		 (progn (push x x-stack)(push y y-stack)
			(if (/= next-x x)
			  (setf (aref h-walls (min x next-x) y) nil)
			  (setf (aref v-walls x (min y next-y)) nil))
			(setf x next-x y next-y)
			(setf (aref visited x y) t)
			(incf nb-visited))
		 (progn (setf x (pop x-stack) y (pop y-stack))))))
    (pdf:with-document ()
      (pdf:with-page ()
	(pdf:with-outline-level ("Example" (pdf:register-page-reference))
	  (pdf:translate (* 0.5 (- 595 (* nx size)))(* 0.5 (- 841 (* ny size))))
	  (setf (aref h-walls (1- nx) (random ny)) nil)
	  (pdf:move-to 0 0)
	  (pdf:line-to (*  nx size) 0)
	  (pdf:move-to 0 size)
	  (pdf:line-to 0 (* ny size))
	  (loop for x from 0 below nx
		for x0 = 0 then x1
		for x1 from size by size
		do (loop for y from 0 below ny
			 for y0 = 0 then y1
			 for y1 from size by size
			 do
			 (when (aref h-walls x y)
			   (pdf:move-to x1 y0)
			   (pdf:line-to x1 y1))
			 (when (aref v-walls x y)
			   (pdf:move-to x0 y1)
			   (pdf:line-to x1 y1)))
		(pdf:stroke))))
      (pdf:write-document file))))


(defun example6 (&optional (file #P"/tmp/ex6.pdf"))
  (pdf:with-document ()
    (pdf:with-page ()
      (pdf:with-outline-level ("Example" (pdf:register-page-reference))
	(let ((helvetica (pdf:get-font "Helvetica")))
	  (pdf:in-text-mode
	   (pdf:set-font helvetica 36.0)
	   (pdf:move-text 100 800)
	   (pdf:draw-text "cl-pdf: Example 6"))
	  (pdf:set-rgb-stroke 0.1 0.1 0.1)
	  (pdf:set-rgb-fill 0.8 0.8 0.8)
	  (let ((x 50) (y 600))
	    (dotimes (i 2)
	      (pdf:rectangle x y 500 140 :radius 10)
	      (pdf:close-fill-and-stroke)
	      (setf y (- y 180))))
	  (pdf:translate 50 670)
	  (let ((x 50) (y 0))
	    (loop repeat 4
	      for i = 8 then (* i 1.05)
	      do
	      (pdf:set-rgb-fill (* 0.1 i) (* 0.01 i) (* 0.02 i))
	      (pdf:circle x y (* 4 i))
	      (pdf:close-fill-and-stroke)
	      (pdf:ellipse (+ x 250) y (* 5 i) (* 4 i))
	      (pdf:close-fill-and-stroke)
	      (setf x (+ x 50))))
	  (pdf:translate 0 -180)
	  (pdf:regular-polygon 150 0 50 7 :fillet-radius 8)
	  (pdf:close-fill-and-stroke)
	  (pdf:star 350 0 50 30 6 :fillet-radius 5)
	  (pdf:close-fill-and-stroke)
	  
	  (pdf:set-rgb-fill 0.8 0.6 0.2)
	  (pdf:regular-polygon 150 0 30 5 :fillet-radius 4)
	  (pdf:close-fill-and-stroke)
	  (pdf:star 350 0 40 20 4 :fillet-radius 6)
	  (pdf:close-fill-and-stroke)
	  
	  (pdf:set-rgb-fill 0.4 0.8 0.7)
	  (pdf:regular-polygon 150 0 15 3 :fillet-radius 3)
	  (pdf:close-fill-and-stroke)
	  (pdf:star 350 0 35 10 12 :fillet-radius 1)
	  (pdf:close-fill-and-stroke)
	  (pdf:set-line-width 0.5)
	  (loop for r from 2 to 100 by 2
		for start = (* pi 0.001 (random 2000))
		for length = (* pi 0.001 (random 2000))
		do (pdf:set-rgb-stroke (* 0.01 (random 100))(* 0.01 (random 100))(* 0.01 (random 100)))
		(pdf:arc 250 -230 r start length)
		(pdf:stroke)))))
    (pdf:write-document file)))

(defvar *test-jpeg-file-path* (when *load-pathname*
			   (merge-pathnames #P"banner.jpg" *load-pathname*)))

(unless *test-jpeg-file-path*
  (error "please set the *test-jpeg-file-path* variable to the banner.jpg file location"))

(defvar *test-jpeg* *test-jpeg-file-path*)

(defun example7 (&optional (file #P"/tmp/ex7.pdf"))
  (pdf:with-document ()
    (let ((jpg-image (pdf:make-jpeg-image *test-jpeg*))
	  (helvetica (pdf:get-font "Helvetica")))
      (pdf:with-outline-level ("Contents" "page 1")
	(pdf:with-page ()
	  (pdf:register-page-reference "page 1")
	  (pdf:with-outline-level ("Page 1" "page 1")
	    (pdf:in-text-mode
	     (pdf:set-font helvetica 36.0)
	     (pdf:move-text 100 800)
	     (pdf:draw-text "cl-pdf: Example 7"))
	    (pdf:set-rgb-stroke 0.1 0.1 0.1)
	    (pdf:set-rgb-fill 0.6 0.6 0.8)
	    (pdf:in-text-mode
	     (pdf:set-font helvetica 13.0)
	     (pdf:move-text 10 700)
	     (pdf:draw-text "Test for bookmarks, JPEG support, internal links, URI links and basic charts"))
	    (pdf:add-images-to-page jpg-image)
	    (pdf:draw-image jpg-image 10 10 239 50 0 t)
	    (pdf:add-URI-link 10 10 239 50 "http://www.fractalconcept.com/asp/html/cl-pdf.html" :border #(1 1 1))
	    (pdf:in-text-mode
	     (pdf:set-font helvetica 10.0)
	     (pdf:move-text 500 10)
	     (pdf:draw-text "goto page 2"))
	    (pdf:add-link 495 8 80 14 "page 2")
	    (pdf:draw-object (make-instance 'pdf:histogram :x 200 :y 450 :width 300 :height 200
					    :label-names '("Winter" "Spring" "Summer" "Autumn")
					    :labels&colors '(("Serie 1" (1.0 0.0 0.0))
							     ("Serie 2" (0.0 1.0 0.0)))
					    :series '((42 46 48 42)(40 38 51 46))
					    :background-color '(0.9 0.9 0.9)
					    :stacked-series nil ;;; try also with t
					    :x-axis-options ()
					    :y-axis-options ()
					    :legend-options ()))
	    (pdf:draw-object (make-instance 'pdf:pie-chart :x 200 :y 100 :width 200 :height 200
					    :serie '(12 23 65 33)
					    :labels&colors '(("Winter" (1.0 0.0 0.0))
							     ("Spring" (0.0 1.0 0.0))
							     ("Summer" (0.0 0.0 1.0))
							     ("Autumn" (0.0 1.0 1.0)))))))
	(pdf:with-page ()
	  (pdf:register-page-reference "page 2")
	  (pdf:with-outline-level ("Page 2" "page 2")
	    (pdf:in-text-mode
	     (pdf:set-font helvetica 36.0)
	     (pdf:move-text 100 800)
	     (pdf:draw-text "Page 2"))
	    (pdf:add-images-to-page jpg-image)
	    (pdf:draw-image jpg-image 10 10 239 50 0 t)
	    (pdf:add-URI-link 10 10 239 50 "http://www.fractalconcept.com/asp/html/cl-pdf.html" :border #(1 1 1))
	    (pdf:in-text-mode
	     (pdf:set-font helvetica 10.0)
	     (pdf:move-text 500 10)
	     (pdf:draw-text "goto page 1"))
	    (pdf:add-link 495 8 80 14 "page 1")
	    (pdf:draw-object 
	     (make-instance 'pdf:plot-xy :x 100 :y 400 :width 400 :height 200
			    :labels&colors '(("Data 1" (1.0 0.0 0.0))
					     ("Data 2" (0.0 1.0 0.0))
					     ("Data 3" (0.0 0.0 1.0)))
			    :series '(((1 40) (3 38) (5 31) (7 36))
				      ((2 53) (2.5 42) (3.7 46) (6 48))
				      ((1.3 12) (1.6 18) (2 16) (3 27)))
			    :background-color '(0.9 0.9 0.9)
			    :x-axis-options ()
			    :y-axis-options '(:min-value 0)
			    :legend-options ()))))))
    (pdf:write-document file)))

; Von Koch fractal (brute force ;-))

(defun vk-fractal (l level)
  (pdf:with-saved-state
      (if (zerop level)
	  (progn 
	    (pdf:move-to 0 0)
	    (pdf:line-to l 0)
	    (pdf:stroke))
	  (let((l3 (/ l 3.0))
	       (level (1- level)))
	    (vk-fractal l3 level)
	    (pdf:rotate 60)
	    (vk-fractal l3 level)
	    (pdf:rotate -120)
	    (vk-fractal l3 level)
	    (pdf:rotate 60)
	    (vk-fractal l3 level))))
  (pdf:translate l 0))

(defun example8 (&optional (file #P"/tmp/ex8.pdf"))
  (pdf:with-document ()
    (loop for i from 0 to 6
	  do (pdf:with-page ()
	       (pdf:with-outline-level ((format nil "Page ~d" i)(pdf:register-page-reference))
		 (let* ((helvetica (pdf:get-font "Helvetica" :win-ansi-encoding)))
		   (pdf:draw-centered-text 297 800
					   (format nil "Flocon de Koch (niveau ~d, ~d segments, périmètre ~,1f mm)" 
						   i (* 3 (expt 4 i))(/ (* 180 (* 3 (expt 4 i)))(expt 3 i)))
				      helvetica 18.0)
                   (pdf:translate 42 530)
		   (pdf:set-line-width 0.1)
		   (vk-fractal 510 i)(pdf:rotate -120)(vk-fractal 510 i)(pdf:rotate -120)(vk-fractal 510 i)))))
    (pdf:write-document file)))

