[cello-cvs] CVS cello/cl-magick - cello-cvs@common-lisp.net - mailman3.common-lisp.net

17 May 2006


      Update of /project/cello/cvsroot/cello/cl-magick
In directory clnet:/tmp/cvs-serv22618/cl-magick
Added Files:
    build.lisp cl-magick.asd cl-magick.lisp cl-magick.lpr 
    drawing-wand.lisp magick-wand.lisp mgk-utils.lisp 
    pixel-wand.lisp wand-image.lisp wand-pixels.lisp 
    wand-texture.lisp 
Log Message:
CVS re-organization bringing auxiliary packages under one Cello module
--- /project/cello/cvsroot/cello/cl-magick/build.lisp	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/build.lisp	2006/05/17 16:14:29	1.1
(in-package :cl-user)
#-allegro-ide
(let ((drive "C")
      (d-force nil))
  (build-sys d-force drive "dvx" "uffi")
  (build-sys d-force drive "dvx" "ffi-extender")
  (build-sys d-force drive "dvx" "cl-opengl")
  (load (dev-root "cl-ftgl" "cl-ftgl.lisp"))
  (build-sys d-force drive "dvx" "cl-magick")
  ; (cl-magick::cl-magick-test)
  )
#+test
(cl-magick::cl-magick-test)
(in-package :cl-user)
#-allegro-ide
(let ((drive "C")
      (d-force nil))
  (build-sys d-force drive "dvx" "uffi")
  (build-sys d-force drive "dvx" "ffi-extender")
  (build-sys d-force drive "dvx" "cl-opengl")
  (load (dev-root "cl-ftgl" "cl-ftgl.lisp"))
  (build-sys d-force drive "dvx" "cl-magick")
  ; (cl-magick::cl-magick-test)
  )
