;;; -*- Mode:LISP; Package: COMPOSER; Readtable:CL; Base:10 -*-
;;;
;;; Primitives for drawing musical stuff on windows
;;;
;;;

(defconst *standard-staff-space-width* 8)

(defun staff-height (line-width)
  (+ (* 4 *standard-staff-space-width*) (* 5 line-width)))

(defun staff-interspacing-size (line-width)
  (staff-height line-width)))

(defun draw-staff (window x-pos y-pos n-staves measure-width n-measures line-width
		   &aux
		   (inside-height (send window :inside-height))
		   (inside-width (send window :inside-width))
		   (interspacing-size (staff-interspacing-size line-width))
		   (staff-height (staff-height line-width))
		   (total-width (* measure-width n-measures)))
  (send window :refresh)
  (when (or (> (+ x-pos (* n-measures measure-width) n-measures) inside-width)
	    (> (+ y-pos (* n-staves staff-height) interspacing-size)
	       inside-height))
    (ferror nil "Staff wont fit inside window"))
  (do ((staff 1 (add1 staff))
       (y y-pos (+ y staff-height interspacing-size)))
      ((> staff n-staves))
    (draw-individual-staff window x-pos y measure-width n-measures line-width))
  (send window :draw-line x-pos y-pos
	x-pos
	(+ y-pos (* n-staves staff-height) (* (sub1 n-staves) interspacing-size)))
  (send window :draw-line (+ x-pos total-width) y-pos
	(+ x-pos total-width)
	(+ y-pos (* n-staves staff-height) (* (sub1 n-staves) interspacing-size))))
		  
(defun draw-individual-staff (window x-pos y-pos measure-width n-measures line-width)
  (do ((count 1 (add1 count))
       (y y-pos (+ y *standard-staff-space-width* line-width)))
      ((> count 5))
    (do ((count 1 (add1 count))
	 (line-length (* measure-width n-measures)))
	((> count line-width))
      (send window :draw-line x-pos (+ y count) (+ x-pos line-length) (+ y count) tv:alu-ior)))
  (do ((count 1 (add1 count))
       (vx (+ x-pos measure-width) (+ vx measure-width)))
      ((= count n-measures))
    (do ((count 1 (add1 count))
	 (line-length (staff-height line-width)))
	((> count line-width))
      (send window :draw-line vx y-pos vx (+ y-pos line-length)))))

; (draw-staff tv:selected-window 0 0 10 100 10 1)