;;;;;;;;;;;;;;DATABASES;;;;;;;;;;;;;;

;; a simple memory resident database to store messages
;; this solution is based on http://www.gigamonkeys.com/book/practical-a-simple-database.html
;; see http://www.gigamonkeys.com/book/practical-an-mp3-database.html for a more
;; advanced solution

;create database:
;	add global variables
;	create admin functions
;	reset-all-databases function
;	confugure databases
;	print databases

;; global variable to hold a reference to the message database
(defvar *triples-db* nil)
(defvar *triples-db-counter* 0)
(defvar *model-code-db* nil)
(defvar *model-code-db-counter* 0)
(defvar *game-elements-db* nil)
(defvar *game-elements-db-counter* 0)

;; add a record to the specified database
(defmacro add-record (db record)
	`(push ,record ,db))

;; clear the specified database
(defmacro clear-db (db) 
	`(setq ,db nil))

;; delete records from the specified database
;; e.g. (delete-records *message-database* (where :object 'value))
(defmacro delete-records (db selector-fn)
  `(setf ,db (remove-if ,selector-fn ,db)))

;; select records from the specified database
;; e.g., (select *triples-db* (where :subject 'agent-1 :object 'ready))
(defun select (db selector-fn)
  (remove-if-not selector-fn db))

(defun filter (db selector-fn)
	(remove-if selector-fn db))

(defun filter-db-by-time (db &key (min-time 0) (max-time nil))
	(let ((row-list nil)
			(max-time (if (not max-time) (calculate-simulation-duration) max-time)))
		(dolist (row db row-list)
			(if (and (> (getf row :timestamp) min-time) (<= (getf row :timestamp) max-time))
				(push row row-list))))
)

(defun count-records (db selector-fn)
	(count-if selector-fn db))

(defmacro where (&rest clauses)
  `#'(lambda (cd) (and ,@(make-comparisons-list clauses))))

(defun make-comparisons-list (fields)
  (loop while fields
     collecting (make-comparison-expr (pop fields) (pop fields))))

(defun make-comparison-expr (field value)
  `(equal (getf cd ,field) ,value))

;; print the contents of the specified database to the standard output
(defun print-db (db)
	(dolist (record db)
		(format t "~&~{~a:~10t~a~%~}~%" record)))

;; prints the specified database to a file.
(defun print-db-to-file (db filename)
	(with-open-file (*standard-output* filename :direction :output :if-exists :supersede)
		(dolist (record db)
			(format t "***~%~{~a:~10t~a~%~}***~%" record))))

;; save the specified database to a file
(defun save-db (filename db)
  (with-open-file (out filename
                   :direction :output
                   :if-exists :supersede)
    (with-standard-io-syntax
      (print db out))))

;; load an existing database from a file - needs to be tested before use
(defmacro load-db (filename db)
  `(with-open-file (in ,filename) (with-standard-io-syntax (setf ,db (read in)))))

(defun reset-all-databases ()
	(reset-triples-db)
	(reset-model-code-db)
	(reset-game-elements-db)
)

;;;;;MODEL CODE DATABASE FUNCTIONS;;;;;;

(defun make-model-code (agent model-code)
	(incf *model-code-db-counter*)
	(list :id *model-code-db-counter* :agent agent :model-code model-code))

(defun add-model-code (agent model-code)
	(add-record *model-code-db* (make-model-code agent model-code))
)

(defun reset-model-code-db ()
	(clear-db *model-code-db*)
	(setf *model-code-db-counter* 0)
)

(defun update-model-code-db (selector-fn &key id agent model-code)
  (setf *model-code-db*
        (mapcar
         #'(lambda (row)
             (when (funcall selector-fn row)
					(if id    (setf (getf row :id) id))
					(if agent   (setf (getf row :agent) agent))
					(if model-code   (setf (getf row :model-code) model-code)))
             row) *model-code-db*)))


;;;;;TRIPLES DATABASE FUNCTIONS;;;;;;

(defun make-triple (subject predicate object)
	(incf *triples-db-counter*)
	(list :id *triples-db-counter* :subject subject :predicate predicate :object object))

(defun add-triple (subject predicate object)
	(let ((triple(select *triples-db* (where :subject subject :predicate predicate :object object))))
		(if (eq triple nil)
			(add-record *triples-db* (make-triple subject predicate object))
		  (format t "~&Duplicate triple. Subject:~s Predicate:~s Object:~s" subject predicate object))))

(defun reset-triples-db ()
	(clear-db *triples-db*)
	(setf *triples-db-counter* 0)
)

(defun update-triples-db (selector-fn &key id subject predicate object)
  (setf *triples-db*
        (mapcar
         #'(lambda (row)
             (when (funcall selector-fn row)
					(if id    (setf (getf row :id) id))
					(if subject   (setf (getf row :subject) subject))
					(if predicate   (setf (getf row :predicate) predicate))
					(if object   (setf (getf row :object) object)))
             row) *triples-db*)))


;;;;;GAME ELEMENTS DATABASE FUNCTIONS;;;;;;

(defun make-game-element (world-position-x world-position-y world-position-z height width world-distance screen-x screen-y screen-width screen-height element-type element-color)
	(incf *game-elements-db-counter*)
	(list :id *game-elements-db-counter* 
			:world-position-x world-position-x 
			:world-position-y world-position-y 
			:world-position-z world-position-z
			:height height
			:width width
			:world-distance world-distance
			:screen-x screen-x
			:screen-y screen-y
			:screen-width screen-width
			:screen-height screen-height
			:element-type element-type
			:element-color element-color
			:current t)
)

(defun add-game-element (world-position-x world-position-y world-position-z height width world-distance screen-x screen-y screen-width screen-height element-type element-color)
	(add-record *game-elements-db* (make-game-element world-position-x world-position-y 
				world-position-z height width world-distance 
				screen-x screen-y screen-width screen-height element-type element-color))
)

(defun reset-game-elements-db ()
	(clear-db *game-elements-db*)
	(setf *game-elements-db-counter* 0)
)

(defun update-game-elements-db (selector-fn &key id world-position-x world-position-y world-position-z 
				height width world-distance screen-x screen-y screen-width screen-height element-type element-color current)
  (setf *game-elements-db*
        (mapcar
         #'(lambda (row)
             (when (funcall selector-fn row)
					(if id    (setf (getf row :id) id))
					(if world-position-x   (setf (getf row :world-position-x) world-position-x))
					(if world-position-y   (setf (getf row :world-position-y) world-position-y))
					(if world-position-z   (setf (getf row :world-position-z) world-position-z))
					(if height   (setf (getf row :height) height))
					(if width   (setf (getf row :width) width))
					(if world-distance   (setf (getf row :world-distance) world-distance))
					(if screen-x   (setf (getf row :screen-x) screen-x))
					(if screen-y   (setf (getf row :screen-y) screen-y))
					(if screen-width   (setf (getf row :screen-width) screen-width))
					(if screen-height   (setf (getf row :screen-height) screen-height))
					(if element-type  (setf (getf row :element-type) element-type))
					(if element-color   (setf (getf row :element-color) element-color))
					(if current (setf (getf row :current) current)))
             row) *game-elements-db*)))
