117 lines
2.7 KiB
Common Lisp
117 lines
2.7 KiB
Common Lisp
|
|
;; chapter 12, not covering CLOS
|
|
|
|
(defstruct starship
|
|
(name nil)
|
|
(speed 0)
|
|
(condition `green)
|
|
(shields `down))
|
|
|
|
;; this defines also a MAKE-STARSHIP
|
|
;; and also STARSHIP becomes type that works with TYPEP and TYPE-OF, and type predicate STARSHIP-P
|
|
|
|
(setf s1 (make-starship))
|
|
s1
|
|
|
|
(setf s2 '#s(starship speed (warp 3)
|
|
condition red
|
|
shields up))
|
|
s2
|
|
|
|
(type-of s2)
|
|
|
|
;; also there are accessor functions:
|
|
(starship-shields s2)
|
|
(starship-speed s2)
|
|
|
|
;; and they can be used for SETF as place functions, cool
|
|
(setf (starship-name s1) "Enterprise")
|
|
s1
|
|
|
|
;;; and the constructor also takes arguments as &keys
|
|
(setf s3 (make-starship :name "Reliant"
|
|
:shields 'damaged))
|
|
|
|
(describe s3)
|
|
|
|
;;; exercise, discrimination net
|
|
(defstruct node
|
|
name
|
|
question
|
|
yes-case
|
|
no-case)
|
|
|
|
(setf *NODE-LIST* nil)
|
|
|
|
(defun init ()
|
|
(setf *node-list* nil))
|
|
(init)
|
|
|
|
(defun add-node (name question yes-case no-case)
|
|
(push (make-node :name name
|
|
:question question
|
|
:yes-case yes-case
|
|
:no-case no-case)
|
|
*node-list*))
|
|
|
|
|
|
(add-node 'other
|
|
"Bad question?"
|
|
"Hello, yesman"
|
|
"Goodbye, noman")
|
|
|
|
(add-node 'start
|
|
"Does the engine turn over?"
|
|
'engine-turns-over
|
|
'engine-wont-turn-over)
|
|
|
|
(add-node 'engine-turns-over
|
|
"lalal?"
|
|
"yes, lala"
|
|
"no, alallala")
|
|
|
|
*node-list*
|
|
|
|
(defun find-node (name nodes)
|
|
(find name nodes :test (lambda (left right) (equal (node-name right) left))))
|
|
;; so in :test function, first item is the one we're searching for
|
|
;; and right one is the one we iterate over
|
|
|
|
(find-node 'start *node-list*)
|
|
(find-node 'other *node-list*)
|
|
(find-node 'engine-turns-over *node-list*)
|
|
|
|
;; either print that node not defined
|
|
;; or ask question and return action
|
|
(defun process-node (name)
|
|
(let ((current-node (find-node name *node-list*)))
|
|
(if current-node
|
|
(progn
|
|
(format t "~&~S" (node-question current-node))
|
|
(if (yes-or-no-p) (node-yes-case current-node)
|
|
(node-no-case current-node)))
|
|
(format t "~&No node is defined"))))
|
|
|
|
(process-node 'start)
|
|
(process-node 'engine-turns-over)
|
|
(process-node 'end)
|
|
|
|
|
|
;; on 'start' node
|
|
;; loop asking question, and processing response
|
|
;; if node - find and continue running
|
|
;; if string - print
|
|
(defun run (node-list)
|
|
(do ((current-block 'start (process-node current-block)))
|
|
(nil)
|
|
( if (stringp current-block)
|
|
(format t "~S" current-block))
|
|
(if (or (stringp current-block)
|
|
(null current-block))
|
|
(return))))
|
|
|
|
(process-node 'start)
|
|
(process-node 'engine-turns-over)
|
|
|
|
(run *node-list*)
|