;;;-*- Mode: Lisp; Package: ccl -*-
;*********************************************************************
;*                                                                   *
;*            I M A G E     T O O L S                                *
;*                                                                   *
;*********************************************************************
;* Author       : Alexander Repenning, alexander@agentsheets.com     *
;*                http://www.agentsheets.com                         *
;* Copyright    : (c) 1996-2005, AgentSheets Inc.                    *
;* Filename     : Image-Tools.lisp                                   * 
;* Last Update  : 11/04/05                                           *
;* Version      :                                                    *
;*    1.0       : 11/04/05                                           *
;* Systems      : G4, MCL 5.0, OS X 10.4.3                           *
;* License      : LGPL                                               *
;* Abstract     : convert images and access meta information         *
;* Todos        : Move from OpenGL system into Quicktime?            *
;*                                                                   *
;*********************************************************************

(in-package :ccl)


(export '(image-file-information convert-image-file ))


(defun IMAGE-FILE-INFORMATION (Pathname) "
  in:  Pathname pathname.
  out: Width Height Depth fixnum.
  Return basic image information."
  (rlet ((&importer :handle)
         (Fsspec :fsspec))
    ;; Set File Spec
    (with-pstrs ((&name (mac-namestring (probe-file Pathname))))
      (unless (zerop (#_FSMakeFSSpec 0 0 &name Fsspec))
        (error "Invalid file reference ~A" Pathname))
      ;; Read Image dimensions and create GWorld
      (unless (zerop (#_GetGraphicsImporterForFile Fsspec &importer))
        (error "_GetGraphicsImporterForFile")))
    (let ((Importer (%get-ptr &importer))) 
      (rlet ((&ImageDescriptor :pointer))
        (#_GraphicsImportGetImageDescription Importer &ImageDescriptor)
        (#_CloseComponent Importer)
        (let ((Imagedescriptor (%get-ptr &ImageDescriptor)))
          (values 
           (rref ImageDescriptor :imagedescription.width)
           (rref ImageDescriptor :imagedescription.height)
           (rref ImageDescriptor :imagedescription.depth)))))))


(defun CONVERT-IMAGE-FILE (Source Destination &key (Width 32) (Height 32) (Depth 32) 
                                     (Pixel-Format #$k32ARGBPixelFormat)
                                     (Quicktime-File-Type #$kQTFileTypePNG)
                                     (Codec-Quality #$codecNormalQuality)) "
  in:  Source Destination Pathname; 
       &key Width fixnum default 32; Height fixnum default 32; Depth fixnum default 32; 
         Pixel-Format osType default k32ARGBPixelFormat;
         Quicktime-File-Type ostype default kQTFileTypePNG;
         Codec-Quality ostype default codecNormalQuality.
  Create a new image file of different size, format and quality."
  (rlet ((&gworld :pointer)
         (&importer :handle)
         (&exporter :pointer)
         (&inFsspec :fsspec)
         (&outFSSpec :fsspec))
    ;; Set File Spec
    (with-pstrs ((&name (mac-namestring (probe-file Source)))) 
      (unless (zerop (#_FSMakeFSSpec 0 0 &name &inFsspec))
        (error "Invalid file reference ~A" Source))
      ;; Read Image dimensions and create GWorld
      (unless (zerop (#_GetGraphicsImporterForFile &inFsspec &importer))
        (error "_GetGraphicsImporterForFile")))
    (let ((Importer (%get-ptr &importer))) 
      (rlet ((&ImageDescriptor :pointer))
        (#_GraphicsImportGetImageDescription Importer &ImageDescriptor)
        (let ((Imagedescriptor (%get-ptr &ImageDescriptor)))
          (let ((Src-Width (rref ImageDescriptor :imagedescription.width))
                (Src-Height (rref ImageDescriptor :imagedescription.height))
                (Src-Depth (rref ImageDescriptor :imagedescription.depth)))
            ;; (format t "~%-loading image ~A size: ~A x ~A, depth: ~A" Source Src-Width Src-Height Src-Depth)
            )
          ;; create the GWorld
          (let ((&Texture (#_newPtr (ceiling (* Width Height Depth) 8))))
            (rlet ((&rect :rect :topleft #@(0 0) :botright (make-point Width Height)))
              (unless (zerop (#_QTNewGWorldFromPtr &gworld (ecase Depth
                                                             (1 #$k1MonochromePixelFormat)
                                                             (24 #$k24RGBPixelFormat)
                                                             (32 #$k32ARGBPixelFormat))
                              &rect (%null-ptr) (%null-ptr) 0 &texture (ceiling (* Width Depth) 8)))
                (error "Cannot create GWorld from texture file"))
              (let* ((Gworld (%get-ptr &gworld))
                     (Pixmap-Handle (#_getGWorldPixmap Gworld)))
                (#_LockPixels Pixmap-Handle)
                ;; set port and draw image into texture buffer
                (#_GraphicsImportSetGWorld Importer Gworld (%null-ptr))
                ;; (#_GraphicsImportSetGraphicsMode Importer #$graphicsModeStraightAlpha (%null-ptr))
                (#_GraphicsImportSetBoundsRect Importer &rect)
                (#_GraphicsImportDraw Importer)
                (setq &texture (#_GetPixBaseAddr Pixmap-Handle))  ;; is this really necessary? Could memory have moved?
                ;; EXPORT: Set File Spec
                (with-pstrs ((&name (mac-namestring Destination)))
                  (let ((Error-Code (#_FSMakeFSSpec 0 0 &name &outFSSpec)))
                    ;; expect no error or file not found error (i.e. new file)
                    (unless (or (= #$noErr Error-Code) (= #$fnfErr Error-Code))
                      (error "Invalid file reference ~A" Destination))))
                (#_SetGWorld GWorld (%null-ptr))
                ;; make exporter
                (unless (zerop (#_OpenADefaultComponent #$GraphicsExporterComponentType 
                                Quicktime-File-Type &exporter))
                  (error "can't find component"))
                (let ((Exporter (%get-ptr &exporter)))
                  ;; define window port
                  (#_GraphicsExportSetInputGWorld Exporter GWorld)
                  ;; write to file
                  (#_GraphicsExportSetOutputFile Exporter &outFSSpec)
                  (#_GraphicsExportSetDepth Exporter Pixel-Format)
                  (#_GraphicsExportSetCompressionQuality Exporter Codec-Quality)
                  (#_GraphicsExportDoExport Exporter (%null-ptr))
                  (#_CloseComponent Importer)
                  (#_CloseComponent Exporter)
                  ;; wrap up GWorld stuff
                  (#_UnlockPixels (#_GetGWorldPixMap GWorld))
                  (#_DisposeGWorld GWorld)
                  (#_DisposePtr &Texture))))))))))


#| Examples:


(image-file-information (choose-file-dialog))


(convert-image-file (choose-file-dialog) (choose-new-file-dialog))

(convert-image-file (choose-file-dialog) (choose-new-file-dialog) :width 128 :height 256)

|#