;;; -*- Mode:LISP; Package:USER; Readtable:CL; Base:10 -*-

;;;TOGGLE-WINDOW.LISP

;;;This example illustrates one of the easiest (but reliable) ways to get
;;;a mouse-click from the user.  It is reliable because you know the
;;;mouse-click is for you, not some other window.
;;;
;;;MAKE-TOGGLE-WINDOW creates a pop-window with a mouse-sensitive
;;;message.  This window can be reused.
;;;
;;;TOGGLE-WINDOW exposes the (previously made) pop-up window with a label
;;;and the mouse-sensitive message. If the user clicks left on the
;;;message, we return T; if the user presses <End>, or clicks right and
;;;selects an alternative right-key option, we return NIL.  This way the
;;;user can tell a calling routine to abort, rather than do something it
;;;was waiting to do.

(defflavor toggle-window
	 (
	  ;;Default refresh function has no items.
	  ;;Initialize this to one that creates mouse items.
	  (refresh-function #'(lambda()(send self :clear-window)))
	  (alias-window nil)			;Our :alias-for-selected-windows, if non-NIL
	  )
	 (tv:basic-mouse-sensitive-items
	  tv:borders-mixin
	  tv:top-box-label-mixin
	  tv:window)
  (:inittable-instance-variables)
  (:settable-instance-variables alias-window)
  (:default-init-plist
    :blinker-p nil				;no cursor needed
    :save-bits t				;like any good pop-up
    :borders 2					;dark outline
    ))

;;Copied from BASIC-NVT (SUPDUP) flavor:

(DEFMETHOD (toggle-window :ALIAS-FOR-SELECTED-WINDOWS) ()
  (OR ALIAS-WINDOW
      (AND TV:SUPERIOR (SEND TV:SUPERIOR ':ALIAS-FOR-INFERIORS))
      SELF))

(defmethod (toggle-window :after :refresh) (&rest ignore)
  "Calls the window's own refresh-function, which should
be a function that initializes the window's items."
  (funcall refresh-function))

(compile-flavor-methods toggle-window)

(defun make-toggle-window(&optional
			  (left-msg "Ready")
			  (right-msg "Abort")
			  (label "Click when ready"))
  "  Create a window that waits for the user to click on a message.
  LEFT-MSG is the string to display that the user clicks on, corresponding
to a left-click.
  If RIGHT-MSG is NIL, the user can only click left, and the menu will
return T.  If RIGHT-MSG is a non-NIL string, the user can also click
right, and the menu will return NIL."
  ;;
  ;;This error-checking is over-kill, not really needed unless
  ;;this is a "published" routine
  ;;
  (assert (typep left-msg 'string)
	  (left-msg)
	  "LEFT-MSG is not a string: ~s" left-msg)
  (assert (typep right-msg '(or null string))
	  (right-msg)
	  "RIGHT-MSG is neither NIL nor a string: ~s" right-msg)
  (assert (typep label 'string)
	  (label)
	  "LABEL is not a string: ~s" label)
  ;;
  ;;Create item-list, then window
  ;;
  (let(itemlist)
    ;;Set up function for left click
    (tv:add-typeout-item-type
      itemlist
      :toggle
      left-msg
      true					;item will return value (TRUE)  T
      t						;this will be the default item
      (format nil "L: ~a" left-msg)		;who-line documentation
      )
    ;;Set up function for right click
    (when right-msg
      (tv:add-typeout-item-type
	itemlist
	:toggle
	right-msg
	false					;always returns (FALSE)  NIL
	nil					;not default item, only on menu
	(format nil "R: ~a" right-msg)		;who-line documentation
	))
    ;;Return the window
    (make-instance 'toggle-window
		   :character-width (1+ (max
					  (+ 2 (string-length left-msg))
					  (+ 2 (string-length right-msg))
					  (string-length label)))
		   :character-height (if right-msg 3 2)
		   :item-type-alist itemlist
		   ;;
		   ;;This is where the item gets created.  When the window
		   ;;gets exposed, this gets called:
		   :refresh-function #'(lambda()
					 (send self :clear-window)
					 (send self :item :toggle left-msg))
		   :label label)))

(defun toggle-window(mywindow &optional (near-mode :mouse) (x 0) (y 0))
  "Expose MYWINDOW, a TOGGLE-WINDOW created by MAKE-TOGGLE-WINDOW, 
according to NEAR-MODE.
  Returns T if the user selected the default mouse item, NIL otherwise."
  (tv:expose-window-near
    mywindow
    ;;This is just for purposes of demonstration, various ways to
    ;;specify where to expose the window
    (cond
      ((eq near-mode :mouse)  '(:mouse))
      ((eq near-mode :window) `(:window ,terminal-io))
      ((eq near-mode :point)  `(:point ,x ,y))
      (t near-mode)))
  (do((input (send mywindow :any-tyi)
	     (send mywindow :any-tyi)))
     (nil)
    (cond
      ((and (listp input) (eq (car input) :typeout-execute))
       (return(funcall(second input))))
      ((char-equal input #\end)
       (return nil))
      ((char-equal input #\page)
       (send mywindow :refresh))
      (t (beep)))))

(defmacro with-toggle-window((var under-window) &body body)
  `(let((under-window ,under-window)
	,var
	window)
     (check-type under-window tv:window "a window")
     (setq window (make-toggle-window))
     (unwind-protect
	(progn
	  (send under-window :set-selection-substitute window)
	  (send window :set-alias-window under-window)
	  (setq ,var
		(multiple-value-bind(x y)
		    (send terminal-io :edges)
		  (toggle-window window `(:point ,(+ x 10) ,(+ y 10)))))
	  ,@body)
       (progn
	 (send under-window :set-selection-substitute nil)
	 (send window :deexpose)))))

(defun test-toggle(&aux result) 
  (with-toggle-window(answer terminal-io)
    ;;You don't want to do much of anything in the body of this macro,
    ;;just set a variable to the answer you get from the toggle window.
    ;;For demonstration purposes, I'll also flash the window:
    (setq result answer)
    (let((beep :flash)) (beep)))
  ;;
  ;;Very important: HERE is where you put the code that uses
  ;;the result you got. 
  (format t "~:[The user aborted~;The user is ready~]." result))