# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1470584150 0
# Node ID 0851dc71ee9eb78a817a84ac54f622a14f744e98
# Parent  94af6897af93eac09d2283c485b3bddf45130b3c
Add timing, improve coordinate store

diff -r 94af6897af93 -r 0851dc71ee9e silt.lisp
--- a/silt.lisp	Sun Aug 07 03:52:51 2016 +0000
+++ b/silt.lisp	Sun Aug 07 15:35:50 2016 +0000
@@ -16,6 +16,7 @@
 (defparameter *game-log* nil)
 (defparameter *population* 0)
 (defparameter *tick* 0)
+(defparameter *timing* (cons 0 0))
 
 
 (deftype world-coordinate ()
@@ -196,6 +197,20 @@
        (< -1 sy *screen-height*)))
 
 
+(defmacro timing (&body body)
+  `(let ((start (get-internal-run-time)))
+     (prog1
+       (progn ,@body)
+       (setf (cdr *timing*)
+             (/ (+ (* (car *timing*) (cdr *timing*))
+                   (- (get-internal-run-time) start))
+               (incf (car *timing*)))))))
+
+(defun reset-timing ()
+  (setf *timing* (cons 0 0)))
+
+
+
 ;;;; Terrain Generation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defun average4 (a b c d)
   (/ (+ a b c d) 4))
@@ -454,27 +469,32 @@
 
 ;;;; Components ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Coordinates
-(define-component coords x y)
+(define-component coords
+  (x :type world-coordinate)
+  (y :type world-coordinate))
 
 
-(defparameter *coords-contents* (make-hash-table))
+(deftype coordinate-array ()
+  `(simple-array list (,+world-size+ ,+world-size+)))
+
+(declaim (type coordinate-array *coords-contents*))
+(defparameter *coords-contents*
+  (make-array (list +world-size+ +world-size+) :initial-element nil))
 
 
-(defun coordinate-key (x y)
-  (array-row-major-index *heightmap* (wrap x) (wrap y)))
-
-(defun coordinate-key-for-entity (e)
-  (coordinate-key (coords/x e) (coords/y e)))
-
+(declaim (ftype (function (fixnum fixnum) list)
+                coords-lookup)
+         (ftype (function (coords) list)
+                coords-insert-entity coords-remove-entity)
+         (ftype (function (coords fixnum fixnum) list)
+                coords-move-entity))
 
 (defun coords-insert-entity (e)
-  (push e (gethash (coordinate-key-for-entity e) *coords-contents*)))
+  (push e (aref *coords-contents* (coords/x e) (coords/y e))))
 
 (defun coords-remove-entity (e)
-  (let ((k (coordinate-key-for-entity e)))
-    (when (null (zap% (gethash k *coords-contents*)
-                      #'delete e %))
-      (remhash k *coords-contents*))))
+  (zap% (aref *coords-contents* (coords/x e) (coords/y e))
+        #'delete e %))
 
 (defun coords-move-entity (e new-x new-y)
   (coords-remove-entity e)
@@ -483,8 +503,12 @@
   (coords-insert-entity e))
 
 (defun coords-lookup (x y)
-  (gethash (coordinate-key x y) *coords-contents*))
+  (aref *coords-contents* (wrap x) (wrap y)))
+
 
+(defmethod initialize-instance :after ((entity coords) &key)
+  (zapf (coords/x entity) #'wrap
+        (coords/y entity) #'wrap))
 
 (defmethod entity-created :after ((entity coords))
   (coords-insert-entity entity))
@@ -851,7 +875,12 @@
       (format nil "[~D, ~D]" *cursor-x* *cursor-y*)
       (format nil "~D creature~:P" *population*)
       (format nil "~D entit~:@P" (hash-table-count *entity-index*))
-      (format nil "tick ~D" *tick*))
+      (format nil "tick ~D" *tick*)
+      (if (equal *timing* (cons 0 0))
+        ""
+        (format nil "~,5Fms per run over ~D runs"
+                (/ (cdr *timing*) internal-time-units-per-second 1/1000)
+                (car *timing*))))
     (1- *screen-width*)
     1))
 
@@ -1028,7 +1057,6 @@
          (state-map-loop)))))
 
 
-
 (defun state-help ()
   (render-help)
   (press-any-key)
@@ -1062,3 +1090,4 @@
 ; (run)
 ; (start-profiling)
 ; (stop-profiling)
+