1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-23 10:59:24 +00:00
PDP-10.its/src/libdoc/laugh.gsb3

53 lines
1.8 KiB
Common Lisp
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

; Friü˜| ASept 8,1978 22:14 NM+6D.17H.53M.39S. -*- Lisp -*-
(declare (array* (notype (laughs ?)))
(special *laughs-dimension)
(fixnum *laughs-dimension))
(defun one-laugh1 (phrase output-file)
(or (and (eq output-file t) (setq output-file tyo) (not (null ^w)))
((lambda (pos)
(declare (fixnum pos))
(cond ((> (+ (flatc phrase) 1 pos) (linel output-file))
(terpri output-file))
((not (= pos 0)) (princ '| | output-file)))
(and (eq output-file tyo) (+tyo 7. output-file))
(princ phrase output-file))
(charpos output-file))))
(defun one-laugh2 (phrase list)
(mapc '(lambda (f) (one-laugh1 phrase f)) list)
t)
(defun one-laugh (output-file)
((lambda (phrase)
(cond ((null output-file)
(one-laugh1 phrase t)
(and ^r (one-laugh2 phrase outfiles)))
((atom output-file) (one-laugh1 phrase output-file))
(t (one-laugh2 phrase output-file))))
(laughs (random *laughs-dimension))))
(defun laugh (arg output-filespec)
(prog (i no-sleep-p)
(declare (fixnum i))
(setq no-sleep-p (and (filep output-filespec)
(eq (caar (namelist output-filespec)) 'cli)))
error-return-loop
(cond ((null arg) (setq i 1))
((eq arg 'uncontrollably) (setq i 1_34.))
((eq (typep arg) 'fixnum) (setq i arg))
(t (setq arg (error '|Bad arg - LAUGH| arg 'wrng-type-arg))
(go error-return-loop)))
(terpri output-filespec)
super-hackish-losing-loop
(one-laugh output-filespec)
(and (not (plusp (setq i (1- i)))) (return 'hic))
(and (null no-sleep-p)
(sleep (+$ (//$ (float (random 20.)) 30.0) 0.05)))
(go super-hackish-losing-loop)))
((lambda (l)
(fillarray (array laughs t (setq *laughs-dimension (length l))) l))
'(|Ha Ha| |Snort| |Chortle| |Ha| |He| |He He| |He He He| |Chortle|
|Ho| |Ho Ho| |Ho Ho Ho| |Snicker| |Ha Ha Ha| |Giggle| |Chuckle|
|Guffaw|))