;;; -*- Mode:COMMON-LISP; Package:X11; Base:10.; Fonts:(MEDFNB hl12B hl12bi) -*-

;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1987, Texas Instruments Incorporated. All rights reserved.

;;; Change history:
;;;
;;;  Date       Author1 *     Description
;;;1 * -------------------------------------------------------------------------------------
;;; 03/29/89	WJB	Patch 1.66; Fix force-screen-saver and set-screen-saver.
;;; 03/29/89    DAN     Patch 1.63; Fix get-screen-saver-request for case of NIL
;;;			TV:*SCREEN-SAVER-TIME-DELAY* 
;;; 12/22/88	LGO	Implement the screen-saver requests
;;;  9/12/88    LGO	Remove error from illegal-request
;;;  9/09/88    LGO	Implement the BELL request
;;;  2/29/88    TWE	Moved screen saver code from EVENTS.LISP.
;;;  2/26/88    TWE	Added code for the bell function.
;1;;  12/15/87  TWE*	1Removed almost all requests to their own files.  Added the force-screen-saver request*
;1;;*		1which didn't exist in the source code previously.*
;1;;  12/11/87  TWE*	1Fixed create-gcontext to load the font in properly.  This fixes a bad-name error during*
;1;;*		1open-display.
;;;  10/06/87  KDB*	1Removed Poly-line, Poly-rectangle, Poly-arc requests and code to their respective files.
;;;                          Gone also are the Fill-polygon, as well as Poly-fill-arc and Poly-fill-rectangle.
;;;  10/13/87  KDB*	1Removed Poly-point request and code.
;;;  10/30/87  KDB*	1added first-pass Copy-GC and Free-gc functions*


(defun illegal-request (state offset length)
  (ignore state offset length)
  (send-error Bad-Request))

(defreq Bell ((percent (INT8 -100 100)))
  (bell percent))

(DEFUN BELL (&optional (percent 0))
  (declare (type (integer -100 100) percent))
  (let* ((keybd (input-info.keyboard input-info))
	 (cntrl (device.keyboard-control keybd))
	 (bell-pitch (keyboard-control.bell-pitch cntrl))
	 (bell-duration (keyboard-control.bell-duration cntrl))
	 (base (keyboard-control.bell cntrl))
	 (volume (if (plusp percent)
		     (+ (- base (floor (* base percent) 100)) percent)
		   (+ base (floor (* base percent) 100))))
	 (loudness (floor volume (/ 100 15.0))))
    (declare (type (unsigned-byte 15) bell-pitch)      ;1 In hertz*
	     (type (unsigned-byte 15) bell-duration)   ;1 In milliseconds*
	     (type (integer 0 100) base)
	     (type (integer 0 100) volume)
	     (type (integer 0 15) loudness))
    (when (and (plusp bell-pitch)
	       (plusp bell-duration))
      (w:simple-beep bell-pitch bell-duration (- 15 loudness)))))

(defreq Force-Screen-Saver ((mode (card8 force-screen-saver-reset force-screen-saver-active)))
  (case-eval mode
    (force-screen-saver-reset
      (setq tv:kbd-last-activity-time (time)))
    (force-screen-saver-active
      (when (boundp 'tv:*screen-saver-time-delay*)
	(when (null tv:*screen-saver-time-delay*)
	  (setq tv:*screen-saver-time-delay* 20))
	(setq tv:kbd-last-activity-time
	      (- (time) (* 3600 tv:*screen-saver-time-delay*)))))))

(defreq Get-Screen-Saver ()
  (format-reply (state)
    :word (if (and (boundp 'tv:*screen-saver-time-delay*)
                   tv:*screen-saver-time-delay*)
	      (* tv:*screen-saver-time-delay* 60.) ;1; return seconds*
	    0)			       ;1 Timeout*
    :word 0			       ;1 Interval*
    :byte false			       ;1 Prefer-blanking*
    :byte false			       ;1 Allow exposures*
    ))

(defreq Set-Screen-Saver ((timeout (int16 -1))
			  (interval (int16 -1))
			  (prefer-blank (card8 prefer-blanking dont-prefer-blanking
					       default-blanking))
			  (allow-expose (card8 allow-exposures dont-allow-exposures
					       default-exposures)))
  (when (boundp 'tv:*screen-saver-time-delay*)
    (if (plusp timeout)
	(setq tv:*screen-saver-time-delay* (ceiling timeout 60.))
      (setq tv:*screen-saver-time-delay* 20.))))