diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9839557 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +naledi.log diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9839557 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +naledi.log diff --git a/item-classes.lisp b/item-classes.lisp index 2643ca9..378d13b 100644 --- a/item-classes.lisp +++ b/item-classes.lisp @@ -59,7 +59,8 @@ (group-size :reader .group-size :initarg :group-size :initform 1) (habitat :reader .habitat :initarg :habitat :initform '()) ;; individual properties - (id :reader .id :initarg :id :initform -1)) + (id :reader .id :initarg :id :initform -1) + (last-move :accessor .last-move :initform 0)) (:default-initargs :destroy-with '(weapon) :movable T)) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9839557 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +naledi.log diff --git a/item-classes.lisp b/item-classes.lisp index 2643ca9..378d13b 100644 --- a/item-classes.lisp +++ b/item-classes.lisp @@ -59,7 +59,8 @@ (group-size :reader .group-size :initarg :group-size :initform 1) (habitat :reader .habitat :initarg :habitat :initform '()) ;; individual properties - (id :reader .id :initarg :id :initform -1)) + (id :reader .id :initarg :id :initform -1) + (last-move :accessor .last-move :initform 0)) (:default-initargs :destroy-with '(weapon) :movable T)) diff --git a/item-methods.lisp b/item-methods.lisp index 3c5e02e..f21cddd 100644 --- a/item-methods.lisp +++ b/item-methods.lisp @@ -26,19 +26,25 @@ ;;TODO (defmethod attack ((a animal) (w weapon))) (defmethod update ((a animal)) - (random-move a)) + (when (> (age-of-the-world) (.last-move a)) + (random-move a) + (incf (.last-move a)))) (defmethod random-move ((a animal)) "Move in a random direction within the species' habitat niche" (do* ((dir (random-elt *directions*) (random-elt *directions*)) - (next-patch (patch-in-dir (.x a) (.y a) dir) - (patch-in-dir (.x a) (.y a) dir)) + (next-patch (patchindir (.x a) (.y a) dir) + (patchindir (.x a) (.y a) dir)) (ttl 10 (1- ttl))) - ((zerop ttl) NIL) + ((zerop ttl) + (logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) + NIL) (when (and next-patch (null (patch-occupant next-patch)) (member (read-from-string (biome-name (patch-biome next-patch))) (.habitat a))) + (logging "The ~A at ~S/~S is moving ~S." + (.name a) (.x a) (.y a) dir) (setf (patch-occupant (coord (.x a) (.y a))) NIL) (setf (.x a) (first (patch-pos next-patch)) (.y a) (second (patch-pos next-patch))) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9839557 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +naledi.log diff --git a/item-classes.lisp b/item-classes.lisp index 2643ca9..378d13b 100644 --- a/item-classes.lisp +++ b/item-classes.lisp @@ -59,7 +59,8 @@ (group-size :reader .group-size :initarg :group-size :initform 1) (habitat :reader .habitat :initarg :habitat :initform '()) ;; individual properties - (id :reader .id :initarg :id :initform -1)) + (id :reader .id :initarg :id :initform -1) + (last-move :accessor .last-move :initform 0)) (:default-initargs :destroy-with '(weapon) :movable T)) diff --git a/item-methods.lisp b/item-methods.lisp index 3c5e02e..f21cddd 100644 --- a/item-methods.lisp +++ b/item-methods.lisp @@ -26,19 +26,25 @@ ;;TODO (defmethod attack ((a animal) (w weapon))) (defmethod update ((a animal)) - (random-move a)) + (when (> (age-of-the-world) (.last-move a)) + (random-move a) + (incf (.last-move a)))) (defmethod random-move ((a animal)) "Move in a random direction within the species' habitat niche" (do* ((dir (random-elt *directions*) (random-elt *directions*)) - (next-patch (patch-in-dir (.x a) (.y a) dir) - (patch-in-dir (.x a) (.y a) dir)) + (next-patch (patchindir (.x a) (.y a) dir) + (patchindir (.x a) (.y a) dir)) (ttl 10 (1- ttl))) - ((zerop ttl) NIL) + ((zerop ttl) + (logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) + NIL) (when (and next-patch (null (patch-occupant next-patch)) (member (read-from-string (biome-name (patch-biome next-patch))) (.habitat a))) + (logging "The ~A at ~S/~S is moving ~S." + (.name a) (.x a) (.y a) dir) (setf (patch-occupant (coord (.x a) (.y a))) NIL) (setf (.x a) (first (patch-pos next-patch)) (.y a) (second (patch-pos next-patch))) diff --git a/naledi.lisp b/naledi.lisp index 1dae3d9..bc60f7b 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -10,6 +10,7 @@ (defparameter *debugging* T) (defparameter *logfile* "naledi.log") +(defparameter *framerate* 1000) (ql:quickload :bordeaux-threads) (ql:quickload :croatoan) @@ -25,12 +26,16 @@ (load "animals.lisp") (defun start-game () + ;;Initialize the log and random state + (write-to-file "NALEDI ya AFRICA" *logfile*) + (logging (time-stamp)) (setf *random-state* (make-random-state t)) (create-world 250) - (bt:make-thread #'update-loop :name "world-thread") - (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t - :cursor-visibility nil :input-reading :unbuffered) + (with-screen (scr :input-blocking *framerate* :enable-colors t + :input-echoing nil :cursor-visibility nil + :input-reading :unbuffered) (splash-screen scr) + (run-world) (user-interface scr))) (defun splash-screen (scr) @@ -49,6 +54,7 @@ (move scr (1- height) (- width 22)) (add-string scr "(c) 2018 Daniel Vedder") (event-case (scr event) + ((nil) nil) (otherwise (return-from event-case))))) (defun user-interface (scr) @@ -57,21 +63,21 @@ (me (list (round (/ width 4)) (halve height)))) (clear scr) (refresh scr) - (with-windows ((mapwin :position '(0 0) :input-blocking t :border t - :width (- width 51) :height height) + (with-windows ((mapwin :position '(0 0) :input-blocking *framerate* + :border t :width (- width 51) :height height) (playerwin :position (list 0 (- width 50)) - :input-blocking t :border t + :input-blocking *framerate* :border t :width 50 :height (halve height 'down)) - (placewin :input-blocking t :border t + (placewin :input-blocking *framerate* :border t :position (list (halve height) (- width 50)) :width 50 :height (halve height 'down)) - (newswin :input-blocking t + (newswin :input-blocking *framerate* :position (list height 0) :width width :height 1)) (update-ui mapwin playerwin placewin newswin me) ;;TODO (event-case (scr event) - (#\q (return-from event-case)) + (#\q (terminate) (return-from event-case)) (#\n (draw-menu (message-window))) (:up (decf (second me)) (update-ui mapwin playerwin placewin newswin me)) @@ -81,6 +87,8 @@ placewin newswin me)) (:right (incf (first me)) (update-ui mapwin playerwin placewin newswin me)) + ((nil) (logging "Detected NIL event.") + (update-ui mapwin playerwin placewin newswin me)) (otherwise (notify (string event))))))) (defun update-ui (mapwin playerwin placewin newswin me) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9839557 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +naledi.log diff --git a/item-classes.lisp b/item-classes.lisp index 2643ca9..378d13b 100644 --- a/item-classes.lisp +++ b/item-classes.lisp @@ -59,7 +59,8 @@ (group-size :reader .group-size :initarg :group-size :initform 1) (habitat :reader .habitat :initarg :habitat :initform '()) ;; individual properties - (id :reader .id :initarg :id :initform -1)) + (id :reader .id :initarg :id :initform -1) + (last-move :accessor .last-move :initform 0)) (:default-initargs :destroy-with '(weapon) :movable T)) diff --git a/item-methods.lisp b/item-methods.lisp index 3c5e02e..f21cddd 100644 --- a/item-methods.lisp +++ b/item-methods.lisp @@ -26,19 +26,25 @@ ;;TODO (defmethod attack ((a animal) (w weapon))) (defmethod update ((a animal)) - (random-move a)) + (when (> (age-of-the-world) (.last-move a)) + (random-move a) + (incf (.last-move a)))) (defmethod random-move ((a animal)) "Move in a random direction within the species' habitat niche" (do* ((dir (random-elt *directions*) (random-elt *directions*)) - (next-patch (patch-in-dir (.x a) (.y a) dir) - (patch-in-dir (.x a) (.y a) dir)) + (next-patch (patchindir (.x a) (.y a) dir) + (patchindir (.x a) (.y a) dir)) (ttl 10 (1- ttl))) - ((zerop ttl) NIL) + ((zerop ttl) + (logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) + NIL) (when (and next-patch (null (patch-occupant next-patch)) (member (read-from-string (biome-name (patch-biome next-patch))) (.habitat a))) + (logging "The ~A at ~S/~S is moving ~S." + (.name a) (.x a) (.y a) dir) (setf (patch-occupant (coord (.x a) (.y a))) NIL) (setf (.x a) (first (patch-pos next-patch)) (.y a) (second (patch-pos next-patch))) diff --git a/naledi.lisp b/naledi.lisp index 1dae3d9..bc60f7b 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -10,6 +10,7 @@ (defparameter *debugging* T) (defparameter *logfile* "naledi.log") +(defparameter *framerate* 1000) (ql:quickload :bordeaux-threads) (ql:quickload :croatoan) @@ -25,12 +26,16 @@ (load "animals.lisp") (defun start-game () + ;;Initialize the log and random state + (write-to-file "NALEDI ya AFRICA" *logfile*) + (logging (time-stamp)) (setf *random-state* (make-random-state t)) (create-world 250) - (bt:make-thread #'update-loop :name "world-thread") - (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t - :cursor-visibility nil :input-reading :unbuffered) + (with-screen (scr :input-blocking *framerate* :enable-colors t + :input-echoing nil :cursor-visibility nil + :input-reading :unbuffered) (splash-screen scr) + (run-world) (user-interface scr))) (defun splash-screen (scr) @@ -49,6 +54,7 @@ (move scr (1- height) (- width 22)) (add-string scr "(c) 2018 Daniel Vedder") (event-case (scr event) + ((nil) nil) (otherwise (return-from event-case))))) (defun user-interface (scr) @@ -57,21 +63,21 @@ (me (list (round (/ width 4)) (halve height)))) (clear scr) (refresh scr) - (with-windows ((mapwin :position '(0 0) :input-blocking t :border t - :width (- width 51) :height height) + (with-windows ((mapwin :position '(0 0) :input-blocking *framerate* + :border t :width (- width 51) :height height) (playerwin :position (list 0 (- width 50)) - :input-blocking t :border t + :input-blocking *framerate* :border t :width 50 :height (halve height 'down)) - (placewin :input-blocking t :border t + (placewin :input-blocking *framerate* :border t :position (list (halve height) (- width 50)) :width 50 :height (halve height 'down)) - (newswin :input-blocking t + (newswin :input-blocking *framerate* :position (list height 0) :width width :height 1)) (update-ui mapwin playerwin placewin newswin me) ;;TODO (event-case (scr event) - (#\q (return-from event-case)) + (#\q (terminate) (return-from event-case)) (#\n (draw-menu (message-window))) (:up (decf (second me)) (update-ui mapwin playerwin placewin newswin me)) @@ -81,6 +87,8 @@ placewin newswin me)) (:right (incf (first me)) (update-ui mapwin playerwin placewin newswin me)) + ((nil) (logging "Detected NIL event.") + (update-ui mapwin playerwin placewin newswin me)) (otherwise (notify (string event))))))) (defun update-ui (mapwin playerwin placewin newswin me) diff --git a/util.lisp b/util.lisp index 02a7e3e..3d992b7 100644 --- a/util.lisp +++ b/util.lisp @@ -267,7 +267,7 @@ (f (if append (open filename :direction :output :if-exists :append :if-does-not-exist :create) - (open filename :direction :output)))) + (open filename :direction :output :if-exists :supersede)))) (dolist (line text-list) (format f "~&~A~&" line)) (close f))) @@ -278,6 +278,11 @@ (dolist (i lst) (format f "~&~S" i)) (close f))) +(defun time-stamp (&optional (time-t (get-universal-time))) + (let ((time (multiple-value-list (decode-universal-time time-t)))) + (format NIL "~S/~S/~S ~S:~S" + (nth 3 time) (nth 4 time) (nth 5 time) (nth 2 time) (nth 1 time)))) + (defun build-symbol (&rest components) "Concatenate the passed components into a single symbol" (read-from-string (string-from-list components ""))) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..9839557 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +naledi.log diff --git a/item-classes.lisp b/item-classes.lisp index 2643ca9..378d13b 100644 --- a/item-classes.lisp +++ b/item-classes.lisp @@ -59,7 +59,8 @@ (group-size :reader .group-size :initarg :group-size :initform 1) (habitat :reader .habitat :initarg :habitat :initform '()) ;; individual properties - (id :reader .id :initarg :id :initform -1)) + (id :reader .id :initarg :id :initform -1) + (last-move :accessor .last-move :initform 0)) (:default-initargs :destroy-with '(weapon) :movable T)) diff --git a/item-methods.lisp b/item-methods.lisp index 3c5e02e..f21cddd 100644 --- a/item-methods.lisp +++ b/item-methods.lisp @@ -26,19 +26,25 @@ ;;TODO (defmethod attack ((a animal) (w weapon))) (defmethod update ((a animal)) - (random-move a)) + (when (> (age-of-the-world) (.last-move a)) + (random-move a) + (incf (.last-move a)))) (defmethod random-move ((a animal)) "Move in a random direction within the species' habitat niche" (do* ((dir (random-elt *directions*) (random-elt *directions*)) - (next-patch (patch-in-dir (.x a) (.y a) dir) - (patch-in-dir (.x a) (.y a) dir)) + (next-patch (patchindir (.x a) (.y a) dir) + (patchindir (.x a) (.y a) dir)) (ttl 10 (1- ttl))) - ((zerop ttl) NIL) + ((zerop ttl) + (logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) + NIL) (when (and next-patch (null (patch-occupant next-patch)) (member (read-from-string (biome-name (patch-biome next-patch))) (.habitat a))) + (logging "The ~A at ~S/~S is moving ~S." + (.name a) (.x a) (.y a) dir) (setf (patch-occupant (coord (.x a) (.y a))) NIL) (setf (.x a) (first (patch-pos next-patch)) (.y a) (second (patch-pos next-patch))) diff --git a/naledi.lisp b/naledi.lisp index 1dae3d9..bc60f7b 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -10,6 +10,7 @@ (defparameter *debugging* T) (defparameter *logfile* "naledi.log") +(defparameter *framerate* 1000) (ql:quickload :bordeaux-threads) (ql:quickload :croatoan) @@ -25,12 +26,16 @@ (load "animals.lisp") (defun start-game () + ;;Initialize the log and random state + (write-to-file "NALEDI ya AFRICA" *logfile*) + (logging (time-stamp)) (setf *random-state* (make-random-state t)) (create-world 250) - (bt:make-thread #'update-loop :name "world-thread") - (with-screen (scr :input-echoing nil :input-blocking t :enable-colors t - :cursor-visibility nil :input-reading :unbuffered) + (with-screen (scr :input-blocking *framerate* :enable-colors t + :input-echoing nil :cursor-visibility nil + :input-reading :unbuffered) (splash-screen scr) + (run-world) (user-interface scr))) (defun splash-screen (scr) @@ -49,6 +54,7 @@ (move scr (1- height) (- width 22)) (add-string scr "(c) 2018 Daniel Vedder") (event-case (scr event) + ((nil) nil) (otherwise (return-from event-case))))) (defun user-interface (scr) @@ -57,21 +63,21 @@ (me (list (round (/ width 4)) (halve height)))) (clear scr) (refresh scr) - (with-windows ((mapwin :position '(0 0) :input-blocking t :border t - :width (- width 51) :height height) + (with-windows ((mapwin :position '(0 0) :input-blocking *framerate* + :border t :width (- width 51) :height height) (playerwin :position (list 0 (- width 50)) - :input-blocking t :border t + :input-blocking *framerate* :border t :width 50 :height (halve height 'down)) - (placewin :input-blocking t :border t + (placewin :input-blocking *framerate* :border t :position (list (halve height) (- width 50)) :width 50 :height (halve height 'down)) - (newswin :input-blocking t + (newswin :input-blocking *framerate* :position (list height 0) :width width :height 1)) (update-ui mapwin playerwin placewin newswin me) ;;TODO (event-case (scr event) - (#\q (return-from event-case)) + (#\q (terminate) (return-from event-case)) (#\n (draw-menu (message-window))) (:up (decf (second me)) (update-ui mapwin playerwin placewin newswin me)) @@ -81,6 +87,8 @@ placewin newswin me)) (:right (incf (first me)) (update-ui mapwin playerwin placewin newswin me)) + ((nil) (logging "Detected NIL event.") + (update-ui mapwin playerwin placewin newswin me)) (otherwise (notify (string event))))))) (defun update-ui (mapwin playerwin placewin newswin me) diff --git a/util.lisp b/util.lisp index 02a7e3e..3d992b7 100644 --- a/util.lisp +++ b/util.lisp @@ -267,7 +267,7 @@ (f (if append (open filename :direction :output :if-exists :append :if-does-not-exist :create) - (open filename :direction :output)))) + (open filename :direction :output :if-exists :supersede)))) (dolist (line text-list) (format f "~&~A~&" line)) (close f))) @@ -278,6 +278,11 @@ (dolist (i lst) (format f "~&~S" i)) (close f))) +(defun time-stamp (&optional (time-t (get-universal-time))) + (let ((time (multiple-value-list (decode-universal-time time-t)))) + (format NIL "~S/~S/~S ~S:~S" + (nth 3 time) (nth 4 time) (nth 5 time) (nth 2 time) (nth 1 time)))) + (defun build-symbol (&rest components) "Concatenate the passed components into a single symbol" (read-from-string (string-from-list components ""))) diff --git a/world.lisp b/world.lisp index d5f683e..8104d48 100644 --- a/world.lisp +++ b/world.lisp @@ -116,8 +116,9 @@ (let ((flist (biome-features (patch-biome patch)))) (dolist (f flist NIL) (when (chancep (second f)) - ;;FIXME I need to get an actual item and set its position - (return-from get-patch-feature (make-instance (first f))))))) + (return-from get-patch-feature + (make-instance (first f) :x (first (patch-pos patch)) + :y (second (patch-pos patch)))))))) (defun generate-biomes (size-factor) ;;XXX The maps this produces don't look quite as expected, but for @@ -160,12 +161,31 @@ (dotimes (s (round (/ (expt size 2) 2000))) (generate-stream (random size) (random size)))) -(let ((uptime 0)) +;;TODO This section needs to go somewhere else (naledi-server?) +(let ((uptime 0) (running NIL) (world-thread NIL)) + (defun run-world () + (setf running T) + (setf world-thread + (bt:make-thread #'update-loop :name "world-thread"))) + + (defun interrupt-world () (setf running NIL)) + + (defun terminate () + (notify "Terminating the world.") + (interrupt-world) + (bt:join-thread world-thread)) + + (defun age-of-the-world () uptime) + + (defun reset-world-age () (setf uptime 0)) + (defun update-loop () "The main loop, updating the world in the background" - ;;Update all items in each patch + ;;Update all items and occupants in each patch (dotimes (y (world-size)) (dotimes (x (world-size)) + (when (patch-occupant (coord x y)) + (update (patch-occupant (coord x y)))) (dolist (i (patch-items (coord x y))) (update i)))) ;;Update all items each player has @@ -174,12 +194,8 @@ (save-world) ;XXX not yet implemented (incf uptime) (logging "Ran update ~S." uptime) - (sleep 0.5) - (update-loop)) ;;requires Tail-Call Optimization - - (defun age-of-the-world () uptime) - - (defun reset-world-age () (setf uptime 0))) + (sleep (/ *framerate* 1000)) + (when running (update-loop)))) ;;requires Tail-Call Optimization (defun describe-patch (p) "Return a list of lines describing this patch."