#+test
(cl-magick::cl-magick-test)
--- /project/cello/cvsroot/cello/cl-magick/cl-magick.asd	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/cl-magick.asd	2006/05/17 16:14:29	1.1
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;(declaim (optimize (debug 2) (speed 1) (safety 1) (compilation-speed 1)))
(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
(in-package :asdf)
#+(or allegro lispworks cmu mcl cormanlisp sbcl scl)
(defsystem cl-magick
  :name "cl-magick"
  :author "Kenny Tilton ktilton@nyc.rr.com"
  :version "1.0.0"
  :maintainer "Kenny Tilton ktilton@nyc.rr.com"
  :licence "MIT"
  :description "Bindings for ImageMagick"
  :long-description "Poorly implemented bindings to half of ImageMagick"
  :components ((:file "cl-magick")
               (:file "magick-wand" :depends-on ("cl-magick"))
               (:file "drawing-wand" :depends-on ("magick-wand"))
               (:file "pixel-wand" :depends-on ("drawing-wand"))
               (:file "mgk-utils" :depends-on ("pixel-wand"))
               (:file "wand-image" :depends-on ("mgk-utils"))
               (:file "wand-texture" :depends-on ("wand-image"))
               (:file "wand-pixels" :depends-on ("wand-texture"))
               (:file "mgk-test" :depends-on ("wand-pixels"))))
--- /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lisp	2006/05/17 16:14:29	1.1
;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-magick; -*-
;;;
;;; Copyright © 2004 by Kenneth William Tilton.
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining a copy 
;;; of this software and associated documentation files (the "Software"), to deal 
;;; in the Software without restriction, including without limitation the rights 
;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 
;;; copies of the Software, and to permit persons to whom the Software is furnished 
;;; to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be included in 
;;; all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 
;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 
;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 
;;; IN THE SOFTWARE.
(defpackage :cl-magick
    (:nicknames :mgk)
    (:use
     #:common-lisp
     #-(or cormanlisp ccl) #:clos
     #:hello-c
     #:ffx
     #+cl-opengl
     #:cl-opengl ;; wands as opengl textures
     )
  (:export #:wand-manager #:wand-ensure-typed
    #:wands-clear #:wand-pixels #:wand-texture 
    #:wand-render
    #:image-size #:wand-texture-activate #:xim
    #:magick-get-image-width #:magick-get-image-height #:magick-get-image-pixels
    #:new-magick-wand #:magick-read-image #:magick-flip-image #:wand-get-image-pixels
    #:path-to-wand #:mgk-wand-images-write
    #:magick-wand-template))
(eval-when (:compile-toplevel :load-toplevel :execute)
  (pushnew :cl-magick *features*))
(in-package :cl-magick)
(defun magick-wand-template ()
  (path-to-wand
   (make-pathname
     :directory '(:absolute "0dev" "user"
                   "graphics" "templates")
     :name "metal" :type "gif")))
(defparameter *imagick-dll-loaded* nil)
(defparameter *wands-loaded* nil)
(defparameter *mgk-version* (fgn-alloc :unsigned-long 1))
(cffi:define-foreign-library Magick
    (:darwin (:framework "GraphicsMagick"))
  (:windows (:or #+not "C:\Program Files\ImageMagick-6.2.7-Q8\CORE_RL_wand_.dll"
              "C:\Program Files\GraphicsMagick-1.1.7-Q8\CORE_RL_wand_.dll")))
(eval-when (load eval)
  (cffi:use-foreign-library magick))
;-------------------------------------------------------------------
(defun cl-magick-init ()
  (or *imagick-dll-loaded*
    (progn
      ;(print "clearing magick wands")
      ;(wands-clear)
(assert (setq *imagick-dll-loaded* t
                  #+not (cffi:use-foreign-library magick))
        () "Unable to load imagick" )
      (print `(magick-copyright ,(magick-get-copyright)))
      (print `(magick-version ,(magick-get-version *mgk-version*)))
      *imagick-dll-loaded*)))
#+test
(cl-magick-init)
(defun wands-loaded () *wands-loaded*)
(DEFUN (setf wands-loaded) (new-value)
  (setf *wands-loaded* new-value))
(defun wands-clear ()
  (loop for wand in *wands-loaded*
        do (wand-release (cdr wand)))
  (setf *wands-loaded* nil))
(defun wand-ensure-typed (wand-type file-path$ &rest iargs)
  (when file-path$
    (cl-magick-init)
    (let ((key (list* wand-type (namestring file-path$) iargs)))
      (or (let ((old nil #+nope (cdr (assoc key (wands-loaded) :test 'equal)))) ;;/// primitive test
            (when old
              (print `(wand-ensure-typed re-using prior load ,wand-type ,file-path$)))
            old)
        (let ((wi (apply 'make-instance wand-type
                    :file-path$ file-path$
                    iargs)))
          (print `(wand-ensure-typed forced to load ,wand-type ,file-path$))
          (push (cons key wi) (wands-loaded))
          wi)
        (error "Unable to load image file ~a" file-path$)))))
#+allegro
(defun xim ()
  (wands-clear)
  (dolist (dll (ff:list-all-foreign-libraries))
    (when (search "wand" (pathname-name dll))
      (print `(unloading foreign library ,dll))
      (setf *imagick-dll-loaded* nil)
      (ff:unload-foreign-library dll))))
--- /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/cl-magick.lpr	2006/05/17 16:14:29	1.1
;; -*- lisp-version: "8.0 [Windows] (May 5, 2006 15:39)"; cg: "1.81"; -*-
(in-package :cg-user)
(defpackage :CL-MAGICK)
(define-project :name :cl-magick
  :modules (list (make-instance 'module :name "cl-magick.lisp")
                 (make-instance 'module :name "magick-wand.lisp")
                 (make-instance 'module :name "drawing-wand.lisp")
                 (make-instance 'module :name "pixel-wand.lisp")
                 (make-instance 'module :name "mgk-utils.lisp")
                 (make-instance 'module :name "wand-image.lisp")
                 (make-instance 'module :name "wand-texture.lisp")
                 (make-instance 'module :name "wand-pixels.lisp"))
  :projects (list (make-instance 'project-module :name
                                 "..\cl-opengl\cl-opengl"))
  :libraries nil
  :distributed-files nil
  :internally-loaded-files nil
  :project-package-name :cl-magick
  :main-form nil
  :compilation-unit t
  :verbose nil
  :runtime-modules nil
  :splash-file-module (make-instance 'build-module :name "")
  :icon-file-module (make-instance 'build-module :name "")
  :include-flags '(:local-name-info)
  :build-flags '(:allow-debug :purify)
  :autoload-warning t
  :full-recompile-for-runtime-conditionalizations nil
  :default-command-line-arguments "+cx +t "Initializing""
  :additional-build-lisp-image-arguments '(:read-init-files nil)
  :old-space-size 256000
  :new-space-size 6144
  :runtime-build-option :standard
  :on-initialization 'cl-magick::cl-magick-test
  :on-restart 'do-default-restart)
;; End of Project Definition
--- /project/cello/cvsroot/cello/cl-magick/drawing-wand.lisp	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/drawing-wand.lisp	2006/05/17 16:14:29	1.1
;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cl-magick; -*-
;;;
;;; Copyright © 2004 by Kenneth William Tilton.
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining a copy 
;;; of this software and associated documentation files (the "Software"), to deal 
;;; in the Software without restriction, including without limitation the rights 
;;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 
;;; copies of the Software, and to permit persons to whom the Software is furnished 
;;; to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be included in 
;;; all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 
;;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 
;;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 
;;; IN THE SOFTWARE.
(in-package :cl-magick)
;;;/*
;;;  ImageMagick Drawing Wand API.
;;;*/
;;;#ifndef _MAGICK_DRAWING_WAND_H
;;;#define _MAGICK_DRAWING_WAND_H
;;;
;;;#if defined(__cplusplus) || defined(c_plusplus)
;;;extern "C" {
;;;#endif
;;;
;;;#include "wand/pixel_wand.h"
;;;
;;;typedef struct _DrawingWand
;;;  *DrawContext
;;;  DrawingWand;
;;;
;;;extern WandExport char
;;;  *DrawGetClipPath( :void *DrawingWand)
;;;  *DrawGetFont( :void *DrawingWand)
;;;  *DrawGetFontFamily( :void *DrawingWand)
;;;  *DrawGetTextEncoding( :void *DrawingWand);
;;;
;;;extern WandExport ClipPathUnits
;;;  DrawGetClipUnits( :void *DrawingWand);
;;;
;;;extern WandExport DecorationType
;;;  DrawGetTextDecoration( :void *DrawingWand);
;;;
;;;extern WandExport double
;;;  DrawGetFillOpacity( :void *DrawingWand)
;;;  DrawGetFontSize( :void *DrawingWand)
;;;  *DrawGetStrokeDashArray( :void *DrawingWandunsigned long *)
;;;  DrawGetStrokeDashOffset( :void *DrawingWand)
;;;  DrawGetStrokeOpacity( :void *DrawingWand)
;;;  DrawGetStrokeWidth( :void *DrawingWand);
;;;
;;;extern WandExport DrawInfo
;;;  *DrawPeekGraphicContext( :void *DrawingWand);
;;;
(defun-ffx (* :void) "imagick" "NewDrawingWand" ())
;;;extern WandExport DrawingWand
;;;  *DrawAllocateWand( DrawInfo *Image *)
;;;  *NewDrawingWand(void);
;;;
;;;extern WandExport FillRule
;;;  DrawGetClipRule( :void *DrawingWand)
;;;  DrawGetFillRule( :void *DrawingWand);
;;;
;;;extern WandExport GravityType
;;;  DrawGetGravity( :void *DrawingWand);
;;;
;;;extern WandExport LineCap
;;;  DrawGetStrokeLineCap( :void *DrawingWand);
;;;
;;;extern WandExport LineJoin
;;;  DrawGetStrokeLineJoin( :void *DrawingWand);
;;;
;;;extern WandExport StretchType
;;;  DrawGetFontStretch( :void *DrawingWand);
;;;
;;;extern WandExport StyleType
;;;  DrawGetFontStyle( :void *DrawingWand);
;;;
;;;extern WandExport :unsigned-int
;;;  DrawGetStrokeAntialias( :void *DrawingWand)
;;;  DrawGetTextAntialias( :void *DrawingWand)
;;;  DrawRender( :void *DrawingWand);
;;;
;;;extern WandExport :unsigned-long
;;;  DrawGetFontWeight( :void *DrawingWand)
;;;  DrawGetStrokeMiterLimit( :void *DrawingWand);
;;;
(ffx::defun-ffx-multi :void "imagick"
;;;  DrawAffine(:void *DrawingWand AffineMatrix *)
;;;  DrawAnnotation(:void *DrawingWand double double :unsigned-char *)
;;;  DrawArc(:void *DrawingWand double double double double
;;;     double double)
;;;  DrawBezier(:void *DrawingWand :unsigned-long PointInfo *)
;;;  DrawCircle(:void *DrawingWand double double double double)
;;;  DrawColor(:void *DrawingWand double double PaintMethod)
;;;  DrawComment(:void *DrawingWand char *)
;;;  DestroyDrawingWand(:void *DrawingWand)
  "DrawEllipse" (:void *drawingwand :double ox :double oy :double rx :double ry
                  :double start-angle :double end-angle)
;;;  DrawComposite(:void *DrawingWand CompositeOperator double double
;;;     double double Image *)
;;;  DrawGetFillColor( :void *DrawingWandPixelWand *)
;;;  DrawGetStrokeColor( :void *DrawingWandPixelWand *)
;;;  DrawGetTextUnderColor( :void *DrawingWandPixelWand *)
;;;  DrawLine(:void *DrawingWand double  double double double)
;;;  DrawMatte(:void *DrawingWand double double PaintMethod)
;;;  DrawPathClose(:void *DrawingWand)
;;;  DrawPathCurveToAbsolute(:void *DrawingWand double double double
;;;     double double double)
;;;  DrawPathCurveToRelative(:void *DrawingWand double double double
;;;     double double  double)
;;;  DrawPathCurveToQuadraticBezierAbsolute(:void *DrawingWand double
;;;     double double double)
;;;  DrawPathCurveToQuadraticBezierRelative(:void *DrawingWand double
;;;     double double double)
;;;  DrawPathCurveToQuadraticBezierSmoothAbsolute(:void *DrawingWand double
;;;     double)
;;;  DrawPathCurveToQuadraticBezierSmoothRelative(:void *DrawingWand double
;;;     double)
;;;  DrawPathCurveToSmoothAbsolute(:void *DrawingWand double double
;;;     double double)
;;;  DrawPathCurveToSmoothRelative(:void *DrawingWand double double
;;;     double double)
;;;  DrawPathEllipticArcAbsolute(:void *DrawingWand double double
;;;     double:unsigned-int:unsigned-int double double)
;;;  DrawPathEllipticArcRelative(:void *DrawingWand double double
;;;     double:unsigned-int:unsigned-int double double)
;;;  DrawPathFinish(:void *DrawingWand)
;;;  DrawPathLineToAbsolute(:void *DrawingWand double double)
;;;  DrawPathLineToRelative(:void *DrawingWand double double)
;;;  DrawPathLineToHorizontalAbsolute(:void *DrawingWand double)
;;;  DrawPathLineToHorizontalRelative(:void *DrawingWand double)
;;;  DrawPathLineToVerticalAbsolute(:void *DrawingWand double)
;;;  DrawPathLineToVerticalRelative(:void *DrawingWand double)
;;;  DrawPathMoveToAbsolute(:void *DrawingWand double double)
;;;  DrawPathMoveToRelative(:void *DrawingWand double double)
;;;  DrawPathStart(:void *DrawingWand)
;;;  DrawPoint(:void *DrawingWand double double)
;;;  DrawPolygon(:void *DrawingWand :unsigned-long PointInfo *)
;;;  DrawPolyline(:void *DrawingWand :unsigned-long PointInfo *)
;;;  DrawPopClipPath(:void *DrawingWand)
;;;  DrawPopDefs(:void *DrawingWand)
;;;  DrawPopGraphicContext(:void *DrawingWand)
;;;  DrawPopPattern(:void *DrawingWand)
;;;  DrawPushClipPath(:void *DrawingWand char *)
;;;  DrawPushDefs(:void *DrawingWand)
;;;  DrawPushGraphicContext(:void *DrawingWand)
;;;  DrawPushPattern(:void *DrawingWand char * double double
;;;     double double)
;;;  DrawRectangle(:void *DrawingWand double double double
;;;     double)
;;;  DrawRotate(:void *DrawingWand double)
;;;  DrawRoundRectangle(:void *DrawingWanddoubledoubledoubledoubledoubledouble)
;;;  DrawScale(:void *DrawingWand double double)
;;;  DrawSetClipPath(:void *DrawingWand char *)
;;;  DrawSetClipRule(:void *DrawingWand FillRule)
;;;  DrawSetClipUnits(:void *DrawingWand ClipPathUnits)
;;;  DrawSetFillColor(:void *DrawingWand PixelWand *)
;;;  DrawSetFillOpacity(:void *DrawingWand double)
;;;  DrawSetFillRule(:void *DrawingWand FillRule)
;;;  DrawSetFillPatternURL(:void *DrawingWand char *)
;;;  DrawSetFont(:void *DrawingWand char *)
;;;  DrawSetFontFamily(:void *DrawingWand char *)
;;;  DrawSetFontSize(:void *DrawingWand double)
;;;  DrawSetFontStretch(:void *DrawingWand StretchType)
;;;  DrawSetFontStyle(:void *DrawingWand StyleType)
;;;  DrawSetFontWeight(:void *DrawingWand :unsigned-long)
;;;  DrawSetGravity(:void *DrawingWand GravityType)
;;;  DrawSkewX(:void *DrawingWand double)
;;;  DrawSkewY(:void *DrawingWand double)
;;;  DrawSetStrokeAntialias(:void *DrawingWand :unsigned-int)
;;;  DrawSetStrokeColor(:void *DrawingWand PixelWand *)
;;;  DrawSetStrokeDashArray(:void *DrawingWand :unsigned-long double *)
[21 lines skipped]
--- /project/cello/cvsroot/cello/cl-magick/magick-wand.lisp	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/magick-wand.lisp	2006/05/17 16:14:29	1.1
[357 lines skipped]
--- /project/cello/cvsroot/cello/cl-magick/mgk-utils.lisp	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/mgk-utils.lisp	2006/05/17 16:14:29	1.1
[457 lines skipped]
--- /project/cello/cvsroot/cello/cl-magick/pixel-wand.lisp	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/pixel-wand.lisp	2006/05/17 16:14:29	1.1
[555 lines skipped]
--- /project/cello/cvsroot/cello/cl-magick/wand-image.lisp	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/wand-image.lisp	2006/05/17 16:14:29	1.1
[665 lines skipped]
--- /project/cello/cvsroot/cello/cl-magick/wand-pixels.lisp	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/wand-pixels.lisp	2006/05/17 16:14:29	1.1
[740 lines skipped]
--- /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp	2006/05/17 16:14:29	NONE
+++ /project/cello/cvsroot/cello/cl-magick/wand-texture.lisp	2006/05/17 16:14:29	1.1
[875 lines skipped]