;;; xlib-img.el --- Imaging for Xlib.

;; Copyright (C) 2003-2005 by XWEM Org.

;; Author: Zajcev Evgeny <zevlg@yandex.ru>
;; Created: Fri Dec 12 11:22:19 MSK 2003
;; Keywords: xlib, xwem
;; X-CVS: $Id: xlib-img.el,v 1.5 2005-04-04 19:55:28 lg Exp $

;; This file is part of XWEM.

;; XWEM is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XWEM is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
;; License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;;; Synched up with: Not in FSF

;;; Commentary:

;; Introduces new data type X-Image.

;;; Code:

(require 'xlib-xlib)

(defstruct (X-Image (:predicate X-Image-isimage-p))
  width
  height
  xoffset
  format				; X-XYPixmap X-XYBitmap or X-ZPixmap
  data					; data string
  byte-order
  bitmap-scanline-unit
  bitmap-bit-order
  bitmap-scanline-pad
  depth					; depth of image
  bytes-per-line
  bits-per-pixel
  (red-mask 0)
  (green-mask 0)
  (blue-mask 0)

  ;; functions
  create-image
  get-pixel
  put-pixel
  add-pixel
  destroy-image

  plist)                                ; user defined plist

;; Plist ops
(defsubst X-Image-put-prop (ximg prop val)
  (setf (X-Image-plist ximg)
        (plist-put (X-Image-plist ximg) prop val)))
(put 'X-Image-put-prop 'lisp-indent-function 2)
(defsubst X-Image-get-prop (ximg prop)
  (plist-get (X-Image-plist ximg) prop))
(defsubst X-Image-rem-prop (ximg prop)
  (setf (X-Image-plist ximg)
        (plist-remprop (X-Image-plist ximg) prop)))

(defconst X:X-low-bits-table
  (vconcat (mapcar (lambda (el)
		     (- (Xmask el) 1))
		   '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31))))


;;; Functions
(defun X:XReverse-bytes (bp n)
  )

(defun X:-xynormalizeimagebits (bp img)
  ;; TODO:
  ;;   * write me
  (unless (= (X-Image-byte-order img) (X-Image-bitmap-bit-order img))
    (cond ((= (X-Image-bitmap-scanline-unit img) 16)
	   )

	  ((= (X-Image-bitmap-scanline-unit img) 32)
	   )
	  ))

  (when (= (X-Image-bitmap-bit-order img) X-MSBFirst)
    (X:XReverse-bytes bp (lsh (X-Image-bitmap-scanline-unit img) -3))))


(defun X:-znormalizeimagebits (bp img)
  ;; TODO:
  ;;   * write me
  (let ((bpp (X-Image-bits-per-pixel img)))
    (cond ((= bpp 4)
	   )
	  ((= bpp 16)
	   )
	  ((= bpp 24)
	   )
	  ((= bpp 32)
	   ))))

(defun X:XImageXYNormalize (bp img)
  (when (or (= (X-Image-byte-order img) X-MSBFirst)
	    (= (X-Image-bitmap-bit-order img) X-MSBFirst))
    (X:-xynormalizeimagebits bp img)))

(defun X:XImageZNormalize (bp img)
  (when (= (X-Image-byte-order img) X-MSBFirst)
    (X:-znormalizeimagebits bp img)))

(defun X:XGetPixel (img x y)
  "Return pixel of X-Image IMG at X and Y."
  (cond ((= (logior (X-Image-bits-per-pixel img) (X-Image-depth img)) 1)
	 
	 )))

(defun X:XGetBitsPerPixel (xdpy depth)
  "Return bits per pixel value."
  (let ((formats (X-Dpy-formats xdpy)))

    (while (and formats (not (= (X-ScreenFormat-depth (car formats)) depth)))
      (setq formats (cdr formats)))

    (if formats
	(X-ScreenFormat-bits-per-pixel (car formats))
      
      (cond ((<= depth 4) 4)
	    ((<= depth 8) 8)
	    ((<= depth 16) 16)
	    (t 32)))))

(defun X:XRoundUpBits (nbytes pad)
  (/ (+ nbytes (- pad 1)) (* pad (lsh pad -3))))

(defun X:XInitImageFuncs (img)
  "Initilize functions for IMG."
  (setf (X-Image-create-image img) 'XCreateImage)
  (setf (X-Image-destroy-image img) 'XDestroyImage)
  (setf (X-Image-add-pixel img) 'X:XAddPixel)

  (let ((fmt (X-Image-format img)))
    (cond ((and (= fmt X-ZPixmap) (= (X-Image-bits-per-pixel img) 8))
	   (setf (X-Image-get-pixel img) 'X:XGetPixel8)
	   (setf (X-Image-put-pixel img) 'X:XPutPixel8))

	  ((and (= (logior (X-Image-bits-per-pixel img) (X-Image-depth img)) 1)
		(= (X-Image-byte-order img) (X-Image-bitmap-bit-order img)))
	   (setf (X-Image-get-pixel img) 'X:XGetPixel1)
	   (setf (X-Image-put-pixel img) 'X:XPutPixel1))

	  ((and (= fmt X-ZPixmap) (= (X-Image-bits-per-pixel img) 32))
	   (setf (X-Image-get-pixel img) 'X:XGetPixel32)
	   (setf (X-Image-put-pixel img) 'X:XPutPixel32))
	   
	  ((and (= fmt X-ZPixmap) (= (X-Image-bits-per-pixel img) 16))
	   (setf (X-Image-get-pixel img) 'X:XGetPixel16)
	   (setf (X-Image-put-pixel img) 'X:XPutPixel16))

	  (t (setf (X-Image-get-pixel img) 'X:XGetPixel)
	     (setf (X-Image-put-pixel img) 'X:XPutPixel)))
    img))

(defun XCreateImage (xdpy visual depth format offset data width height xpad image-bytes-per-line)
  "Create new image."
  (let (img)
    (if (or (= depth 0)
	    (> depth 32)
	    (not (memq format (list X-XYBitmap X-XYPixmap X-ZPixmap)))
	    (and (= format X-XYBitmap) (not (= depth 1)))
	    (not (memq xpad '(8 16 32)))
	    (< offset 0)
	    (< image-bytes-per-line 0))
	nil				; invalid parameter

      (setq img (make-X-Image :width width :height height
			      :format format :byte-order (X-Dpy-byte-order xdpy)
			      :bitmap-scanline-unit (X-Dpy-bitmap-scanline-unit xdpy)
			      :bitmap-bit-order (X-Dpy-bitmap-bit-order xdpy)
			      :bitmap-scanline-pad xpad
			      :xoffset offset
			      :depth depth
			      :data data
			      ))

      (when (X-Visual-p visual)
	(setf (X-Image-red-mask img) (X-Visual-red-mask visual))
	(setf (X-Image-green-mask img) (X-Visual-green-mask visual))
	(setf (X-Image-blue-mask img) (X-Visual-blue-mask visual)))

      (if (= format X-ZPixmap)
	  (setf (X-Image-bits-per-pixel img) (X:XGetBitsPerPixel xdpy depth))

	;; XXX
	(setf (X-Image-bits-per-pixel img) 1))

      (if (= image-bytes-per-line 0)
	  (if (= format X-ZPixmap)
	      (setf (X-Image-bytes-per-line img)
		    (X:XRoundUpBits (* (X-Image-bits-per-pixel img) width) (X-Image-bitmap-scanline-pad img)))
	    (setf (X-Image-bytes-per-line img)
		  (X:XRoundUpBits (+ width offset) (X-Image-bitmap-scanline-pad img))))
	
	(setf (X-Image-bytes-per-line img) image-bytes-per-line))

      (X:XInitImageFuncs img)
      img)))

(defun XDestroyImage (img)
  "Destroy image IMG."
  (X-invalidate-cl-struct img))

(defun XImageGet (xdpy d x y width height)
  "On display XDPY and drawable D get image with geom +X+Y+WIDTHxHEIGHT."
  (let* ((xdata-1 (XGetImage xdpy d x y width height X-AllPlanes X-ZPixmap))
         (xdata (and (car xdata-1) (nth 4 xdata-1)))
         (tlen (length xdata))
         (coff 0)
         tline ex-mcc ximg)

    ;; Create data for XIMG
    (while (< coff tlen)
      (setq tline (cons (string2->number (substring xdata coff (+ coff 2))) tline))
      (setq coff (+ coff 2))
      (when (= (length tline) width)
        (setq ex-mcc (cons (nreverse tline) ex-mcc)
              tline nil)))
    (setq ex-mcc (nreverse ex-mcc))
    (setq xdata (mapcar #'(lambda (l)
                            (apply 'concat (mapcar 'int->string2 l)))
                        ex-mcc))

    (setq ximg (XCreateImage xdpy nil (XDefaultDepth xdpy)
                             X-ZPixmap 0 xdata width height
                             (X-Dpy-bitmap-scanline-pad xdpy) 1))
    ;; Save pixels layout
    (X-Image-put-prop ximg 'px-layout ex-mcc)
    ximg))

;; Testing (XImageGet (xwem-dpy) (xwem-cl-xwin (xwem-cl-selected)) 40 10 100 100)
;;         (XImagePut (xwem-dpy) (XDefaultGC (xwem-dpy)) (xwem-frame-xwin (nth 1 xwem-frames-list)) 30 40 ximg)

(defun XImagePut (xdpy gc d x y ximg)
  "On display XDPY and drawable D at X Y put an XIMG."
  (let (data left-pad)
    (unless (stringp (X-Image-data ximg))
      (setq data (mapconcat 'identity (X-Image-data ximg) "")))

    (if (or (= (X-Image-bits-per-pixel ximg) 1)
	    (not (= (X-Image-format ximg) X-ZPixmap)))
	(setq left-pad (% (X-Image-width ximg) 8))
      (setq left-pad 0))

    (XPutImage xdpy d gc (X-Image-depth ximg)
	       (X-Image-width ximg) (X-Image-height ximg) x y left-pad
	       (X-Image-format ximg) data)))


(provide 'xlib-img)

;;; xlib-img.el ends here