;;; Level2-view.lisp 
;;; Matrix views

;;; Copyright (C) 2009 Joern Inge Vestgaarden
;;;
;;; 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 2 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, write to the Free Software Foundation, Inc.,
;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

(in-package :lisplab)


(defmethod view-matrix (matrix shape &optional (type))
  "Outputs a function matrix"
  (declare (ignore type))
  (let* ((rows (car shape))
	 (cols (cadr shape)))
    (make-instance 'function-matrix 
		   :rows rows
		   :cols cols
		   :mref #'(lambda (x i j) 
			    (declare (ignore x))
			    (vref matrix (column-major-idx i j rows)))
		   :set-mref #'(lambda (value x i j) 
			      (declare (ignore x))
			      (setf (vref matrix (column-major-idx i j rows)) value))
		   :vref #'(lambda (x i) 
			    (declare (ignore x))
			    (vref matrix i))
		   :set-vref #'(lambda (value x i) 
			      (declare (ignore x))
			      (setf (vref matrix i) value))))) 
(defmethod view-row (matrix row)
  "Outputs a function matrix"
  (make-instance 'function-matrix 
		 :rows 1
		 :cols (cols matrix)
		 :mref #'(lambda (x i j) 
			  (declare (ignore x i)) 
			  (mref matrix row j))
		 :set-mref #'(lambda (value x i j)
			      (declare (ignore x i))
			      (setf (mref matrix row j) value))
		 :vref #'(lambda (x i)
			  (declare (ignore x))
			  (mref matrix row i))
		 :set-vref #'(lambda (value x i) 
			      (declare (ignore x)) 
			      (setf (mref matrix row i) value))))
		  
(defmethod view-col (matrix col)
  "Outputs a function matrix"
  (make-instance 'function-matrix  
		 :rows (rows matrix)
		 :cols 1
		 :mref #'(lambda (x i j) 
			  (declare (ignore x j)) 
			  (mref matrix i col))
		 :set-mref #'(lambda (value x i j) 
			      (declare (ignore x j)) 
			      (setf (mref matrix i col) value))
		 :vref #'(lambda (x i) 
			  (declare (ignore x)) 
			  (mref matrix i col))
		 :set-vref #'(lambda (value x i) 
			       (declare (ignore x)) 
			      (setf (mref matrix i col) value)))) 

(defmethod view-transpose (matrix)
  "Outputs a function matrix"
  (make-instance 'function-matrix 
		 :rows (cols matrix)
		 :cols (rows matrix)
		 :mref #'(lambda (x i j)
			  (declare (ignore x))
			  (mref matrix j i))
		 :set-mref #'(lambda (value x i j) 
			      (declare (ignore x))
			      (setf (mref matrix j i) value))
		 :vref #'(lambda (x i) 
			  (declare (ignore x))
			  (vref matrix i))
		 :set-vref #'(lambda (value x i) 
			      (declare (ignore x))
			      (setf (vref matrix i) value))))