;;;
;;; Just playing around
;;;

(in-package :neth)

(defvar *romfile-stream* nil "An input stream for loading a ROM")
(declaim (type (simple-array (unsigned-byte 8) (*)) *ines-header* *prg-rom* *chr-rom* *work-ram*))
(defvar *ines-header* nil "The iNES header for the current ROM file")
(defvar *prg-rom* nil "The PRG-ROM part of the current ROM file")
(defvar *chr-rom* nil "The CHR-ROM part of the current ROM file")

(defvar *work-ram* (make-array #x2000 :element-type `(unsigned-byte 8)
			       :initial-element 0)
  "Storage for the #x6000-#x7fff WRAM area")

(defvar *mapper* nil "The context for the currently emulated mapper")
(defvar *prg-mask* 0 "The number of 8k PRG pages, less one.")
(defvar *chr-mask* 0 "The number of 1k CHR pages, less one.")

(defvar *mapper-list* nil "A plist of all supported mappers")

(defun ignore-write (address data)
  (declare (ignore address data)))

(defun ram-write (address data)
  (setf (aref *cpu-ram* (logand #x7ff address)) data))

(defun ram-read (address)
  (aref *cpu-ram* (logand #x7ff address)))


(defun misc-write (address data)
  (declare (ignorable address data))
  ;; FIXME: Fill out.
  )

(defun misc-read (address)
  (declare (ignorable address))
  ;; FIXME: Fill out.
  0)

(defun wram-write (address data)
  (setf (aref *work-ram* (logand #x1fff address)) data))

(defun wram-read (address)
  (aref *work-ram* (logand #x1fff address)))

(defun rom-read (address)
  (aref (aref *prg-banks* (ldb (byte 2 13) address)) (logand #x1fff address)))

(defun write-handler-init ()
  (setf (aref *cpu-write-handlers* 0) #'ram-write)
  (setf (aref *cpu-write-handlers* 1) #'ppu-write)
  (setf (aref *cpu-write-handlers* 2) #'misc-write)
  (setf (aref *cpu-write-handlers* 3) #'wram-write)
  (setf (aref *cpu-write-handlers* 4) #'ignore-write)
  (setf (aref *cpu-write-handlers* 5) #'ignore-write)
  (setf (aref *cpu-write-handlers* 6) #'ignore-write)
  (setf (aref *cpu-write-handlers* 7) #'ignore-write))

(defun read-handler-init ()
  (setf (aref *cpu-read-handlers* 0) #'ram-read)
  (setf (aref *cpu-read-handlers* 1) #'ppu-read)
  (setf (aref *cpu-read-handlers* 2) #'misc-read)
  (setf (aref *cpu-read-handlers* 3) #'wram-read)
  (setf (aref *cpu-read-handlers* 4) #'rom-read)
  (setf (aref *cpu-read-handlers* 5) #'rom-read)
  (setf (aref *cpu-read-handlers* 6) #'rom-read)
  (setf (aref *cpu-read-handlers* 7) #'rom-read))

(defun prg-map-8k (bank page)
  (setf (aref *prg-banks* bank)
	(make-array #x2000 :element-type '(unsigned-byte 8)
		    :displaced-to *prg-rom*
		    :displaced-index-offset (* #x2000
					       (logand *prg-mask* page)))))

(defun prg-map-16k (bank page)
  (prg-map-8k (+ bank bank)   (+ page page))
  (prg-map-8k (+ bank bank 1) (+ page page 1)))

(defun prg-map-32k (bank page)
  (declare (ignore bank))
  (prg-map-8k 0 (+ 0 (* page 4)))
  (prg-map-8k 1 (+ 1 (* page 4)))
  (prg-map-8k 2 (+ 2 (* page 4)))
  (prg-map-8k 3 (+ 3 (* page 4))))

#-nil(defun chr-rom-init ()
       (dotimes (i 8)
	 (setf (aref *ppu-pattern-tables* i)
	       (make-array #x400 :element-type '(unsigned-byte 8)
			   :adjustable t
			   :displaced-to *chr-rom*
			   :displaced-index-offset (dpb i (byte 3 10) 0)))))

(defun chr-map-1k (bank page)
  (unless (zerop (array-total-size *chr-rom*))
    (setf (aref *ppu-pattern-tables* bank)
	  (make-array #x400 :element-type '(unsigned-byte 8)
		      :adjustable t
		      :displaced-to *chr-rom*
		      :displaced-index-offset (dpb page (byte 3 10) 0)))))

(defun chr-map-2k (bank page)
  (chr-map-1k (+ bank bank)   (+ page page))
  (chr-map-1k (+ bank bank 1) (+ page page 1)))

(defun chr-map-4k (bank page)
  (chr-map-1k (+ 0 (* bank 4)) (+ 0 (* page 4)))
  (chr-map-1k (+ 1 (* bank 4)) (+ 1 (* page 4)))
  (chr-map-1k (+ 2 (* bank 4)) (+ 2 (* page 4)))
  (chr-map-1k (+ 3 (* bank 4)) (+ 3 (* page 4))))

(defun chr-map-8k (bank page)
  (chr-map-1k (+ 0 (* bank 8)) (+ 0 (* page 8)))
  (chr-map-1k (+ 1 (* bank 8)) (+ 1 (* page 8)))
  (chr-map-1k (+ 2 (* bank 8)) (+ 2 (* page 8)))
  (chr-map-1k (+ 3 (* bank 8)) (+ 3 (* page 8)))
  (chr-map-1k (+ 4 (* bank 8)) (+ 4 (* page 8)))
  (chr-map-1k (+ 5 (* bank 8)) (+ 5 (* page 8)))
  (chr-map-1k (+ 6 (* bank 8)) (+ 6 (* page 8)))
  (chr-map-1k (+ 7 (* bank 8)) (+ 7 (* page 8))))

(defgeneric mapper-init (mapper))

(defun defmapper (number initfunc name)
  (setf (getf *mapper-list* number)
	    (cons initfunc name)))


;;; You know, I'd really like something more efficient-sounding than
;;; read-byte for reading blocks of data from binary streams...

; (defun load-array (size)
;   (let ((array (make-array size :element-type '(unsigned-byte 8))))
;     (dotimes (i size)
;            (setf (aref array i)
;                  (read-byte *romfile-stream*)))
;     array))

;;; system:read-n-bytes is a CMUCL extension which does what I want

(defun load-array (size)
  (let ((array (make-array size :element-type '(unsigned-byte 8))))
    (#+cmu system:read-n-bytes #+sbcl sb-sys:read-n-bytes *romfile-stream* array 0 size)
    array))

(defun load-header ()
  (setq *ines-header* (load-array 16)))

(defun load-prg ()
  (setq *prg-rom* (load-array (* #16r4000 (aref *ines-header* 4)))))

(defun load-chr ()
  (setq *chr-rom* (load-array (* #16r2000 (aref *ines-header* 5)))))

(defun dump-header ()
  (dotimes (i 16)
           (format t "~2,'0X " (aref *ines-header* i))))

(defun print-header ()
  (let* ((mapper (ldb (byte 4 4) (aref *ines-header* 6)))
	 (mapper-info (getf *mapper-list* mapper))
	 (prg-size (aref *ines-header* 4))
	 (chr-size (aref *ines-header* 5)))
    (format t "~2,' D x 16k PRG (~Dk).~%~2,' D x  8k CHR (~Dk).~%Mapper ~D (~A).~%"
	    prg-size (* prg-size 16)
	    chr-size (* chr-size 8)
	    mapper
	    (if mapper-info
		(cdr mapper-info)
	      "???"))))

(defun dump-chr-tile-bit (data1 data2 mask)
  (if (= (boole boole-and mask data1) mask)
      (if (= (boole boole-and mask data2) mask)
          (princ "*") (princ "+"))
    (if (= (boole boole-and mask data2) mask)
        (princ "x") (princ " "))))

(defun dump-chr-tile-line (tile line)
  (let ((data1 (aref *chr-rom* (+ (* tile 16) line)))
        (data2 (aref *chr-rom* (+ (* tile 16) line 8))))
    (dotimes (i 8)
             (dump-chr-tile-bit data1 data2 (expt 2 (- 7 i))))))

(defun dump-chr-tile (tile)
  (dotimes (i 8)
           (dump-chr-tile-line tile i)
           (terpri)))

(defun dump-chr-tile-pair (tile1 tile2)
  (dotimes (i 8)
           (dump-chr-tile-line tile1 i)
           (dump-chr-tile-line tile2 i)
           (terpri)))

(defun load-romfile (filename)
  (with-open-file (*romfile-stream* filename
                                    :direction :input
                                    :element-type '(unsigned-byte 8))
                  (load-header)
                  (load-prg)
                  (load-chr))
  T)

(defun system-init ()
  (setf *prg-mask* (1- (* 2 (aref *ines-header* 4))))
  (setf *chr-mask* (1- (* 8 (aref *ines-header* 5))))
  (when (= -1 *chr-mask*) (setf *chr-mask* 0))
  (setf *cpu* (make-cpu6502))
  (ppu-init :chr-rom (/= *chr-mask* 0)
	    :mirroring (if (zerop (logand (aref *ines-header* 6) 1))
			   :vertical :horizontal))
  (let ((mapper-info (getf *mapper-list*
			   (ldb (byte 4 4)
				(aref *ines-header* 6)))))
    (setf *mapper* (funcall (the function (car mapper-info)))))
  (read-handler-init)
  (write-handler-init)
  (mapper-init *mapper*)
  (cpu6502-reset *cpu*))

(defun system-run ()
  (do () ((eq nil t))
    (cpu6502-run *cpu* 113)
    (if (ppu-periodic)
	(cpu6502-nmi *cpu*))))

;;; EOF
