;; # 1 "config.c"
;; Truly sick and twisted hack. By extensive use of macros, and with a
;; little help from the C preprocessor, we now can run NanoCAD in either
;; Common Lisp or in MzScheme/MrEd.











(defvar  true    t  ) 
(defvar  false    nil  ) 




(defvar  debugging    nil  ) 





(defvar  use-mred    nil  ) 


;; # 66 "config.c"

(defvar else t)

(defmacro list-ref (lst n) `(nth ,n ,lst))
(defmacro make-lambda (args &rest body) `#'(lambda ,args ,@body))
(defmacro func (x)  `#',x)
(defmacro do-lisp (x) x)
(defmacro do-scheme (x) '())

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

(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))

(defun make-vector (n)
  (make-array (list n)))

;  (labels
;   ((make-list (n)
;	       (if (= n 0) '() (cons '() (make-list (- n 1))))))
;   (apply #'vector (make-list n))))

(if debugging
    (let ()
      (defmacro dbgprintf (x &rest y)
	`(format t ,x ,@y))
      (defmacro entering (name)
	`(format t "Entering ~s~%" ,name)))
    (let ()
      (defmacro dbgprintf (x &rest y) nil)
      (defmacro entering (name) nil)))



;; ==================================================================
;; Big Fun Data Types

;; # 235 "config.c"


(defstruct atm   element species position velocity force)
(defun create-atm (e p)
  (let ((a (make-atm :element e :position p
		     :velocity '#(0.0 0.0 0.0) :force '#(0.0 0.0 0.0))))
    (setf (atm-species a)
	  (lookup-species (element-name e)
			  (element-initial-hybridization e)))
    a))
(defun atm-set-species (a s) (setf (atm-species a) s))
(defun atm-add-pos (a x)
  (setf (atm-position a)
	(vplus x (atm-position a))))
(defun atm-set-pos (a s) (setf (atm-position a) s))
(defun atm-add-velocity (a v)
  (setf (atm-velocity a)
	(vplus v (atm-velocity a))))
(defun atm-set-velocity (a s) (setf (atm-velocity a) s))
(defun atm-zero-velocity (a) (setf (atm-velocity a) '#(0.0 0.0 0.0)))
(defun atm-zero-force (a) (setf (atm-force a) '#(0.0 0.0 0.0)))
(defun atm-add-force (a v)
  (setf (atm-force a)
	(vplus v (atm-force a))))

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



(defstruct element
  name rvdw mass total-bonds initial-hybridization how-to-hybridize)
(defun 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))

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

(defstruct bond-count  singles doubles triples total-bonds)
(defun create-bond-count (n)
  (let ((bc (make-bond-count :singles 0 :doubles 0 :triples 0 :total-bonds 0)))
    (dolist (bond bond-list)
	    (if (or (= n (bond-first bond)) (= n (bond-second bond)))
		(case (bond-order bond)
		      (1 (incf (bond-count-singles bc)))
		      (2 (incf (bond-count-doubles bc)))
		      (t (incf (bond-count-triples bc))))))
    (setf (bond-count-total-bonds bc)
	  (+ (bond-count-singles bc)
	     (* 2 (bond-count-doubles bc))
	     (* 3 (bond-count-triples bc))))
    bc))

(defstruct dd   diff dist)
(defun create-diff-dist (m n)
  (let* ((dif (vdiff (atm-position m) (atm-position n))))
    (make-dd :diff dif :dist (vlen dif))))





(load "ncad022.scm")