callback-included.lisp 4.02 KB
Newer Older
1 2
;; The mobject that defines callbacks
;; Liam Healy 2009-03-14 11:20:03EDT callback-included.lisp
3
;; Time-stamp: <2011-01-10 18:19:12EST callback-included.lisp>
4
;;
5
;; Copyright 2009, 2011 Liam M. Healy
6 7 8 9 10 11 12 13 14 15 16 17 18 19
;; Distributed under the terms of the GNU General Public License
;;
;; This program 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 3 of the License, or
;; (at your option) any later version.
;;
;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
20 21 22

(in-package :gsl)

23 24 25 26
;;;;****************************************************************************
;;;; Class definitions and macros
;;;;****************************************************************************

27
(defclass callback-included (mobject)
28 29
  ((cbinfo
    :initarg :cbinfo :reader cbinfo
30
    :documentation "The specification form for static callback information.")
31 32 33 34
   (dimension-names
    :initarg :dimension-names :reader dimension-names
    :documentation "The names in the GSL struct for dimensions.")
   (functions
35
    :initarg :functions :reader functions :initform nil
36
    :documentation "The user functions as function designators.
37
    These should correspond in order to the structure-slot-name list.")
38 39 40 41
   (funcallables
    :initarg :funcallables :reader funcallables :initform nil
    :documentation "The function objects that will be called by
    the callbacks.")
42 43 44 45
   (scalarsp
    :initarg :scalarsp :reader scalarsp :initform t
    :documentation "Whether the function expect to be passed and return
    scalars or arrays.")
46
   (grid:dimensions :initarg :dimensions :reader grid:dimensions))
47 48 49 50 51 52 53 54 55 56 57
  (:documentation
   "A mobject that includes a callback function or functions to GSL."))

(defclass callback-included-cl (callback-included)
  ((callback :initarg :callback :reader callback-struct))
  (:documentation
   "A mobject that includes a callback function or functions, in which
    the pointer to the callback structure is stored in a CL class
    slot."))

(defmacro def-ci-subclass
58
    (class-name superclasses documentation dimension-names)
59
  `(defclass ,class-name ,superclasses
60
     ((dimension-names :initform ',dimension-names :allocation :class))
61 62 63
     (:documentation ,documentation)))

(defmacro def-ci-subclass-1d
64 65
    (class-name superclasses documentation ignore)
  (declare (ignore ignore))
66
  `(defclass ,class-name ,superclasses
67
     ((dimension-names :initform nil :allocation :class)
68
      (grid:dimensions :initform '(1) :allocation :class)
69
      (scalarsp :initform T :allocation :class))
70 71
     (:documentation ,documentation)))

Liam Healy's avatar
Liam Healy committed
72 73 74 75 76 77 78
(defmethod print-object ((object callback-included) stream)
  (print-unreadable-object (object stream :type t :identity t)
    (when (slot-boundp object 'functions)
      (princ "for " stream)
      (princ (first (functions object)) stream)
      (princ ", " stream))
    (princ "dimensions " stream)
79
    (princ (grid:dimensions object) stream)))
Liam Healy's avatar
Liam Healy committed
80

81 82 83 84
;;;;****************************************************************************
;;;; For making mobjects
;;;;****************************************************************************

85
;;; This is expanded in defmfun to set the dynamic variables. 
86
(defun callback-set-dynamic (callback-object &optional arglist)
87
  "Make a form to set the dynamic variable defining callbacks."
88 89 90
  (when (listp callback-object)
    (setf arglist callback-object
	  callback-object (caar callback-object)))
91 92 93 94 95 96 97
  `((setf 
     ,@(loop for symb in
	    (let ((class (category-for-argument arglist callback-object)))
	      (mobject-fnvnames
	       class
	       (number-of-callbacks (get-callbacks-for-class class))))
	    for n from 0
98
	    append `(,symb (nth ,n (funcallables ,callback-object)))))))