;; Common Lisp configuration file for NanoCAD

(defmacro define (name-args &rest body)
  (cond ((listp name-args)
	 `(defun ,(car name-args) ,(cdr name-args) ,@body))
	(t
	 `(defvar ,name-args ,@body))))

(defconstant  true    t  ) 
(defconstant  false    nil  ) 

(defconstant  debugging    nil  ) 

(defconstant  use-mred    nil  ) 

(defconstant else t)
(defmacro list-ref (lst n) `(nth ,n ,lst))
(defmacro make-lambda (args &rest body) `#'(lambda ,args ,@body))
(defmacro func (x)  `#',x)
(defmacro real-part (x) x)
(defmacro printf (fmt &rest args) `(format t ,fmt ,@args))
(defmacro set! (var value) `(setf ,var ,value))
(defmacro equal? (x y) `(equal ,x ,y))
(defmacro null? (x) `(null ,x))
(defmacro vector-ref (v n) `(svref ,v ,n))
(defmacro vector-set! (v n value) `(setf (svref ,v ,n) ,value))
(defmacro defined? (x) `(boundp ,x))
(defmacro qsort (x y) `(sort ,x ,y))
(defmacro eq? (x y) `(eq ,x ,y))
(defmacro fprintf (f &rest args)
  `(format ,f ,@args))
(defmacro define-structure (name &rest stuff)
  `(defstruct ,name ,@stuff))

(defun make-vector (n) (make-array (list n)))
(defun open-input-file (name)
  (open name))
(defun open-output-file (name)
  (open name :direction :output :if-exists :supersede))
(defun close-input-port (name)
  (close name))
(defun close-output-port (name)
  (close name))

(defmacro dbgprintf (x &rest y) nil)
(defmacro entering (name) nil)

(define-structure atm   element species position velocity force)
(define (create-atm e p)
  (let ((s (lookup-species (element-name e)
			   (element-initial-hybridization e))))

    (make-atm :element e :species s :position p
	      :velocity '#(0.0 0.0 0.0) :force '#(0.0 0.0 0.0))

    ))

(define (atm-set-species a s) (set! (atm-species a) s))
(define (atm-add-pos a x)
  (set! (atm-position a)
        (vplus x (atm-position a))))
(define (atm-set-pos a s) (set! (atm-position a) s))
(define (atm-add-velocity a v)
  (set! (atm-velocity a)
        (vplus v (atm-velocity a))))
(define (atm-set-velocity a s) (set! (atm-velocity a) s))
(define (atm-zero-velocity a) (set! (atm-velocity a) '#(0.0 0.0 0.0)))
(define (atm-zero-force a) (set! (atm-force a) '#(0.0 0.0 0.0)))
(define (atm-add-force a v)
  (set! (atm-force a)
        (vplus v (atm-force a))))

(define-structure bond  order first second)

(define (create-bond ord f s)
  (make-bond :order ord :first f :second s))

(define-structure element
  name rvdw mass total-bonds initial-hybridization how-to-hybridize)

(define (create-element name rvdw mass bonds init-hybrid ch-hybrid)
  (make-element :name name :rvdw rvdw :mass mass :total-bonds bonds
                :initial-hybridization init-hybrid
                :how-to-hybridize ch-hybrid))

(define-structure species  name hybridization evdw mm2index)

(define (create-species name hybrid evdw mm2)
  (make-species :name name :hybridization hybrid :evdw evdw :mm2index mm2))

(define-structure bond-count  singles doubles triples total-bonds)
(define (create-bond-count n)
  (let ((b1 0) (b2 0) (b3 0))
    (do ((BL bond-list (cdr BL)))
	((null? BL))
	(if (or (= n (bond-first (car BL))) (= n (bond-second (car BL))))
	    (cond ((= (bond-order (car BL)) 1) (set! b1 (+ b1 1)))
		  ((= (bond-order (car BL)) 2) (set! b2 (+ b1 1)))
		  (else (set! b2 (+ b1 1))))))
    (let ((total (+ b1 (* 2 b2) (* 3 b3))))

      (make-bond-count :singles b1 :doubles b2 :triples b3 :total-bonds total)

      )))

(define-structure dd   diff dist)
(define (create-diff-dist m n)
  (let ((dif (vdiff (atm-position m) (atm-position n))))

    (make-dd :diff dif :dist (vlen dif))

    ))