(load "/usr/local/glisp/rsv_exec/rsv-biff.lsp")(defvar biff-list '())(defvar msg-list '())(defvar exec-list '())(defvar biff-dsp-list (list nil nil))(defun map-enable ()(not $TELETEXT-DISPLAYING$))(defun rsv-biff-message (name msg)(let* ((doubly-obj nil)(new-item (list name msg)))(do ((tmp biff-list (cdr tmp)))((eq tmp nil))(when (eq name (car (car tmp)))(setf doubly-obj (car tmp))))(when (not doubly-obj)(setf biff-list (nconc biff-list (list new-item)))(when (or (eq (nth 0 biff-dsp-list) nil)(eq (nth 1 biff-dsp-list) nil))(change-biff)))))(defun should-unmap-biff (dsp-obj-name)(case (length biff-list)((0)
t)((1)(if (eq dsp-obj-name (car (car biff-list)))
nil
t))(otherwise
(if (or (eq dsp-obj-name (car (car biff-list)))(eq dsp-obj-name (car (car (cdr biff-list)))))
nil
t))))(defun get-next-display-biff ()(let* ((dsp1-name (nth 0 biff-dsp-list))(dsp2-name (nth 1 biff-dsp-list))(next-obj nil))(case (length biff-list)((0)
nil)((1)(if (or (eq dsp1-name (car (car biff-list)))(eq dsp2-name (car (car biff-list))))
nil
(car biff-list)))(otherwise
(if (or (eq dsp1-name (car (car biff-list)))(eq dsp2-name (car (car biff-list))))(if (or (eq dsp1-name (car (car (cdr biff-list))))(eq dsp2-name (car (car (cdr biff-list)))))
nil
(car (cdr biff-list)))(car biff-list))))))(defun change-biff ()(let* ((dsp1-name (nth 0 biff-dsp-list))(dsp2-name (nth 1 biff-dsp-list)))(when (and dsp1-name (should-unmap-biff dsp1-name))(unmap-frame 'rsv-biff1-panel)(setf biff-dsp-list (list nil (nth 1 biff-dsp-list))))(when (and dsp2-name (should-unmap-biff dsp2-name))(unmap-frame 'rsv-biff2-panel)(setf biff-dsp-list (list (nth 0 biff-dsp-list) nil))))(when (not (nth 0 biff-dsp-list))(let* ((next-obj (get-next-display-biff)))(when next-obj
(setf-gtext-box-ndisphead rsv-biff1-panel-msg 0)(setf-gtext-box-string-list
rsv-biff1-panel-msg (split-string-by-width
(nth 1 next-obj)
font-id (m-scale-h 734 h-unit)))(if (frame-mapped-p rsv-biff1-panel)(draw-obj rsv-biff1-panel rsv-biff1-panel-msg)(when (map-enable)(map-frame 'rsv-biff1-panel)))(setf biff-dsp-list (list (car next-obj) (nth 1 biff-dsp-list))))))(when (not (nth 1 biff-dsp-list))(let* ((next-obj (get-next-display-biff)))(when next-obj
(setf-gtext-box-ndisphead rsv-biff2-panel-msg 0)(setf-gtext-box-string-list
rsv-biff2-panel-msg (split-string-by-width
(nth 1 next-obj)
font-id (m-scale-h 734 h-unit)))(if (frame-mapped-p rsv-biff2-panel)(draw-obj rsv-biff2-panel rsv-biff2-panel-msg)(when (map-enable)(map-frame 'rsv-biff2-panel)))(setf biff-dsp-list (list (nth 0 biff-dsp-list) (car next-obj)))))))(defun rsv-biff-cancel (name)(let* ((rmv-obj nil))(do ((tmp biff-list (cdr tmp)))((eq tmp nil))(when (eq name (car (car tmp)))(setf rmv-obj (car tmp))))(when rmv-obj
(setf biff-list (delete rmv-obj biff-list))(when (or (eq (nth 0 biff-dsp-list) (car rmv-obj))(eq (nth 1 biff-dsp-list) (car rmv-obj)))(if (eq (nth 0 biff-dsp-list) (car rmv-obj))(progn
(when (find-timer-hook 'biff-timer-1)(remove-timer-hook 'biff-timer-1)))(progn
(when (find-timer-hook 'biff-timer-2)(remove-timer-hook 'biff-timer-2))))(change-biff)))))(defun add-reserve (name chan start end msg)(let ((l))(remove-reserve name)(setf l (list name chan start end msg))(setf exec-list (cons l exec-list))))(defun remove-reserve (name)(let ((rmv-obj nil))(do ((tmp exec-list (cdr tmp)))((eq tmp nil))(when (eq name (car (car tmp)))(setf rmv-obj (car tmp))))(when rmv-obj
(setf exec-list (delete rmv-obj exec-list)))))(defun del-reserve (name)(remove-reserve name))(defun update-reserve-title (name title)(let ((up-obj nil)(new-obj nil)(new-list nil))(do ((tmp exec-list (cdr tmp)))((eq tmp nil))(when (eq name (car (car tmp)))(setf up-obj (car tmp))))(when up-obj
(setf new-obj (list (nth 0 up-obj) (nth 1 up-obj) (nth 2 up-obj)(nth 3 up-obj) title))(do ((tmp exec-list (cdr tmp)))((eq tmp nil))(if (eq (car up-obj) (car (car tmp)))(setf new-list (cons new-obj new-list))(setf new-list (cons (car tmp) new-list))))(setf exec-list (reverse new-list)))))(defun rsv-biff1-key (key on-off)(if (eq on-off 'key-release)
nil
(case key
((TXK_CANCEL)(write-back-bytes 10 4 (car biff-dsp-list))(remove-reserve (car biff-dsp-list))(rsv-biff-cancel (car biff-dsp-list))
t)((TXK_ENTER TXK_RETURN)(rsv-biff-cancel (car biff-dsp-list))
t)(otherwise
(rsv-biff-cancel (car biff-dsp-list))
nil))))(defun rsv-biff2-key (key on-off)(if (eq on-off 'key-release)
nil
(case key
((TXK_CANCEL)(write-back-bytes 10 4 (cadr biff-dsp-list))(remove-reserve (cadr biff-dsp-list))(rsv-biff-cancel (cadr biff-dsp-list))
t)((TXK_ENTER TXK_RETURN)(rsv-biff-cancel (cadr biff-dsp-list))
t)(otherwise
(rsv-biff-cancel (cadr biff-dsp-list))
nil))))(defun rsv-biff-resolution-center (f)(let* ((osd-x (get-osd-visible-x LOCAL_OSD))(osd-y (get-osd-visible-y LOCAL_OSD))(osd-w (get-osd-visible-width LOCAL_OSD))(osd-h (get-osd-visible-height LOCAL_OSD))(frm-w (get-width f))(frm-h (get-height f))(pos-x (+ osd-x (/ (- osd-w frm-w) 2)))(pos-y (+ osd-y (/ (- osd-h frm-h) 2))))(repos-frame f pos-x pos-y)))(defun start-msg (msg duration)(when (map-enable)(setf rsv-start-biff-msg msg)(when (and (find 'rsv-start-biff (frame-stack-sym))(frame-mapped-p rsv-start-biff))(unmap-frame 'rsv-start-biff))(panel-rsv-start-biff)(map-frame 'rsv-start-biff)(add-timer-hook #'next-msg
'rsv-start-timer nil duration 0)))(defun next-msg ()(unmap-frame 'rsv-start-biff))(defun check-msg-type-exist (type)(let* ((found nil))(do ((tmp msg-list (cdr tmp)))((eq tmp nil) found)(when (eq type (nth 0 (car tmp)))(setf found t)))))(defun add-msg (type duration msg)(when (find-timer-hook 'rsv-start-timer)(remove-timer-hook 'rsv-start-timer))(start-msg (gettext msg) duration))(register-frame2 'rsv-biff1-panel
"/usr/local/glisp/rsv_exec/rsv-biff.lsp"
LOCAL_OSD
40
nil
nil
#'rsv-biff1-key
nil
nil)(set-frame-independent-on-off-top 'rsv-biff1-panel t)(register-frame2 'rsv-biff2-panel
"/usr/local/glisp/rsv_exec/rsv-biff.lsp"
LOCAL_OSD
40
nil
nil
#'rsv-biff2-key
nil
nil)(set-frame-independent-on-off-top 'rsv-biff2-panel t)(register-frame2 'rsv-start-biff
"/usr/local/glisp/rsv_exec/rsv-biff.lsp"
LOCAL_OSD
40
nil
nil
#'(lambda (key on-off)(if (eq on-off 'key-release)
nil
(if (frame-mapped-p rsv-start-biff)(case key
(otherwise
(unmap-frame 'rsv-start-biff)
nil)))
nil))
nil
#'rsv-biff-resolution-center)(set-frame-independent-on-off-top 'rsv-start-biff t)
