;;;;circuits.lisp
;;;
;;;An object-oriented simulation of a number 
;;;of digital circuit board elements.
;;;
;;;Author: Zach Tomaszewski
;;;Date: 06 Nov 2002
;;;


;;;CLASSES

;;The superclass of all circuit elements.
;;Includes name, value, and outputs
;;
(defclass circuit-element () 
 ((name :accessor name 
        :initarg :name
        :type symbol
        :documentation "The name/id of this element.")
  (value :accessor value
         :initarg :value
         :type boolean
         :initform ()
         :documentation "The true/false (on/off) value of this gate.") 
  (outputs :accessor outputs
           :initarg :outputs
           :type list     ;a list of circuit-elements
           :initform ()
           :documentation "The elements that this object is connected
             and outputting to.")
 )
)


;;Simulates a connecting wire, 
;;particularly those entering the system
;;
(defclass hard-wire (circuit-element)
 ((class-name :allocation :class
              :reader class-name
              :initform 'hard-wire
              :type symbol
              :documentation "The class of this circuit-element")
 )
)


;;The superclass for all unary and binary gates
;;Adds an inputs slot
;;
(defclass gate (circuit-element)
  ((inputs :accessor inputs
           :initarg :inputs
           :initform ()
           :type list  ;;list of circuit-elements
           :documentation "The list of elements feeding their output
              into this gate.")
  )
)


;;The class of those gates with only one input and one output
;; such as buffer-gates and not-gates
;;
(defclass unary-gate (gate)
  ()
)

;;Merely holds/passes on whatever value it is given
;;
(defclass buffer-gate (unary-gate)
 (
  (class-name :allocation :class
              :reader class-name
              :initform 'buffer
              :type symbol
              :documentation "The class of this circuit-element")
 )
)

;;Inverts whatever value it is given
;;
(defclass not-gate (unary-gate)
  ((class-name :allocation :class
              :reader class-name
              :initform 'not
              :type symbol
              :documentation "The class of this circuit-element")
  )
)



;;Super class those gates with two inputs and one outputs, 
;; such as AND, NAND, OR, NOR, and XOR
;;
(defclass binary-gate (gate)
 ()
)

;;AND gate
;;
(defclass and-gate (binary-gate)
  ((class-name :allocation :class
              :reader class-name
              :initform 'AND
              :type symbol
              :documentation "The class of this circuit-element")
  )
)

;;OR gate
;;
(defclass or-gate (binary-gate)
  ((class-name :allocation :class
              :reader class-name
              :initform 'OR
              :type symbol
              :documentation "The class of this circuit-element")
  )
)

;;XOR gate
;;
(defclass xor-gate (binary-gate)
  ((class-name :allocation :class
              :reader class-name
              :initform 'XOR
              :type symbol
              :documentation "The class of this circuit-element")
  )
)

;;NAND gate
;;
(defclass nand-gate (binary-gate)
  ((class-name :allocation :class
              :reader class-name
              :initform 'NAND
              :type symbol
              :documentation "The class of this circuit-element")
  )
)

;;NOR gate
;;
(defclass nor-gate (binary-gate)
  ((class-name :allocation :class
              :reader class-name
              :initform 'NOR
              :type symbol
              :documentation "The class of this circuit-element")
  )
)



;;;METHODS

;;The methods for printing the state of circuit elements to the screen
;;(Called print-element to avoid conflicth with existing print-object)
;;
(defgeneric print-object ((elem circuit-element)(str stream))
  (:documentation "Prints the state of a circuit element to the screen")

  ;;hard-wire
  (:method ((hw hard-wire)(str stream))
    (format str "[~A: hard-wire ~A]~%" 
    (if (slot-boundp hw 'name) (name hw) 'unbound )
    (if (value hw) 1 0))
  )

  ;;unary-gate
  (:method ((ug unary-gate)(str stream))
    (format str "[~A: ~A ~A=~A is ~A]~%"
      (if (slot-boundp ug 'name) (name ug) 'unbound )
      (class-name ug)
      ;input1-name 
      (if (null (inputs ug)) 'unbound (name (car (inputs ug))))
      ;input1-value
      (if (null (inputs ug)) 'unbound (if (value (car (inputs ug))) 1 0))
      (if (value ug) 1 0)
    )
  )

  ;;binary-gate
  (:method ((bg binary-gate)(str stream))
    (format str "[~A: ~A=~A ~A ~A=~A  is ~A]~%"
      (if (slot-boundp bg 'name) (name bg) 'unbound )
      ;input1-name 
      (if (null (inputs bg)) 'unbound (name (car (inputs bg))))
      ;input1-value
      (if (null (inputs bg)) 'unbound (if (value (car (inputs bg))) 1 0))
      ;class-name
      (class-name bg)
      ;input2-name 
      (if (null (cdr (inputs bg))) 'unbound (name (cadr (inputs bg))))
      ;input2-value
      (if (null (cdr (inputs bg))) 
         'unbound 
         (if (value (cadr (inputs bg))) 1 0)
      )
      (if (value bg) 1 0)
    )
  )
)


;;Methods used by gates to compute their values based on inputs
;;
(defgeneric compute (gate)
  (:documentation "Compute the value of a gate based on inputs.")

  ;;BUFFER
  (:method ((thisgate buffer-gate))
    (when (and (slot-boundp thisgate 'inputs) 
               (not (null (inputs thisgate) )) 
               (= 1 (length (inputs thisgate)))
          )
      (set-gate-value thisgate 
        ;newvalue is same as single input
        (value (car (inputs thisgate))) 
      )
    )
  )

  ;;NOT
  (:method ((thisgate not-gate))
    (when (and (slot-boundp thisgate 'inputs) 
               (not (null (inputs thisgate) )) 
               (= 1 (length (inputs thisgate)))
          )
      (set-gate-value thisgate 
        ;newvalue is opposite of single input
        (not (value (car (inputs thisgate))))
      )
    )
  )

;;AND
  (:method ((thisgate and-gate))
    (when (and (slot-boundp thisgate 'inputs) 
               (not (null (inputs thisgate) )) 
               (= 2 (length (inputs thisgate)))
          )
      (set-gate-value thisgate 
        (and (value (car (inputs thisgate)))
             (value (cadr (inputs thisgate))))
      )
    )
  )

;;OR
  (:method ((thisgate or-gate))
    (when (and (slot-boundp thisgate 'inputs) 
               (not (null (inputs thisgate) )) 
               (= 2 (length (inputs thisgate)))
          )
      (set-gate-value thisgate 
        (or (value (car (inputs thisgate)))
             (value (cadr (inputs thisgate))))
      )
    )
  )

  ;;XOR
  (:method ((thisgate xor-gate))
    (when (and (slot-boundp thisgate 'inputs) 
               (not (null (inputs thisgate) )) 
               (= 2 (length (inputs thisgate)))
          )
      (set-gate-value thisgate 
        ;newvalue is either of the inputs but (and) not both
        (and (or (value (car (inputs thisgate)))
                 (value (cadr (inputs thisgate))) )
             (not (and (value (car (inputs thisgate)))
                       (value (cadr (inputs thisgate))) ))
        )
      )
    )
  )

  ;;NAND
  (:method ((thisgate nand-gate))
    (when (and (slot-boundp thisgate 'inputs) 
               (not (null (inputs thisgate) )) 
               (= 2 (length (inputs thisgate)))
          )
      (set-gate-value thisgate 
        (not (and (value (car (inputs thisgate)))
                  (value (cadr (inputs thisgate)))
             )
        )
      )
    )
  )

  ;;NOR
  (:method ((thisgate nor-gate))
    (when (and (slot-boundp thisgate 'inputs)
               (not (null (inputs thisgate) )) 
               (= 2 (length (inputs thisgate)))
          )
      (set-gate-value thisgate 
        (not (or (value (car (inputs thisgate)))
                 (value (cadr (inputs thisgate)))
             )
        )
      )
    )
  )
);end compute

;;The general method that changes a gate, 
;; given the gate and a boolean newvalue for it.
;;
(defmethod set-gate-value ((thisgate gate) newvalue)
  (unless (equal newvalue (value thisgate))
    (setf (value thisgate) newvalue)
  )
)

;;This method is called after any setf on the value of an element 
;; It then updates all the values of its outputs
;;
(defmethod (setf value) :after (newvalue (thiselement circuit-element))
  (mapcar 'compute (outputs thiselement))
)

;;This method is called after a gate is created.
;; It computes its value based on its inputs 
;; (which in turn fires the updating of it's outputs' values)
;;
(defmethod initialize-instance :after ((thisgate gate) &rest init-args)
  (compute thisgate)
)


;;An interactive half-adder, using an AND gate and XOR gate.
;;Asks for the two hardwire inputs of A and B.
;;Prints the value of S (the sum) and C (the carry)
;;
(defun half-adder ()
 (let* ((a (make-instance 'Hard-Wire :name 'A))
        (b (make-instance 'Hard-Wire :name 'B))
        (c (make-instance 'And-Gate :name 'and1 :inputs (list a b)))
        (s (make-instance 'Xor-Gate :name 'xor1 :inputs (list a b)))
       )
    (setf (outputs a) (list s c))
    (setf (outputs b) (list s c))
    (loop do (read-input a "A") ; read-input sets the gate
          do (read-input b "B") 
          do (format t "Output: S is ~A, C is ~A~%"
               (if (value s) 1 0) (if (value c) 1 0)  )
          while (y-or-n-p "Another computation? (y or n): ")
     )
 )
);end half-adder


;;An interactive full-adder.
;;Asks for the two hardwire inputs of C (incoming carry), A and B.
;;Prints the value of S (the sum) and C2 (the out-going carry).
;;
(defun full-adder ()
 (let* ((c (make-instance 'Hard-Wire :name 'C))
        (a (make-instance 'Hard-Wire :name 'A))
        (b (make-instance 'Hard-Wire :name 'B))
        (xor1 (make-instance 'Xor-Gate :name 'xor1 :inputs (list a b)))
        (and1 (make-instance 'And-Gate :name 'and1 :inputs (list a b)))
        (s (make-instance 'Xor-Gate :name 'xor2 :inputs (list c xor1)))
        (and2 (make-instance 'And-Gate :name 'and2 :inputs (list c xor1)))
        (c2 (make-instance 'Or-Gate :name 'or1 :inputs (list and1 and2)))
       )
    (setf (outputs c) (list s and2))
    (setf (outputs a) (list xor1 and1))
    (setf (outputs b) (list xor1 and1))
    (setf (outputs xor1) (list s and2))
    (setf (outputs and1) (list c2))
    (setf (outputs and2) (list c2))

    (loop do (read-input c "C")
          do (read-input a "A") ; read-input sets the gate
          do (read-input b "B") 
          do (format t "Output: S is ~A, C2 is ~A~%"
               (if (value s) 1 0) (if (value c2) 1 0)  )
          while (y-or-n-p "Another computation? (y or n): ")
     )
 )
);end full-adder


;;An interactive set-reset flip-flop circuit, using two NOR gates.
;;Asks for the two hardwire inputs of S (set) and R (reset).
;;Prints the value of both the Top and Bottom gate.
;;
(defun sr-flip-flop ()
 (let* ((s (make-instance 'Hard-Wire :name 'Set))
        (r (make-instance 'Hard-Wire :name 'Reset))
        (top (make-instance 'Nor-Gate :name 'top-nor))
        (bot (make-instance 'Nor-Gate :name 'bottom-nor))
         s-input r-input   ;;for I/O
       )
    (setf (outputs s) (list top))
    (setf (outputs r) (list bot))
    (setf (inputs top) (list s bot))
    (setf (outputs top) (list bot))
    (setf (inputs bot) (list top r))
    (setf (outputs bot) (list top))
    
    (loop do (setf s-input (read-01-input "S (set)")) ;query user for values
          do (setf r-input (read-01-input "R (reset)")) 
          do (if (= s-input r-input 1)  ;;both inputs are 1
               ;then
               (format t "Sorry, S and R cannot both be 1. ~%")
               ;else
               (progn
                 (setf (value s) (eq s-input 1)) ;set to t or nil on
                 (setf (value r) (eq r-input 1)) ;whether input is 1 or 0
                 (format t "Output: Top is ~A, Bottom is ~A~%"
                    (if (value top) 1 0) (if (value bot) 1 0)  ) 
               );end progn
             );end if
       while (y-or-n-p "Another computation? (y or n): ")
    )
 );end let
);end sr-flip-flop



;;read-input takes a circuit element (ce)
;; and a string that explains that element to the user (printvar).
;;It asks the user for a value for printvar, 
;; and uses it to updates ce's value.
;;
(defun read-input (ce printvar)
  (let ( (tempvar (read-01-input printvar)) ) 
    ;tempvar is now either 1 or 0
    (if (eq tempvar 1) 
      (setf (value ce) t)
      (setf (value ce) nil)
    )
  );end let
);end read-input

;;read-01-input takes a string (printvar) that describes an element.
;;It asks the user for a value for printvar, 
;; and returns that value.
;;It will keep asking the user until the value entered is either 0 or 1.
;;
(defun read-01-input (printvar)
  (let (tempvar) 
    (loop do (format t "Enter input ~A (0 or 1): " printvar)
          do (setf tempvar (read) )
          while (not (and (integerp tempvar)
                          (or (eq tempvar 0) (eq tempvar 1) )
                 ))
    )
    tempvar ;return tempvar
  )
)