CCL Home Page
Up Directory CCL gambit
;; Gambit configuration file for NanoCAD

(define  true    #t  ) 
(define  false    #f  ) 

(define  debugging    #f  ) 

(define  use-mred    #f  ) 

(define-macro (make-lambda args . body) `(lambda ,args ,@body))
(define-macro (funcall lexp . args) `(,lexp ,@args))
(define-macro (func x) x)
(define-macro (mapcar f lst) `(map ,f ,lst))
(define-macro (qsort x y) `(quicksort ,x ,y))
(define-macro (labels defns . body)
  `(let
       ,(map
	 (lambda (x)
	   (list (car x) (cons 'lambda (cdr x))))
	 defns)
     ,@body))

(define-macro (dolist args . body)
  `(do ((local-list ,(cadr args) (cdr local-list))
	(,(car args) '()))
       ((null? local-list))
       (set! ,(car args) (car local-list))
       ,@body))

(define-macro (dotimes args . body)
  `(do ((,(car args) 0 (+ 1 ,(car args)))
	(iteration-limit ,(cadr args)))
       ((>= ,(car args) iteration-limit))
       ,@body))

(define-macro (dbgprintf x . y) '())
(define-macro (entering name) '())

(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 e s p '#(0.0 0.0 0.0) '#(0.0 0.0 0.0))

    ))

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

(define-structure bond  order first second)

(define (create-bond ord f s)
  (make-bond ord f 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 rvdw mass bonds init-hybrid ch-hybrid))

(define-structure species  name hybridization evdw mm2index)

(define (create-species name hybrid evdw mm2)
  (make-species name hybrid evdw 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 b1 b2 b3 total)

      )))

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

    (make-dd dif (vlen dif))

    ))

Modified: Mon Mar 17 17:00:00 1997 GMT
Page accessed 4397 times since Sat Apr 17 22:31:39 1999 GMT