;;; set up our user-interface
(let* ((shell-app #f)
       (app (car (main-widgets)))

       (shell (let* ((xdismiss (XmStringCreate "Go away" XmFONTLIST_DEFAULT_TAG))
		     (xhelp (XmStringCreate "Help" XmFONTLIST_DEFAULT_TAG))
		     (titlestr (XmStringCreate "FM Forever!" XmFONTLIST_DEFAULT_TAG))
		     (dialog (XmCreateTemplateDialog (cadr (main-widgets)) "FM Forever!"
						     (list XmNcancelLabelString   xdismiss
							   XmNhelpLabelString     xhelp
							   XmNautoUnmanage        #f
							   XmNdialogTitle         titlestr
							   XmNresizePolicy        XmRESIZE_GROW
							   XmNnoResize            #f
							   XmNtransient           #f))))
		(XtAddCallback dialog 
			       XmNhelpCallback (lambda (w context info)
						 (snd-print "This dialog lets you experiment with simple FM")))
		(XmStringFree xhelp)
		(XmStringFree xdismiss)
		(XmStringFree titlestr)
		dialog))

       (dpy (XtDisplay shell))
       (screen (DefaultScreenOfDisplay dpy))
       (cmap (DefaultColormap dpy (DefaultScreen dpy)))
       (black (BlackPixelOfScreen screen))
       (white (WhitePixelOfScreen screen)))

  (define (get-color color)
    (let ((col (XColor)))
      (if (= (XAllocNamedColor dpy cmap color col col) 0)
	  (error (format #f "can't allocate ~A" color))
	  (.pixel col))))

  (define (set-flabel label value)
    (let ((s1 (XmStringCreate (format #f "~,3F" value) XmFONTLIST_DEFAULT_TAG)))
      (XtVaSetValues label (list XmNlabelString s1))
      (XmStringFree s1)))

  (define (set-ilabel label value)
    (let ((s1 (XmStringCreate (format #f "~D" value) XmFONTLIST_DEFAULT_TAG)))
      (XtVaSetValues label (list XmNlabelString s1))
      (XmStringFree s1)))

  (let* ((light-blue (position-color))
	 (form (XtCreateManagedWidget "form" xmFormWidgetClass shell 
		 (list XmNbackground white
		       XmNforeground black
		       XmNresizePolicy XmRESIZE_GROW)))
	 ;; toggle named "play"
	 (play-button (XtCreateManagedWidget "play" xmToggleButtonWidgetClass form
                        (list XmNleftAttachment   XmATTACH_FORM
			      XmNbottomAttachment XmATTACH_NONE
			      XmNtopAttachment    XmATTACH_FORM
			      XmNrightAttachment  XmATTACH_NONE
			      XmNbackground       white)))
	 ;; carrier freq
	 (carrier (XtCreateManagedWidget "carrier freq:" xmLabelWidgetClass form
                    (list XmNleftAttachment   XmATTACH_FORM
			  XmNbottomAttachment XmATTACH_NONE
			  XmNtopAttachment    XmATTACH_WIDGET
			  XmNtopWidget        play-button
			  XmNrightAttachment  XmATTACH_NONE
			  XmNrecomputeSize    #f
			  XmNbackground       white)))
	 (freq-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
                       (list XmNleftAttachment   XmATTACH_WIDGET
			     XmNleftWidget       carrier
			     XmNbottomAttachment XmATTACH_NONE
			     XmNtopAttachment    XmATTACH_OPPOSITE_WIDGET
			     XmNtopWidget        carrier
			     XmNrightAttachment  XmATTACH_NONE
			     XmNbackground       white)))
	 (freq-scale (XtCreateManagedWidget "carrier freq" xmScaleWidgetClass form
                       (list XmNleftAttachment   XmATTACH_WIDGET
			     XmNleftWidget       freq-label
			     XmNbottomAttachment XmATTACH_NONE
			     XmNtopAttachment    XmATTACH_OPPOSITE_WIDGET
			     XmNtopWidget        freq-label
			     XmNrightAttachment  XmATTACH_FORM
			     XmNshowValue        #f
			     XmNorientation      XmHORIZONTAL
			     XmNbackground       light-blue)))
	 ;; amp
	 (amp (XtCreateManagedWidget "amp:" xmLabelWidgetClass form
                (list XmNleftAttachment   XmATTACH_FORM
		      XmNbottomAttachment XmATTACH_NONE
		      XmNtopAttachment    XmATTACH_WIDGET
		      XmNtopWidget        carrier
		      XmNrightAttachment  XmATTACH_NONE
		      XmNrecomputeSize    #f
		      XmNbackground       white)))
	 (amp-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
                      (list XmNleftAttachment   XmATTACH_WIDGET
			    XmNleftWidget       amp
			    XmNbottomAttachment XmATTACH_NONE
			    XmNtopAttachment    XmATTACH_OPPOSITE_WIDGET
			    XmNtopWidget        amp
			    XmNrightAttachment  XmATTACH_NONE
			    XmNbackground       white)))
	 (amp-scale (XtCreateManagedWidget "amp" xmScaleWidgetClass form
                      (list XmNleftAttachment   XmATTACH_WIDGET
			    XmNleftWidget       amp-label
			    XmNbottomAttachment XmATTACH_NONE
			    XmNtopAttachment    XmATTACH_OPPOSITE_WIDGET
			    XmNtopWidget        amp-label
			    XmNrightAttachment  XmATTACH_FORM
			    XmNshowValue        #f
			    XmNorientation      XmHORIZONTAL
			    XmNbackground       light-blue)))
	 ;; fm index
	 (fm-index (XtCreateManagedWidget "fm index:" xmLabelWidgetClass form
                     (list XmNleftAttachment   XmATTACH_FORM
			   XmNbottomAttachment XmATTACH_NONE
			   XmNtopAttachment    XmATTACH_WIDGET
			   XmNtopWidget        amp-scale
			   XmNrightAttachment  XmATTACH_NONE
			   XmNrecomputeSize    #f
			   XmNbackground       white)))
	 (fm-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
                     (list XmNleftAttachment   XmATTACH_WIDGET
			   XmNleftWidget       fm-index
			   XmNbottomAttachment XmATTACH_NONE
			   XmNtopAttachment    XmATTACH_OPPOSITE_WIDGET
			   XmNtopWidget        fm-index
			   XmNrightAttachment  XmATTACH_NONE
			   XmNbackground       white)))
	 (fm-scale (XtCreateManagedWidget "fm index" xmScaleWidgetClass form
                     (list XmNleftAttachment   XmATTACH_WIDGET
			   XmNleftWidget       fm-label
			   XmNbottomAttachment XmATTACH_NONE
			   XmNtopAttachment    XmATTACH_OPPOSITE_WIDGET
			   XmNtopWidget        fm-label
			   XmNrightAttachment  XmATTACH_FORM
			   XmNshowValue        #f
			   XmNorientation      XmHORIZONTAL
			   XmNbackground       light-blue)))
	 ;; c/m ratio
	 (cm-ratio (XtCreateManagedWidget "c/m ratio:" xmLabelWidgetClass form
                     (list XmNleftAttachment   XmATTACH_FORM
			   XmNbottomAttachment XmATTACH_NONE
			   XmNtopAttachment    XmATTACH_WIDGET
			   XmNtopWidget        fm-scale
			   XmNrightAttachment  XmATTACH_NONE
			   XmNrecomputeSize    #f
			   XmNbackground       white)))
	 (cm-label (XtCreateManagedWidget "label" xmLabelWidgetClass form
                     (list XmNleftAttachment   XmATTACH_WIDGET
			   XmNleftWidget       cm-ratio
			   XmNbottomAttachment XmATTACH_NONE
			   XmNtopAttachment    XmATTACH_OPPOSITE_WIDGET
			   XmNtopWidget        cm-ratio
			   XmNrightAttachment  XmATTACH_NONE
			   XmNbackground       white)))
	 (cm-scale (XtCreateManagedWidget "cm ratio" xmScaleWidgetClass form
                     (list XmNleftAttachment   XmATTACH_WIDGET
			   XmNleftWidget       cm-label
			   XmNbottomAttachment XmATTACH_NONE
			   XmNtopAttachment    XmATTACH_OPPOSITE_WIDGET
			   XmNtopWidget        cm-label
			   XmNrightAttachment  XmATTACH_FORM
			   XmNshowValue        #f
			   XmNorientation      XmHORIZONTAL
			   XmNbackground       light-blue)))
	 (frequency 220.0)
	 (low-frequency 40.0)
	 (high-frequency 2000.0)
	 (amplitude 0.5)
	 (index 1.0)
	 (high-index 3.0)
	 (ratio 1)
	 (high-ratio 10)
	 (playing 0.0)
	 (carosc (make-oscil 0.0))
	 (modosc (make-oscil 0.0)))

    (define (freq-callback w c i)
      (set! frequency (+ low-frequency (* (.value i) (/ (- high-frequency low-frequency) 100.0))))
      (set-flabel freq-label frequency))

    (define (amp-callback w c i)
      (set! amplitude (/ (.value i) 100.0))
      (set-flabel amp-label amplitude))

    (define (fm-callback w c i)
      (set! index (* (.value i) (/ high-index 100.0)))
      (set-flabel fm-label index))

    (define (ratio-callback w c i)
      (set! ratio (floor (* (.value i) (/ high-ratio 100.0))))
      (set-ilabel cm-label ratio))

    ;; add scale-change (drag and value-changed) callbacks
    (XtAddCallback freq-scale XmNdragCallback freq-callback)
    (XtAddCallback freq-scale XmNvalueChangedCallback freq-callback)

    (XtAddCallback amp-scale XmNdragCallback amp-callback)
    (XtAddCallback amp-scale XmNvalueChangedCallback amp-callback)

    (XtAddCallback fm-scale XmNdragCallback fm-callback)
    (XtAddCallback fm-scale XmNvalueChangedCallback fm-callback)

    (XtAddCallback cm-scale XmNdragCallback ratio-callback)
    (XtAddCallback cm-scale XmNvalueChangedCallback ratio-callback)

    (XtAddCallback play-button XmNvalueChangedCallback (lambda (w c i) (set! playing (if (.set i) 1.0 0.0))))
    
    ;; set initial values
    (set-flabel freq-label frequency)
    (set-flabel amp-label amplitude)
    (set-flabel fm-label index)
    (set-ilabel cm-label ratio)

    (XmScaleSetValue freq-scale (floor (* 100 (/ (- frequency low-frequency) (- high-frequency low-frequency)))))
    (XmScaleSetValue amp-scale (floor (* 100 amplitude)))
    (XmScaleSetValue fm-scale (floor (* 100 (/ index high-index))))
    (XmScaleSetValue cm-scale (floor (* ratio (/ 100 high-ratio))))

    (XtManageChild shell)
    (XtRealizeWidget shell)

    ;; send fm data to dac
    (mus-oss-set-buffers 4 12) ; a no-op except in OSS/Linux
    (let* ((bufsize 256)
	   (srate 22050)
	   (chans 1)
	   (data (make-sound-data chans bufsize))
	   (proc #f)
	   (port (mus-audio-open-output mus-audio-default srate chans mus-lshort (* bufsize 2))))
      (if (< port 0) 
	  (display (format #f "can't open DAC!")))

      (XmAddWMProtocolCallback shell 
			       (XmInternAtom dpy "WM_DELETE_WINDOW" #f)
			       (lambda (w c i)
				 (XtRemoveWorkProc proc) ; odd that there's no XtAppRemoveWorkProc
				 (mus-audio-close port))
			       #f)
      (XtAddCallback shell
		     XmNcancelCallback (lambda (w context info)
					 (XtRemoveWorkProc proc)
					 (mus-audio-close port)
					 (XtUnmanageChild shell)))
      (set! proc (XtAppAddWorkProc 
		  app 
		  (lambda (ignored-arg)
		    (do ((i 0 (+ 1 i)))
			((= i bufsize))
		      (sound-data-set! 
		       data 0 i
		       (* amplitude playing
			  (oscil carosc 
				 (+ (hz->radians frequency)
				    (* index 
				       (oscil modosc 
					      (hz->radians (* ratio frequency)))))))))
		    (mus-audio-write port data bufsize)
		    #f))))
    ))

