blob: 88afb718668e9bdd3220b6ddb75dcf0767ebdd0f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
(in-package :moxie)
(defgeneric moxie-event-handler (event &rest args)
(:documentation "Handle EVENT (w/ ARGS)."))
(defmethod moxie-event-handler ((event (eql :world-event)) &rest args)
(apply #'world-event args))
(defmethod moxie-event-handler ((event (eql :eval)) &rest args)
(do* ((f args (cdr f))
(form (car f) (car f)))
((null f))
(case form
(:r (let ((restarts (compute-restarts))
(num (cadr f)))
(if (and (integerp num)
(> num 0) (<= num (length restarts)))
(progn
(setf f (cdr f))
(invoke-restart (elt restarts (1- num))))
(print-restarts restarts))))
((:? :h :help) (format t "~A~%" *repl-help*))
(t (let (values)
(setq - form)
(setq values (multiple-value-list (eval -)))
(setq /// // // / / values *** ** ** * * (car /))
(send-command :repl-result `(:values ,@values))))))
(send-command :repl-result `(:prompt ,(repl-prompt))))
(defmethod world-event-handler ((event (eql :close-world)) &rest args)
(declare (ignore args))
(close-world))
(defmethod world-event-handler ((event (eql :connect-world)) &rest args)
(declare (ignore args))
(world-connect))
(defmethod world-event-handler ((event (eql :disconnect-world)) &rest args)
(declare (ignore args))
(world-disconnect))
(defmethod world-event-handler ((event (eql :load-world)) &rest args)
(format t "world-event-handler :load-world ~S~%" args)
(apply #'load-world-state *world* args))
(defmethod world-event-handler ((event (eql :save-world)) &rest args)
(apply #'save-world-state *world* args))
(defmethod world-event-handler ((event (eql :setting-changed)) &rest args)
(let* ((form (car args))
(key (car form))
(val (cadr form))
(old-val (world-var key)))
(unless (eql old-val val)
(format t "DEBUG: changing setting ~S: ~S -> ~S.~%" key old-val val)
(setf (world-var key) val)
(format t "DEBUG: running hook.~%")
(run-hook :setting-changed-hook (list key val old-val))
(format t "DEBUG: hook finished.~%"))))
(defmethod world-event-handler ((event (eql :input-from-client-hook)) &rest args)
(send-to-mux *world* (or (run-hook event (car args)) (car args))))
(defmethod load-world-state ((world world) &key path &allow-other-keys)
(format t "load-world-state ~S ~S~%" world path)
(with-open-file (s (or path (world-save-path world)))
(awhen (aand (read s) (parse-world-version-1 it))
(setf (world-vars world) it)
(setf (world-save-path world) path)
(let ((*world* world))
(run-hook :world-loaded-hook)))))
(defmethod save-world-state ((world world) &key path as-copy &allow-other-keys)
(with-open-file (s (or path (world-save-path world))
:direction :output :if-exists :supersede
:if-does-not-exist :create)
(prin1 (write-world-version-1) s))
(unless as-copy
(setf (world-save-path world) path))
(let ((*world* world))
(run-hook :world-saved-hook)))
(defun parse-world-version-1 (form)
"Parses a world definition in the form '(:KEY value), returning an ALIST."
(when (evenp (length form))
(labels ((keyvalue-to-alist (form &optional (accumulator nil))
(if (null form)
accumulator
(keyvalue-to-alist (cddr form)
(cons (cons (car form) (cadr form)) accumulator)))))
(keyvalue-to-alist form))))
(defun write-world-version-1 (&optional (world *world*))
"Writes out a FORM of '(:KEY1 value1 :KEY2 value2) from WORLD."
(labels ((alist-to-keyvalue (form &optional (accumulator nil))
(if (null form)
accumulator
(alist-to-keyvalue (cdr form)
(cons (caar form) (cons (cdar form) accumulator))))))
(alist-to-keyvalue (world-vars world))))
|
