(in-package :clf)

;;  класс примитивных переменных

(defclass primitive-variables ()
  ((var-vector :initform (make-array *number-of-primitive-variables*)
	       :accessor var-vector)
   (headers/primitive-variables :initform '(P rg phi ug ul)
				:allocation :class)))

(defmethod initialize-instance :after ((vars primitive-variables) &key P phi ug ul rg number var-vector)
  (cond (var-vector (setf (var-vector vars) var-vector))
	(number (setf (var-vector vars) (make-array *number-of-primitive-variables*
						    :initial-element number)))
	((and P rg) (error "Давление и плотность линейно связаны, их нельзя задавать одновременно"))
	((and phi ug ul (or P rg))
	 (progn
	   (when P (setf (P vars) P))
	   (when rg (setf (rg vars) rg))
	   (setf (phi vars) phi)
	   (setf (ug vars) ug)
	   (setf (ul vars) ul)))
	(t (error "не хватает флагов для определения ячейки"))))

(make-header-for-class primitive-variables)

(defun primitive-variables-p (obj)
    (typep obj 'primitive-variables))

(print-functions-for-class primitive-variables
			   ((inherit . primitive-variables)))

;; акцессоры примитивных переменных

(defmethod P ((vars primitive-variables))
  (elt (var-vector vars) 0))

(defmethod phi ((vars primitive-variables))
  (elt (var-vector vars) 1))

(defmethod ug ((vars primitive-variables))
  (elt (var-vector vars) 2))

(defmethod ul ((vars primitive-variables))
  (elt (var-vector vars) 3))

(defmethod rg ((vars primitive-variables))
  (P->rg (P vars)))

;; мутаторы примитивных переменных

(defmethod (setf P) (num (vars primitive-variables))
  (setf (elt (var-vector vars) 0) num))

(defmethod (setf phi) (num (vars primitive-variables))
  (setf (elt (var-vector vars) 1) num))

(defmethod (setf ug) (num (vars primitive-variables))
  (setf (elt (var-vector vars) 2) num))

(defmethod (setf ul) (num (vars primitive-variables))
  (setf (elt (var-vector vars) 3) num))

(defmethod (setf rg) (num (vars primitive-variables))
  (setf (P vars) (rg->P num)))

;; давление и плотность газа
	
(defun P->rg (P)
  (if (equal P 'undef)
      'undef
      (/ (* *kappa* P)
	 (* *Cg* *Cg*))))

(defun rg->P (rg)
  (if (equal rg 'undef)
      'undef
      (/ (* *Cg* *Cg* rg)
	 *kappa*)))

;; операции, которые можно производить над примитивными переменными		 

(defun number->primitive (num)
  (make-instance 'primitive-variables :number num))

(defun any->primitive (obj)
  (cond ((numberp obj) (number->primitive obj))
	((typep obj 'primitive-variables) obj)
	(t (error "need num or primitive!"))))

(defmacro primitive-variables-operator (pv-list func)
  `(progn
     (when (null ,pv-list) (error "primitive-variables-operator нельзя применять к пустому списку"))
     (unless (andmap #'primitive-variables-p ,pv-list)
       (error "Операция ~s требует, чтобы все аргунты были типа 'primitive-variables" ,func))
     (make-instance 'primitive-variables
		    :var-vector (apply #'map 'vector ,func
				       (mapcar #'var-vector ,pv-list)))))

(defun pvar+ (&rest pv-list)
  (primitive-variables-operator pv-list #'+))

(defun pvar- (&rest pv-list)
  (primitive-variables-operator pv-list #'-))

(defun pvar/ (&rest pvs&nums)
  (let ((pv-list (mapcar #'any->primitive pvs&nums)))
    (primitive-variables-operator pv-list #'/)))

(defun pvar* (&rest pvs&nums)
  (let ((pv-list (mapcar #'any->primitive pvs&nums)))
    (primitive-variables-operator pv-list #'*)))

(defun pvar-abs (pv)
  (primitive-variables-operator (list pv) #'abs))

(defun pvar-min (&rest pvs&nums)
  (let ((pv-list (mapcar #'any->primitive pvs&nums)))
    (primitive-variables-operator pv-list #'min)))

(defun pvar-signum (pv)
  (primitive-variables-operator (list pv) #'signum))

;;

(defmethod make-dummy-variables ((type (eql 'primitive-variables)))
  (make-instance 'primitive-variables
		 :var-vector (coerce (loop repeat *number-of-primitive-variables*
					collect 'undef)
				     'vector)))