diff --git a/lisp/game-objects.lisp b/lisp/game-objects.lisp new file mode 100644 index 0000000..9535c08 --- /dev/null +++ b/lisp/game-objects.lisp @@ -0,0 +1,19 @@ +;;; +;;; Atlantis is a framework for creating multi-user dungeon worlds. +;;; This is the Common Lisp implementation. +;;; +;;; This file contains all the various kinds of in-game objects like +;;; places, monsters, NPCs, items... +;;; +;;; Licensed under the terms of the MIT license. +;;; author: Daniel Vedder +;;; date: 15/05/2015 +;;; + +(defstruct place + (name "") + (neighbours NIL) + (items NIL) + (monsters NIL) + (npcs NIL)) + diff --git a/lisp/game-objects.lisp b/lisp/game-objects.lisp new file mode 100644 index 0000000..9535c08 --- /dev/null +++ b/lisp/game-objects.lisp @@ -0,0 +1,19 @@ +;;; +;;; Atlantis is a framework for creating multi-user dungeon worlds. +;;; This is the Common Lisp implementation. +;;; +;;; This file contains all the various kinds of in-game objects like +;;; places, monsters, NPCs, items... +;;; +;;; Licensed under the terms of the MIT license. +;;; author: Daniel Vedder +;;; date: 15/05/2015 +;;; + +(defstruct place + (name "") + (neighbours NIL) + (items NIL) + (monsters NIL) + (npcs NIL)) + diff --git a/lisp/interpreter.lisp b/lisp/interpreter.lisp index 8265344..c3a76c5 100644 --- a/lisp/interpreter.lisp +++ b/lisp/interpreter.lisp @@ -8,3 +8,33 @@ ;;; author: Daniel Vedder ;;; date: 09/05/2015 ;;; + +(load 'util.lisp) +(load 'game-objects.lisp) +(load 'world.lisp) + + +(defun define-place (name) + (format t "~&Making place ~A" name) + (make-place :name name)) + +(defun start-place (place) + ;not yet defined + ) + +(defun load-atl-file (file-name) + "Load an ATL source file" + (do* ((line-nr 0 (1+ line-nr)) (source (load-file file-name)) + (line (nth line-nr source) (nth line-nr source)) + (current-object NIL)) + ((= line-nr (length source)) NIL) + (unless (or (zerop (length line)) + (eql (aref line 0) #\;)) + (eql (aref line 0) #\SPACE) + (eql (aref line 0) #\TAB)) + ; interpret a define command + (funcall (symbol-function (read-from-string line)) + ; here follows is a kludge to work around a clisp bug (the + ; :start keyword in read-from-string is not recognized) + (read-from-string + (second (cut-string line (find-char #\space line))))))) diff --git a/lisp/game-objects.lisp b/lisp/game-objects.lisp new file mode 100644 index 0000000..9535c08 --- /dev/null +++ b/lisp/game-objects.lisp @@ -0,0 +1,19 @@ +;;; +;;; Atlantis is a framework for creating multi-user dungeon worlds. +;;; This is the Common Lisp implementation. +;;; +;;; This file contains all the various kinds of in-game objects like +;;; places, monsters, NPCs, items... +;;; +;;; Licensed under the terms of the MIT license. +;;; author: Daniel Vedder +;;; date: 15/05/2015 +;;; + +(defstruct place + (name "") + (neighbours NIL) + (items NIL) + (monsters NIL) + (npcs NIL)) + diff --git a/lisp/interpreter.lisp b/lisp/interpreter.lisp index 8265344..c3a76c5 100644 --- a/lisp/interpreter.lisp +++ b/lisp/interpreter.lisp @@ -8,3 +8,33 @@ ;;; author: Daniel Vedder ;;; date: 09/05/2015 ;;; + +(load 'util.lisp) +(load 'game-objects.lisp) +(load 'world.lisp) + + +(defun define-place (name) + (format t "~&Making place ~A" name) + (make-place :name name)) + +(defun start-place (place) + ;not yet defined + ) + +(defun load-atl-file (file-name) + "Load an ATL source file" + (do* ((line-nr 0 (1+ line-nr)) (source (load-file file-name)) + (line (nth line-nr source) (nth line-nr source)) + (current-object NIL)) + ((= line-nr (length source)) NIL) + (unless (or (zerop (length line)) + (eql (aref line 0) #\;)) + (eql (aref line 0) #\SPACE) + (eql (aref line 0) #\TAB)) + ; interpret a define command + (funcall (symbol-function (read-from-string line)) + ; here follows is a kludge to work around a clisp bug (the + ; :start keyword in read-from-string is not recognized) + (read-from-string + (second (cut-string line (find-char #\space line))))))) diff --git a/lisp/util.lisp b/lisp/util.lisp index 062834a..c527654 100644 --- a/lisp/util.lisp +++ b/lisp/util.lisp @@ -10,6 +10,8 @@ ;;; +;;; MACROS + ; potentially inefficient if called often (defmacro set-list (value &rest var-list) "Set each symbol in var-list to value" @@ -50,8 +52,55 @@ "An implementation of a while loop as found in other languages" `(do () ((not ,condition)) - ,@body)) + (,@body))) +(defmacro != (object1 object2 &key (test 'eql)) + "A not-equals macro to save some typing" + `(not (,test ,object1 ,object2))) + +(defmacro cassoc (entry table &key (test #'eql)) + "Returns (car (cdr (assoc entry table)))" + `(car (cdr (assoc ,entry ,table :test ,test)))) + +(defmacro safe-aref (vector index) + "Return (aref vector index), but return NIL if out of range" + `(if (> ,index (1- (length ,vector))) + NIL (aref ,vector ,index))) + +(defmacro dovector ((element vector &optional (return-variable NIL)) &body body) + "A macro analogous to dolist" + (let ((index (gensym))) + `(do* ((,index 0 (1+ ,index)) + (,element (safe-aref ,vector ,index) + (safe-aref ,vector ,index))) + ((= ,index (length ,vector)) ,return-variable) + ,@body))) + + +;;; FUNCTIONS + +; Some of these functions are probably quite inefficient (lots of consing) + +(defun cut-string (s i) + "Cut string s in two at index i and return the two substrings in a list" + (do* ((c 0 (1+ c)) (letter (aref s c) (aref s c)) + (letter-list-1 NIL) (letter-list-2 NIL)) + ((= c (1- (length s))) + (list (to-string (append letter-list-1)) + (to-string (append letter-list-2 (list letter))))) + (if (< c i) (setf letter-list-1 (append letter-list-1 (list letter))) + (setf letter-list-2 (append letter-list-2 (list letter)))))) + +(defun to-string (char-list) + "Convert a character list to a string" + (let ((s (make-string (length char-list) :initial-element #\SPACE))) + (dotimes (i (length char-list) s) + (setf (aref s i) (nth i char-list))))) + +(defun find-char (c s) + "Find character c in string s and return the index (or NIL if non-existent)" + (dotimes (letter (length s) NIL) + (when (eql (char s letter) c) (return letter)))) (defun count-instances (search-term search-list) "Count the number of instances of search-term in search-list" @@ -60,7 +109,14 @@ (counter 0 (1+ counter))) ((null lst) counter))) -; Probably quite inefficient, maybe remove this function later +(defun count-vector-instances (search-term search-vector) + "Count the number of instances of search-term in search-vector" + (do ((count 0) (item-nr 0 (1+ item-nr)) + (item (aref search-vector item-nr) (aref search-vector item-nr))) + ((= item-nr (1- (length search-vector))) count) + ;TODO + )) + (defun to-list (vector) "Turn the vector into a list" (do* ((i 0 (1+ i)) @@ -70,16 +126,10 @@ (defun load-file (file-name) "Load a file into a list of strings (representing the lines)" + ;; adds two NIL to the end? (with-open-file (f file-name) (do* ((line (read-line f nil nil) (read-line f nil nil)) (file-lines (list line) (append file-lines (list line)))) ((null line) file-lines)))) - -;; Intended for interactive sessions -;; Load automatically at any clisp start? -(let ((file-name 'util.lisp)) - (defun l (&optional new-file-name) - (when new-file-name (setf file-name new-file-name)) - (load file-name))) diff --git a/lisp/game-objects.lisp b/lisp/game-objects.lisp new file mode 100644 index 0000000..9535c08 --- /dev/null +++ b/lisp/game-objects.lisp @@ -0,0 +1,19 @@ +;;; +;;; Atlantis is a framework for creating multi-user dungeon worlds. +;;; This is the Common Lisp implementation. +;;; +;;; This file contains all the various kinds of in-game objects like +;;; places, monsters, NPCs, items... +;;; +;;; Licensed under the terms of the MIT license. +;;; author: Daniel Vedder +;;; date: 15/05/2015 +;;; + +(defstruct place + (name "") + (neighbours NIL) + (items NIL) + (monsters NIL) + (npcs NIL)) + diff --git a/lisp/interpreter.lisp b/lisp/interpreter.lisp index 8265344..c3a76c5 100644 --- a/lisp/interpreter.lisp +++ b/lisp/interpreter.lisp @@ -8,3 +8,33 @@ ;;; author: Daniel Vedder ;;; date: 09/05/2015 ;;; + +(load 'util.lisp) +(load 'game-objects.lisp) +(load 'world.lisp) + + +(defun define-place (name) + (format t "~&Making place ~A" name) + (make-place :name name)) + +(defun start-place (place) + ;not yet defined + ) + +(defun load-atl-file (file-name) + "Load an ATL source file" + (do* ((line-nr 0 (1+ line-nr)) (source (load-file file-name)) + (line (nth line-nr source) (nth line-nr source)) + (current-object NIL)) + ((= line-nr (length source)) NIL) + (unless (or (zerop (length line)) + (eql (aref line 0) #\;)) + (eql (aref line 0) #\SPACE) + (eql (aref line 0) #\TAB)) + ; interpret a define command + (funcall (symbol-function (read-from-string line)) + ; here follows is a kludge to work around a clisp bug (the + ; :start keyword in read-from-string is not recognized) + (read-from-string + (second (cut-string line (find-char #\space line))))))) diff --git a/lisp/util.lisp b/lisp/util.lisp index 062834a..c527654 100644 --- a/lisp/util.lisp +++ b/lisp/util.lisp @@ -10,6 +10,8 @@ ;;; +;;; MACROS + ; potentially inefficient if called often (defmacro set-list (value &rest var-list) "Set each symbol in var-list to value" @@ -50,8 +52,55 @@ "An implementation of a while loop as found in other languages" `(do () ((not ,condition)) - ,@body)) + (,@body))) +(defmacro != (object1 object2 &key (test 'eql)) + "A not-equals macro to save some typing" + `(not (,test ,object1 ,object2))) + +(defmacro cassoc (entry table &key (test #'eql)) + "Returns (car (cdr (assoc entry table)))" + `(car (cdr (assoc ,entry ,table :test ,test)))) + +(defmacro safe-aref (vector index) + "Return (aref vector index), but return NIL if out of range" + `(if (> ,index (1- (length ,vector))) + NIL (aref ,vector ,index))) + +(defmacro dovector ((element vector &optional (return-variable NIL)) &body body) + "A macro analogous to dolist" + (let ((index (gensym))) + `(do* ((,index 0 (1+ ,index)) + (,element (safe-aref ,vector ,index) + (safe-aref ,vector ,index))) + ((= ,index (length ,vector)) ,return-variable) + ,@body))) + + +;;; FUNCTIONS + +; Some of these functions are probably quite inefficient (lots of consing) + +(defun cut-string (s i) + "Cut string s in two at index i and return the two substrings in a list" + (do* ((c 0 (1+ c)) (letter (aref s c) (aref s c)) + (letter-list-1 NIL) (letter-list-2 NIL)) + ((= c (1- (length s))) + (list (to-string (append letter-list-1)) + (to-string (append letter-list-2 (list letter))))) + (if (< c i) (setf letter-list-1 (append letter-list-1 (list letter))) + (setf letter-list-2 (append letter-list-2 (list letter)))))) + +(defun to-string (char-list) + "Convert a character list to a string" + (let ((s (make-string (length char-list) :initial-element #\SPACE))) + (dotimes (i (length char-list) s) + (setf (aref s i) (nth i char-list))))) + +(defun find-char (c s) + "Find character c in string s and return the index (or NIL if non-existent)" + (dotimes (letter (length s) NIL) + (when (eql (char s letter) c) (return letter)))) (defun count-instances (search-term search-list) "Count the number of instances of search-term in search-list" @@ -60,7 +109,14 @@ (counter 0 (1+ counter))) ((null lst) counter))) -; Probably quite inefficient, maybe remove this function later +(defun count-vector-instances (search-term search-vector) + "Count the number of instances of search-term in search-vector" + (do ((count 0) (item-nr 0 (1+ item-nr)) + (item (aref search-vector item-nr) (aref search-vector item-nr))) + ((= item-nr (1- (length search-vector))) count) + ;TODO + )) + (defun to-list (vector) "Turn the vector into a list" (do* ((i 0 (1+ i)) @@ -70,16 +126,10 @@ (defun load-file (file-name) "Load a file into a list of strings (representing the lines)" + ;; adds two NIL to the end? (with-open-file (f file-name) (do* ((line (read-line f nil nil) (read-line f nil nil)) (file-lines (list line) (append file-lines (list line)))) ((null line) file-lines)))) - -;; Intended for interactive sessions -;; Load automatically at any clisp start? -(let ((file-name 'util.lisp)) - (defun l (&optional new-file-name) - (when new-file-name (setf file-name new-file-name)) - (load file-name))) diff --git a/lisp/world.lisp b/lisp/world.lisp new file mode 100644 index 0000000..bff9d90 --- /dev/null +++ b/lisp/world.lisp @@ -0,0 +1,10 @@ +;;; +;;; Atlantis is a framework for creating multi-user dungeon worlds. +;;; This is the Common Lisp implementation. +;;; +;;; The world stores the current state of the game. +;;; +;;; Licensed under the terms of the MIT license +;;; author: Daniel Vedder +;;; date: 15/05/2015 +;;; diff --git a/lisp/game-objects.lisp b/lisp/game-objects.lisp new file mode 100644 index 0000000..9535c08 --- /dev/null +++ b/lisp/game-objects.lisp @@ -0,0 +1,19 @@ +;;; +;;; Atlantis is a framework for creating multi-user dungeon worlds. +;;; This is the Common Lisp implementation. +;;; +;;; This file contains all the various kinds of in-game objects like +;;; places, monsters, NPCs, items... +;;; +;;; Licensed under the terms of the MIT license. +;;; author: Daniel Vedder +;;; date: 15/05/2015 +;;; + +(defstruct place + (name "") + (neighbours NIL) + (items NIL) + (monsters NIL) + (npcs NIL)) + diff --git a/lisp/interpreter.lisp b/lisp/interpreter.lisp index 8265344..c3a76c5 100644 --- a/lisp/interpreter.lisp +++ b/lisp/interpreter.lisp @@ -8,3 +8,33 @@ ;;; author: Daniel Vedder ;;; date: 09/05/2015 ;;; + +(load 'util.lisp) +(load 'game-objects.lisp) +(load 'world.lisp) + + +(defun define-place (name) + (format t "~&Making place ~A" name) + (make-place :name name)) + +(defun start-place (place) + ;not yet defined + ) + +(defun load-atl-file (file-name) + "Load an ATL source file" + (do* ((line-nr 0 (1+ line-nr)) (source (load-file file-name)) + (line (nth line-nr source) (nth line-nr source)) + (current-object NIL)) + ((= line-nr (length source)) NIL) + (unless (or (zerop (length line)) + (eql (aref line 0) #\;)) + (eql (aref line 0) #\SPACE) + (eql (aref line 0) #\TAB)) + ; interpret a define command + (funcall (symbol-function (read-from-string line)) + ; here follows is a kludge to work around a clisp bug (the + ; :start keyword in read-from-string is not recognized) + (read-from-string + (second (cut-string line (find-char #\space line))))))) diff --git a/lisp/util.lisp b/lisp/util.lisp index 062834a..c527654 100644 --- a/lisp/util.lisp +++ b/lisp/util.lisp @@ -10,6 +10,8 @@ ;;; +;;; MACROS + ; potentially inefficient if called often (defmacro set-list (value &rest var-list) "Set each symbol in var-list to value" @@ -50,8 +52,55 @@ "An implementation of a while loop as found in other languages" `(do () ((not ,condition)) - ,@body)) + (,@body))) +(defmacro != (object1 object2 &key (test 'eql)) + "A not-equals macro to save some typing" + `(not (,test ,object1 ,object2))) + +(defmacro cassoc (entry table &key (test #'eql)) + "Returns (car (cdr (assoc entry table)))" + `(car (cdr (assoc ,entry ,table :test ,test)))) + +(defmacro safe-aref (vector index) + "Return (aref vector index), but return NIL if out of range" + `(if (> ,index (1- (length ,vector))) + NIL (aref ,vector ,index))) + +(defmacro dovector ((element vector &optional (return-variable NIL)) &body body) + "A macro analogous to dolist" + (let ((index (gensym))) + `(do* ((,index 0 (1+ ,index)) + (,element (safe-aref ,vector ,index) + (safe-aref ,vector ,index))) + ((= ,index (length ,vector)) ,return-variable) + ,@body))) + + +;;; FUNCTIONS + +; Some of these functions are probably quite inefficient (lots of consing) + +(defun cut-string (s i) + "Cut string s in two at index i and return the two substrings in a list" + (do* ((c 0 (1+ c)) (letter (aref s c) (aref s c)) + (letter-list-1 NIL) (letter-list-2 NIL)) + ((= c (1- (length s))) + (list (to-string (append letter-list-1)) + (to-string (append letter-list-2 (list letter))))) + (if (< c i) (setf letter-list-1 (append letter-list-1 (list letter))) + (setf letter-list-2 (append letter-list-2 (list letter)))))) + +(defun to-string (char-list) + "Convert a character list to a string" + (let ((s (make-string (length char-list) :initial-element #\SPACE))) + (dotimes (i (length char-list) s) + (setf (aref s i) (nth i char-list))))) + +(defun find-char (c s) + "Find character c in string s and return the index (or NIL if non-existent)" + (dotimes (letter (length s) NIL) + (when (eql (char s letter) c) (return letter)))) (defun count-instances (search-term search-list) "Count the number of instances of search-term in search-list" @@ -60,7 +109,14 @@ (counter 0 (1+ counter))) ((null lst) counter))) -; Probably quite inefficient, maybe remove this function later +(defun count-vector-instances (search-term search-vector) + "Count the number of instances of search-term in search-vector" + (do ((count 0) (item-nr 0 (1+ item-nr)) + (item (aref search-vector item-nr) (aref search-vector item-nr))) + ((= item-nr (1- (length search-vector))) count) + ;TODO + )) + (defun to-list (vector) "Turn the vector into a list" (do* ((i 0 (1+ i)) @@ -70,16 +126,10 @@ (defun load-file (file-name) "Load a file into a list of strings (representing the lines)" + ;; adds two NIL to the end? (with-open-file (f file-name) (do* ((line (read-line f nil nil) (read-line f nil nil)) (file-lines (list line) (append file-lines (list line)))) ((null line) file-lines)))) - -;; Intended for interactive sessions -;; Load automatically at any clisp start? -(let ((file-name 'util.lisp)) - (defun l (&optional new-file-name) - (when new-file-name (setf file-name new-file-name)) - (load file-name))) diff --git a/lisp/world.lisp b/lisp/world.lisp new file mode 100644 index 0000000..bff9d90 --- /dev/null +++ b/lisp/world.lisp @@ -0,0 +1,10 @@ +;;; +;;; Atlantis is a framework for creating multi-user dungeon worlds. +;;; This is the Common Lisp implementation. +;;; +;;; The world stores the current state of the game. +;;; +;;; Licensed under the terms of the MIT license +;;; author: Daniel Vedder +;;; date: 15/05/2015 +;;; diff --git a/worlds/Example/lisp-test.atl b/worlds/Example/lisp-test.atl new file mode 100644 index 0000000..fdb5416 --- /dev/null +++ b/worlds/Example/lisp-test.atl @@ -0,0 +1,18 @@ +; This is a simple test ATL file to test whatever I have implemented so far. +; @author Daniel Vedder +; @date 04/05/2015 + +define-place "Nowhere" + description "Welcome to Nowhere!" +;You are in the void, the space between +;the worlds. Around you is black. Black, except for one tiny pin-prick of +;light to the north. + neighbour "Elysium" + +define-place "Elysium" + description "This is where you want to be when you are six feet under..." + neighbour "Nowhere" + +;load test2.atl + +start-place "Nowhere" \ No newline at end of file