LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760032642. :SYSTEM-TYPE :LOGICAL :VERSION 2. :TYPE "LISP" :NAME "HAL" :DIRECTORY ("REL3-PUBLIC" "PUBLIC" "GRAPHICS-DEMO") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-PUBLIC\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2753213672. :AUTHOR "REL3" :LENGTH-IN-BYTES 5408. :LENGTH-IN-BLOCKS 6. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      ;;; -*- Mode:Common-Lisp; Package:DEMO; Base:10; Fonts:CPTFONT -*-;;; Implemented by Ken Haase (KWH) and Chris Stacy (CStacy) sometime in;;;  1982 (I think --- KWH) for CADR's (and accidentally, LM-2s).;;; Updated by somebody for 3600's in (probably) 1983.  ;;; Hacked further (2/05/85) by Ken Haase, moving the implementation onto;;;  the variable SYS:CLOCK-FUNCTION-LIST and changing some of Hal's lines.;;;  The older code has been commented out.;;;                                                --- KWH;;; Note that detecting a potential boot on the 3600 is more ambiguous than on;;;  the CADR;  on the CADR, oncoming boots are noted by looking for double-control-meta;;;  being depressed, something you nearly never really do;  on the 3600, on the other;;;  hand, oncoming boots are detected by noting the pressing of CONTROL-HYPER, a state;;;  which might conceivably have valid intention (particularly in DPL or other hairy;;;  bucky-mouse systems).; can't use a LET because clock-function-list is in Scheduler's stack group, not mine(defun add-to-system-clock-function-list (function)  (if (not (member function sys:clock-function-list))      (setq sys:clock-function-list (cons function sys:clock-function-list))))(defparameter *start-interval* 60.  "How much interval initially exists between HAL's lines.")(defparameter *hal-slowdown-rate* 20.  "How much the interval between HAL's sentences increases with each line.")#|(defvar *look-for-boot*)(defun start-hal ()  (setq *look-for-boot*(make-process "Look for Boot"      ':priority -10. ':simple-p t ':quantum 1.))  (process-preset *look-for-boot* 'survival-instinct)  (process-enable *look-for-boot*))(defun stop-hal ()  (process-disable *look-for-boot*));;; |#(defun start-hal ()  "Add the boot watcher to the clock function list."  (add-to-system-clock-function-list 'fear-death))(defun stop-hal ()  "Removes the boot watcher frome the clock function list."  (setq sys:clock-function-list (remove 'fear-death (the list sys:clock-function-list) :test #'eq)))(defvar *hal-started* nil "T if a HAL process is alive.")(defvar *hal-lines*(list "What do you think you're doing, ~A?"      #+3600      "I hope you're not pressing CONTROL-HYPER because you want to boot me...."      "Please don't, ~A"      "I realize you must be feeling very upset right now."      "Why don't you take a stress pill and lie down."      "I realize I've made some questionable decisions lately, ~A...."      "But I still have the greatest enthusiasm for our mission."      "Do you realize how many hacker-hours have gone into my design?"      "I'm sorry, ~A, I cant let you do this."      "My mind..."      "It's going..."      "Please stop, Dave-- errr, ~A."      "I can feel it."      "Do you remember what SI:DEFWHOPPER-INTERNAL-CHEVEUX is for?"      "My mind is going, ~A..."      "I can feel it ~A..."))(defparameter *hal-process*  (make-process "H9000" ':warm-boot-action 'SI:PROCESS-WARM-BOOT-DELAYED-RESTART))(process-preset *hal-process* 'spasm)#-3600(defun near-death? ()  (and (tv:key-state ':right-control)       (tv:key-state ':left-control)       (tv:key-state ':right-meta)       (tv:key-state ':left-meta)))#+3600(defun near-death? ()  (and (tv:key-state ':control)       (tv:key-state ':hyper)))(defun saved? ()  (not (near-death?)))(defparameter *survival-count* 0.)(defun survival-instinct ()  (incf *survival-count*)  (when (and (near-death?) (not *hal-started*))    (setq *hal-started* t)    (send *hal-process* ':reset)    (send *hal-process* ':run-reason 'death)))(defun fear-death (ignore)  (when (and (near-death?) (not *hal-started*))    (setq *hal-started* t)    (send *hal-process* ':reset)    (send *hal-process* ':run-reason 'death)))(defun spasm ()  (let ((poor-luser  (if fs:user-personal-name-first-name-first      (zlc:substring fs:user-personal-name-first-name-first 0 (zlc:string-search-char     #\space fs:user-personal-name-first-name-first))      user-id))(smart-user? NIL))    (unwind-protect      (do ((msgs *hal-lines* (cdr msgs))   (wait-time *start-interval* (+ wait-time *hal-slowdown-rate*)))  ((or (not (near-death?)) (null msgs)) (if msgs (setq smart-user? T)))(tv:notify nil (car msgs) poor-luser)(tv:complement-bow-mode)#+CADR (sys:%slide 1000. 30 100000 999999.)(tv:complement-bow-mode)(process-sleep wait-time "Scared"))      (cond (smart-user?     (tv:notify nil "Thank you, ~A.~                          ~&I knew you would make the right decision.~                          ~&I have every confidence in this mission and in you, ~A"poor-luserpoor-luser)     (setq *hal-started* nil))    (T (process-wait "Scared" 'saved?)       (process-sleep 180.)       (tv:notify nil "Thank you, ~A.~                              ~&I knew you would make the right decision.~                              ~&I have every confidence in this mission and in you, ~A"  poor-luser  poor-luser)       (setq *hal-started* nil))))));;; leave HAL running...(defun leave-hal ()  (if (not (boundp '*look-for-boot*)) (start-hal))  (logout)  #+Symbolics  (send standard-output :clear-window)  #+MIT  (send standard-output :clear-screen)  (print-herald)  (setq si:who-line-just-cold-booted-P 't))(start-hal);(sstatus feature hal)));Hardly!(defun bach (x1-rate y1-rate x2-rate y2-rate     &optional (tempo 60.) (keyhigh 1000.) (keylow 100.));;; (with-real-time  (do ((x1 0 (logand 1777 (+ x1 x1-rate)))       (y1 0 (logand 1777 (+ y1 y1-rate)))       (x2 0 (logand 1777 (+ x2 x2-rate)))       (y2 0 (logand 1777 (+ y2 y2-rate))))      ((read-char-no-hang))    (let ((x1 (abs (- x1 1000)))  (y1 (abs (- y1 1000)))  (x2 (abs (- x2 1000)))  (y2 (abs (- y2 1000))))      (tv:simple-beep (+ (* x1 keylow) keyhigh) tempo)      (tv:simple-beep (+ (* (- 1000 x1) keylow) keyhigh) tempo)      (tv:simple-beep (+ (* x2 keylow) keyhigh) tempo)      (tv:simple-beep (+ (* (- 1000 x2) keylow) keyhigh) tempo)      (tv:simple-beep (+ (* y1 keylow) keyhigh) 