Browse code

Work on x-if.lexicon, x-if.client* etc.

Jaidyn Levesque authored on 2020-01-10 23:19:45
Showing 1 changed files
... ...
@@ -18,12 +18,17 @@
18 18
   (:use :cl :arnesi)
19 19
   (:nicknames :xif))
20 20
 
21
+(defpackage :x-if.misc
22
+  (:use :cl)
23
+  (:nicknames :xif.m)
24
+  (:export :line-cdr :line-car :line-length))
25
+
21 26
 (defpackage :x-if.lexicon
22 27
   (:use :cl :arnesi :earley-parser)
23 28
   (:nicknames :xif.l)
24 29
   (:export :action-indirect-required-p :action-direct-required-p
25
-           :action-p :action-function
26
-           *lexicon* :add-adjective :add-noun :add-proper-noun))
30
+           :action-p :action-function :add-action :add-verb
31
+           *lexicon* :add-adjective :add-noun :add-proper-noun :reload-lexicon))
27 32
 
28 33
 (defpackage :x-if.environment
29 34
   (:use :cl :arnesi :bknr.datastore)
... ...
@@ -92,7 +97,7 @@
92 97
   "Parse a given string into a list of Earley trees."
93 98
   (mapcar #'car
94 99
   (mapcar #'parse-statement
95
-          (mapcar #'clean-statement(split-statements sentence)))))
100
+          (mapcar #'clean-statement (split-statements sentence)))))
96 101
 
97 102
 ;; —————————————————————————————————————
98 103
 
... ...
@@ -102,11 +107,9 @@
102 107
   (earley-parser:chart-listing->trees
103 108
     (earley-parser:earley-parse statement
104 109
       (earley-parser:load-bnf-grammar #p"example/grammar.txt")
105
-      (earley-parser:load-lexicon #p"example/lexicon.txt"))))
110
+      (xif.l:reload-lexicon))))
106 111
 
107
-;; —————————————————————————————————————
108 112
 
109
-;; STRING → LIST_OF_STRINGS
110 113
 (defun split-statements (sentence)
111 114
   "Split up a string into different statements, based on punctuation."
112 115
   (cl-strings:split sentence ","))
... ...
@@ -203,7 +206,19 @@
203 206
 
204 207
 ;; —————————————————————————————————————
205 208
 
206
-(defvar *lexicon* "")
209
+(defvar *lexicon*
210
+"the :class <det>
211
+that :class <det>
212
+this :class <det>
213
+here :class <prep>
214
+there :class <prep>
215
+be :class <aux>
216
+to :class <prep>
217
+with :class <prep>
218
+a :class <det>
219
+an :class <det>
220
+")
221
+
207 222
 (defvar *actions* (make-hash-table :test #'equal))
208 223
 
209 224
 (defmacro add-string-to-var (var string)
... ...
@@ -222,14 +237,28 @@
222 237
 (defmethod add-adjective ((adj string))
223 238
   (add-word adj "adjective"))
224 239
 
225
-(defmethod add-adjective ((adjectives xif.e::god))
240
+(defmethod add-adjective ((object xif.e::god))
226 241
   (mapcar #'add-adjective (xif.e:adjectives object)))
227 242
 
228 243
 (defmethod add-verb ((verb string))
229 244
   (add-word verb "verb"))
230 245
 
231
-(defun add-action (
246
+(defmethod add-action ((action xif.e::action))
247
+  (mapcar #'add-verb (xif.e::verbs action)))
232 248
 
249
+(defun load-string-lexicon (lex-string)
250
+  "Read all words from a dictionary file into a lexicon and a part of speech."
251
+  (with-input-from-string (lex-str-stream lex-string)
252
+  (let ((lexicon (make-hash-table :test earley-parser::*string-comparer*))
253
+        (part-of-speech nil))
254
+    (loop :while (listen lex-str-stream)
255
+          :do (let ((w (earley-parser::read-lexicon-line lex-str-stream)))
256
+                (pushnew (earley-parser::terminal-class w) part-of-speech :test earley-parser::*string-comparer*)
257
+                (push w (gethash (earley-parser::terminal-word w) lexicon))))
258
+    (earley-parser::make-lexicon :dictionary lexicon :part-of-speech part-of-speech))))
259
+
260
+(defun reload-lexicon ()
261
+  (load-string-lexicon *lexicon*))
233 262
 
234 263
 ;; —————————————————————————————————————
235 264
 ;; X-IF.INTERPRET
... ...
@@ -302,6 +331,8 @@
302 331
 
303 332
 ;; —————————————————————————————————————
304 333
 
334
+
335
+
305 336
 (define-persistent-class god ()
306 337
   ((id :read
307 338
       :initarg :id :reader id
... ...
@@ -309,12 +340,12 @@
309 340
       :index-initargs (:test #'equal)
310 341
       :index-reader id→object
311 342
       :index-values all-objects)
312
-   (name :read
313
-      :initarg :name :reader name
343
+   (nouns :read
344
+      :initarg :nouns :reader nouns
314 345
       :index-type bknr.datastore::hash-index
315
-      :index-initargs (:test #'equal)
316
-      :index-reader name→object)
317
-   (proper-name :read
346
+      :index-initargs (:test #'position)
347
+      :index-reader noun→object)
348
+   (proper-noun :read
318 349
       :initarg :proper-name :reader proper-name
319 350
       :index-type bknr.datastore::hash-index
320 351
       :index-initargs (:test #'equal)
... ...
@@ -363,20 +394,42 @@
363 394
   ((extreme-makeover-home-edition :read
364 395
                                   :initform T :index-values all-locations)))
365 396
 
366
-(define-persistent-class fareblo ()
397
+(define-persistent-class action ()
367 398
   ((function-name :read
368
-      :initarg :function :reader function-name
369
-      :index-type bknr.datastore::hash-index
370
-      :index-reader function→action)
399
+      :initarg :function :reader function-name)
400
+      ; :index-type bknr.datastore::hash-index
401
+      ; :index-reader function→action
371 402
    (verbs :read
372 403
        :initarg :verbs :reader verbs)
373
-   (
374
-
404
+       ; :index-type bknr.datastore::hash-index
405
+       ; :index-reader verb→action
406
+   (direct-object-p :read
407
+       :initarg :direct-object-p :initform nil :reader direct-object-required-p)
408
+   (indirect-object-p :read
409
+       :initarg :indirect-object-p :initform nil :reader indirect-object-required-p)))
410
+
411
+(defclass queued-action ()
412
+  ((function-name
413
+       :initarg :function :accessor function-name)
414
+   (direct-object
415
+       :initarg :direct-object :initform nil :accessor direct-object)
416
+   (indirect-object
417
+       :initarg :indirect-object :initform nil :accessor indirect-object)
418
+   (subject
419
+       :initarg :subject :initform (get-player) :accessor subject)))
375 420
 
376 421
 (defun get-player ()
377 422
   (id→object 100))
378 423
 
379 424
 
425
+(defmethod initialize-instance :after ((god god) &key)
426
+  (xif.l:add-noun god)
427
+  (xif.l:add-adjective god)
428
+  (xif.l:reload-lexicon))
429
+
430
+(defmethod initialize-instance :after ((action action) &key)
431
+  (xif.l:add-action action)
432
+  (xif.l:reload-lexicon))
380 433
 
381 434
 
382 435
 ;; —————————————————————————————————————
... ...
@@ -412,6 +465,9 @@
412 465
     (populate-world))
413 466
   (game-loop))
414 467
 
468
+(defun examine (object)
469
+  (text (xif.e:description object)))
470
+
415 471
 (defun populate-world ()
416 472
   (make-instance 'xif.e::location :name "Lobby" :id 0
417 473
                  :description "It's rather ugly, really.")
... ...
@@ -420,7 +476,9 @@
420 476
                  :location (id→object 0))
421 477
   (make-instance 'xif.e::player :name "Maria"   :id 100
422 478
                  :description "A rather hideous lass."
423
-                 :location (id→object 0)))
479
+                 :location (id→object 0))
480
+  (make-instance 'xif.e::action :function-name 'xif.c::examine :direct-object-p T
481
+                 :verbs '("examine" "look" "view")))
424 482
 
425 483
 
426 484
 
... ...
@@ -442,3 +500,21 @@
442 500
 
443 501
 (defun xif.c::input-sentence ()
444 502
   (read-line))
503
+
504
+(in-package :x-if.misc)
505
+
506
+(defun string-lines (string)
507
+  (cl-strings:split string #\newline))
508
+
509
+(defun line-cdr (string)
510
+  (lines-string (cdr (string-lines string))))
511
+
512
+(defun line-car (string)
513
+  (lines-string (car (string-lines string))))
514
+
515
+(defun line-length (string)
516
+  (length (string-lines string)))
517
+
518
+(defun lines-string (lines)
519
+  (cl-strings:join lines :separator "
520
+"))