# HG changeset patch # User Steve Losh # Date 1470798178 0 # Node ID 9b03bd85390672089e3cfa4f0d875f5972d6600b # Parent 42c463ae193e60ad2ebeb59a033a380277fa7435 Refactor periodics, add Yggdrasil diff -r 42c463ae193e -r 9b03bd853906 silt.lisp --- a/silt.lisp Wed Aug 10 02:20:27 2016 +0000 +++ b/silt.lisp Wed Aug 10 03:02:58 2016 +0000 @@ -67,9 +67,11 @@ (+color-black-white+ charms/ll:COLOR_BLACK charms/ll:COLOR_WHITE) (+color-black-yellow+ charms/ll:COLOR_BLACK charms/ll:COLOR_YELLOW) - (+color-white-blue+ charms/ll:COLOR_WHITE charms/ll:COLOR_BLUE) + (+color-white-blue+ charms/ll:COLOR_WHITE charms/ll:COLOR_BLUE) - (+color-white-red+ charms/ll:COLOR_WHITE charms/ll:COLOR_RED)) + (+color-white-red+ charms/ll:COLOR_WHITE charms/ll:COLOR_RED) + + (+color-white-green+ charms/ll:COLOR_WHITE charms/ll:COLOR_GREEN)) (defmacro with-color (color &body body) (once-only (color) @@ -537,11 +539,26 @@ ;;; Brains (define-aspect sentient function) +(define-aspect periodic + function + (counter :initform 1) + next + min + max) (define-system sentient-act ((entity sentient)) (funcall (sentient/function entity) entity)) +(define-system periodic-tick ((entity periodic)) + (when (zerop (setf (periodic/counter entity) + (mod (1+ (periodic/counter entity)) + (periodic/next entity)))) + (setf (periodic/next entity) + (random-range (periodic/min entity) + (periodic/max entity))) + (funcall (periodic/function entity) entity))) + ;;; Age (define-aspect aging @@ -799,12 +816,12 @@ (define-entity monolith (coords visible sentient flavor) (countdown :initarg :countdown)) -(define-entity fountain (coords visible sentient flavor inspectable) +(define-entity fountain (coords visible sentient flavor) (recent :initform (make-ticklist))) -(define-entity colossus (coords visible sentient flavor inspectable) - (counter :initform 1) - (next :initform 1000)) +(define-entity colossus (coords visible periodic flavor)) +(define-entity yggdrasil (coords visible periodic flavor)) +(define-entity yggdrasil-sapling (coords visible flavor)) (defun monolith-act (m) @@ -832,13 +849,19 @@ (creature-name creature)))))) (defun colossus-act (c) - (with-slots (counter next) c - (incf counter) - (modf counter next) - (when (zerop counter) - (setf next (random-range 1000 4000)) - (coords-move-entity c (1+ (coords/x c)) (coords/y c)) - (log-message "The colossus takes a step.")))) + (coords-move-entity c (1+ (coords/x c)) (coords/y c)) + (log-message "The colossus takes a step.")) + +(defun yggdrasil-act (ygg) + (let* ((x (coords/x ygg)) + (y (coords/y ygg)) + (nx (random-gaussian-integer x 10)) + (ny (random-gaussian-integer y 10))) + (unless (or (and (= x nx) (= y ny)) + (find-if #'yggdrasil-sapling? (coords-lookup nx ny))) + (log-message "A leaf falls from the massive ash tree and flutters to the ground.") + (log-message "A new tree springs up where it fell!") + (make-yggdrasil-sapling nx ny)))) (defun make-monolith () @@ -862,9 +885,8 @@ :visible/glyph "ƒ" :visible/color +color-white-blue+ :sentient/function 'fountain-act - :inspectable/slots '(recent) :flavor/text - '("A marble fountain burbles peacefully here."))))) + '("A marble fountain burbles peacefully."))))) (defun make-colossus () (let ((loc (random-coordinate :snow))) @@ -874,15 +896,42 @@ :coords/y (cdr loc) :visible/glyph "@" :visible/color +color-white-red+ - :sentient/function 'colossus-act - :inspectable/slots '(counter next) + :periodic/function 'colossus-act + :periodic/next 1000 + :periodic/min 2000 + :periodic/max 10000 :flavor/text '("A massive granite statue of an alien being."))))) +(defun make-yggdrasil () + (let ((loc (random-coordinate :grass))) + (when loc + (create-entity 'yggdrasil + :coords/x (car loc) + :coords/y (cdr loc) + :visible/glyph "Y" + :visible/color +color-white-green+ + :periodic/function 'yggdrasil-act + :periodic/next 40 + :periodic/min 200 + :periodic/max 1000 + :flavor/text + '("An immense ash tree." + "Its branches touch the stars."))))) + +(defun make-yggdrasil-sapling (x y) + (create-entity 'yggdrasil-sapling + :coords/x x + :coords/y y + :visible/glyph "y" + :visible/color +color-green-black+ + :flavor/text '("An small ash tree bends toward the sun."))) + (defun generate-mysteries () (make-colossus) (make-fountain) + (make-yggdrasil) (make-monolith)) @@ -1126,7 +1175,8 @@ (run-age) (run-consume-energy) (tick-flora) - (run-sentient-act)) + (run-sentient-act) + (run-periodic-tick)) (defun tick-log () (flet ((decrement (message)