;1;; -*- Mode:LISP; Package:LASER2; Fonts:(CPTFONT HL12B); Base:8 -*-*
;1;; Copyright (c) 1985, LISP Machine, Inc.*

;1;; Description: Laser2 packet protocol data structures*
;1;; Programmer: James M. Turner*
;1;; Last Modification: 11-Jan-1985*
;1;;*
;1;; Change History:*
;1;;*

(defflavor laser2-configuration-window ()
	   (tv:process-mixin tv:notification-mixin tv:stream-mixin tv:select-mixin
	    tv:bordered-constraint-frame-with-shared-io-buffer))

(defflavor laser2-menu ()
	   (tv:pane-mixin tv:command-menu))

(defflavor laser2-typeout ()
	   (tv:notification-mixin tv:window))

(defun configure-laser2 ()
  (let ((base 10.)
	(ibase 10.)
	(window
	  (make-instance
	    'laser2-configuration-window
	    ':panes 
	    '((TYPEOUT-PANE laser2-typeout
			    :BLINKER-P
			    T
			    :SAVE-BITS
			    T
			    :MORE-P nil
			    :DEEXPOSED-TYPEOUT-ACTION
			    :PERMIT
			    :LABEL
			    "Debugging Window")
	      (COMMAND-PANE laser2-menu
			    :ITEM-LIST
			    (("Toggle Debug" :VALUE :TOGGLE)
			     ("Reset Processes" :VALUE :RESET)
			     ("Abort Printing" :VALUE :ABORT)
			     ("Delete Queue Item" :VALUE :DELETE))
			    :LABEL
			    "Commands")
	      (OPTION-PANE TV:CHOOSE-VARIABLE-VALUES-PANE
			   :STRING-FONT fonts:hl12b
			   :name-font fonts:hl10b
			   :margin-choices ()
			   :VARIABLES
			   ("Text Related Variables (all units are 1//240's of an inch)"
			    (left-margin " Left Margin" :decimal-number)
			    (top-margin " Top Margin" :decimal-number)
			    (header-space " Space Between Header and First Line"
						 :decimal-number)
			    (page-size " Paper Length" :decimal-number)
			    (interline-spacing " Space Between Lines"
						      :decimal-number)
			    (default-font " Default Font" :sexp)
			    (header-font " Header Font" :sexp)
			    (*laser2-print-mode* " Print Mode" :CHOOSE (:IMPRESS :TEXT))
			    ""
			    "System Internal Constants"
			    (laser2-baud-rate " Baud Rate" :decimal-number)
			    (laser2-timeout " Character Timeout (1//60's of a second)"
					    :decimal-number)
			    (laser2-queue-lock " Queue Interlock" :sexp)
			    (image-mag " Array Dump Magnification Factor" :assoc ((1 . 0) (2 . 1)
										  (4 . 2)))
			    (charmag " Character Magnification Factor" :choose (1 2 3 4 5)))
			   :LABEL
			   "Options"))
	      ':constraints
	      '((main-frame . 
			    ((DUMMY-NAME3 TYPEOUT-PANE)
			     ((DUMMY-NAME3 :HORIZONTAL
					   (0.3s0)
					   (OPTION-PANE COMMAND-PANE)
					   ((COMMAND-PANE :ASK :PANE-SIZE))
					   ((OPTION-PANE :EVEN))))
			     ((TYPEOUT-PANE :EVEN)))))
	      :process
	      '(run-laser2-configuration))))
    (send window :send-pane 'option-pane :set-stack-group tv:current-stack-group)
    (send window :send-pane 'command-pane :set-io-buffer (send window :io-buffer))
    (send window :select)))

(defmethod (laser2-configuration-window :print-notification) (time string window-of-interest)
  (send self :send-pane 'typeout-pane
	:print-notification-on-self time string window-of-interest))

(putprop :decimal-number '(print-decimal read-decimal  nil nil nil
					 "Mouse this item to enter a decimal value.")
	 'tv:choose-variable-values-keyword)

(defun print-decimal (n stream)
  (let ((base 10.))
    (prin1 n stream)))

(defun read-decimal (stream)
  (let ((ibase 10.))
    (tv:read-number stream)))

(defun run-laser2-configuration (window)
  (do ((base 10.) (ibase 10.)) (())
    (send window :process-character)))

(defmethod (laser2-configuration-window :process-character) ()
  (let ((base 10.)
	(ibase 10.)
	(item (send self :list-tyi)))
    (selectq (car item)
      (:MENU
       (selectq (third (cadr item))
	 (:TOGGLE
	  (if (not reporting-window)
	      (setq reporting-window (send self :get-pane 'typeout-pane))
	    (setq laser2:reporting-window nil)))
	 (:RESET
	  (reset-laser2 t))
	 (:ABORT
	  (reset-laser2))
	 (:DELETE
	  (setf (send *laser2-stream* :printer-queue)
		(remq (tv:menu-choose (mapcar #'(lambda (x) (list
							      (format nil "~S" (cadr x))
							      :value x))
					      (send *laser2-stream* :printer-queue)))
		      (send *laser2-stream* :printer-queue))))))
      (:VARIABLE-CHOICE
       (tv:choose-variable-values-process-message (send self :get-pane 'option-pane)
						  item))))
  (let ((items (send self :send-pane 'option-pane :items)))
    (dotimes (n (array-active-length items))
      (if (listp (aref items n))
	  (send self :send-pane 'option-pane :redisplay-variable (car (aref items n)))))))

(tv:add-system-key #/O 'laser2-configuration-window "LMI Laser II Configurator"
		   '(laser2:configure-laser2))