Archived
1
0
Disbranĉigi 0

Remove arnesi; distinguish *string-lexicon* and *lexicon*

This commit is contained in:
Jaidyn Levesque 2020-01-14 23:46:57 -06:00
parent beaeb51043
commit f4b0ce1f39
2 changed files with 423 additions and 124 deletions

View File

@ -3,5 +3,5 @@
:license "GPLv3" :license "GPLv3"
:author "Jaidyn Ann <jadedctrl@teknik.io>" :author "Jaidyn Ann <jadedctrl@teknik.io>"
:description "A flexible IF engine." :description "A flexible IF engine."
:depends-on (:cl-earley-parser :bknr.datastore :arnesi :cl-strings) :depends-on (:cl-earley-parser :bknr.datastore :anaphora :cl-strings)
:components ((:file "x-if"))) :components ((:file "x-if")))

545
x-if.lisp
View File

@ -7,39 +7,54 @@
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details. ;; GNU General Public License for more details.
;; TODO: get x-if.lexicon working, so the lexicon can be modified on-the-fly ;; TODO: Get :x-if.interpret to make ACTION objects.
;; by x-if.environment, when new objects are created.
;; also add :synonyms and :adjectives to the GOD object class
;; ————————————————————————————————————— ;; —————————————————————————————————————
;; PACKAGES ;; PACKAGES
(defpackage :x-if (defpackage :x-if
(:use :cl :arnesi) (:use :cl)
(:nicknames :xif)) (:nicknames :xif))
(defpackage :x-if.misc (defpackage :x-if.misc
(:use :cl) (:use :cl :anaphora)
(:nicknames :xif.m) (:nicknames :xif.m)
(:export :line-cdr :line-car :line-length)) (:export :line-cdr :line-car
:line-length :line-position
:in-string-p
:remove-line
:position-equal))
(defpackage :x-if.lexicon (defpackage :x-if.lexicon
(:use :cl :arnesi :earley-parser) (:use :cl :earley-parser)
(:nicknames :xif.l) (:nicknames :xif.l)
(:export :action-indirect-required-p :action-direct-required-p (:export :action-indirect-required-p :action-direct-required-p
:action-p :action-function :add-action :add-verb :action-p :action-function :add-action :add-verb :remove-word
*lexicon* :add-adjective :add-noun :add-proper-noun :reload-lexicon)) *string-lexicon* *lexicon*
:add-game-object-words :delete-game-object-words
:add-adjective :add-noun :add-proper-noun :add-verb
:reload-lexicon))
(defpackage :x-if.environment (defpackage :x-if.environment
(:use :cl :arnesi :bknr.datastore) (:use :cl :bknr.datastore)
(:nicknames :xif.e) (:nicknames :xif.e)
(:export :nameobject :all-objects :idobject :get-player (:export :idgame-object :get-player
:adjectives :description :id :name :synonyms :adjectives :all-game-objects
:locationentity :all-entities :noungame-objects :proper-noungame-objects :adjectivegame-objects
:inventory :max-inventory :weight :hp :max-hp)) :all-entities
:nounentities :proper-nounentities :adjectiveentities
:all-mobs
:nounmobs :proper-nounmobs :adjectivemobs
:nounlocations :proper-nounlocations :adjectivelocations
:all-locations
:id :description
:nouns :proper-nouns :adjectives
:max-children :weight :hp :max-hp
:children :parent
:link :unlink))
(defpackage :x-if.parsing (defpackage :x-if.parsing
(:use :cl :arnesi) (:use :cl)
(:nicknames :xif.p) (:nicknames :xif.p)
(:export :parse (:export :parse
:noun-phrases :det :prep :proper-noun :noun-name :det :prep :noun-phrases :det :prep :proper-noun :noun-name :det :prep
@ -48,18 +63,18 @@
:the-action :the-subject)) :the-action :the-subject))
(defpackage :x-if.interpret (defpackage :x-if.interpret
(:use :cl :arnesi) (:use :cl)
(:nicknames :xif.i)) (:nicknames :xif.i))
(defpackage :x-if.client (defpackage :x-if.client
(:use :cl :arnesi :xif.e :bknr.datastore) (:use :cl :xif.e :bknr.datastore)
(:nicknames :xif.c) (:nicknames :xif.c)
(:export :start (:export :start
:text :input-sentence :display-options :input-options :play-music :text :input-sentence :display-options :input-options :play-music
:show-image :status :prompt)) :show-image :status :prompt))
(defpackage :x-if.client.terminal (defpackage :x-if.client.terminal
(:use :cl :arnesi :xif.e) (:use :cl :xif.e)
(:nicknames :xif.c.t)) (:nicknames :xif.c.t))
@ -107,8 +122,7 @@
(earley-parser:chart-listing->trees (earley-parser:chart-listing->trees
(earley-parser:earley-parse statement (earley-parser:earley-parse statement
(earley-parser:load-bnf-grammar #p"example/grammar.txt") (earley-parser:load-bnf-grammar #p"example/grammar.txt")
(xif.l:reload-lexicon)))) xif.l:*lexicon*)))
(defun split-statements (sentence) (defun split-statements (sentence)
"Split up a string into different statements, based on punctuation." "Split up a string into different statements, based on punctuation."
@ -206,12 +220,17 @@
;; ————————————————————————————————————— ;; —————————————————————————————————————
(defvar *lexicon* (defvar *string-lexicon*)
(setq *string-lexicon*
"the :class <det> "the :class <det>
that :class <det> that :class <det>
this :class <det> this :class <det>
here :class <prep> here :class <prep>
there :class <prep> there :class <prep>
above :class <prep>
below :class <prep>
beside :class <prep>
across :class <prep>
be :class <aux> be :class <aux>
to :class <prep> to :class <prep>
with :class <prep> with :class <prep>
@ -219,46 +238,83 @@ a :class <det>
an :class <det> an :class <det>
") ")
(defvar *actions* (make-hash-table :test #'equal)) (defvar *lexicon* nil)
(defmacro add-string-to-var (var string)
`(setq ,var (concatenate 'string ,var ,string)))
(defun add-word (name class) ;; STRING STRING → NIL
(add-string-to-var *lexicon* (format nil "~A :class \<~A\>~%" name class))) (defun add-word (word class)
"Add a word of the given class to the string-lexicon and parsed lexicon."
(setq *string-lexicon*
(concatenate 'string *string-lexicon*
(format nil "~A :class \<~A\>~%" word class)))
(reload-lexicon))
(defmethod add-noun ((name string))
(add-word name "noun"))
(defmethod add-noun ((object xif.e::god)) ;; STRING → NIL
(mapcar #'add-noun (xif.e:synonyms object)) (defun remove-word (word)
(add-noun (xif.e:name object))) "Remove a word from the string-lexicon and parsed lexicon."
(when (is-word-p word)
(setq *string-lexicon*
(xif.m:remove-line *string-lexicon* word
:test #'cl-strings:starts-with))
(reload-lexicon)))
(defmethod add-adjective ((adj string)) ;; STRING → BOOLEAN
(add-word adj "adjective")) (defun is-word-p (word)
"Return whether or not a given word is in the lexicon."
(xif.m:line-position *string-lexicon* word :test #'cl-strings:starts-with))
(defmethod add-adjective ((object xif.e::god))
(mapcar #'add-adjective (xif.e:adjectives object)))
(defmethod add-verb ((verb string)) ;; SYMBOL SYMBOL STRING → (DEFUN … )
(add-word verb "verb")) (defmacro defun-add-wordclass (function-name class-symbol class-string)
"Define the add-WORD function of the given word-class. #'add-noun, etc."
`(defun ,function-name (,class-symbol)
,(format nil "Add a word of class ~A to the lexicon." class-string)
(add-word ,class-symbol ,class-string)))
(defmethod add-action ((action xif.e::action)) (defun-add-wordclass add-proper-noun proper-noun "proper-noun")
(mapcar #'add-verb (xif.e::verbs action))) (defun-add-wordclass add-noun noun "noun")
(defun-add-wordclass add-adjective adjective "adjective")
(defun-add-wordclass add-verb verb "verb")
;; GAME-OBJECT → NIL
(defmethod add-game-object-words ((object xif.e::game-object))
"Add a game-object's words (nouns, adjectives, proper-nouns) to the lexicon."
(mapcar #'add-adjective (xif.e:adjectives object))
(mapcar #'add-proper-noun (xif.e:proper-nouns object))
(mapcar #'add-noun (xif.e:nouns object)))
;; GAME-OBJECT → NIL
(defmethod remove-game-object-words ((object xif.e::game-object))
"Remove a game-object's words (nouns, adjectives, proper-nouns) to the lexicon."
(mapcar #'xif.l:remove-word (xif.e:nouns object))
(mapcar #'xif.l:remove-word (xif.e:proper-nouns object))
(mapcar #'xif.l:remove-word (xif.e:adjectives object)))
;; STRING → LEXICON
(defun load-string-lexicon (lex-string) (defun load-string-lexicon (lex-string)
"Read all words from a dictionary file into a lexicon and a part of speech." "Read all words from a dictionary file into a lexicon and a part of speech.
Abridged version of #'earley-parser:load-lexicon (which reads from a file)."
(with-input-from-string (lex-str-stream lex-string) (with-input-from-string (lex-str-stream lex-string)
(let ((lexicon (make-hash-table :test earley-parser::*string-comparer*)) (let ((lexicon (make-hash-table :test earley-parser::*string-comparer*))
(part-of-speech nil)) (part-of-speech nil))
(loop :while (listen lex-str-stream) (loop :while (listen lex-str-stream)
:do (let ((w (earley-parser::read-lexicon-line lex-str-stream))) :do (let ((w (earley-parser::read-lexicon-line lex-str-stream)))
(pushnew (earley-parser::terminal-class w) part-of-speech :test earley-parser::*string-comparer*) (pushnew (earley-parser::terminal-class w)
part-of-speech
:test earley-parser::*string-comparer*)
(push w (gethash (earley-parser::terminal-word w) lexicon)))) (push w (gethash (earley-parser::terminal-word w) lexicon))))
(earley-parser::make-lexicon :dictionary lexicon :part-of-speech part-of-speech)))) (earley-parser::make-lexicon :dictionary lexicon
:part-of-speech part-of-speech))))
;; NIL → NIL
(defun reload-lexicon () (defun reload-lexicon ()
(load-string-lexicon *lexicon*)) "Updates the lexicon by parsing the string-lexicon."
(setq *lexicon* (load-string-lexicon *string-lexicon*)))
;; ————————————————————————————————————— ;; —————————————————————————————————————
;; X-IF.INTERPRET ;; X-IF.INTERPRET
@ -290,18 +346,23 @@ an :class <det>
;; It will also return an appropriate error symbol, as a second value— ;; It will also return an appropriate error symbol, as a second value—
;; I.E., 'INVALID-ACTION, etc. ;; I.E., 'INVALID-ACTION, etc.
;; If a word *isn't* in lexicon, then #'x.if.parsing:parse will return an ;; If a word *isn't* in lexicon, or something else crops up, then
;; error-string instead of a parsed Earley tree— which means that #'interpret ;; #'x.if.parsing:parse will return an error symbol instead of a queued-action
;; will recieve that error string from the engine. In this case, #'interpret ;; object— which means that #'interpret will recieve that error symbol from the
;; will return the string as if it were its own error-string, but with an ;; engine. In this case, #'interpret will return the symbol as if it were its
;; error-symbol of 'PARSE-DIE. ;; own error-symbol, but with an error-symbol of 'PARSE-DIE.
;; If the error is in the interpretation method, it'll obviously return the
;; second error-symbol as 'INTERPRET-DIE.
;; Anyway, ultimately the engine will actually execute the actionable list ;; Anyway, ultimately the engine will actually execute the actionable list
;; generated by #'interpret. ;; generated by #'interpret.
;; ————————————————————————————————————— ;; —————————————————————————————————————
;; TREE_OF_STATEMENT → LIST || (STRING SYMBOL) ;; TODO: Obviously, if there are multiple matches it should error TF out
;; and die, and... and... AHHHH good luck ;w;
;; TREE_OF_STATEMENT → LIST || (SYMBOL SYMBOL)
(defmethod interpret ((statement-tree list)) (defmethod interpret ((statement-tree list))
"Actually interpret a parsed statement-tree; returns a list with the "Actually interpret a parsed statement-tree; returns a list with the
applicable function-name for the action, and the objects for the direct and applicable function-name for the action, and the objects for the direct and
@ -309,8 +370,8 @@ an :class <det>
(let* ((subject (or (the-subject statement-tree) (xif.e:get-player))) (let* ((subject (or (the-subject statement-tree) (xif.e:get-player)))
(action (the-action statement-tree)) (action (the-action statement-tree))
(verb (verb action)) (verb (verb action))
(indirect (xif.e:nameobject (indirect-object action))) (indirect (xif.e:noungame-objects (indirect-object action)))
(direct (xif.e:nameobject (direct-object action)))) (direct (xif.e:noungame-objects (direct-object action))))
(cond ((not (xif.l:action-p verb)) (cond ((not (xif.l:action-p verb))
"That… that's just not a thing people do.") "That… that's just not a thing people do.")
((and (not indirect) (xif.l:action-indirect-required-p verb)) ((and (not indirect) (xif.l:action-indirect-required-p verb))
@ -326,74 +387,78 @@ an :class <det>
;; ————————————————————————————————————— ;; —————————————————————————————————————
;; X-IF.ENVIRONMENT ;; X-IF.ENVIRONMENT
;; OBJECTS, GAME-STATE, ETC.
(in-package :x-if.environment) (in-package :x-if.environment)
;; ————————————————————————————————————— ;; —————————————————————————————————————
;; This package contains all aspect of the actual game 'environment'—
;; all objects (rooms, entities, etc), means of accessing and modifying them,
;; etc.
;; There is a main overarching class (game-object), of which everything else is
;; derived. From there, there are two divering subclasses— the 'location'
(define-persistent-class god () ;; —————————————————————————————————————
;; CLASSES
;; The overarching class
(define-persistent-class game-object ()
((id :read ((id :read
:initarg :id :reader id :initarg :id :reader id
:index-type bknr.datastore::unique-index :index-type bknr.datastore::unique-index
:index-initargs (:test #'equal) :index-initargs (:test #'equal)
:index-reader idobject :index-reader idgame-object
:index-values all-objects) :index-values all-game-objects)
(nouns :read (nouns :update
:initarg :nouns :reader nouns :initarg :nouns :reader nouns)
:index-type bknr.datastore::hash-index (proper-nouns :update
:index-initargs (:test #'position) :initarg :proper-name :reader proper-nouns
:index-reader nounobject)
(proper-noun :read
:initarg :proper-name :reader proper-name
:index-type bknr.datastore::hash-index
:index-initargs (:test #'equal)
:index-reader proper-nameobject
:initform nil) :initform nil)
(adjectives :read (adjectives :update
:initarg :adjectives :reader adjectives :initarg :adjectives :reader adjectives
:initform nil) :initform nil)
(synonyms :read (description :update
:initarg :synonyms :reader synonyms
:initform nil)
(description :read
:initarg :desc :reader description :initarg :desc :reader description
:initform nil)
(parent :update
:initarg :parent :reader parent
:initform nil)
(children :update
:initarg :children :reader children
:initform nil)
(max-children :update
:initarg :max-children :reader max-children
:initform nil))) :initform nil)))
(define-persistent-class entity (god) ;; For any object that can interacted with
((location :read (define-persistent-class entity (game-object)
:initarg :location :reader location ((hp :update
:index-type bknr.datastore::hash-index
:index-initargs (:test #'equal)
:index-reader locationentity
:index-values all-entities)
(inventory :read
:initarg :inventory :reader inventory
:initform nil)
(max-inventory :read
:initarg :max-inventory :reader max-inventory
:initform 0)
(weight :read
:initarg :weight :reader weight
:initform 0)
(hp :read
:initarg :hp :reader hp :initarg :hp :reader hp
:initform nil) :initform nil)
(max-hp :read (max-hp :update
:initarg :max-hp :reader max-hp :initarg :max-hp :reader max-hp
:initform nil))) :initform nil)
(weight :update
:initarg :weight :reader weight
:initform 0)))
(define-persistent-class npc (entity) ((normie :read :initform T :index-values all-npcs))) ;; These classes only exist for indexing and semantic purposes;
;; they are identical to their super-classes
(define-persistent-class player (npc) ;; For NPCs, animals, etc.
((mlg :read (define-persistent-class mob (entity) ())
:initform T :index-values get-player)))
(define-persistent-class location (entity) ;; For the PLAYER.
((extreme-makeover-home-edition :read (define-persistent-class player (mob) ())
:initform T :index-values all-locations)))
;; For LOCATIONS (rooms and such).
(define-persistent-class location (game-object) ())
;; For hypothetical ACTIONS;
;; that is, commands the player can enter which will execute a given function.
(define-persistent-class action () (define-persistent-class action ()
((function-name :read ((function-name :read
:initarg :function :reader function-name) :initarg :function :reader function-name)
@ -408,6 +473,9 @@ an :class <det>
(indirect-object-p :read (indirect-object-p :read
:initarg :indirect-object-p :initform nil :reader indirect-object-required-p))) :initarg :indirect-object-p :initform nil :reader indirect-object-required-p)))
;; For tuŝeblaj ACTIONS; generated by :x-if.interpret from interpreting a user
;; statement. This is what will actually be executed by :x-if.interpret.
(defclass queued-action () (defclass queued-action ()
((function-name ((function-name
:initarg :function :accessor function-name) :initarg :function :accessor function-name)
@ -418,22 +486,171 @@ an :class <det>
(subject (subject
:initarg :subject :initform (get-player) :accessor subject))) :initarg :subject :initform (get-player) :accessor subject)))
(defun get-player ()
(idobject 100)) ;; —————————————————
;; OBJECT ADD/DEL
;; These are here to appropriately modify the LEXICON (xif.l:*lexicon*)
;; according to objects in the game. Words used to describe objects
;; and actions will be added when an object is initialized; deleted
;; when destroyed.
;; TODO
;; Nuance is necessary; if a noun/adjective/etc is used for other objects,
;; it shouldn't be added again nor deleted from the lexicon when adding a new
;; object or deleting one, respectively.
;; For now, it's assumed all words are new, and are all used by one object.
(defmethod initialize-instance :after ((game-object game-object) &key)
(xif.l:add-game-object-words game-object))
(defmethod destroy-object :after ((game-object game-object) &key)
(xif.l:delete-game-object-words game-object))
(defmethod initialize-instance :after ((god god) &key)
(xif.l:add-noun god)
(xif.l:add-adjective god)
(xif.l:reload-lexicon))
(defmethod initialize-instance :after ((action action) &key) (defmethod initialize-instance :after ((action action) &key)
(xif.l:add-action action) (mapcar #'xif.l:add-verb (verbs action)))
(xif.l:reload-lexicon))
;; TODO: write #'xif.l:remove-action
(defmethod destroy-object :after ((action action) &key))
;; —————————————————
;; PARENT/CHILD
;; GAME-OBJECT GAME-OBJECT → NIL
(deftransaction link (child parent)
"Link two objects together, as child and parent."
(setf (slot-value parent 'children)
(nconc (slot-value parent 'children) (list child)))
;; --
(if (child-p child) (unlink child))
(setf (slot-value child 'parent) parent))
;; GAME-OBJECT → NIL
(deftransaction unlink (child)
"Seperate a child from it's parent (and vice-versa)."
(let ((parent (slot-value child 'parent)))
(setf (slot-value parent 'children)
(delete child (slot-value parent 'children)))
;; --
(setf (slot-value child 'parent) nil)))
;; GAME-OBJECT → BOOLEAN
(defmethod parent-p ((object game-object))
"Return whether or not an object is a parent (has 1+ children)."
(slot-value object 'children))
;; GAME-OBJECT → BOOLEAN
(defmethod child-p ((object game-object))
"Return whether or not an object is a child (has a parent)."
(slot-value object 'parent))
;; —————————————————
;; INDEXING
;; NIL → PLAYER
(defun get-player ()
"Return the player object."
(car (store-objects-with-class 'player)))
;; NIL → LIST_OF_LOCATIONS
(defun all-locations ()
"Get all location objects."
(store-objects-with-class 'location))
;; NIL → LIST_OF_MOBS
(defun all-mobs ()
"Get all mob objects."
(store-objects-with-class 'mob))
;; NIL → LIST_OF_ENTITIES
(defun all-entities ()
"Get all entity objects."
(store-objects-with-class 'entity))
;; NIL → LIST_OF_ENTITIES
(defun all-actions ()
"Get all entity objects."
(store-objects-with-class 'action))
;; LIST_OF_OBJECTS STRING → LIST_OF_OBJECTS
(defun nounobjects (objects noun)
"Return objects within the current list of objects of the given noun."
(index-by-slot-list objects 'nouns noun))
;; LIST_OF_OBJECTS STRING → LIST_OF_OBJECTS
(defun adjectiveobjects (objects adjective)
"Return objects within the current list of objects of the given adjective."
(index-by-slot-list objects 'adjectives adjective))
;; LIST_OF_OBJECTS STRING → LIST_OF_OBJECTS
(defun proper-nounobjects (objects proper-noun)
"Return objects within the current list of objects of the given proper-noun"
(index-by-slot-list objects 'proper-nouns proper-noun))
;; STRING → LIST_OF_ACTIONS
(defun verbactions (verb)
"Return all actions matching the given verb."
(index-by-slot-list (all-actions) 'verbs verb))
;; SYMBOL SYMBOL FUNCTION SYMBOL FUNCTION → (DEFUN …)
(defmacro defun-obj-word-index (name obj-type all-obj-type word-type word-fun)
"Makes an index function for the given object type and word-type.
I.E., will generate #'adjectivemobs for object-type 'mobs' and word-type of
'adjective'"
`(defun ,name (,word-type)
,(format nil "Return the ~A corresponding with the given ~A."
obj-type word-type)
(funcall ,word-fun (funcall ,all-obj-type) ,word-type)))
;; SYMBOL FUNCTION SYMBOL SYMBOL SYMBOL → ( (DEFUN …) (DEFUN …) (DEFUN …))
(defmacro defuns-obj-word-indices (obj-type all-obj adjobj nounobj pnounobj)
"Makes the index functions for a given object type for every word type.
I.E., when given 'mobs', it'll make #'nounmobs, #'adjectivemobs, etc."
`(progn
(defun-obj-word-index ,adjobj ,obj-type ,all-obj adjective
#'adjectiveobjects)
(defun-obj-word-index ,nounobj ,obj-type ,all-obj noun #'nounobjects)
(defun-obj-word-index ,pnounobj ,obj-type ,all-obj proper-noun
#'proper-nounobjects)))
(defuns-obj-word-indices game-object #'all-game-objects
adjectivegame-objects noungame-objects proper-noungame-objects)
(defuns-obj-word-indices entity #'all-entities
adjectiveentities nounentities proper-nounentities)
(defuns-obj-word-indices mob #'all-mobs
adjectivemobs nounmobs proper-nounmobs)
(defuns-obj-word-indices locations #'all-locations
adjectivelocations nounlocations proper-nounlocations)
;; LIST_OF_OBJECTS SYMBOL VARYING → LIST_OF_OBJECTS
(defun index-by-slot-list (objects slot-name target)
"Return objects from the given list that contain a target item in the list
of the given slot."
(index-by-slot objects slot-name target :test #'xif.m:position-equal))
;; LIST_OF_OBJECTS SYMBOL VARYING :FUNCTION → LIST_OF_OBJECTS
(defun index-by-slot (objects slot-name target &key (test #'equal))
"Return objects from the given list that pass the given test between
slot-value and target."
(loop :for object :in objects
:if (funcall test target (slot-value object slot-name))
:collect object))
;; ————————————————————————————————————— ;; —————————————————————————————————————
;; X-IF.CLIENT ;; X-IF.CLIENT
;; ACTUALLY PLAY THE GAME
(in-package :x-if.client) (in-package :x-if.client)
@ -444,7 +661,7 @@ an :class <det>
;; ————————————————————————————————————— ;; —————————————————————————————————————
(defun status () (defun status ()
(format nil "~A~%" (slot-value (get-player) 'xif.e::location))) (format nil "~A~%" (slot-value (get-player) 'xif.e::parent)))
(defun prompt () ">> ") (defun prompt () ">> ")
@ -453,7 +670,7 @@ an :class <det>
(display-status) (display-status)
(setq m (input-sentence)) (setq m (input-sentence))
(text "You said: ~A~%" m) (text "You said: ~A~%" m)
(text "~A~%" (xif.e:all-objects)) (text "~A~%" (xif.e:all-game-objects))
(text "I LOVE YOU~%") (text "I LOVE YOU~%")
(sleep 2) (sleep 2)
(game-loop))) (game-loop)))
@ -461,7 +678,7 @@ an :class <det>
(defun start (game) (defun start (game)
(make-instance 'mp-store :directory #p"~/.local/share/x-if/" (make-instance 'mp-store :directory #p"~/.local/share/x-if/"
:subsystems (list (make-instance 'store-object-subsystem))) :subsystems (list (make-instance 'store-object-subsystem)))
(if (not (all-objects)) (if (not (all-game-objects))
(populate-world)) (populate-world))
(game-loop)) (game-loop))
@ -469,22 +686,34 @@ an :class <det>
(text (xif.e:description object))) (text (xif.e:description object)))
(defun populate-world () (defun populate-world ()
(make-instance 'xif.e::location :name "Lobby" :id 0 (make-instance 'xif.e::location :id 0 :proper-nouns '("Lobby")
:nouns '("room")
:adjectives '("ugly")
:description "It's rather ugly, really.") :description "It's rather ugly, really.")
(make-instance 'xif.e::npc :name "Barry" :id 101
:description "He looks suspicious, no?" (make-instance 'xif.e::mob :id 101 :proper-nouns '("Barry")
:location (idobject 0)) :nouns '("human" "person" "man" "gentleman" "sir" "dude")
(make-instance 'xif.e::player :name "Maria" :id 100 :adjectives '("suspicious")
:description "A rather hideous lass." :description "He looks suspicious, no?")
:location (idobject 0))
(make-instance 'xif.e::player :id 100
:proper-nouns '("Maria" "I" "myself" "me")
:nouns '("human" "person" "woman" "lady" "lass" "dudette")
:adjectives '("hideous")
:description "A rather hideous lass.")
(make-instance 'xif.e::action :function-name 'xif.c::examine :direct-object-p T (make-instance 'xif.e::action :function-name 'xif.c::examine :direct-object-p T
:verbs '("examine" "look" "view"))) :verbs '("examine" "look" "view"))
(link (get-player) (idgame-object 0))
(link (idgame-object 100) (idgame-object 0)))
;; ————————————————————————————————————— ;; —————————————————————————————————————
;; X-IF.CLIENT.TERMINAL ;; X-IF.CLIENT.TERMINAL
;; A SIMPLE CLIENT
(in-package :x-if.client.terminal) (in-package :x-if.client.terminal)
@ -501,20 +730,90 @@ an :class <det>
(defun xif.c::input-sentence () (defun xif.c::input-sentence ()
(read-line)) (read-line))
;; —————————————————————————————————————
;; X-IF.MISC
;; MISC HELPER FUNCTIONS
(in-package :x-if.misc) (in-package :x-if.misc)
;; —————————————————————————————————————
;; This package just contains random, useful functions that're used throughout
;; x-if. Mainly they're for string manipulations, etc.
;; STRING → LIST_OF_STRINGS
(defun string-lines (string) (defun string-lines (string)
"Turn a multi-line string into a list of lines."
(cl-strings:split string #\newline)) (cl-strings:split string #\newline))
(defun line-cdr (string) ;; LIST_OF_STRINGS → STRING
(lines-string (cdr (string-lines string))))
(defun line-car (string)
(lines-string (car (string-lines string))))
(defun line-length (string)
(length (string-lines string)))
(defun lines-string (lines) (defun lines-string (lines)
"Turn a list of strings into a multi-lined string, with each string being
a seperate line."
(cl-strings:join lines :separator " (cl-strings:join lines :separator "
")) "))
;; STRING → STRING
(defmethod line-cdr ((string string))
"Get the 'cdr' of a multi-lined string (pop off the first line)."
(line-cdr (string-lines string)))
;; LIST_OF_STRINGS → STRING
(defmethod line-cdr ((lines list))
"Get the 'cdr' of a list of lines, then turn back into a string."
(lines-string (cdr lines)))
;; STRING → STRING
(defmethod line-car ((string string))
"Get a multi-lined string's 'car' (the first line)."
(line-car (string-lines string)))
;; LIST_OF_STRINGS → STRING
(defmethod line-car ((lines list))
"Get the 'car' of a list of lines."
(car lines))
;; STRING → NUMBER
(defun line-length (string)
"Return the amount of lines in a given string."
(length (string-lines string)))
;; STRING STRING FUNCTION → NUMBER
(defmethod line-position ((string string) target &key (test #'in-string-p))
"Return the number of the line in which a given target-string can be found,
within a multi-lined string."
(line-position (string-lines string) target :test test))
;; LIST_OF_STRINGS STRING FUNCTION → NUMBER
(defmethod line-position ((lines list) target &key (test #'in-string-p))
"Return which number string the given target-string can be found in."
(position T (mapcar (lambda (line) (funcall test line target)) lines)))
;; STRING STRING → BOOLEAN
(defun in-string-p (string target)
"Return whether or not a target-string is within another string."
(< 1 (length (cl-strings:split string target))))
;; STRING STRING FUNCTION → STRING
(defmethod remove-line ((string string) target &key (test #'in-string-p))
"Remove a line matching the given test, given a target string."
(remove-line (string-lines string) target :test test))
;; LIST_OF_STRINGS STRING FUNCTION → STRING
(defmethod remove-line ((lines list) target &key (test #'in-string-p))
"Remove a line matching the test, return a multi-lined string based on
given list, but sans that removed line, ofc."
(aif (ignore-errors (line-position lines target :test test))
(lines-string
(remove (nth it lines) lines :test #'equal :count 1))
(lines-string list)))
;; ITEM LIST → NUMBER
(defun position-equal (item list)
"Literally just #'cl:position but with the test equal."
(position item list :test #'equal))