(use extras aquaterm)

;; initialize the library
(unless (aqt:init) (error "could not initialize AquaTerm"))

;; open a plot for drawing
(aqt:open-plot 1)
(aqt:set-plot-size! 620 420)
(aqt:set-plot-title! "Testview")

;; set colormap
(let next ((i 0)
	   (colors
	    '((1.0 1.0 1.0) ;; white
	      (0.0 0.0 0.0) ;; black
	      (1.0 0.0 0.0) ;; red
	      (0.0 1.0 0.0) ;; green
	      (0.0 0.0 1.0) ;; blue
	      (1.0 0.0 1.0) ;; purple
	      (1.0 1.0 0.5) ;; yellow
	      (0.0 0.5 0.5)))) ;; dark-green
  (apply aqt:set-colormap-entry! i (car colors))
  (unless (null? (cdr colors))
    (next (add1 i) (cdr colors))))

;; set color explicitly
(aqt:set-color! 0.0 0.0 0.0)
(aqt:set-fontname! "Helvetica")
(aqt:set-fontsize! 12)
(aqt:add-label! "Testview 620x420 pt"  4 412 0 'left 'middle)

;; frame the plot
(aqt:move-to! 20 20)
(for-each
 (cute apply aqt:add-line-to! <>)
 '((600  20)
   (600 400)
   ( 20 400)
   ( 20  20)))
(aqt:add-label! "Frame 600x400 pt" 24 30 0 'left 'middle)

;; colormap
(aqt:add-label!
 (sprintf "Custom colormap (8 out of ~a)" (aqt:colormap-size))
 30 390 0 'left 'middle)

(aqt:set-color! 0.8 0.8 0.8)
(aqt:add-filled-rect! 28 348 24 24)
(do ((i 0 (add1 i))) ((>= i 8))
  (aqt:take-color-from-colormap-entry! i)
  (aqt:add-filled-rect! (+ 30 (* i 30)) 350 20 20)
  (aqt:set-color! 0.5 0.5 0.5)
  (aqt:add-label! (number->string i) (+ 40 (* i 30)) 360 0 'center 'middle))

;; continuous colors
(aqt:take-color-from-colormap-entry! 1)
(aqt:add-label! "\"Any color you like\"" 320 390 0 'left 'middle)
(aqt:set-linewidth! 1)
(do ((i 0 (add1 i))) ((>= i 256))
  (let* ((f (/ i 255)) (g (- 1 f)))
    (aqt:set-color! 1 f (/ f 2))
    (aqt:add-filled-rect! (+ 320 i) 350 1 20)
    (aqt:set-color! 0 f g)
    (aqt:add-filled-rect! (+ 320 i) 328 1 20)
    (aqt:set-color! g g g)
    (aqt:add-filled-rect! (+ 320 i) 306 1 20)))

;; lines
(aqt:take-color-from-colormap-entry! 1)
(do ((f 1 (+ f 2))) ((>= f 13))
  (let ((lw (/ f 2)) (g (+ 200.5 (* f 10))))
    (aqt:set-linewidth! lw)
    (aqt:move-to! 30 g)
    (aqt:add-line-to! 200 g)
    (aqt:add-label!
     (sprintf "linewidth ~a" lw) 210 (add1 g) 0 'left 'middle)))

