;;; -*- Mode:LISP; Package:MKS10; Base:10 -*-
;;;
;;;
;;;
;;;

;MKS-10 sound module stuff

;7 bits
;<0>   I or II
;<1:3> piano (long default), clavi (short), harps (long), e-piano (long)
;<4>   release time
;<7:5> normal, chorus, flanger, tremoro sine,
;      tremoro square, chorus & tremoro sine, chorus & tremoro square, flanger & tremoro sine

(defun mks-10-set-program (color chorus-or-flanger tremoro-type &optional (channel 0))
  (@program-change
   (+ (selectq chorus-or-flanger
	(chorus
	 (selectq tremoro-type
	   (sine 80.)
	   (square 96.)
	   (nil 16.)
	   (t (ferror nil "unknown"))))
	(flanger
	 (selectq tremoro-type
	   (sine 112.)
	   (nil 32.)
	   (t (ferror nil "unknown"))))
	(nil
	 (selectq tremoro-type
	   (sine 48.)
	   (square 64.)
	   (nil 0)
	   (t (ferror nil "unknown")))))
      color
      )
   channel))

(defvar *mks-10-main-color* 'piano)
(defvar *mks-10-i-or-ii* 'i)
(defvar *mks-10-default-release-time-p* 'normal)
(defvar *mks-10-chorus-or-flanger* nil)
(defvar *mks-10-tremoro-type* nil)
(defvar *default-channel* 0)

(defun mks-10-choose-program-from-menu ()
  (let ((base 10.) (ibase 10.))
    (tv:choose-variable-values
      '(
	(*default-channel* "Channel" :choose (0 1 2 3 4 5 6 7 8 9 10. 11. 12. 13. 14. 15.))
	(*mks-10-main-color* "Main Color" :choose (piano clavi harps e-piano))
	(*mks-10-i-or-ii* "Sub-color" :choose (I II))
	(*mks-10-default-release-time-p* "Release time" :choose (normal special))
	(*mks-10-chorus-or-flanger* "Chorus or Flanger" :choose (chorus flanger neither))
	(*mks-10-tremoro-type* "Tremoro type" :choose (sine square none))
	)
      ))
  (mks-10-set-program
    (+ (ash (find-position-in-list *mks-10-main-color* '(piano clavi harps e-piano)) 1)
       (if (eq *mks-10-i-or-ii* 'i) 0 1)
       (if (eq *mks-10-default-release-time-p* 'normal) 0 8))
    (if (eq *mks-10-chorus-or-flanger* 'neither) nil *mks-10-chorus-or-flanger*)
    (if (eq *mks-10-tremoro-type* 'none) nil *mks-10-tremoro-type*)
    *default-channel*))

(defun setup ()
  (mks-10-choose-program-from-menu))

(defun mks-10-damper (on-p &optional (channel 0))
  (@control-change 64. channel (if on-p #o127 0)))