Massive reorganization in progress.

[sod] / src / impl-output.lisp

;;; -*-lisp-*-
;;;
;;; Output scheduling protocol implementation
;;;
;;; (c) 2009 Straylight/Edgeware
;;;

;;;----- Licensing notice ---------------------------------------------------
;;;
;;; This file is part of the Sensble Object Design, an object system for C.
;;;
;;; SOD is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2 of the License, or
;;; (at your option) any later version.
;;;
;;; SOD is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with SOD; if not, write to the Free Software Foundation,
;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

(cl:in-package #:sod)

;;;--------------------------------------------------------------------------
;;; Sequencing machinery.

(defmethod print-object ((item sequencer-item) stream)
  (print-unreadable-object (item stream :type t)
    (prin1 (sequencer-item-name item) stream)))

(defmethod ensure-sequencer-item ((sequencer sequencer) name)
  (with-slots (table) sequencer
    (or (gethash name table)
	(setf (gethash name table)
	      (make-instance 'sequencer-item :name name)))))

(defmethod add-sequencer-constraint ((sequencer sequencer) (constraint list))
  (let ((converted-constraint
	 (mapcar (lambda (name)
		   (ensure-sequencer-item sequencer name))
		 constraint)))
    (with-slots (constraints) sequencer
      (pushnew converted-constraint constraints :test #'equal))))

(defmethod add-sequencer-item-function ((sequencer sequencer) name function)
  (let ((item (ensure-sequencer-item sequencer name)))
    (pushnew function (sequencer-item-functions item))))

(defmethod invoke-sequencer-items ((sequencer sequencer) &rest arguments)
  (dolist (item (merge-lists (reverse (sequencer-constraints sequencer))))
    (dolist (function (reverse (sequencer-item-functions item)))
      (apply function arguments))))

;;;----- That's all, folks --------------------------------------------------