;;; -*- Mode:LISP; Package:li; Base:10; Readtable:CL -*-


(defconstant vcmem-size-in-words #.(lisp:* 32. 1024.))
(defconstant vcmem-size-in-bytes #.(lisp:* vcmem-size-in-words 4))
(defconstant vcmem-bitmap-offset #x20000)
(DEFCONSTant SCAN-LINE-TABLE-BEGIN  #x6000)
(DEFCONSTant SCAN-LINE-TABLE-LENGTH #.(lisp:/ #x1000 4))

(defconstant tv-config-reg 0)
(defconstant tv-mem-control-reg 4)
(defconstant tv-interrupt-reg 2)
(defconstant tv-status-reg 3)
(defconstant tv-data-rate-reg 4)
(defconstant tv-data-port-a #o14)
(defconstant tv-command-port-a #o15)
(defconstant tv-data-port-b #o16)
(defconstant tv-command-port-b #o17)


(defconstant tv-config-reset-bit (byte 1. 0.))
(defconstant tv-config-enable-bit (byte 1 1))
(defconstant tv-config-mode-bits (byte 2. 3.))

(defconstant vcmem-xor-mode 0)
(defconstant vcmem-ior-mode 1)
(defconstant vcmem-and-mode 2)
(defconstant vcmem-move-mode 3)


(defvar *vcmem-slot* #xf9)
(defvar *screen-address*)


(defun vcmem-read-word (addr)
  (nubus-stuff:%bus-read (hw:dpb-unboxed *vcmem-slot* (byte 8. 24.) addr))
  )

(defun vcmem-write-word (addr data)
  (nubus-stuff:%bus-write (hw:dpb-unboxed *vcmem-slot* (byte 8. 24.) addr) (nubus-stuff:unboxed-32 data)))

(defun vcmem-write-bitmap (addr data)
  (nubus-stuff:%bus-write (hw:dpb-multiple-unboxed
			    *vcmem-slot* (byte 8. 24.)
			    1 (byte 1 17.) 		; #x20000 is the offset.
			    addr)
			  (nubus-stuff:unboxed-32 data))
  )

(defun vcmem-read-bitmap (addr)
  (nubus-stuff:%bus-read (hw:dpb-multiple-unboxed *vcmem-slot* (byte 8. 24.)
						      1 (byte 1 17.)
						      addr))
  )

(defun read-tv-config ()
  (vcmem-read-word 0))

(defun write-tv-config (data)
  (vcmem-write-word 0 data))

(defun reset-tv ()
;  (let ((old-status (read-tv-config)))
;    (write-tv-config (dpb 1 tv-config-reset-bit old-status))
;    (write-tv-config (dpb 0 tv-config-reset-bit old-status))
;    )
  (write-tv-config (hw:dpb 1 tv-config-reset-bit 0))
  (write-tv-config 0)
  )

(defun enable-tv ()
  (write-tv-config (hw:dpb 1 tv-config-enable-bit (read-tv-config))))

(defun disable-tv ()
  (write-tv-config (hw:dpb 0 tv-config-enable-bit (read-tv-config))))

(defun set-up-tv (&OPTIONAL (words-per-line 32.))
  (reset-tv)
  (enable-tv)
  (tv-set-move-mode)
  (tv-enable-copy-a-to-b))

(defun tv-set-mode (mode)
  (write-tv-config (hw:dpb mode tv-config-mode-bits (read-tv-config))))

(defun tv-set-xor-mode ()
  (write-tv-config (hw:dpb vcmem-xor-mode tv-config-mode-bits (read-tv-config))))

(defun tv-set-ior-mode ()
  (write-tv-config (hw:dpb vcmem-ior-mode tv-config-mode-bits (read-tv-config))))

(defun tv-set-and-mode ()
  (write-tv-config (hw:dpb vcmem-and-mode tv-config-mode-bits (read-tv-config))))

(defun tv-set-move-mode ()
  (write-tv-config (hw:dpb vcmem-move-mode tv-config-mode-bits (read-tv-config))))

;;; Memory control stuff

(defconstant tv-refresh-per-line-bits 0002)

(defconstant tv-refresh-1-per-line 0)
(defconstant tv-refresh-2-per-line 1)
(defconstant tv-refresh-3-per-line 2)
(defconstant tv-refresh-4-per-line 3)

(defconstant tv-mem-bank-bit (byte 1 2))
(defconstant tv-copy-a-to-b-bit (byte 1 3))
(defconstant tv-reverse-video-bit (byte 1 4))
(defconstant tv-interrupt-enable-bit (byte 1 5))
(defconstant tv-bus-selector-bit (byte 1 6))

(defun read-tv-mem-control ()
  (hw:32logand #o177777 (vcmem-read-word tv-mem-control-reg)))

(defun write-tv-mem-control (data)
  (vcmem-write-word tv-mem-control-reg data))

(defun tv-enable-copy-a-to-b ()
  (write-tv-mem-control (hw:dpb 1 tv-copy-a-to-b-bit (read-tv-mem-control))))


(defun tv-black-on-white ()
  (write-tv-mem-control (hw:dpb 1 tv-reverse-video-bit (read-tv-mem-control))))

(defun tv-white-on-black ()
  (write-tv-mem-control (hw:dpb 0 tv-reverse-video-bit (read-tv-mem-control))))

(defun tv-enable-interrupts (&optional (slot *vcmem-slot*))
  (write-tv-mem-control (hw:dpb 1 tv-interrupt-enable-bit (read-tv-mem-control)))
  )

(defun tv-disable-interrupts (&optional (slot *vcmem-slot*))
  (write-tv-mem-control (hw:dpb 0 tv-interrupt-enable-bit (read-tv-mem-control)))
  )

(DEFUN WRITE-SCAN-LINE-TABLE (ADR DATA)
  (vcmem-write-word (+ (ash ADR 2) SCAN-LINE-TABLE-BEGIN) DATA))

(DEFUN LOAD-SCAN-LINE-TABLE (&optional (WORDS-PER-LINE 32.))
  (DO ((LINE-NUMBER 0 (1+ LINE-NUMBER))
       (double-words-per-line (+ words-per-line words-per-line))   ;
       (BIT-MAP-POINTER 0 (+ BIT-MAP-POINTER double-WORDS-PER-LINE)))
      ((>= LINE-NUMBER SCAN-LINE-TABLE-LENGTH) ())
    (WRITE-SCAN-LINE-TABLE LINE-NUMBER BIT-MAP-POINTER)))

(defun clear-vcmem (&optional (data 0))
  (do ((i 0 (+ i 4)))
      ((> i vcmem-size-in-bytes))
    (vcmem-write-bitmap i data)))


(defun init-tv (&optional (slot *vcmem-slot*))
  (setq *vcmem-slot* slot)
  (set-up-tv)
  (load-scan-line-table)
  (clear-vcmem 1)
  (setq *screen-address* (nubus-stuff:make-screen-bit-array
			   (hw:dpb-multiple-unboxed
			    *vcmem-slot* (byte 8. 24.)
			    1 (byte 1 17.) 		; #x20000 is the offset.
			    (hw:unboxed-constant 0))
			   vcmem-size-in-bytes))
  (boot-stack-groups)
  (loop)
  )
  
(defun test-tv-1 (&optional (screen-device *screen-address*))
  (clear-vcmem)
  (do ((v 0 (+ v 32.))
       (i 0 (1+ i)))
      ((= i 1024.))
    (array:aset-n #x00000001 screen-device v)
    (array:aset-n #x80000000 screen-device (+ v 24.)))
  (do ((h 0 (+ h 1.))
       (i 0 (1+ i)))
      ((= i 32.))
    (array:aset-n #xffffffff screen-device h)
    (array:aset-n #xffffffff screen-device (+ h (- vcmem-size-in-words 32.))))
  (loop)
  )