;;;
;;; ppu.lisp
;;;
;;; The NES Picture Processing Unit
;;;

(in-package :neth)

(defvar *ppu-control-1* 0 "PPU control register 1")
(defvar *ppu-control-2* 0 "PPU control register 2")
(defvar *ppu-status* 0 "PPU status register")
(defvar *ppu-spraddy* 0 "PPU sprite address")
(defvar *ppu-address* 0 "PPU memory address")

(defvar *ppu-scanline* 0 "The current scanline")
(defvar *ppu-refresh-data* 0 "I forget?")
(defvar *ppu-refresh-temp* 0 "I forget?")
(defvar *ppu-finescroll* 0 "PPU fine (sub-tile) horizontal scroll")
(defvar *ppu-read-latch* 0 "PPU memory read latch")
(defvar *ppu-address-latch* 0 "PPU address write latch")
(defvar *ppu-amode* nil "PPU address byte toggle")

(declaim (type (simple-array (unsigned-byte 8) (*)) *ppu-sprram* *ppu-palette* *ppu-nametable-ram* *ppu-low-nametable* *ppu-high-nametable* *ppu-pattern-ram*))
(defvar *ppu-sprram* (make-array #x100 :element-type '(unsigned-byte 8)
				 :initial-element 0)
  "PPU sprite memory")
(defvar *ppu-palette* (make-array #x20 :element-type '(unsigned-byte 8)
				  :initial-element 0)
  "PPU palette memory")

(declaim (type (simple-array (array (unsigned-byte 8) (*)) (*)) *ppu-nametables* *ppu-pattern-tables*))
(defvar *ppu-nametables* (make-array 4)
  "PPU nametable pointers")
(defvar *ppu-nametable-ram* (make-array #x800 :element-type '(unsigned-byte 8)
					:initial-element 0)
  "PPU nametable memory")