;; linecap styles
(aqt:add-label! "(aqt:set-linecap-style! ..." 43 190.5 0 'left 'middle)
(let next ((styles '(butt round square)) (y 170.5))
  (aqt:set-linewidth! 11)
  (aqt:take-color-from-colormap-entry! 1)
  (aqt:set-line-cap-style! (car styles))
  (aqt:move-to! 40.5 y)
  (aqt:add-line-to! 150.5 y)
  (aqt:add-label!
   (sprintf "... '~a)" (car styles))
   160.5 y 0 'left 'middle)
  (aqt:set-linewidth! 1)
  (aqt:take-color-from-colormap-entry! 6)
  (aqt:move-to! 40.5 y)
  (aqt:add-line-to! 150.5 y)
  (unless (null? (cdr styles))
    (next (cdr styles) (- y 20))))

;; line joins
(aqt:take-color-from-colormap-entry! 1)
(aqt:add-label! "Line joins:" 43 90 0 'left 'middle)

(for-each
 (lambda (xs)
   (aqt:set-linewidth! 11)
   (aqt:take-color-from-colormap-entry! 1)
   (aqt:set-line-cap-style! 'butt)
   (aqt:move-to! (vector-ref xs 0) 50)
   (aqt:add-line-to! (vector-ref xs 1) 70)
   (aqt:add-line-to! (vector-ref xs 2) 50)
   (aqt:set-linewidth! 1)
   (aqt:take-color-from-colormap-entry! 6)
   (aqt:move-to! (vector-ref xs 0) 50)
   (aqt:add-line-to! (vector-ref xs 1) 70)
   (aqt:add-line-to! (vector-ref xs 2) 50))
 '(#(40 75 110)
   #(130 150 170)
   #(190 200 210)))

;; polygons
(aqt:take-color-from-colormap-entry! 1)
(aqt:add-label! "Polygons" 320 290 0 'left 'middle)

(aqt:take-color-from-colormap-entry! 2)
(aqt:add-polygon!
 (let more ((i 0))
   (if (< i 4)
       (cons
	(let ((rad (* i (asin 1))))
	  (list (+ 340 (* 20 (cos rad))) (+ 255 (* 20 (sin rad)))))
	(more (add1 i)))
       '())))

(let ((ps (let more ((i 0))
	    (if (< i 5)
		(cons
		 (let ((rad (* i (acos -1) 0.8)))
		   (list
		    (+ 400 (* 20 (cos rad)))
		    (+ 255 (* 20 (sin rad)))))
		 (more (add1 i)))
		'()))))
  (aqt:take-color-from-colormap-entry! 3)
  (aqt:add-polygon! ps)
  (aqt:take-color-from-colormap-entry! 1)
  (aqt:add-polyline! (append ps (list (car ps)))))

(aqt:take-color-from-colormap-entry! 4)
(aqt:add-polygon!
 (let more ((i 0))
   (if (< i 8)
       (cons
	(let ((rad (* i (asin 1) 0.5)))
	  (list (+ 460 (* 20 (cos rad))) (+ 255 (* 20 (sin rad)))))
	(more (add1 i)))
       '())))

(aqt:take-color-from-colormap-entry! 5)
(aqt:add-polygon!
 (let more ((i 0))
   (if (< i 32)
       (cons
	(let ((rad (* i (asin 1) 0.125)))
	  (list (+ 520 (* 20 (cos rad))) (+ 255 (* 20 (sin rad)))))
	(more (add1 i)))
       '())))

;; images
(aqt:take-color-from-colormap-entry! 1)
(aqt:add-label! "Images" 320 220 0 'left 'middle)

(let ((img "\xFF\x00\x00\x00\xFF\x00\x00\x00\xFF\x00\x00\x00"))
  (aqt:add-image-with-bitmap! img 2 2 328 200 4 4)
  (aqt:add-label! "bits" 330 180 0 'center 'middle)
  (aqt:add-image-with-bitmap! img 2 2 360 190 40 15)
  (aqt:add-label! "fit bounds" 380 180 0 'center 'middle)
  (aqt:set-image-transform! 9.23880 3.82683 -3.82683 9.23880 494.6 186.9)
  (aqt:add-transformed-image-with-bitmap! img 2 2 0 0 600 400)
  (aqt:add-label! "scale, rotate and translate" 500 180 0 'center 'middle)
  (aqt:reset-image-transform!))

;; text
(for-each
 (lambda (as)
   (aqt:take-color-from-colormap-entry! (vector-ref as 0))
   (aqt:set-fontname! (vector-ref as 1))
   (aqt:set-fontsize! (vector-ref as 2))
   (aqt:add-label!
    (sprintf "~a ~a pt" (vector-ref as 1) (vector-ref as 2))
    320 (vector-ref as 3) 0 'left 'middle))
 '(#(1 "Times-Roman" 16 150)
   #(2 "Times-Italic" 16 130)
   #(4 "Zapfino" 12 100)))

(aqt:take-color-from-colormap-entry! 2)
(aqt:set-linewidth! 0.5)
(aqt:move-to! 510.5 160)
(aqt:add-line-to! 510.5 100)

(aqt:add-polyline!
 '((545.5 75.5) (535.5 75.5) (540.5 75.5) (540.5 70.5) (540.5 80.5)))

(aqt:take-color-from-colormap-entry! 1)
(aqt:set-fontname! "Verdana")
(aqt:set-fontsize! 10)
(let next ((as '(left center right)) (y 150))
  (aqt:add-label! (sprintf "~a-aligned" (car as)) 510.5 y 0 (car as) 'middle)
  (unless (null? (cdr as))
    (next (cdr as) (- y 20))))

(aqt:set-fontname! "Times-Roman")
(aqt:set-fontsize! 14)
(for-each
 (cute aqt:add-label! "-rotate" 540.5 75.5 <> 'left 'middle)
 '(90 45 -30 -60 -90))

;; string styling is not possible through the C interface
(aqt:set-fontsize! 12)
(aqt:add-label!
 "No string styling from Scheme, sorry" 320 75 0 'left 'middle)

(aqt:take-color-from-colormap-entry! 2)
(aqt:set-linewidth! 0.5)
(aqt:move-to! 320 45.5)
(aqt:add-line-to! 520 45.5)
(aqt:take-color-from-colormap-entry! 1)
(aqt:set-fontname! "Times-Italic")
(aqt:set-fontsize! 14)
(let next ((as '(top bottom middle baseline)) (x 330))
  (aqt:add-label! (symbol->string (car as)) x 45.5 0 'left (car as))
  (unless (null? (cdr as))
    (next (cdr as) (+ x 45))))

;; draw it all
(aqt:render-plot!)

;; wait for events
(let loop ()
  (let ((evt (aqt:wait-next-event)))
    (unless (and evt (pair? evt) (eq? (car evt) 'key) (eq? (caddr evt) #\q))
      (display "unhandled event: ") (write evt) (newline)
      (loop))))

;; let go of it when done
(aqt:close-plot!)
(aqt:terminate)