github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-04 23:54:37 +00:00
Code Issues Releases Wiki Activity

Added NGAME and games invoked by it.

Browse Source
This commit is contained in:
Eric Swenson
2018-05-19 22:26:29 -07:00
parent 94eb2a1810
commit 088ec2d6d9
53 changed files with 22974 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

135
src/games/lsrrtn.insert Normal file
View File

@@ -0,0 +1,135 @@
;;; -*- LISP -*-
;;;
;;; Functions defined
;;;
;;; (OPEN-INQUIR-FILE)
;;; Must be done before these other things can happen
;;;
;;; (LOOKUP-INQUIR-INFO <evaluable-uname> <un-eval'd tag>)
;;; Macro to look up a certain tag in the INQUIR database
;;;
;;; (GET-USER-NAME <evaluable-uname>)
;;;
;;; SUBR returns something of the form
;;; ((last-name first-name middle-name) title lineage alias? nickname)
;;; or NIL if no such user.
;;;
;;; TITLE is one a word like [MR, MRS, ... DR, ...] (see code
;;; for currently used list)
;;;
;;; LINEAGE is one of II, III, or JR
;;;
;;; NIL is returned for unspecified elements. Alias's are tried to be
;;; traced through. If something was an alias, the ALIAS? flag is non-NIL
;;; all other info is as if it had been info about who it is an alias for.
;;; Multiple aliases should be traced through correctly.
;;;
;;; (CLOSE-INQUIR-FILE)
;;; Should be done after all LOOKUP-INQUIR-INFO's are done to
;;; close our INQUIR disk channel.
;;;
(DEFPROP LSRMAP ((DSK games) LSRRTN FASL) AUTOLOAD)
(DECLARE (SPECIAL *INQUIR-FILE-OBJECT*)
(*EXPR LSRMAP LSRITM LSRUNM))
(DEFUN OPEN-INQUIR-FILE () ; Allocate 15 pages for this map
(SETQ *INQUIR-FILE-OBJECT* (LSRMAP 15.))
T)
(DEFUN CLOSE-INQUIR-FILE ()
(CLOSE *INQUIR-FILE-OBJECT*)
T)
(DEFUN LOOKUP-INQUIR-INFO MACRO (FORM)
(LET (((UNAME DATA) (CDR FORM)))
`(LSRITM ',(OR (CDR (ASSQ DATA '((UNAME . 0.)
(FULL-NAME . 1.)
(NICKNAME . 2.)
(SOCIAL-SECURITY-NUMBER . 3.)
(MIT-ADDRESS . 4.)
(MIT-TELEPHONE-NUMBER . 5.)
(HOME-ADDRESS . 6.)
(HOME-TELEPHONE-NUMBER . 7.)
(SUPERVISOR . 8.)
(PROJECT . 9.)
(FILE-DIRECTORY-NAMES . 10.)
(AUTHORIZATION . 11.)
(GROUP-AFFILIATION . 12.)
(RELATION TO GROUP . 13.)
(BIRTHDAY . 14.)
(REMARKS . 15.)
(NETWORK-ADDRESS . 16.)
(LAST-ALTERATION . 17.)
(MACHINES-KNOWN-ON . 18.))))
(ERROR '|Unknown INQUIR Keyword| DATA))
(LSRUNM *INQUIR-FILE-OBJECT* ,UNAME))))
(DEFUN UNAME? (X) (AND (SYMBOLP X)
(PLUSP (LSRUNM *INQUIR-FILE-OBJECT* X))))
(DECLARE (*EXPR PARSE$MAKE-WORDS))
(DEFPROP PARSE$MAKE-WORDS ((games) PARSE FASL) AUTOLOAD)
(DEFUN GET-USER-NAME (WHO)
(COND ((NOT (UNAME? WHO)) NIL)
(T
(LET* ((DATA (LOOKUP-INQUIR-INFO WHO FULL-NAME))
(TOKENS (PARSE$MAKE-WORDS (EXPLODEC DATA)))
(LAST-NAME) (FIRST-NAME) (MIDDLE) (TITLE-ETC) (LINEAGE)
(ALIAS ()))
(DO ()
((NOT
(AND (EQ (CADR TOKENS) '/,)
(EQ (CAR (LAST TOKENS)) 'FOR)
(MEMQ (LOOKUP-INQUIR-INFO WHO GROUP-AFFILIATION)
'(/@ /O)))))
(SETQ ALIAS T)
(SETQ WHO (CAR TOKENS))
(SETQ TOKENS
(PARSE$MAKE-WORDS
(EXPLODEC
(SETQ DATA
(LOOKUP-INQUIR-INFO WHO FULL-NAME))))))
(SETQ TOKENS (DELETE '/. TOKENS))
(COND ((SETQ TITLE-ETC (CAR (OR (MEMQ 'MR TOKENS)
(MEMQ 'MRS TOKENS)
(MEMQ 'MISS TOKENS)
(MEMQ 'MS TOKENS)
(MEMQ 'DR TOKENS))))
(SETQ TOKENS (DELETE TITLE-ETC TOKENS))))
(COND ((SETQ LINEAGE (CAR (OR (MEMQ 'II TOKENS)
(MEMQ 'III TOKENS)
(MEMQ 'JR TOKENS))))
(SETQ TOKENS (DELETE LINEAGE TOKENS))))
(COND ((NOT (MEMQ '/, TOKENS)) ; What a loser...
(POP TOKENS FIRST-NAME)
(COND ((CDR TOKENS)
(POP TOKENS MIDDLE)
(POP TOKENS LAST-NAME))
(T
(POP TOKENS LAST-NAME))))
((EQ (CADR TOKENS) '/,)
(SETQ TOKENS (DELETE '/, TOKENS))
(POP TOKENS LAST-NAME)
(POP TOKENS FIRST-NAME)
(POP TOKENS MIDDLE))
(T
(SETQ FIRST-NAME (CADR (MEMQ '/, TOKENS)))
(SETQ LAST-NAME (DO ((L () (CONS (CAR TOKS) L))
(TOKS TOKENS (CDR TOKS)))
((EQ (CAR TOKS) '/,)
(IMPLODE
(MAPCAN 'EXPLODEC
(NREVERSE L))))))))
`( (,LAST-NAME
,FIRST-NAME
,@(COND (MIDDLE (NCONS MIDDLE))))
,TITLE-ETC
,LINEAGE
,ALIAS
,(LET ((NICKNAME (LOOKUP-INQUIR-INFO WHO NICKNAME)))
(COND ((EQ NICKNAME '||) NIL)
(T NICKNAME))))))))