;;;
;;; video.lisp
;;;
;;; X Windows video interface
;;;

(in-package :neth)

(defvar *vid-display* nil "The X display")
(defvar *vid-screen* nil "The X screen")
(defvar *vid-window* nil "Our output window")
(defvar *vid-gc* nil "Our graphics context")
(defvar *vid-colormap* nil "Our colormap")
(defvar *vid-depth* 0 "The display depth of our window")
(defvar *vid-buffer* nil "Our display buffer")
(defvar *vid-palette-low* (make-array 64 :element-type '(unsigned-byte 8)) "8-bit palette and 16-bit palette lower bytes")
(defvar *vid-palette-high* (make-array 64 :element-type '(unsigned-byte 8)) "16-bit palette upper bytes")
(defvar *vid-palette-24* (make-array 64 :element-type '(unsigned-byte 8)) "24-bit palette 3rd byte")
(defvar *vid-palette-32* (make-array 64 :element-type '(unsigned-byte 8)) "32-bit palette 4th byte")
(defvar *vid-setpel* nil "Pixel setting function")


(defun video-initialize ()
  (setf *vid-display* (xlib:open-display "localhost" :display 10))
  (setf *vid-screen* (first (xlib:display-roots *vid-display*)))
  (setf *vid-window* (xlib:create-window :parent (xlib:screen-root *vid-screen*) :class :input-output :x 0 :y 0 :width 256 :height 240 :border-width 1))
  (setf *vid-gc* (xlib:create-gcontext :drawable *vid-window*))
  (setf *vid-depth* (xlib:drawable-depth *vid-window*))
  (setf *vid-colormap* (xlib:screen-default-colormap *vid-screen*))
  (xlib:set-wm-properties *vid-window* :min-width 256 :max-width 256 :min-height 240 :max-height 240 :name "Neth - Stopped")
  (xlib:map-window *vid-window*)
  (xlib:display-finish-output *vid-display*))

(defun video-display ()
  (xlib:put-raw-image *vid-window* *vid-gc* *vid-buffer* :depth *vid-depth*
		      :x 0 :y 0 :width 256 :height 240 :format :z-pixmap)
  (xlib:display-finish-output *vid-display*))

(defun video-putpel-8 (scanline offset color)
  (setf (aref *vid-buffer* (+ scanline offset)) (aref *vid-palette-low* color)))

(defun video-putpel-16 (scanline offset color)
  (setf (aref *vid-buffer* (+ scanline scanline offset 0)) (aref *vid-palette-low*  color))
  (setf (aref *vid-buffer* (+ scanline scanline offset 1)) (aref *vid-palette-high* color)))

(defun video-putpel-32 (scanline offset color)
  (setf (aref *vid-buffer* (+ scanline scanline scanline scanline offset 0)) (aref *vid-palette-low*  color))
  (setf (aref *vid-buffer* (+ scanline scanline scanline scanline offset 1)) (aref *vid-palette-high* color))
  (setf (aref *vid-buffer* (+ scanline scanline scanline scanline offset 2)) (aref *vid-palette-24*  color))
  (setf (aref *vid-buffer* (+ scanline scanline scanline scanline offset 3)) (aref *vid-palette-32* color)))

(defun video-init-buffer ()
  (let ((bpp (case *vid-depth*
	       (8 (setf *vid-setpel* #'video-putpel-8) 8)
	       (16 (setf *vid-setpel* #'video-putpel-16) 16)
	       (24 (setf *vid-setpel* #'video-putpel-32) 32)
	       (32 (setf *vid-setpel* #'video-putpel-32) 32))))
    (setf *vid-buffer* (make-array (* 256 240 bpp) :element-type '(unsigned-byte 8))))
  (values))

(defun video-init-palette (reds greens blues)
  (dotimes (i 64)
    (let ((color (xlib:alloc-color *vid-colormap*
				   (xlib:make-color :reg (aref reds i)
						    :green (aref greens i)
						    :blue (aref blues i)))))
      (setf (aref *vid-palette-low* i) (ldb (byte 8 0) color))
      (setf (aref *vid-palette-high* i) (ldb (byte 8 8) color))
      (setf (aref *vid-palette-24* i) (ldb (byte 8 16) color))
      (setf (aref *vid-palette-32* i) (ldb (byte 8 24) color)))))

#|
(map '(vector float 64) (lambda (x) (/ x 255)) )
#(    139   0   0  90 106 123 139 123 106  90   0   0   0    0 0 0
    205  67  67 133 152 171 205 171 152 133  67  67  67    0 0 0
    238  90  90 154 182 210 238 210 182 154  90  90  90    0 0 0
    255 135 135 165 195 225 255 225 195 165 135 135 135    0 0 0
)

#(    139  90   0   0   0   0   0  90 106 123 139 123 106    0 0 0
    205 133  67  67  67  67  67 133 152 171 205 171 152    0 0 0
    238 154  90  90  90  90  90 154 182 210 238 210 182    0 0 0
    255 165 135 135 135 135 135 165 195 225 255 225 195    0 0 0
)

#(    139 123 139 123 106  90   0   0   0   0   0  90 106    0 0 0
    205 171 205 171 152 133  67  67  67  67  67 133 152    0 0 0
    238 210 238 210 182 154  90  90  90  90  90 154 182    0 0 0
    255 225 255 225 195 165 135 135 135 135 135 165 195    0 0 0
)
|#

(defvar +nespal-reds+ #(139/255 0 0 6/17 106/255 41/85 139/255 41/85 106/255
				6/17 0 0 0 0 0 0 41/51 67/255 67/255 133/255
				152/255 57/85 41/51 57/85 152/255 133/255
				67/255 67/255 67/255 0 0 0 14/15 6/17 6/17
				154/255 182/255 14/17 14/15 14/17 182/255
				154/255 6/17 6/17 6/17 0 0 0 1 9/17 9/17
				11/17 13/17 15/17 1 15/17 13/17 11/17 9/17
				9/17 9/17 0 0 0))

(defvar +nespal-greens+ #(139/255 6/17 0 0 0 0 0 6/17 106/255 41/85 139/255
				  41/85 106/255 0 0 0 41/51 133/255 67/255
				  67/255 67/255 67/255 67/255 133/255 152/255
				  57/85 41/51 57/85 152/255 0 0 0 14/15
				  154/255 6/17 6/17 6/17 6/17 6/17 154/255
				  182/255 14/17 14/15 14/17 182/255 0 0 0 1
				  11/17 9/17 9/17 9/17 9/17 9/17 11/17 13/17
				  15/17 1 15/17 13/17 0 0 0))

(defvar +nespal-blues+ #(139/255 41/85 139/255 41/85 106/255 6/17 0 0 0 0 0
				 6/17 106/255 0 0 0 41/51 57/85 41/51 57/85
				 152/255 133/255 67/255 67/255 67/255 67/255
				 67/255 133/255 152/255 0 0 0 14/15 14/17
				 14/15 14/17 182/255 154/255 6/17 6/17 6/17
				 6/17 6/17 154/255 182/255 0 0 0 1 15/17 1
				 15/17 13/17 11/17 9/17 9/17 9/17 9/17 9/17
				 11/17 13/17 0 0 0))

(defun video-shutdown ()
  (xlib:close-display *vid-display*))

;;; EOF
