[cello-cvs] CVS cello/cl-magick
ktilton
ktilton at common-lisp.net
Wed May 17 16:14:29 UTC 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 at nyc.rr.com>"
:version "1.0.0"
:maintainer "Kenny Tilton <ktilton at 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]
More information about the Cello-cvs
mailing list