(defvar *ppu-low-nametable* (make-array #x400 :element-type '(unsigned-byte 8)
					:displaced-to *ppu-nametable-ram*
					:displaced-index-offset #x000))
(defvar *ppu-high-nametable* (make-array #x400 :element-type '(unsigned-byte 8)
					 :displaced-to *ppu-nametable-ram*
					 :displaced-index-offset #x400))

(defvar *ppu-pattern-ram* (make-array #x2000 :element-type '(unsigned-byte 8)
				      :initial-element 0)
  "PPU pattern memory (write-only when CHR-ROM present)")
(defvar *ppu-pattern-tables* (make-array 8)
  "PPU pattern table pointers")

(defun ppu-set-mirroring (mirroring)
  (case mirroring
    (:vertical
     (setf (aref *ppu-nametables* 0) *ppu-low-nametable*)
     (setf (aref *ppu-nametables* 1) *ppu-high-nametable*)
     (setf (aref *ppu-nametables* 2) *ppu-low-nametable*)
     (setf (aref *ppu-nametables* 3) *ppu-high-nametable*))
    (:horizontal
     (setf (aref *ppu-nametables* 0) *ppu-low-nametable*)
     (setf (aref *ppu-nametables* 1) *ppu-low-nametable*)
     (setf (aref *ppu-nametables* 2) *ppu-high-nametable*)
     (setf (aref *ppu-nametables* 3) *ppu-high-nametable*))
    (:one-low
     (setf (aref *ppu-nametables* 0) *ppu-low-nametable*)
     (setf (aref *ppu-nametables* 1) *ppu-low-nametable*)
     (setf (aref *ppu-nametables* 2) *ppu-low-nametable*)
     (setf (aref *ppu-nametables* 3) *ppu-low-nametable*))
    (:one-high
     (setf (aref *ppu-nametables* 0) *ppu-high-nametable*)
     (setf (aref *ppu-nametables* 1) *ppu-high-nametable*)
     (setf (aref *ppu-nametables* 2) *ppu-high-nametable*)
     (setf (aref *ppu-nametables* 3) *ppu-high-nametable*))))

(defun ppu-memory-read (address)
  (setf address (logand #x3fff address))
  (cond
   ((>= address #x2000)
    (aref (aref *ppu-nametables* (ldb (byte 2 10) address))
	  (logand #x3ff address)))
   (t (aref (aref *ppu-pattern-tables* (ldb (byte 3 10) address))
	    (logand #x3ff address)))))

(defun ppu-memory-write (address data)
  (setf address (logand #x3fff address))
  (cond
   ((>= address #x3f00)
    (setf (aref *ppu-palette* (logand address #x1f)) (logand #x3f data)))
   ((>= address #x2000)
    (setf (aref (aref *ppu-nametables* (ldb (byte 2 10) address))
		(logand address #x3ff)) data))
   (*ppu-pattern-ram*
    (setf (aref *ppu-pattern-ram* (logand address #x1fff)) data))))

(defun ppu-write (address data)
  (case (logand address 7)
    (0 ;; Control 1
     (setf *ppu-control-1* data)
     (setf *ppu-refresh-temp*
	   (logand #x7fff (dpb data (byte 2 10)
			       *ppu-refresh-temp*))))
    (1 ;; Control 2
     (setf *ppu-control-2* data))
    (2 ;; Unknown
     )
    (3 ;; Sprite address
     (setf *ppu-spraddy* data))
    (4 ;; Sprite data
     (setf (aref *ppu-sprram* *ppu-spraddy*) data)
     (setf *ppu-spraddy* (logand #xff (1+ *ppu-spraddy*))))
    (5 ;; Scroll
     (if *ppu-amode*
	 (progn
	   (setf *ppu-amode* nil)
	   (setf *ppu-refresh-temp*
		 (logior (dpb data (byte 3 12) 0)
			 (logand (ash data 2) #x3e0)
			 (logand *ppu-refresh-temp* #x0c1f))))
       (progn
	 (setf *ppu-amode* t)
	 (setf *ppu-refresh-temp*
	       (logior (logand #x7fe0 *ppu-refresh-temp*)
		       (ldb (byte 5 3) data)))
	 (setf *ppu-finescroll* (logand data 7)))))
    (6 ;; PPU address
     (if *ppu-amode*
	 (progn
	   (setf *ppu-amode* t)
	   (setf *ppu-address* (dpb *ppu-address-latch* (byte 8 8) data))
	   (setf *ppu-refresh-temp* (dpb data (byte 8 0) *ppu-refresh-temp*))
	   (setf *ppu-refresh-data* *ppu-refresh-temp*))
       (progn
	 (setf *ppu-amode* nil)
	 (setf *ppu-address-latch* data)
	 (setf *ppu-refresh-temp* (dpb data (byte 6 8) *ppu-refresh-temp*)))))
    (7 ;; PPU data
     (ppu-memory-write *ppu-address* data)
     (setf *ppu-address* (+ *ppu-address*
			      (if (zerop (logand *ppu-control-1* #x04))
				  1 #x20))))))

(defun ppu-read (address)
  (case (logand address 7)
    (2 ;; Status
     (let ((retval *ppu-status*))
       (setf *ppu-status* (logand *ppu-status* #x7f))
       (setf *ppu-amode* nil)
       retval))
    (4 ;; Sprite RAM
     (let ((retval (aref *ppu-sprram* *ppu-spraddy*)))
       (setf *ppu-spraddy* (logand #xff (1+ *ppu-spraddy*)))
       retval))
    (7 ;; PPU memory
     (let ((retval *ppu-read-latch*))
       (setf *ppu-read-latch* (ppu-memory-read *ppu-address*))
       (setf *ppu-address* (+ *ppu-address*
			      (if (zerop (logand *ppu-control-1* #x04))
				  1 #x20)))
       retval))
    (t ;; Open bus
     0)))

(defun video-display-buffer ()
  (format t "Frame.~%"))

(defun ppu-render-scanline ()
  )

(defun ppu-periodic ()
  #+nil(format t "Periodic.~%")
  ;; Mapper-based raster effects
  #+nil(if (and (or (< *ppu-scanline* 240)
	       (= *ppu-scanline* 262))
	   (/= 0 (logand *ppu-control-2* #x18)))
      )

  ;; Rendering control
  (when (< *ppu-scanline* 240)
    (setf *ppu-refresh-data* (logior (logand *ppu-refresh-data* #x7be0)
				     (logand *ppu-refresh-temp* #x041f)))
    (ppu-render-scanline))

  (when (= *ppu-scanline* 240)
    (setf *ppu-status* #x80)
    (video-display-buffer))

  (incf *ppu-scanline*)

  ;; Frame end handling
  (when (= *ppu-scanline* 262)
    (setf *ppu-status* 0)
    (setf *ppu-scanline* 0)
    (setf *ppu-refresh-data* *ppu-refresh-temp*))
  
  ;; NMI control (return value)
  (and (= *ppu-scanline* 243)
       (/= 0 (logand *ppu-control-1* #x80))))

(defun ppu-init (&key chr-rom (mirroring :horizontal))
  (setf *ppu-scanline* 0)
  
  (unless chr-rom
    (dotimes (i 8)
      (setf (aref *ppu-pattern-tables* i)
	    (make-array #x400 :element-type '(unsigned-byte 8)
			:displaced-to *ppu-pattern-ram*
			:displaced-index-offset (dpb i (byte 3 10) 0)))))
  
  (ppu-set-mirroring mirroring))

;;; EOF
