;;;
;;; sib-nubus.lisp
;;;
;;; NuBus interface to the SIB board.
;;;

(in-package :nevermore)

(declaim (type (simple-array (unsigned-byte 8) (*)) *sib-config-rom*))
(defvar *sib-config-rom* (make-array '(#x2000) :element-type '(unsigned-byte 8)
				     :initial-element 0))

(declaim (type (simple-array (unsigned-byte 8) (*)) *sib-framebuffer*))
(defvar *sib-framebuffer* (make-array '(#x20000) :element-type '(unsigned-byte 8)
				      :initial-element 0))

(defun sib-nubus-read (slot address width)
  (declare (type (unsigned-byte 8) slot)
	   (type (unsigned-byte 24) address)
	   (ignorable slot))
  (cond ((= (logand address #xff8000) #xff8000)
	 (setf *inhibit-nubus-trace* t)
	 (setf (aref *memory-data*) (dpb (aref *sib-config-rom* (ldb (byte 13 2) address)) (byte 8 (* 8 (logand 3 address))) 0)))
	((= (logand address #xfe0000) #xe80000)
	 (setf *inhibit-nubus-trace* t)
	 (if (eq width :byte)
	     (setf (aref *memory-data*) (aref *sib-framebuffer* (logand #x1ffff address)))
	   (setf (aref *memory-data*) (dpb (aref *sib-framebuffer* (+ (logand #x1ffff address) 3)) (byte 8 24)
				    (dpb (aref *sib-framebuffer* (+ (logand #x1ffff address) 2)) (byte 8 16)
					 (dpb (aref *sib-framebuffer* (+ (logand #x1ffff address) 1)) (byte 8 8)
					      (aref *sib-framebuffer* (logand #x1ffff address))))))))
	(t (setf *nubus-error* t)))
  (values))

(defun sib-nubus-write (slot address width)
  (declare (type (unsigned-byte 8) slot)
	   (type (unsigned-byte 24) address)
	   (ignorable slot))
  (cond ((= (logand address #xfe0000) #xe80000)
	 (setf *inhibit-nubus-trace* t)
	 (if (eq width :byte)
	     (setf (aref *sib-framebuffer* (logand #x1ffff address)) (ldb (byte 8 (* 8 (logand 3 address))) (aref *memory-data*)))
	   (progn
	     (setf (aref *sib-framebuffer* (+ (logand #x1ffff address) 3)) (ldb (byte 8 24) (aref *memory-data*)))
	     (setf (aref *sib-framebuffer* (+ (logand #x1ffff address) 2)) (ldb (byte 8 16) (aref *memory-data*)))
	     (setf (aref *sib-framebuffer* (+ (logand #x1ffff address) 1)) (ldb (byte 8  8) (aref *memory-data*)))
	     (setf (aref *sib-framebuffer* (+ (logand #x1ffff address) 0)) (ldb (byte 8  0) (aref *memory-data*))))))
	(t (setf *nubus-error* t)))
  (values))

#|
(with-open-file (romfile #p"/home/nyef/src/lisp/aek/E1_eproms/2236662_SIB"
			 :direction :input :element-type '(unsigned-byte 8))
		(dotimes (i #x2000)
		  (setf (aref *sib-config-rom* i) (read-byte romfile))))

(with-open-file (imagefile #p"framebuffer" :direction :output
			   :element-type '(unsigned-byte 8))
		(dotimes (i #x19400)
		  (write-byte (aref *sib-framebuffer* i) imagefile)))
|#

(defparameter *sib-bmp-header* #(#x42 #x4d #x3e #x94 1 0 0 0 0 0 #x3e 0 0 0 #x28 0 0 0 0 4 0 0 #x28 3 0 0 1 0 1 0 0 0 0 0 0 #x94 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 #xff #xff #xff 0))

(defun sib-write-screenshot (filename)
  (with-open-file (imagefile filename :direction :output
			     :element-type '(unsigned-byte 8))
		  (dotimes (i #x3e)
		    (write-byte (aref *sib-bmp-header* i) imagefile))
		  (dotimes (y 808)
		    (dotimes (x 128)
		      (let ((data (aref *sib-framebuffer* (+ x (* (- 807 y) 128)))))
			(setf data (logior (ash (logand data #x55) 1)
					   (ash (logand data #xaa) -1)))
			(setf data (logior (ash (logand data #x33) 2)
					   (ash (logand data #xcc) -2)))
			(setf data (logior (ash (logand data #x0f) 4)
					   (ash (logand data #xf0) -4)))

			(write-byte data imagefile))))))

;;; EOF
