diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..209a790 --- /dev/null +++ b/.gitignore @@ -0,0 +1,9 @@ +*.[oa] +*.cm[ioxat] +*.cmx[as] +*.so +*.opt +*.byte +*.exe +src/doc +_* diff --git a/LICENSE.txt b/LICENSE.txt index e863cd5..b2c4f8d 100644 --- a/LICENSE.txt +++ b/LICENSE.txt @@ -1,18 +1,9 @@ -Copyright (C) 2004 2005 2006 Florent Monnier +Copyright (C) 2022 Florent Monnier - This software is provided 'as-is', without any express or implied - warranty. In no event will the authors be held liable for any damages - arising from the use of this software. - - Permission is granted to anyone to use this software for any purpose, - including commercial applications, and to alter it and redistribute it - freely, subject to the following restrictions: - - 1. The origin of this software must not be misrepresented; you must not - claim that you wrote the original software. If you use this software - in a product, an acknowledgment in the product documentation would be - appreciated but is not required. - 2. Altered source versions must be plainly marked as such, and must not be - misrepresented as being the original software. - 3. This notice may not be removed or altered from any source distribution. +Permission is granted to anyone to use this software for any purpose, +including commercial applications, and to modify it and redistribute it +freely. +This software is provided "AS-IS", without any express or implied warranty. +In no event will the authors be held liable for any damages arising from +the use of this software. diff --git a/META b/META deleted file mode 100644 index 0501a34..0000000 --- a/META +++ /dev/null @@ -1,7 +0,0 @@ -name = "libMagick" -version = "0.33" -description = "OCaml interface for the libMagickCore (ImageMagick)" -license = "GPL" -requires = "bigarray" -archive(byte) = "magick.cma" -archive(native) = "magick.cmxa" diff --git a/Makefile b/Makefile index 7e19ca2..96b291f 100644 --- a/Makefile +++ b/Makefile @@ -1,147 +1,6 @@ -# +-----------------------------------------------------------------+ -# | Copyright (C) 2010 Florent Monnier | -# +-----------------------------------------------------------------+ -# | This binding aims to provide the ImageMagick methods to OCaml. | -# +-----------------------------------------------------------------+ -# | This program 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 | -# | of the License, or (at your option) any later version. | -# | | -# | This program 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. | -# | | -# | http://www.gnu.org/licenses/gpl.html | -# | | -# | You should have received a copy of the GNU General Public | -# | License along with this program; if not, | -# | write to the Free Software Foundation, Inc., | -# | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA | -# +-----------------------------------------------------------------+ - -# path to the MagickCore-config utility -MAGICK_INSTALLED_BIN := $(shell which MagickCore-config) - -MAGICK_PREFIX := $(shell $(MAGICK_INSTALLED_BIN) --prefix) - -MAGICK_CLIBS := $(shell $(MAGICK_INSTALLED_BIN) --libs) - -MAGICK_CLIBS_ := $(shell ocaml mlarg.ml $(MAGICK_CLIBS)) - -MAGICK_CFLAGS := $(shell $(MAGICK_INSTALLED_BIN) --cflags) - -OCAML_DIR := $(shell ocamlfind printconf stdlib) - -all: byte opt -byte: magick.cma -opt: magick.cmxa magick.cmxs - -imagemagick_wrap.o: imagemagick_wrap.c imagemagick_list.h imagemagick.h - gcc -fPIC -c -I"$(OCAML_DIR)" $(MAGICK_CFLAGS) imagemagick_wrap.c - -imagemagick_list.o: imagemagick_list.c imagemagick.h - gcc -fPIC -c -I"$(OCAML_DIR)" $(MAGICK_CFLAGS) imagemagick_list.c - -dllimagemagick_stubs.so: imagemagick_wrap.o imagemagick_list.o - ocamlmklib -o imagemagick_stubs $^ $(MAGICK_CLIBS) - -magick.mli: magick.ml - ocamlc -i $< > $@ - -magick.cmi: magick.mli - ocamlc -c $< - -magick.cmo: magick.ml magick.cmi - ocamlc -c $< - -magick.cma: magick.cmo dllimagemagick_stubs.so - ocamlc -a -o $@ $< -dllib -limagemagick_stubs $(MAGICK_CLIBS_) - -magick.cmx: magick.ml magick.cmi - ocamlopt -c $< - -magick.cmxa: magick.cmx dllimagemagick_stubs.so - ocamlopt -a -o $@ $< -cclib -limagemagick_stubs $(MAGICK_CLIBS_) - -magick.cmxs: magick.cmxa dllimagemagick_stubs.so - ocamlopt -shared -linkall -I ./ -o $@ $< -cclib -limagemagick_stubs $(MAGICK_CLIBS_) - -# ocamlopt -shared -linkall -I /usr/local/lib/ocaml/3.12.1/libMagick -o /usr/local/lib/ocaml/3.12.1/libMagick/magick.cmxs /usr/local/lib/ocaml/3.12.1/libMagick/libimagemagick_stubs.a /usr/local/lib/ocaml/3.12.1/libMagick/magick.cmxa - -clean: - rm -f *.[oa] *.so *.cm[ixoa] *.cmx[as] - +all: + $(MAKE) -C src all +opt: + $(MAKE) -C src opt install: - ocamlfind install magick META \ - magick.mli \ - magick.cmi \ - magick.cma \ - magick.cmxa \ - magick.cmxs \ - magick.a \ - dllimagemagick_stubs.so \ - libimagemagick_stubs.a - -uninstall: - ocamlfind remove magick - -IMAGE := image.png - -test: - @echo - @echo " Press Q to close images" - @echo - ocaml bigarray.cma magick.cma ./examples/example_01.ml $(IMAGE) - ocaml bigarray.cma magick.cma ./examples/example_02.ml $(IMAGE) - ocaml bigarray.cma magick.cma ./examples/example_03.ml $(IMAGE) - ocaml bigarray.cma magick.cma ./examples/example_thumbnail.ml $(IMAGE) - ocaml bigarray.cma magick.cma ./examples/example_compression.ml $(IMAGE) - ocaml bigarray.cma magick.cma ./examples/drawing.ml - @echo -# @touch ./examples/.t - -doc: magick.mli - if [ ! -d $@ ]; then mkdir $@ ; fi - ocamldoc $< -colorize-code -html -d $@ -clean-doc: - rm -f doc/* - rmdir doc/ - -DIST_VERSION := 0.33 -DIST_DIR := OCaml-ImageMagick-$(DIST_VERSION) -EXEMPLE_DIR := $(DIST_DIR)/examples - -dist: - mkdir -p $(DIST_DIR) - cp \ - README.txt \ - LICENSE_GPL.txt \ - Makefile \ - imagemagick.h \ - imagemagick_list.c \ - imagemagick_list.h \ - imagemagick_wrap.c \ - magick.ml \ - magick.mli \ - mlarg.ml \ - image.png \ - $(DIST_DIR)/ - sed -i -e "s/@VERSION@/$(DIST_VERSION)/g" $(DIST_DIR)/imagemagick.h - sed -e 's/@VERSION@/$(DIST_VERSION)/' META > $(DIST_DIR)/META - mkdir -p $(EXEMPLE_DIR) - cp \ - examples/example_01.ml \ - examples/example_02.ml \ - examples/example_03.ml \ - examples/example_compression.ml \ - examples/example_thumbnail.ml \ - examples/drawing.ml \ - $(EXEMPLE_DIR)/ - tar cf $(DIST_DIR).tar $(DIST_DIR) - gzip --best $(DIST_DIR).tar - mv $(DIST_DIR).tar.gz $(DIST_DIR).tgz - ls -l $(DIST_DIR).tgz - -.PHONY: all opt byte clean clean-doc dist install uninstall + $(MAKE) -C src install diff --git a/README.txt b/README.txt index 0ecc61d..7c592ce 100644 --- a/README.txt +++ b/README.txt @@ -1,158 +1,94 @@ WHAT: - This binding is an ImageMagick interface for Objective Caml. + GraphicsMagick bindings for OCaml. AUTHOR: - Copyright (C) 2004 2005 2006 2010 Florent Monnier + Copyright (C) 2022 Florent Monnier NOTICE: - "ImageMagick" is a registered trademark owned by ImageMagick Studio LLC - http://tarr.uspto.gov/servlet/tarr?regser=serial&entry=78333969 + We switched these bindings from ImageMagick to GraphicsMagick + because GraphicsMagick is beleaved to be a fork with a more stable API. REQUISITES: - Objective Caml, which can be obtained from: - - http://caml.inria.fr/ocaml/ - ImageMagick, which you will find at: - - http://www.imagemagick.org/script/download.php + OCaml, which can be obtained from: + https://ocaml.org/ + A build environment with: - - bash, make, sed, install + - bash, make + + And ocamlfind to install. + + GraphicsMagick, which you can find at: + http://www.graphicsmagick.org/ + + Or on debian / chrome-book: + sudo apt-get install graphicsmagick + sudo apt-get install libgraphicsmagick-dev + + On Mageia: + su - -c 'urpmi graphicsmagick libgraphicsmagick3 libgraphicsmagick-devel' VERSIONS: This binding (this current verison) has been tested with OCaml version - '3.11.2' and ImageMagick version '6.6.1-5'. - Previous versions of this binding have been tested with OCaml versions - '3.08.4', '3.09.0', '3.09.2' and '3.11.1' and ImageMagick versions - '6.2.4', '6.2.5', '6.2.6' and '6.5.7'. - The old versions of this binding are still available at: - http://www.linux-nantes.fr.eu.org/~fmonnier/OCaml/IM-old.php - Please report success or failure with other versions. - If you encounter problems to compile from sources, email me and - I will make a static binary available. + '4.14.0' and GraphicsMagick versions '1.3.35', '1.3.36'. -BETA: - The interface to ImageMagick for OCaml is still in beta developement - and I have had very few feedback about success or failure from users yet, - so you should consider it as experimental and use it at your own risks! - Be warn that the name of the functions and the labeling may change too, - and you can also make requests for changes. - -BUGS: - As I don't want you to be afraid by theese, I have put the bugs - descriptions at the end of this file :-) + Please report success or failure with other versions. INSTALL: Run "make" to build the library, and "make install" to install it. -STATIC: - If you wish a static version, just follow the instructions in the Makefile. -TEST: - Run "make test" to run the examples in the 'examples' directory, - or "make test IMAGE=some_img.png" with an other black and white image - or logo. +OPAM: + Install with opam with the command: + opam install . --working-dir + DOCUMENTATION: Run "make doc" to produce the HTML documentation. You can also find the html documentation of the last release at: - http://www.linux-nantes.org/~fmonnier/OCaml/ImageMagick/IM-doc/ - -THREADS: - For threads issues, read this: - http://www.imagemagick.org/script/architecture.php#threads - -TODO: - Next steps with OCaml-libMagick will be to improve the functional module. - Enhance the scripts to generate the 'imagemagick_list.c' file. - Wrapping not just the MagickCore but the MagickWand API too (well maybe...) - Trying to make this interface compatible with GraphicsMagick. - Use the OCaml BigArray module to improve the interoperability between - the OCaml and the ImageMagick worlds. - -WIZARD: - If you wish to thank the author of ImageMagick, you can consider sending - to him a picture postcard of the area where you live. Send postcards to: - ImageMagick Studio LLC - P.O. Box 40 - Landenberg, PA 19350 - USA - He is also interested in receiving currency or stamps from around the world - for his collection. - -THANKS: - Thanks to Matthieu Dubuget for his help to write the first Makefile with - OCamlMakefile, and for his help to resolve the dependencies of compilation. - Thanks to John Cristy for answering ALL my questions about the MagickCore API. - Thanks to Fabrice Le Fessant for having found bugs - with allocated values not registered with CAMLlocal. - Thanks to Christophe Troestler for his help - with big arrays. - Thanks to Bruspal for his book about the C language. - Thanks to all the guys of fr.comp.lang.caml who have answered to my questions. - Thanks to the authors of Objective Caml for this wonderfull language and - thanks to the authors of ImageMagick for this wonderfull library. - - - -HOW TO USE IN THE BUILD DIRECTORY: - Use in byte-code: - ocamlc bigarray.cma magick.cma test.ml -o test.run - - Use in native-code: - ocamlopt bigarray.cmxa magick.cmxa test.ml -o test.opt - - Use in interactive-mode: - ocaml bigarray.cma magick.cma - - Use in script-mode: - ocaml bigarray.cma magick.cma test.ml image.png - or - chmod u+x test.ml - ./test.ml image.png - with the 2 first lines: - #!/usr/bin/env ocaml - #load "magick.cma" + http://decapode314.free.fr/ocaml/GraphicsMagick/doc/ HOW TO USE WITH THIS LIBRARY INSTALLED: Use in byte-code: - ocamlc -I +libMagick bigarray.cma magick.cma test.ml -o test.run + ocamlc -I $(ocamlfind query magick) magick.cma test.ml -o test.byte Use in native-code: - ocamlopt -I +libMagick bigarray.cma magick.cmxa test.ml -o test.opt + ocamlopt -I $(ocamlfind query magick) magick.cmxa test.ml -o test.opt Use in interactive-mode: - ocaml -I +libMagick bigarray.cma magick.cma + ocaml -I $(ocamlfind query magick) magick.cma Use in script-mode: - ocaml -I +libMagick bigarray.cma magick.cma test.ml image.png + ocaml -I $(ocamlfind query magick) magick.cma test.ml or chmod u+x test.ml ./test.ml image.png with the 3 first lines: #!/usr/bin/env ocaml - #directory "+libMagick" ;; - #load "magick.cma" ;; + #directory "+magick" + #load "magick.cma" LICENSE: - This library is distributed under the terms of the zlib license: - - This software is provided 'as-is', without any express or implied - warranty. In no event will the authors be held liable for any damages - arising from the use of this software. + This library is distributed under the terms of the Zlib license: Permission is granted to anyone to use this software for any purpose, - including commercial applications, and to alter it and redistribute it + including commercial applications, and to modify it and redistribute it freely. + This software is provided "AS-IS", without any express or implied + warranty. In no event will the authors be held liable for any damages + arising from the use of this software. + You should have received a copy of the Zlib license along with this program in the file 'LICENSE.txt'; if not, you can find it on the web at: @@ -160,30 +96,6 @@ LICENSE: -KNOWN BUGS: - MINOR: - Images added into image lists are pointers, so if the image is not used - after it has been added into the list it could be garbage collected while - the list still points to it. As a temporary fix, use the function no_op - (see the documentation for more details). - - MAJOR: - The DrawInfo structure is not freed with DestroyDrawInfo() at the end of - the draw_* functions, because it sometimes produces segfaults, I don't - know why, in fact it should not, so I have leaved the DestroyDrawInfo() - calls commented in the source, but perhaps this could lead to a memory - leak, but I have never experienced such a problem yet though, even with - big long time living scripts with lots of images loaded. - It is possible to enable the free() of the (DrawInfo *) structures with - setting MAKE_DESTROY_DRAWINFO to 1. - Please report success or failure related to this issue. - - MEDIUM: - Imper in french sounds close to "impaire" which could be understood like - odd or the cloth you wear when it's raining out, so you can stay behind - the computer ;) - If you really prefer fun programming, you won't understand why this part - of the binding, since for imperative the wand api should be chosen. - When to fix all this arround, just put your hands in ;) - +BUGS: + Please report bugs. diff --git a/examples/drawing.ml b/examples/drawing.ml deleted file mode 100755 index eed3d1a..0000000 --- a/examples/drawing.ml +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/env ocaml -#load "magick.cma" -open Magick -open Imper - -let () = - let img = get_canvas ~width:400 ~height:300 ~color:"#C8E0FF" in - -(* The clouds *) - List.iter (fun (cx, cy) -> - draw_ellipse img ~cx ~cy - ~rx:50 ~ry:20 ~fill_color:(color_of_string "#FFFB") () - ) [ (20, 40); (60, 55); (90, 30); (120, 65); (175, 35); ]; - -(* The hills *) - let path = "M -10 300 L -10 230 C 160 258 188 190 275 188 C 320 188 382 200 410 220 L 410 300" in - draw_path img ~path - ~fill_color:(color_of_string "#7C80") - ~stroke_color:(color_of_string "#4A70") - ~stroke_width:4.0 (); - -(* The building, and its door *) - List.iter (fun (coords, fill, stroke) -> - draw_polyline img ~coords - ~fill_color:(color_of_string fill) - ~stroke_color:(color_of_string stroke) - ~stroke_width:7.0 - ~line_cap:ButtCap - ~line_join:MiterJoin () - ) [ ([| (240, 230); (265, 60); (305, 60); (330, 230) |], "#DCB", "#764"); - ([| (265, 230); (270, 195); (300, 195); (305, 230) |], "#CBA", "transparent") ]; - -(* Open Source logo *) - List.iter (fun (color, stroke_width) -> - draw_ellipse img - ~stroke_width - ~stroke_color:(color_of_string color) - ~fill_color:(color_of_string "transparent") - ~cx:285 ~cy:214 - ~rx:9 ~ry:9 - ~a0:115 ~a1:425 () - ) [("black", 8.2); ("green", 6.2)]; - -(* The arms *) - List.iter (fun coords -> - draw_bezier img ~coords - ~fill_color:(color_of_string "#FFF8F255") - ~stroke_color:(color_of_string "#6548") - ~stroke_width:4.0 - ~line_cap:RoundCap () - ) [ [| (180, 90); (250, 20); (320, 140); (390, 70) |]; - [| (275, -25); (345, 45); (225, 115); (295, 185) |] ]; - -(* Title *) - draw_text img ~text:"Objective Caml\nImageMagick" ~font:"" - ~x:15 ~y:168 - ~point_size:20.0 - ~stroke_width:1.0 - ~fill_color:(color_of_string "#0132") - ~stroke_color:(color_of_string "#48A6") (); - -(* Surrounding *) - draw_round_rectangle img - ~x0:(-4) ~y0:(-4) - ~x1:404 ~y1:304 - ~wc:28 ~hc:28 - ~fill_color:(color_of_string "transparent") - ~stroke_color:(color_of_string "black") - ~stroke_width:16.0 (); - - display img; - -(* vim: sw=2 sts=2 ts=2 et fdm=marker - *) diff --git a/examples/example_01.ml b/examples/example_01.ml old mode 100755 new mode 100644 index 7396b58..d551e1f --- a/examples/example_01.ml +++ b/examples/example_01.ml @@ -1,39 +1,41 @@ #!/usr/bin/env ocaml -(* #directory "+libMagick" ;; *) -#load "magick.cma" ;; -open Magick ;; -open Imper ;; - - -let argc = Array.length Sys.argv in -if (argc < 2) then begin - prerr_endline("Usage:\n" ^ Sys.argv.(0) ^ " "); - exit 1 -end -;; +#load "magick.cma" +open Magick +let () = + let argc = Array.length Sys.argv in + if (argc < 2) then begin + prerr_endline ("Usage:\n" ^ Sys.argv.(0) ^ " "); + exit 1 + end let () = - let t_img = read_image Sys.argv.(1) in - let u_img = clone_image t_img in + Magick.initialize (); + let filename = Sys.argv.(1) in + let t_img = Magick.read_image ~filename in + let u_img = Magick.clone t_img in print_endline " Here is the original image"; - display t_img; + Magick.display t_img; - blur u_img 2.4 (); - modulate u_img ~brightness:70 (); - negate u_img (); + let u_img = Magick.blur u_img ~sigma:2.4 () in + Magick.modulate u_img "70,100,100"; + Magick.negate u_img 0; print_endline " Intermediate processing"; - display u_img; + Magick.display u_img; - blur t_img 0.3 (); (* smooth the path a little *) - roll u_img 2 1; - composite_image t_img u_img Lighten (); + let t_img = Magick.blur t_img ~sigma:0.3 () in (* smooth the path a little *) + let u_img = Magick.roll u_img ~x_offset:2 ~y_offset:1 in + Magick.composite t_img u_img ~compose:CompositeOp.Lighten (); print_endline " Here is the result\n"; - display t_img; + Magick.display t_img; + + Magick.destroy_image t_img; + Magick.destroy_image u_img; + Magick.destroy (); ;; -(* vim: sw=2 ts=2 sts=2 et fdm=marker +(* vim: sw=2 ts=2 sts=2 et *) diff --git a/examples/example_02.ml b/examples/example_02.ml old mode 100755 new mode 100644 index f911cc9..558b378 --- a/examples/example_02.ml +++ b/examples/example_02.ml @@ -1,41 +1,36 @@ #!/usr/bin/env ocaml -(* #directory "+libMagick" ;; *) -#load "magick.cma" ;; -open Magick ;; -open Imper ;; - - -let argc = Array.length Sys.argv in -if (argc < 2) then begin - prerr_endline ("Usage:\n" ^ Sys.argv.(0) ^ " "); - exit 1 -end -;; +#load "magick.cma" +open Magick +let () = + let argc = Array.length Sys.argv in + if (argc < 2) then begin + prerr_endline ("Usage:\n" ^ Sys.argv.(0) ^ " "); + exit 1 + end let () = - let t_img = read_image Sys.argv.(1) in - let u_img = clone_image t_img in + Magick.initialize (); + let filename = Sys.argv.(1) in + let t_img = read_image ~filename in + let u_img = clone t_img in print_endline " Here is the original image"; display t_img; - blur u_img 2.8 (); - negate u_img (); - modulate u_img ~brightness:80 (); - negate u_img (); + let u_img = blur u_img ~sigma:2.8 () in + negate u_img 1; + modulate u_img "80,100,100"; + negate u_img 1; print_endline " Intermediate processing"; display u_img; - blur t_img 0.4 (); - negate t_img (); - roll u_img (-3) 2; - composite_image t_img u_img Lighten (); + let t_img = blur t_img ~sigma:0.4 () in + negate t_img 1; + let u_img = roll u_img ~x_offset:(-3) ~y_offset:2 in + composite t_img u_img ~compose:CompositeOp.Lighten (); print_endline " Here is the result\n"; display t_img; ;; - -(* vim: sw=2 ts=2 sts=2 et fdm=marker - *) diff --git a/examples/example_03.ml b/examples/example_03.ml old mode 100755 new mode 100644 index 15ec43b..217e112 --- a/examples/example_03.ml +++ b/examples/example_03.ml @@ -1,24 +1,24 @@ -#!/usr/bin/env ocaml -(* #directory "+libMagick" ;; *) -#load "magick.cma" ;; -open Magick ;; -open Imper ;; - - -let argc = Array.length Sys.argv in -if (argc < 2) then begin - prerr_endline ("Usage:\n" ^ Sys.argv.(0) ^ " "); - exit 1 -end +#load "magick.cma" +open Magick +open Magick.CompositeOp + +let () = + let argc = Array.length Sys.argv in + if (argc < 2) then begin + prerr_endline ("Usage:\n" ^ Sys.argv.(0) ^ " "); + exit 1 + end ;; let () = - let img_g = read_image Sys.argv.(1) in - let img_o = clone_image img_g in + Magick.initialize (); + let filename = Sys.argv.(1) in + let img_g = read_image ~filename in + let img_o = clone img_g in let width, height = - get_image_width img_g, - get_image_height img_g + (image_width img_g, + image_height img_g) in let img_h = get_canvas ~width ~height ~color:"#C13A28" in @@ -28,30 +28,28 @@ let () = print_endline " Background color"; display img_h; - blur img_g 1.2 (); + let img_g = blur img_g ~sigma:1.2 () in - negate img_g (); - modulate img_g ~brightness:60 (); - negate img_g (); - modulate img_g ~brightness:60 (); + negate img_g 1; + modulate img_g "60,100,100"; + negate img_g 1; + modulate img_g "60,100,100"; - shade img_g ~gray:MagickTrue ~azimuth:50.0 ~elevation:30.0 (); - negate img_g (); + let img_g = shade img_g ~gray:1 ~azimuth:50.0 ~elevation:30.0 in + + negate img_g 1; print_endline " Intermediate processing"; display img_g; - composite_image img_h img_g ~compose:Modulate (); + composite img_h img_g ~compose:Modulate (); print_endline " Composite"; display img_h; - blur img_o 0.3 (); - composite_image img_h img_o ~compose:Lighten (); + let img_o = blur img_o ~sigma:0.3 () in + composite img_h img_o ~compose:Lighten (); print_endline " Here is the result\n"; display img_h; ;; - -(* vim: sw=2 ts=2 sts=2 et fdm=marker - *) diff --git a/examples/example_compression.ml b/examples/example_compression.ml deleted file mode 100755 index 93d522c..0000000 --- a/examples/example_compression.ml +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/env ocaml -(* #directory "+libMagick" ;; *) -#load "magick.cma" ;; -open Magick ;; -open Imper ;; - -#load "unix.cma" ;; - - -let argc = Array.length Sys.argv in -if (argc < 2) then - begin prerr_endline ("Usage:\n" ^ Sys.argv.(0) ^ " ") ; exit 1 end -;; - - -let get_size file = - let stats = Unix.stat file in - let float_bytes_size = float_of_int stats.Unix.st_size in - let size = - if float_bytes_size > 1024.0 - then ( (Printf.sprintf "%.1f" (float_bytes_size /. 1024.0)) ^ " K") - else ( (string_of_float float_bytes_size) ) - in - size -;; - -(* -let tmp_path = "." ;; -let tmp_path = "/mnt/ramdisk" ;; -*) -let tmp_path = "/tmp" ;; - - -let compress_to quality image_handle = - let img_file = (Printf.sprintf "%s/compress-%03d.jpg" tmp_path quality) - and _img_handle = clone_image image_handle - in - set_compression_quality _img_handle quality; - write_image _img_handle img_file; - - let file_size = get_size img_file in - print_endline(Printf.sprintf "\t jpeg compression %d\tsize %s" quality file_size); - - let result = read_image img_file in - Sys.remove img_file; - display result; -;; - - -let () = - let t_img = read_image Sys.argv.(1) in - - let file_size = get_size Sys.argv.(1) in - print_endline(Printf.sprintf "\t original file size %s\n" file_size); - - compress_to 8 t_img; - compress_to 16 t_img; - compress_to 30 t_img; - compress_to 50 t_img; - compress_to 70 t_img; - compress_to 80 t_img; - compress_to 90 t_img; - compress_to 97 t_img; - compress_to 100 t_img; - - print_newline (); -;; - - - - -(* vim: sw=2 ts=2 sts=2 et fdm=marker - *) - diff --git a/examples/example_thumbnail.ml b/examples/example_thumbnail.ml deleted file mode 100755 index 1faefe8..0000000 --- a/examples/example_thumbnail.ml +++ /dev/null @@ -1,75 +0,0 @@ -#!/usr/bin/env ocaml -(* #directory "+libMagick" ;; *) -#load "magick.cma" ;; -open Magick ;; -open Imper ;; - -#load "unix.cma" ;; - - -let argc = Array.length Sys.argv in -if (argc < 2) then - begin prerr_endline ("Usage:\n" ^ Sys.argv.(0) ^ " ") ; exit 1 end -;; - -let get_size file = - let stats = Unix.stat file in - let float_bytes_size = float_of_int stats.Unix.st_size in - let size = - if float_bytes_size > 1024.0 - then ( (Printf.sprintf "%.1f" (float_bytes_size /. 1024.0)) ^ " K") - else ( (string_of_float float_bytes_size) ) - in - size -;; - -let () = - let t_img = read_image Sys.argv.(1) in - let image_type = get_image_type t_img in - - display t_img; - - let width = get_image_width t_img - and height = get_image_height t_img in - Printf.printf "\t original: width = %d height = %d\n" - width height ; - - let size = get_size Sys.argv.(1) in - print_endline (" original file size " ^ size); - - - (* Here is the maximum dimention in pixels of the resulting image: *) - let thumb = 120 in - - - let (thumb_width, thumb_height) = - if (width = height) then - (thumb, thumb) - else - if (width > height) then - (thumb, (thumb * height / width) ) - else - ((thumb * width / height) , thumb) - in - thumbnail t_img thumb_width thumb_height; - - - let new_width = get_image_width t_img - and new_height = get_image_height t_img in - Printf.printf "\t thumbnail: width = %d height = %d\n" - new_width new_height; - - set_image_type t_img image_type; - write_image t_img "/tmp/thumbnail.jpg"; - - let size = get_size "/tmp/thumbnail.jpg" in - print_endline (" thumbnail size " ^ size); - - display t_img; - - print_newline (); -;; - - -(* vim: sw=2 ts=2 sts=2 et fdm=marker - *) diff --git a/image.png b/image.png deleted file mode 100644 index 5bacf7c..0000000 Binary files a/image.png and /dev/null differ diff --git a/imagemagick.h b/imagemagick.h deleted file mode 100644 index 18bca5e..0000000 --- a/imagemagick.h +++ /dev/null @@ -1,15 +0,0 @@ - -/* Constants */ - -/* maximum amount of resources allocated */ -#define OCAML_IMAGEMAGICK_VERSION "0.33" - -/* 8 * 1024 = 8192 ;; 16 * 1024 = 16384 */ -#define MAX_AMOUNT 16384 -#define TYPE_CHECKING 0 -#define CHECK_VALS 0 -#define DEBUG 0 - - -#define CAML_FRAME 0 - diff --git a/imagemagick_list.c b/imagemagick_list.c deleted file mode 100644 index ce652d4..0000000 --- a/imagemagick_list.c +++ /dev/null @@ -1,4964 +0,0 @@ -/* {{{ COPYING - * - * +-----------------------------------------------------------------+ - * | Copyright (C) 2004 2005 2006 Florent Monnier | - * +-----------------------------------------------------------------+ - * | This binding aims to provide the ImageMagick methods to OCaml. | - * +-----------------------------------------------------------------+ - * | This software is provided 'as-is', without any express or | - * | implied warranty. In no event will the authors be held liable | - * | for any damages arising from the use of this software. | - * | | - * | Permission is granted to anyone to use this software for any | - * | purpose, including commercial applications, and to alter it and | - * | redistribute it freely. | - * +-----------------------------------------------------------------+ - * | Author: Florent Monnier | - * | Thanks to Matthieu Dubuget for his help with OCamlMakefile use. | - * +-----------------------------------------------------------------+ - * - * }}} */ - - -/* {{{ headers */ - -#include -#include -#include - -#include -#include -#include -#include -#include - -//define MAGICKCORE_EXCLUDE_DEPRECATED 1 - -#include - - -#include "imagemagick.h" - - -/* }}} */ - - -/* {{{ MagickBoolean_val() - * - * typedef enum - * { - * MagickFalse = 0, - * MagickTrue = 1 - * } MagickBooleanType; - * -static int - */ -int -MagickBoolean_val(value param) -{ -#if CAML_FRAME - CAMLparam1(param); -#endif - -#if TYPE_CHECKING - assert (Is_long(param)); -#endif - - switch (Int_val(param)) - { - case 0: return MagickFalse; - case 1: return MagickTrue; - default: -#if DEBUG - fprintf(stderr, " Error in MagickBoolean_val()\n"); fflush(stderr); - abort(); -#else - fprintf(stderr, "ImageMagick Warning: magick_boolean unrecognized, set to MagickFalse\n"); fflush(stderr); - return MagickFalse; -#endif - } -} - -/* }}} */ - - -/* {{{ imper_flipimage() - * - * Image *FlipImage(Image *image, ExceptionInfo *exception) - */ -CAMLprim value imper_flipimage( - value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = FlipImage( - (Image *) Field(image_bloc,1), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_flopimage() - * - * Image *FlopImage(Image *image, ExceptionInfo *exception) - */ -CAMLprim value imper_flopimage( - value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = FlopImage( - (Image *) Field(image_bloc,1), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_magnifyimage() - * - * Image *MagnifyImage(Image *image, ExceptionInfo *exception) - */ -CAMLprim value imper_magnifyimage( - value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = MagnifyImage( - (Image *) Field(image_bloc,1), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_minifyimage() - * - * Image *MinifyImage(Image *image, ExceptionInfo *exception) - */ -CAMLprim value imper_minifyimage( - value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = MinifyImage( - (Image *) Field(image_bloc,1), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_enhanceimage() - * - * Image *EnhanceImage(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value imper_enhanceimage( - value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = EnhanceImage( - (Image *) Field(image_bloc,1), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_trimimage() - * - * Image *TrimImage(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value imper_trimimage( - value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = TrimImage( - (Image *) Field(image_bloc,1), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_despeckle() - * - * Image *DespeckleImage(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value imper_despeckle( - value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = DespeckleImage( - (Image *) Field(image_bloc,1), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ - -/* {{{ imper_deconstructimages() - * - * Image *DeconstructImages(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value imper_deconstructimages( value image_bloc ) -{ - CAMLparam1(image_bloc); - - Image *new_image; - - ExceptionInfo exception; - - - GetExceptionInfo(&exception); - - new_image = DeconstructImages( - (Image *) Field(image_bloc,1), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ -/* {{{ imper_coalesceimages() - * - * Image *CoalesceImages(Image *image, ExceptionInfo *exception) - */ -CAMLprim value imper_coalesceimages( value image_bloc ) -{ - CAMLparam1(image_bloc); - - Image *new_image; - - ExceptionInfo exception; - - - GetExceptionInfo(&exception); - - new_image = CoalesceImages( - (Image *) Field(image_bloc,1), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ -/* {{{ imper_flattenimages() - * - * Image *FlattenImages(Image *image, ExceptionInfo *exception) - */ -CAMLprim value imper_flattenimages( value image_bloc ) -{ - CAMLparam1(image_bloc); - - Image *new_image; - - ExceptionInfo exception; - - - GetExceptionInfo(&exception); - - /* DEPR - new_image = FlattenImages( - (Image *) Field(image_bloc,1), - &exception ); - */ - - new_image = MergeImageLayers( - (Image *) Field(image_bloc,1), - FlattenLayer, - &exception ); - - /* TODO -typedef enum -{ - UndefinedLayer, - CoalesceLayer, - CompareAnyLayer, - CompareClearLayer, - CompareOverlayLayer, - DisposeLayer, - OptimizeLayer, - OptimizeImageLayer, - OptimizePlusLayer, - OptimizeTransLayer, - RemoveDupsLayer, - RemoveZeroLayer, - CompositeLayer, - MergeLayer, - FlattenLayer, - MosaicLayer, - TrimBoundsLayer -} ImageLayerMethod; - - new_image = MergeImageLayers( - (Image *) Field(image_bloc,1), - const ImageLayerMethod, - &exception ); - */ - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ - - - -/* {{{ imper_blurimage() - * - * Image *BlurImage(const Image *image, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value imper_blurimage( - value image_bloc, - value radius, - value sigma ) -{ - CAMLparam3(image_bloc, radius, sigma) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = BlurImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_radialblurimage() - * - * Image *RadialBlurImage(const Image *image, const double angle, ExceptionInfo *exception) - */ -CAMLprim value imper_radialblurimage( - value image_bloc, - value angle ) -{ - CAMLparam2(image_bloc, angle) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = RadialBlurImage( - (Image *) Field(image_bloc,1), - Double_val(angle), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_charcoalimage() - * - * Image *CharcoalImage(const Image *image, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value imper_charcoalimage( - value image_bloc, - value radius, - value sigma ) -{ - CAMLparam3(image_bloc, radius, sigma) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = CharcoalImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_edgeimage() - * - * Image *EdgeImage(const Image *image, const double radius, ExceptionInfo *exception) - */ -CAMLprim value imper_edgeimage( - value image_bloc, - value radius ) -{ - CAMLparam2(image_bloc, radius) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = EdgeImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_embossimage() - * - * Image *EmbossImage(const Image *image, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value imper_embossimage( - value image_bloc, - value radius, - value sigma ) -{ - CAMLparam3(image_bloc, radius, sigma) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = EmbossImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_gaussianblurimage() - * - * Image *GaussianBlurImage(const Image *image, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value imper_gaussianblurimage( - value image_bloc, - value radius, - value sigma ) -{ - CAMLparam3(image_bloc, radius, sigma) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = GaussianBlurImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_implodeimage() - * - * Image *ImplodeImage(const Image *image, const double amount, ExceptionInfo *exception) - */ -CAMLprim value imper_implodeimage( - value image_bloc, - value amount ) -{ - CAMLparam2(image_bloc, amount) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = ImplodeImage( - (Image *) Field(image_bloc,1), - Double_val(amount), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_medianfilterimage() - * - * Image *MedianFilterImage(const Image *image, const double radius, ExceptionInfo *exception) - */ -CAMLprim value imper_medianfilterimage( - value image_bloc, - value radius ) -{ - CAMLparam2(image_bloc, radius) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = MedianFilterImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_motionblurimage() - * - * Image *MotionBlurImage(const Image *image, const double radius ,const double sigma, const double angle, ExceptionInfo *exception) - */ -CAMLprim value imper_motionblurimage( - value image_bloc, - value radius, - value sigma, - value angle ) -{ - CAMLparam4(image_bloc, radius, sigma, angle) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = MotionBlurImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - Double_val(angle), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_oilpaintimage() - * - * Image *OilPaintImage(const Image *image, const double radius, ExceptionInfo *exception) - */ -CAMLprim value imper_oilpaintimage( - value image_bloc, - value radius ) -{ - CAMLparam2(image_bloc, radius) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = OilPaintImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_reducenoiseimage() - * - * Image *ReduceNoiseImage(Image *image, const double radius, ExceptionInfo *exception) - */ -CAMLprim value imper_reducenoiseimage( - value image_bloc, - value radius ) -{ - CAMLparam2(image_bloc, radius) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = ReduceNoiseImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_rollimage() - * - * Image *RollImage(const Image *image, const long x_offset, const long y_offset, ExceptionInfo *exception) - */ -CAMLprim value imper_rollimage( - value image_bloc, - value x_offset, - value y_offset ) -{ - CAMLparam3(image_bloc, x_offset, y_offset) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = RollImage( - (Image *) Field(image_bloc,1), - Long_val(x_offset), - Long_val(y_offset), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_shadeimage() - * - * Image *ShadeImage(const Image *image, const MagickBooleanType gray, - * const double azimuth, const double elevation, ExceptionInfo *exception) - */ -CAMLprim value imper_shadeimage( - value image_bloc, - value color_shading, - value azimuth, - value elevation ) -{ - CAMLparam4(image_bloc, color_shading, azimuth, elevation) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = ShadeImage( - (Image *) Field(image_bloc,1), - MagickBoolean_val(color_shading), - Double_val(azimuth), - Double_val(elevation), - &exception ) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_sharpenimage() - * - * Image *SharpenImage(Image *image, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value imper_sharpenimage( - value image_bloc, - value radius, - value sigma ) -{ - CAMLparam3(image_bloc, radius, sigma) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = SharpenImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_spreadimage() - * - * Image *SpreadImage(const Image *image, const double radius, ExceptionInfo *exception) - */ -CAMLprim value imper_spreadimage( - value image_bloc, - value radius ) -{ - CAMLparam2(image_bloc, radius) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = SpreadImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_swirlimage() - * - * Image *SwirlImage(const Image *image, double degrees, ExceptionInfo *exception) - */ -CAMLprim value imper_swirlimage( - value image_bloc, - value degrees ) -{ - CAMLparam2(image_bloc, degrees) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = SwirlImage( - (Image *) Field(image_bloc,1), - Double_val(degrees), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_unsharpmaskimage() - * - * Image *UnsharpMaskImage(const Image *image, const double radius, const double sigma, const double amount, const double threshold, ExceptionInfo *exception) - */ -CAMLprim value imper_unsharpmaskimage( - value image_bloc, - value radius, - value sigma, - value amount, - value threshold ) -{ - CAMLparam5(image_bloc, radius, sigma, amount, threshold) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = UnsharpMaskImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - Double_val(amount), - Double_val(threshold), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_waveimage() - * - * Image *WaveImage(const Image *image, const double amplitude, const double wave_length, ExceptionInfo *exception) - */ -CAMLprim value imper_waveimage( - value image_bloc, - value amplitude, - value wave_length ) -{ - CAMLparam3(image_bloc, amplitude, wave_length) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = WaveImage( - (Image *) Field(image_bloc,1), - Double_val(amplitude), - Double_val(wave_length), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ - -/* {{{ imper_rotateimage() - * - * Image *RotateImage(const Image *image, const double degrees, ExceptionInfo *exception) - */ -CAMLprim value imper_rotateimage( - value image_bloc, - value degrees ) -{ - CAMLparam2(image_bloc, degrees); - - Image - *new_image; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image = RotateImage( - (Image *) Field(image_bloc,1), - Double_val(degrees), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ -/* {{{ imper_shearimage() - * - * Image *ShearImage(const Image *image, const double x_shear, const double y_shear, ExceptionInfo *exception) - */ -CAMLprim value imper_shearimage( - value image_bloc, - value x_shear, - value y_shear ) -{ - CAMLparam3(image_bloc, x_shear, y_shear); - - Image - *new_image; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image = ShearImage( - (Image *) Field(image_bloc,1), - Double_val(x_shear), - Double_val(y_shear), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ -/* {{{ imper_sampleimage() - * - * Image *SampleImage(const Image *image, const unsigned long columns, const unsigned long rows, ExceptionInfo *exception) - */ -CAMLprim value imper_sampleimage( - value image_bloc, - value columns, - value rows ) -{ - CAMLparam3(image_bloc, columns, rows); - - Image - *new_image; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image = SampleImage( - (Image *) Field(image_bloc,1), - Long_val(columns), - Long_val(rows), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ -/* {{{ imper_scaleimage() - * - * Image *ScaleImage(const Image *image, const unsigned long columns, const unsigned long rows, ExceptionInfo *exception) - */ -CAMLprim value imper_scaleimage( - value image_bloc, - value columns, - value rows ) -{ - CAMLparam3(image_bloc, columns, rows); - - Image - *new_image; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image = ScaleImage( - (Image *) Field(image_bloc,1), - Long_val(columns), - Long_val(rows), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ -/* {{{ imper_thumbnailimage() - * - * Image *ThumbnailImage(const Image *image,const unsigned long columns, const unsigned long rows,ExceptionInfo *exception) - */ -CAMLprim value imper_thumbnailimage( - value image_bloc, - value columns, - value rows ) -{ - CAMLparam3(image_bloc, columns, rows); - - Image - *new_image; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image = ThumbnailImage( - (Image *) Field(image_bloc,1), - Long_val(columns), - Long_val(rows), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ - -/* {{{ imper_adaptivethresholdimage() - * - * Image *AdaptiveThresholdImage(const Image *image, - * const unsigned long width, const unsigned long height, - * const long offset, ExceptionInfo *exception) - */ -CAMLprim value imper_adaptivethresholdimage( - value image_bloc, - value width, - value height, - value offset ) -{ - CAMLparam4(image_bloc, width, height, offset); - - Image - *new_image; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image = AdaptiveThresholdImage( - (Image *) Field(image_bloc,1), - Long_val(width), - Long_val(height), - Long_val(offset), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ - - -/* {{{ imper_cropimage() - * - * Image *CropImage(const Image *image, const RectangleInfo *geometry, ExceptionInfo *exception) - */ -CAMLprim value imper_cropimage( - value image_bloc, - value x, - value y, - value width, - value height ) -{ - CAMLparam5(image_bloc, x, y, width, height) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - RectangleInfo - geometry ; - - GetExceptionInfo(&exception) ; - - geometry.x = Long_val(x) ; - geometry.y = Long_val(y) ; - geometry.width = Long_val(width) ; - geometry.height = Long_val(height) ; - - new_image = CropImage( - (Image *) Field(image_bloc,1), - &geometry, - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_chopimage() - * - * Image *ChopImage(const Image *image, const RectangleInfo *chop_info, ExceptionInfo *exception) - */ -CAMLprim value imper_chopimage( - value image_bloc, - value x, - value y, - value width, - value height ) -{ - CAMLparam5(image_bloc, x, y, width, height) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - RectangleInfo - chop_info ; - - GetExceptionInfo(&exception) ; - - chop_info.x = Long_val(x) ; - chop_info.y = Long_val(y) ; - chop_info.width = Long_val(width) ; - chop_info.height = Long_val(height) ; - - new_image = ChopImage( - (Image *) Field(image_bloc,1), - &chop_info, - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ - -/* {{{ imper_spliceimage() - * - * Image *SpliceImage(const Image *image, const RectangleInfo *chop_info, ExceptionInfo *exception) - */ -CAMLprim value imper_spliceimage( - value image_bloc, - value x, - value y, - value width, - value height ) -{ - CAMLparam5(image_bloc, x, y, width, height) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - RectangleInfo - chop_info ; - - GetExceptionInfo(&exception) ; - - chop_info.x = Long_val(x) ; - chop_info.y = Long_val(y) ; - chop_info.width = Long_val(width) ; - chop_info.height = Long_val(height) ; - - new_image = SpliceImage( - (Image *) Field(image_bloc,1), - &chop_info, - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ - - - -/* {{{ ChannelType_val() */ - -static int -ChannelType_val( value param ) -{ -#if CAML_FRAME - CAMLparam1 (param); -#endif - -#if TYPE_CHECKING - assert (Is_long (param)); -#endif - -#if DEBUG - printf(" ChannelType_val(%d)\n", Int_val(param)); fflush(stdout); -#endif - - switch (Int_val (param)) - { - case 0: return UndefinedChannel; - case 1: return RedChannel; - case 2: return GrayChannel; - case 3: return CyanChannel; - case 4: return GreenChannel; - case 5: return MagentaChannel; - case 6: return BlueChannel; - case 7: return YellowChannel; - case 8: return AlphaChannel; - case 9: return OpacityChannel; - case 10: return BlackChannel; - case 11: return IndexChannel; - case 12: return AllChannels; - case 13: return DefaultChannels; - default: -#if DEBUG - fprintf(stderr, " Error in ChannelType_val()\n"); fflush(stderr); - abort(); -#else - fprintf(stderr, "OCaml-ImageMagick Warning: channel_type unrecognized, set to DefaultChannels\n"); fflush(stderr); - return DefaultChannels; -#endif - } -} - -/* }}} */ -/* {{{ imper_blurimagechannel() - * - * Image *BlurImageChannel(const Image *image, const ChannelType channel, - * const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value imper_blurimagechannel( - value image_bloc, - value channel, - value radius, - value sigma ) -{ - CAMLparam4(image_bloc, channel, radius, sigma); - - Image - *new_image; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image = BlurImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - Double_val(radius), - Double_val(sigma), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ -/* {{{ imper_radialblurimagechannel() - * - * Image *RadialBlurImageChannel(const Image *image, const ChannelType channel, const double angle, ExceptionInfo *exception) - */ -CAMLprim value imper_radialblurimagechannel( - value image_bloc, - value channel, - value angle ) -{ - CAMLparam3(image_bloc, channel, angle) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = RadialBlurImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - Double_val(angle), - &exception) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_gaussianblurimagechannel() - * - * Image *GaussianBlurImageChannel(const Image *image, const ChannelType channel, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value imper_gaussianblurimagechannel( - value image_bloc, - value channel, - value radius, - value sigma ) -{ - CAMLparam4(image_bloc, channel, radius, sigma); - - Image - *new_image; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image = GaussianBlurImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - Double_val(radius), - Double_val(sigma), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ -/* {{{ imper_bilevelimagechannel() - * - * MagickBooleanType BilevelImageChannel(Image *image, - * const ChannelType channel, const double threshold) - */ -CAMLprim value imper_bilevelimagechannel( - value image_bloc, - value channel, - value threshold ) -{ - CAMLparam3(image_bloc, channel, threshold) ; - - MagickBooleanType - ret ; - - ret = BilevelImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - Double_val(threshold) ) ; - - if (ret == MagickFalse) { - failwith("bilevelimagechannel failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_sharpenimagechannel() - * - * Image *SharpenImageChannel(const Image *image, const ChannelType channel, - * const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value imper_sharpenimagechannel( - value image_bloc, - value channel, - value radius, - value sigma ) -{ - CAMLparam4(image_bloc, channel, radius, sigma) ; - - Image - *new_image ; - - ExceptionInfo - exception ; - - GetExceptionInfo(&exception) ; - - new_image = SharpenImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - Double_val(radius), - Double_val(sigma), - &exception ) ; - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ) ; - } - - failwith( exception.reason ) ; - } - - DestroyImage( (Image *) Field(image_bloc,1) ) ; - Field(image_bloc,1) = (value) new_image ; - - DestroyExceptionInfo(&exception) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ - - - -/* {{{ imper_negateimage() - * - * MagickBooleanType NegateImage(Image *, const MagickBooleanType) - */ -CAMLprim value imper_negateimage( - value image_bloc, - value grayscale ) -{ - CAMLparam2(image_bloc, grayscale) ; - - MagickBooleanType - ret ; - - ret = NegateImage( - (Image *) Field(image_bloc,1), - MagickBoolean_val(grayscale) ) ; - - if (ret == MagickFalse) { - failwith("negate failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_contrastimage() - * - * MagickBooleanType ContrastImage(Image *image, const MagickBooleanType sharpen) - */ -CAMLprim value imper_contrastimage( - value image_bloc, - value sharpen ) -{ - CAMLparam2(image_bloc, sharpen) ; - - MagickBooleanType - ret ; - - /* - ret = ContrastImage( - (Image *) Field(image_bloc,1), - Int_val(sharpen) ) ; - \* - * 0 increases the contrast - * otherwise reduced it - */ - - ret = ContrastImage( - (Image *) Field(image_bloc,1), - MagickBoolean_val(sharpen) ) ; - /* - * MagickFalse increases the contrast, - * otherwise reduced it - */ - - if (ret == MagickFalse) { - failwith("contrast failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_equalizeimage() - * - * MagickBooleanType EqualizeImage(Image *image) - */ -CAMLprim value imper_equalizeimage( value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - MagickBooleanType - ret ; - - ret = EqualizeImage( - (Image *) Field(image_bloc,1) ) ; - - if (ret == MagickFalse) { - failwith("equalize failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_normalizeimage() - * - * MagickBooleanType NormalizeImage(Image *image) - */ -CAMLprim value imper_normalizeimage( value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - MagickBooleanType - ret ; - - ret = NormalizeImage( - (Image *) Field(image_bloc,1) ) ; - - if (ret == MagickFalse) { - failwith("normalize failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_blackthresholdimage() - * - * MagickBooleanType BlackThresholdImage(Image *image, const char *threshold) - */ -CAMLprim value imper_blackthresholdimage( value image_bloc, value threshold ) -{ - CAMLparam2(image_bloc, threshold) ; - - MagickBooleanType - ret ; - - ret = BlackThresholdImage( - (Image *) Field(image_bloc,1), - String_val(threshold) ) ; - - if (ret == MagickFalse) { - failwith("black_threshold failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_whitethresholdimage() - * - * MagickBooleanType WhiteThresholdImage(Image *image, const char *threshold) - */ -CAMLprim value imper_whitethresholdimage( value image_bloc, value threshold ) -{ - CAMLparam2(image_bloc, threshold) ; - - MagickBooleanType - ret ; - - ret = WhiteThresholdImage( - (Image *) Field(image_bloc,1), - String_val(threshold) ) ; - - if (ret == MagickFalse) { - failwith("white_threshold failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_cyclecolormapimage() - * - * MagickBooleanType CycleColormapImage(Image *image, const long displace) - */ -CAMLprim value imper_cyclecolormapimage( - value image_bloc, - value displace ) -{ - CAMLparam2(image_bloc, displace) ; - - MagickBooleanType - ret ; - - ret = CycleColormapImage( - (Image *) Field(image_bloc,1), - Long_val(displace) ) ; - - if (ret == MagickFalse) { - failwith("cyclecolormap failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_modulateimage() - * - * MagickBooleanType ModulateImage(Image *image, const char *modulate) - */ -CAMLprim value imper_modulateimage( - value image_bloc, - value modulate ) -{ - CAMLparam2(image_bloc, modulate) ; - - MagickBooleanType - ret ; - - ret = ModulateImage( - (Image *) Field(image_bloc,1), - String_val(modulate) ) ; - - if (ret == MagickFalse) { - failwith("modulate failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_solarizeimage() - * - * MagickBooleanType SolarizeImage(Image *image, const double threshold) - */ -CAMLprim value imper_solarizeimage( - value image_bloc, - value threshold ) -{ - CAMLparam2(image_bloc, threshold) ; - - MagickBooleanType - ret ; - - ret = SolarizeImage( - (Image *) Field(image_bloc,1), - Double_val(threshold) ) ; - - if (ret == MagickFalse) { - failwith("solarize failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ - -/* {{{ imper_stripimage() - * - * MagickBooleanType StripImage(Image *image) - */ -CAMLprim value imper_stripimage( - value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - MagickBooleanType - ret ; - - ret = StripImage( - (Image *) Field(image_bloc,1) ) ; - - if (ret == MagickFalse) { - failwith("strip failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ - -/* {{{ imper_gammaimagechannel() - * - * MagickBooleanType GammaImageChannel(Image *image, const ChannelType channel, const double gamma) - */ -CAMLprim value imper_gammaimagechannel( value image_bloc, value channel, value gamma ) -{ - CAMLparam3(image_bloc, channel, gamma) ; - - MagickBooleanType - ret ; - - ret = GammaImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - Double_val(gamma) ) ; - - if (ret == MagickFalse) { - failwith("gamma_channel failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ - -/* {{{ imper_levelimage() - * - * MagickBooleanType LevelImage(Image *image, const char *levels) - */ -CAMLprim value imper_levelimage( value image_bloc, value levels ) -{ - CAMLparam2(image_bloc, levels) ; - - MagickBooleanType - ret ; - - ret = LevelImage( - (Image *) Field(image_bloc,1), - String_val(levels) ) ; - - if (ret == MagickFalse) { - failwith("level failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_levelimagechannel() - * - * MagickBooleanType LevelImageChannel(Image *image, const ChannelType channel, - * const double black_point, const double white_point, const double gamma) - */ -CAMLprim value imper_levelimagechannel( value image_bloc, value channel, value black_point, value white_point, value gamma ) -{ - CAMLparam5(image_bloc, channel, black_point, white_point, gamma) ; - - MagickBooleanType - ret ; - - ret = LevelImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - Double_val(black_point), - Double_val(white_point), - Double_val(gamma) ) ; - - if (ret == MagickFalse) { - failwith("level_channel failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_negateimagechannel() - * - * MagickBooleanType NegateImageChannel(Image *image, const ChannelType channel, const MagickBooleanType grayscale) - */ -CAMLprim value imper_negateimagechannel( value image_bloc, value channel, value grayscale ) -{ - CAMLparam3(image_bloc, channel, grayscale) ; - - MagickBooleanType - ret ; - - ret = NegateImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - MagickBoolean_val(grayscale) ) ; - - if (ret == MagickFalse) { - failwith("negate_channel failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ - - - - - -/* {{{ NoiseType_val() */ - -static int -NoiseType_val( value param ) -{ -#if CAML_FRAME - CAMLparam1 (param); -#endif - -#if TYPE_CHECKING - assert (Is_long (param)); -#endif - - switch (Int_val (param)) - { - case 0: return UndefinedNoise; - case 1: return UniformNoise; - case 2: return GaussianNoise; - case 3: return MultiplicativeGaussianNoise; - case 4: return ImpulseNoise; - case 5: return LaplacianNoise; - case 6: return PoissonNoise; - default: -#if DEBUG - fprintf(stderr, " Error in NoiseType_val()\n"); fflush(stderr); - abort(); -#else - fprintf(stderr, "ImageMagick Warning: noise_type unrecognized, set to Undefined\n"); fflush(stderr); - return UndefinedNoise; -#endif - } -} - -/* }}} */ -/* {{{ imper_addnoiseimage() - * - * Image *AddNoiseImage(const Image *image, const NoiseType noise_type, ExceptionInfo *exception) - */ -CAMLprim value imper_addnoiseimage( - value image_bloc, - value noise_type ) -{ - CAMLparam2(image_bloc, noise_type); - - Image - *new_image; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image = AddNoiseImage( - (Image *) Field(image_bloc,1), - NoiseType_val(noise_type), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ - - -/* {{{ FilterType_val() */ - -static FilterTypes -FilterType_val( value param ) -{ -#if CAML_FRAME - CAMLparam1 (param); -#endif - -#if TYPE_CHECKING - assert (Is_long (param)); -#endif - - switch (Int_val (param)) - { - case 0: return UndefinedFilter; - case 1: return PointFilter; - case 2: return BoxFilter; - case 3: return TriangleFilter; - case 4: return HermiteFilter; - case 5: return HanningFilter; - case 6: return HammingFilter; - case 7: return BlackmanFilter; - case 8: return GaussianFilter; - case 9: return QuadraticFilter; - case 10: return CubicFilter; - case 11: return CatromFilter; - case 12: return MitchellFilter; - case 13: return LanczosFilter; - case 14: return BesselFilter; - case 15: return SincFilter; - default: -#if DEBUG - fprintf(stderr, " Error in FilterType_val()\n"); fflush(stderr); - abort(); -#else - fprintf(stderr, "ImageMagick Warning: filter_type unrecognized, set to Undefined\n"); fflush(stderr); - return UndefinedFilter; -#endif - } -} - -/* }}} */ -/* {{{ imper_resizeimage() - * - * Image *ResizeImage(Image *image, const unsigned long columns, const unsigned long rows, - * const FilterTypes filter, const double blur, ExceptionInfo *exception) - */ -CAMLprim value imper_resizeimage( - value image_bloc, - value columns, - value rows, - value filter, - value blur ) -{ - CAMLparam5(image_bloc, columns, rows, filter, blur); - - Image - *new_image; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image = ResizeImage( - (Image *) Field(image_bloc,1), - Long_val(columns), - Long_val(rows), - FilterType_val(filter), - Double_val(blur), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn (Val_unit); -} - -/* }}} */ - - - -/* @TODO: -QuantizeInfo *CloneQuantizeInfo(const QuantizeInfo *quantize_info) -QuantizeInfo *DestroyQuantizeInfo(QuantizeInfo *quantize_info) -MagickBooleanType GetImageQuantizeError(Image *image) -GetQuantizeInfo(QuantizeInfo *quantize_info) -MagickBooleanType QuantizeImage(const QuantizeInfo *quantize_info, Image *image) -MagickBooleanType QuantizeImages(const QuantizeInfo *quantize_info, Image *images) -*/ - - -/* {{{ imper_orderedditherimage() - * - * MagickBooleanType OrderedDitherImage(Image *image) - */ -CAMLprim value -imper_orderedditherimage( value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - MagickBooleanType - ret ; - - ret = OrderedDitherImage( - (Image *) Field(image_bloc,1) ) ; - - if (ret == MagickFalse) { - failwith("ordered_dither failed") ; - } - - CAMLreturn (Val_unit) ; -} - -/* }}} */ - -/* {{{ imper_compressimagecolormap() - * - * void CompressImageColormap(Image *image) - */ -CAMLprim value -imper_compressimagecolormap( value image_bloc ) -{ - CAMLparam1(image_bloc) ; - - CompressImageColormap( - (Image *) Field(image_bloc,1) ) ; - - CAMLreturn (Val_unit) ; -} - -/* }}} */ -/* {{{ imper_posterizeimage() - * - * MagickBooleanType PosterizeImage(Image *image, const unsigned long levels, const MagickBooleanType dither) - */ -CAMLprim value -imper_posterizeimage(value image_bloc, value levels, value dither) -{ - CAMLparam3(image_bloc, levels, dither); - - MagickBooleanType - ret; - - ret = PosterizeImage( - (Image *) Field(image_bloc,1), - Long_val(levels), - MagickBoolean_val(dither) - ); - - if (ret == MagickFalse) { - failwith("posterize failed"); - } - - CAMLreturn (Val_unit); -} - -/* }}} */ - -/* @TODO: -MagickBooleanType MapImages(Image *images,Image *map_image, const MagickBooleanType dither) -*/ - -/* {{{ imper_mapimage() - * - * MagickBooleanType MapImage(Image *image,const Image *map_image, const MagickBooleanType dither) - */ -CAMLprim value -imper_mapimage(value image_bloc, value map_image_bloc, value dither) -{ - CAMLparam3(image_bloc, map_image_bloc, dither); - - MagickBooleanType - ret; - - /* DEPR - ret = MapImage( - (Image *) Field(image_bloc,1), - (Image *) Field(map_image_bloc,1), - MagickBoolean_val(dither) - ); - */ - - QuantizeInfo quantize_info; - GetQuantizeInfo( &quantize_info ); - quantize_info.dither = MagickBoolean_val(dither); - RemapImage( &quantize_info, - (Image *) Field(image_bloc,1), - (Image *) Field(map_image_bloc,1) - ); - - if (ret == MagickFalse) { - failwith("map_image failed"); - } - - CAMLreturn (Val_unit); -} - -/* }}} */ - - - -void finalize_image(value); - -/* {{{ fun_blurimage() - * - * Image *BlurImage(const Image *image, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value -fun_blurimage( - value image_bloc, - value radius, - value sigma ) -{ - CAMLparam3(image_bloc, radius, sigma); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - BlurImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_radialblurimage() - * - * Image *RadialBlurImage(const Image *image, const double angle, ExceptionInfo *exception) - */ -CAMLprim value -fun_radialblurimage( - value image_bloc, - value angle ) -{ - CAMLparam2(image_bloc, angle); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - RadialBlurImage( - (Image *) Field(image_bloc,1), - Double_val(angle), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_radialblurimagechannel() - * - * Image *RadialBlurImageChannel(const Image *image, const ChannelType channel, const double angle, ExceptionInfo *exception) - */ -CAMLprim value -fun_radialblurimagechannel( - value image_bloc, - value channel, - value angle ) -{ - CAMLparam3(image_bloc, channel, angle); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - RadialBlurImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - Double_val(angle), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_charcoalimage() - * - * Image *CharcoalImage(const Image *image, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value -fun_charcoalimage( - value image_bloc, - value radius, - value sigma ) -{ - CAMLparam3(image_bloc, radius, sigma); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - CharcoalImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_edgeimage() - * - * Image *EdgeImage(const Image *image, const double radius, ExceptionInfo *exception) - */ -CAMLprim value -fun_edgeimage( - value image_bloc, - value radius ) -{ - CAMLparam2(image_bloc, radius); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - EdgeImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_embossimage() - * - * Image *EmbossImage(const Image *image, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value -fun_embossimage( - value image_bloc, - value radius, - value sigma ) -{ - CAMLparam3(image_bloc, radius, sigma); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - EmbossImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_gaussianblurimage() - * - * Image *GaussianBlurImage(const Image *image, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value -fun_gaussianblurimage( - value image_bloc, - value radius, - value sigma ) -{ - CAMLparam3(image_bloc, radius, sigma); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - GaussianBlurImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_implodeimage() - * - * Image *ImplodeImage(const Image *image, const double amount, ExceptionInfo *exception) - */ -CAMLprim value -fun_implodeimage( - value image_bloc, - value amount ) -{ - CAMLparam2(image_bloc, amount); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - ImplodeImage( - (Image *) Field(image_bloc,1), - Double_val(amount), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_medianfilterimage() - * - * Image *MedianFilterImage(const Image *image, const double radius, ExceptionInfo *exception) - */ -CAMLprim value -fun_medianfilterimage( - value image_bloc, - value radius ) -{ - CAMLparam2(image_bloc, radius); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - MedianFilterImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_motionblurimage() - * - * Image *MotionBlurImage(const Image *image, const double radius ,const double sigma, const double angle, ExceptionInfo *exception) - */ -CAMLprim value -fun_motionblurimage( - value image_bloc, - value radius, - value sigma, - value angle ) -{ - CAMLparam4(image_bloc, radius, sigma, angle); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - MotionBlurImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - Double_val(angle), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_oilpaintimage() - * - * Image *OilPaintImage(const Image *image, const double radius, ExceptionInfo *exception) - */ -CAMLprim value -fun_oilpaintimage( - value image_bloc, - value radius ) -{ - CAMLparam2(image_bloc, radius); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - OilPaintImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_reducenoiseimage() - * - * Image *ReduceNoiseImage(const Image *image, const double radius, ExceptionInfo *exception) - */ -CAMLprim value -fun_reducenoiseimage( - value image_bloc, - value radius ) -{ - CAMLparam2(image_bloc, radius); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - ReduceNoiseImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_rollimage() - * - * Image *RollImage(const Image *image, const long x_offset, const long y_offset, ExceptionInfo *exception) - */ -CAMLprim value -fun_rollimage( - value image_bloc, - value x_offset, - value y_offset ) -{ - CAMLparam3(image_bloc, x_offset, y_offset); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - RollImage( - (Image *) Field(image_bloc,1), - Long_val(x_offset), - Long_val(y_offset), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_shadeimage() - * - * Image *ShadeImage(const Image *image, const unsigned int color_shading, double azimuth, double elevation, ExceptionInfo *exception) - */ -CAMLprim value -fun_shadeimage( - value image_bloc, - value color_shading, - value azimuth, - value elevation ) -{ - CAMLparam4(image_bloc, color_shading, azimuth, elevation); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - ShadeImage( - (Image *) Field(image_bloc,1), - Int_val(color_shading), - Double_val(azimuth), - Double_val(elevation), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_sharpenimage() - * - * Image *SharpenImage(Image *image, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value -fun_sharpenimage( - value image_bloc, - value radius, - value sigma ) -{ - CAMLparam3(image_bloc, radius, sigma); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - SharpenImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_spreadimage() - * - * Image *SpreadImage(const Image *image, const double radius, ExceptionInfo *exception) - */ -CAMLprim value -fun_spreadimage( - value image_bloc, - value radius ) -{ - CAMLparam2(image_bloc, radius); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - SpreadImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_swirlimage() - * - * Image *SwirlImage(const Image *image, double degrees, ExceptionInfo *exception) - */ -CAMLprim value -fun_swirlimage( - value image_bloc, - value degrees ) -{ - CAMLparam2(image_bloc, degrees); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - SwirlImage( - (Image *) Field(image_bloc,1), - Double_val(degrees), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_unsharpmaskimage() - * - * Image *UnsharpMaskImage(const Image *image, const double radius, const double sigma, const double amount, const double threshold, ExceptionInfo *exception) - */ -CAMLprim value -fun_unsharpmaskimage( - value image_bloc, - value radius, - value sigma, - value amount, - value threshold ) -{ - CAMLparam5(image_bloc, radius, sigma, amount, threshold); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - UnsharpMaskImage( - (Image *) Field(image_bloc,1), - Double_val(radius), - Double_val(sigma), - Double_val(amount), - Double_val(threshold), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_waveimage() - * - * Image *WaveImage(const Image *image, const double amplitude, const double wave_length, ExceptionInfo *exception) - */ -CAMLprim value -fun_waveimage( - value image_bloc, - value amplitude, - value wave_length ) -{ - CAMLparam3(image_bloc, amplitude, wave_length); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - WaveImage( - (Image *) Field(image_bloc,1), - Double_val(amplitude), - Double_val(wave_length), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_rotateimage() - * - * Image *RotateImage(const Image *image, const double degrees, ExceptionInfo *exception) - */ -CAMLprim value -fun_rotateimage( - value image_bloc, - value degrees ) -{ - CAMLparam2(image_bloc, degrees); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - RotateImage( - (Image *) Field(image_bloc,1), - Double_val(degrees), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_shearimage() - * - * Image *ShearImage(const Image *image, const double x_shear, const double y_shear, ExceptionInfo *exception) - */ -CAMLprim value -fun_shearimage( - value image_bloc, - value x_shear, - value y_shear ) -{ - CAMLparam3(image_bloc, x_shear, y_shear); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - ShearImage( - (Image *) Field(image_bloc,1), - Double_val(x_shear), - Double_val(y_shear), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_sampleimage() - * - * Image *SampleImage(const Image *image, const unsigned long columns, const unsigned long rows, ExceptionInfo *exception) - */ -CAMLprim value -fun_sampleimage( - value image_bloc, - value columns, - value rows ) -{ - CAMLparam3(image_bloc, columns, rows); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - SampleImage( - (Image *) Field(image_bloc,1), - Long_val(columns), - Long_val(rows), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_scaleimage() - * - * Image *ScaleImage(const Image *image, const unsigned long columns, const unsigned long rows, ExceptionInfo *exception) - */ -CAMLprim value -fun_scaleimage( - value image_bloc, - value columns, - value rows ) -{ - CAMLparam3(image_bloc, columns, rows); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - ScaleImage( - (Image *) Field(image_bloc,1), - Long_val(columns), - Long_val(rows), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_thumbnailimage() - * - * Image *ThumbnailImage(const Image *image,const unsigned long columns, const unsigned long rows,ExceptionInfo *exception) - */ -CAMLprim value -fun_thumbnailimage( - value image_bloc, - value columns, - value rows ) -{ - CAMLparam3(image_bloc, columns, rows); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - ThumbnailImage( - (Image *) Field(image_bloc,1), - Long_val(columns), - Long_val(rows), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_adaptivethresholdimage() - * - * Image *AdaptiveThresholdImage(const Image *image, const unsigned long width, const unsigned long height, const long offset, ExceptionInfo *exception) - */ -CAMLprim value -fun_adaptivethresholdimage( - value image_bloc, - value width, - value height, - value offset ) -{ - CAMLparam4(image_bloc, width, height, offset); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - AdaptiveThresholdImage( - (Image *) Field(image_bloc,1), - Long_val(width), - Long_val(height), - Long_val(offset), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_blurimagechannel() - * - * Image *BlurImageChannel(const Image *image, const ChannelType channel, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value -fun_blurimagechannel( - value image_bloc, - value channel, - value radius, - value sigma ) -{ - CAMLparam4(image_bloc, channel, radius, sigma); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - -#if DEBUG - printf(" ChannelType_val() returns %d\n", ChannelType_val(channel)); fflush(stdout); -#endif - - Field(new_image_bloc,1) = (value) - BlurImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - Double_val(radius), - Double_val(sigma), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_gaussianblurimagechannel() - * - * Image *GaussianBlurImageChannel(const Image *image, const ChannelType channel, const double radius, const double sigma, ExceptionInfo *exception) - */ -CAMLprim value -fun_gaussianblurimagechannel( - value image_bloc, - value channel, - value radius, - value sigma ) -{ - CAMLparam4(image_bloc, channel, radius, sigma); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - GaussianBlurImageChannel( - (Image *) Field(image_bloc,1), - ChannelType_val(channel), - Double_val(radius), - Double_val(sigma), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_addnoiseimage() - * - * Image *AddNoiseImage(const Image *image, const NoiseType noise_type, ExceptionInfo *exception) - */ -CAMLprim value -fun_addnoiseimage( - value image_bloc, - value noise_type ) -{ - CAMLparam2(image_bloc, noise_type); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - AddNoiseImage( - (Image *) Field(image_bloc,1), - NoiseType_val(noise_type), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_resizeimage() - * - * Image *ResizeImage(Image *image, const unsigned long columns, const unsigned long rows, const FilterTypes filter, const double blur, ExceptionInfo *exception) - */ -CAMLprim value -fun_resizeimage( - value image_bloc, - value columns, - value rows, - value filter, - value blur ) -{ - CAMLparam5(image_bloc, columns, rows, filter, blur); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - ResizeImage( - (Image *) Field(image_bloc,1), - Long_val(columns), - Long_val(rows), - FilterType_val(filter), - Double_val(blur), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ - -/* {{{ fun_enhanceimage() - * - * Image *EnhanceImage(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value -fun_enhanceimage( - value image_bloc ) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - EnhanceImage( - (Image *) Field(image_bloc,1), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_despeckleimage() - * - * Image *DespeckleImage(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value -fun_despeckleimage( - value image_bloc ) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - DespeckleImage( - (Image *) Field(image_bloc,1), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_cropimage() - * - * Image *CropImage(const Image *image, const RectangleInfo *geometry, ExceptionInfo *exception) - */ -CAMLprim value -fun_cropimage( - value image_bloc, - value x, - value y, - value width, - value height ) -{ - CAMLparam5(image_bloc, x, y, width, height); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - RectangleInfo - geometry; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - geometry.x = Long_val(x); - geometry.y = Long_val(y); - geometry.width = Long_val(width); - geometry.height = Long_val(height); - - Field(new_image_bloc,1) = (value) - CropImage( - (Image *) Field(image_bloc,1), - &geometry, - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_minifyimage() - * - * Image *MinifyImage(Image *image, ExceptionInfo *exception) - */ -CAMLprim value -fun_minifyimage( - value image_bloc ) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - MinifyImage( - (Image *) Field(image_bloc,1), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_magnifyimage() - * - * Image *MagnifyImage(Image *image, ExceptionInfo *exception) - */ -CAMLprim value -fun_magnifyimage( - value image_bloc ) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - MagnifyImage( - (Image *) Field(image_bloc,1), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_flipimage() - * - * Image *FlipImage(Image *image, ExceptionInfo *exception) - */ -CAMLprim value -fun_flipimage( - value image_bloc ) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - FlipImage( - (Image *) Field(image_bloc,1), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ -/* {{{ fun_flopimage() - * - * Image *FlopImage(Image *image, ExceptionInfo *exception) - */ -CAMLprim value -fun_flopimage( - value image_bloc ) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) - FlopImage( - (Image *) Field(image_bloc,1), - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ - -/* {{{ fun_spliceimage() - * - * Image *SpliceImage(const Image *image, const RectangleInfo *chop_info, ExceptionInfo *exception) - */ -CAMLprim value -fun_spliceimage( - value image_bloc, - value x, - value y, - value width, - value height ) -{ - CAMLparam5(image_bloc, x, y, width, height); - CAMLlocal1(new_image_bloc); - - RectangleInfo - chop_info; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - chop_info.x = Long_val(x); - chop_info.y = Long_val(y); - chop_info.width = Long_val(width); - chop_info.height = Long_val(height); - - Field(new_image_bloc,1) = (value) - SpliceImage( - (Image *) Field(image_bloc,1), - &chop_info, - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ - -/* {{{ fun_orderedditherimage() - * - * MagickBooleanType OrderedDitherImage(Image *image) - */ -CAMLprim value -fun_orderedditherimage( value image_bloc ) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, - &exception ); - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = OrderedDitherImage( - (Image *) Field(new_image_bloc,1) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("ordered_dither failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ - -/* {{{ fun_negateimage() - * - * MagickBooleanType NegateImage(Image *, const MagickBooleanType) - */ -CAMLprim value -fun_negateimage( - value image_bloc, - value grayscale ) -{ - CAMLparam2(image_bloc, grayscale); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, - &exception ); - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = NegateImage( - (Image *) Field(new_image_bloc,1), - MagickBoolean_val(grayscale) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("negate failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_contrastimage() - * - * MagickBooleanType ContrastImage(Image *image, const MagickBooleanType sharpen) - */ -CAMLprim value -fun_contrastimage( - value image_bloc, - value sharpen ) -{ - CAMLparam2(image_bloc, sharpen); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = ContrastImage( - (Image *) Field(new_image_bloc,1), - MagickBoolean_val(sharpen) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.contrast failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_equalizeimage() - * - * MagickBooleanType EqualizeImage(Image *image) - */ -CAMLprim value -fun_equalizeimage( - value image_bloc ) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = EqualizeImage( - (Image *) Field(new_image_bloc,1) - ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.equalize failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_normalizeimage() - * - * MagickBooleanType NormalizeImage(Image *image) - */ -CAMLprim value -fun_normalizeimage( - value image_bloc ) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = NormalizeImage( - (Image *) Field(new_image_bloc,1) - ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.normalize failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_blackthresholdimage() - * - * MagickBooleanType BlackThresholdImage(Image *image, const char *threshold) - */ -CAMLprim value -fun_blackthresholdimage( - value image_bloc, - value threshold ) -{ - CAMLparam2(image_bloc, threshold); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = BlackThresholdImage( - (Image *) Field(new_image_bloc,1), - String_val(threshold) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.black_threshold failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_whitethresholdimage() - * - * MagickBooleanType WhiteThresholdImage(Image *image, const char *threshold) - */ -CAMLprim value -fun_whitethresholdimage( - value image_bloc, - value threshold ) -{ - CAMLparam2(image_bloc, threshold); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = WhiteThresholdImage( - (Image *) Field(new_image_bloc,1), - String_val(threshold) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.white_threshold failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_cyclecolormapimage() - * - * MagickBooleanType CycleColormapImage(Image *image, const long displace) - */ -CAMLprim value -fun_cyclecolormapimage( - value image_bloc, - value displace ) -{ - CAMLparam2(image_bloc, displace); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = CycleColormapImage( - (Image *) Field(new_image_bloc,1), - Long_val(displace) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.cyclecolormap failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_modulateimage() - * - * MagickBooleanType ModulateImage(Image *image, const char *modulate) - */ -CAMLprim value -fun_modulateimage( - value image_bloc, - value modulate ) -{ - CAMLparam2(image_bloc, modulate); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = ModulateImage( - (Image *) Field(new_image_bloc,1), - String_val(modulate) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.modulate failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_solarizeimage() - * - * MagickBooleanType SolarizeImage(Image *image, const double threshold) - */ -CAMLprim value -fun_solarizeimage( - value image_bloc, - value threshold ) -{ - CAMLparam2(image_bloc, threshold); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = SolarizeImage( - (Image *) Field(new_image_bloc,1), - Double_val(threshold) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.solarize failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_stripimage() - * - * MagickBooleanType StripImage(Image *image) - */ -CAMLprim value -fun_stripimage( - value image_bloc ) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = StripImage( - (Image *) Field(new_image_bloc,1) - ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.strip failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_gammaimagechannel() - * - * MagickBooleanType GammaImageChannel(Image *image, const ChannelType channel, const double gamma) - */ -CAMLprim value -fun_gammaimagechannel( - value image_bloc, - value channel, - value gamma ) -{ - CAMLparam3(image_bloc, channel, gamma); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = GammaImageChannel( - (Image *) Field(new_image_bloc,1), - ChannelType_val(channel), - Double_val(gamma) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.gamma_channel failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_levelimage() - * - * MagickBooleanType LevelImage(Image *image, const char *levels) - */ -CAMLprim value -fun_levelimage( - value image_bloc, - value levels ) -{ - CAMLparam2(image_bloc, levels); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = LevelImage( - (Image *) Field(new_image_bloc,1), - String_val(levels) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.level failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_levelimagechannel() - * - * MagickBooleanType LevelImageChannel(Image *image, const ChannelType channel, - * const double black_point, const double white_point, const double gamma) - */ -CAMLprim value -fun_levelimagechannel( - value image_bloc, - value channel, - value black_point, - value white_point, - value gamma ) -{ - CAMLparam5(image_bloc, channel, black_point, white_point, gamma); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = LevelImageChannel( - (Image *) Field(new_image_bloc,1), - ChannelType_val(channel), - Double_val(black_point), - Double_val(white_point), - Double_val(gamma) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.level_channel failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ -/* {{{ fun_negateimagechannel() - * - * MagickBooleanType NegateImageChannel(Image *image, const ChannelType channel, const MagickBooleanType grayscale) - */ -CAMLprim value -fun_negateimagechannel( - value image_bloc, - value channel, - value grayscale ) -{ - CAMLparam3(image_bloc, channel, grayscale); - CAMLlocal1(new_image_bloc); - - ExceptionInfo exception; - GetExceptionInfo(&exception); - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, &exception ); - - if (exception.severity != UndefinedException) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - - MagickBooleanType status; - status = NegateImageChannel( - (Image *) Field(new_image_bloc,1), - ChannelType_val(channel), - MagickBoolean_val(grayscale) ); - - if (status == MagickFalse) { - if ( Field(new_image_bloc,1) ) { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - failwith("Magick.Fun.negate_channel failed"); - } - - CAMLreturn( new_image_bloc ); -} -/* }}} */ - -/* vim: sw=4 ts=4 sts=4 et fdm=marker - */ diff --git a/imagemagick_list.h b/imagemagick_list.h deleted file mode 100644 index 65238f6..0000000 --- a/imagemagick_list.h +++ /dev/null @@ -1,129 +0,0 @@ -/* {{{ COPYING - * - * +-----------------------------------------------------------------+ - * | Copyright (C) 2004 2005 2006 Florent Monnier | - * +-----------------------------------------------------------------+ - * | This binding aims to provide the ImageMagick methods to OCaml. | - * +-----------------------------------------------------------------+ - * | This software is provided 'as-is', without any express or | - * | implied warranty. In no event will the authors be held liable | - * | for any damages arising from the use of this software. | - * | | - * | Permission is granted to anyone to use this software for any | - * | purpose, including commercial applications, and to alter it and | - * | redistribute it freely. | - * +-----------------------------------------------------------------+ - * | Author: Florent Monnier | - * | Thanks to Matthieu Dubuget for his help with OCamlMakefile use. | - * +-----------------------------------------------------------------+ - * - * }}} */ - -int MagickBoolean_val(value); - -CAMLprim value imper_flipimage(value); -CAMLprim value imper_flopimage(value); -CAMLprim value imper_magnifyimage(value); -CAMLprim value imper_minifyimage(value); -CAMLprim value imper_enhanceimage(value); -CAMLprim value imper_trimimage(value); -CAMLprim value imper_despeckle(value); - -CAMLprim value imper_deconstructimages(value); -CAMLprim value imper_coalesceimages(value); -CAMLprim value imper_flattenimages(value); - - -CAMLprim value imper_negateimage(value, value); -CAMLprim value imper_contrastimage(value, value); -CAMLprim value imper_equalizeimage(value); -CAMLprim value imper_normalizeimage(value); -CAMLprim value imper_blackthresholdimage(value, value); -CAMLprim value imper_cyclecolormapimage(value, value); -CAMLprim value imper_modulateimage(value, value); -CAMLprim value imper_solarizeimage(value, value); -CAMLprim value imper_stripimage(value); - - - -CAMLprim value imper_blurimage(value, value, value); -CAMLprim value imper_charcoalimage(value, value, value); -CAMLprim value imper_edgeimage(value, value); -CAMLprim value imper_embossimage(value, value, value); -CAMLprim value imper_gaussianblurimage(value, value, value); -CAMLprim value imper_implodeimage(value, value); -CAMLprim value imper_medianfilterimage(value, value); -CAMLprim value imper_motionblurimage(value, value, value, value); -CAMLprim value imper_oilpaintimage(value, value); -CAMLprim value imper_reducenoiseimage(value, value); -CAMLprim value imper_rollimage(value, value, value); -CAMLprim value imper_shadeimage(value, value, value, value); -CAMLprim value imper_sharpenimage(value, value, value); -CAMLprim value imper_spreadimage(value, value); -CAMLprim value imper_swirlimage(value, value); -CAMLprim value imper_unsharpmaskimage(value, value, value, value, value); -CAMLprim value imper_waveimage(value, value, value); - -CAMLprim value imper_rotateimage(value, value); -CAMLprim value imper_shearimage(value, value, value); -CAMLprim value imper_sampleimage(value, value, value); -CAMLprim value imper_scaleimage(value, value, value); -CAMLprim value imper_thumbnailimage(value, value, value); - -CAMLprim value imper_adaptivethresholdimage(value, value, value, value); - -CAMLprim value imper_cropimage(value, value, value, value, value); -CAMLprim value imper_chopimage(value, value, value, value, value); - -CAMLprim value imper_blurimagechannel(value, value, value, value); -CAMLprim value imper_gaussianblurimagechannel(value, value, value, value); -CAMLprim value imper_bilevelimagechannel(value, value, value); -CAMLprim value imper_sharpenimagechannel(value, value, value, value); - - -CAMLprim value imper_addnoiseimage(value, value); - - -CAMLprim value imper_resizeimage(value, value, value, value, value); - -CAMLprim value imper_orderedditherimage(value); -CAMLprim value imper_compressimagecolormap(value); -CAMLprim value imper_posterizeimage(value, value, value); -CAMLprim value imper_mapimage(value, value, value); - - - - -CAMLprim value fun_blurimage(value, value, value); -CAMLprim value fun_charcoalimage(value, value, value); -CAMLprim value fun_edgeimage(value, value); -CAMLprim value fun_embossimage(value, value, value); -CAMLprim value fun_gaussianblurimage(value, value, value); -CAMLprim value fun_implodeimage(value, value); -CAMLprim value fun_medianfilterimage(value, value); -CAMLprim value fun_motionblurimage(value, value, value, value); -CAMLprim value fun_oilpaintimage(value, value); -CAMLprim value fun_reducenoiseimage(value, value); -CAMLprim value fun_rollimage(value, value, value); -CAMLprim value fun_shadeimage(value, value, value, value); -CAMLprim value fun_sharpenimage(value, value, value); -CAMLprim value fun_spreadimage(value, value); -CAMLprim value fun_swirlimage(value, value); -CAMLprim value fun_unsharpmaskimage(value, value, value, value, value); -CAMLprim value fun_waveimage(value, value, value); -CAMLprim value fun_rotateimage(value, value); -CAMLprim value fun_shearimage(value, value, value); -CAMLprim value fun_sampleimage(value, value, value); -CAMLprim value fun_scaleimage(value, value, value); -CAMLprim value fun_thumbnailimage(value, value, value); -CAMLprim value fun_adaptivethresholdimage(value, value, value, value); -CAMLprim value fun_blurimagechannel(value, value, value, value); -CAMLprim value fun_gaussianblurimagechannel(value, value, value, value); -CAMLprim value fun_addnoiseimage(value, value); -CAMLprim value fun_resizeimage(value, value, value, value, value); - - - - -/* vim: fdm=marker - */ diff --git a/imagemagick_wrap.c b/imagemagick_wrap.c deleted file mode 100644 index 3c706be..0000000 --- a/imagemagick_wrap.c +++ /dev/null @@ -1,8064 +0,0 @@ -/* {{{ COPYING - * - * +---------------------------------------------------------------+ - * | Copyright (C) 2004, 2005, 2006, 2010 Florent Monnier | - * +---------------------------------------------------------------+ - * | This binding aims to provide the ImageMagick methods to OCaml | - * +---------------------------------------------------------------+ - * | This software is provided 'as-is', without any express or | - * | implied warranty. In no event will the authors be held | - * | liable for any damages arising from the use of this software. | - * | | - * | Permission is granted to anyone to use this software for any | - * | purpose, including commercial applications, and to alter it | - * | and redistribute it freely. | - * +---------------------------------------------------------------+ - * | Author: Florent Monnier | - * | Thanks to Matthieu Dubuget for his help with OCamlMakefile. | - * +---------------------------------------------------------------+ - * - * }}} */ - -/* {{{ headers */ - -#include -#include -#include - -#include -#include -#include -#include -#include - -#include -#include - -#include -#include -#include - -//define MAGICKCORE_EXCLUDE_DEPRECATED 1 - -/* ImageMagick <= 6.0.1 */ -/* #include */ - -/* ImageMagick >= 6.2.4 */ -#include - - -#include "imagemagick_list.h" -#include "imagemagick.h" - -#include - -/* }}} */ - -/* "ocaml.multimedia.2d_graphics.magick.imagemagick" */ - -/* {{{ alloc_image() */ - -Image *alloc_image(void) -{ - Image *img = malloc(sizeof(Image)) ; - return img ; -} -/* -Image *alloc_image(void) -{ - Image *image ; - ImageInfo *image_info ; - - image_info = CloneImageInfo((ImageInfo *) NULL) ; - image = AllocateImage(image_info) ; - DestroyImageInfo(image_info) ; - return image ; -} -*/ - -/* }}} */ -/* {{{ finalize_image() */ - -void -finalize_image(value image_bloc) -{ -#if DEBUG - Image *image; - image = Field(image_bloc,1); - if ( strlen(image->filename) ) { - printf("ImageMagick: image finalisation « %s »\n", image->filename ); fflush(stdout); - } else { - printf("ImageMagick: image finalisation\n"); fflush(stdout); - } -#endif - - if ( (Image *) Field(image_bloc,1) != (Image *) NULL ) { - - DestroyImage((Image *) Field(image_bloc,1)); -#if DEBUG - } else { - printf("ImageMagick: attempt to finalize a null image\n"); fflush(stdout); -#endif - } -} -/* Does not work very well: - * - * ImageMagick: image finalisation - * ocamlrun: magick/image.c:1515: DestroyImage: Assertion `image->signature == 0xabacadabUL' failed. - * Aborted - * - * @TODO find a guru to rewrite this part - */ - -/* }}} */ -/* {{{ finalize_images_list() */ - -void finalize_images_list(value image_bloc) -{ -#if DEBUG - Image *image; - image = Field(image_bloc,1); - if ( strlen(image->filename) ) { - printf("ImageMagick: images_list finalisation « %s »\n", image->filename ); fflush(stdout); - } else { - printf("ImageMagick: images_list finalisation\n"); fflush(stdout); - } -#endif - - if ( (Image *) Field(image_bloc,1) != (Image *) NULL ) { - - /* DestroyImage((Image *) Field(image_bloc,1)); */ - DestroyImageList((Image *) Field(image_bloc,1)); - /* - Image *DestroyImageList(Image *image); - */ -#if DEBUG - } else { - printf("ImageMagick: attempt to finalize a null image\n"); fflush(stdout); -#endif - } -} -/* Does not work very well: - * - * ImageMagick: image finalisation - * ocamlrun: magick/image.c:1515: DestroyImage: Assertion `image->signature == 0xabacadabUL' failed. - * Aborted - * - * @TODO find an ocaml-guru to rewrite this part - */ - -/* }}} */ - -/* {{{ im_readimage() - * - * Image *ReadImage(const ImageInfo *image_info, ExceptionInfo *exception) - */ - -CAMLprim value -im_readimage(value input_image_name) -{ - CAMLparam1(input_image_name); - - CAMLlocal1(image_bloc); - - ExceptionInfo - exception; - - ImageInfo - *image_info; - - - image_bloc = alloc_final(2, (*finalize_image), sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - GetExceptionInfo(&exception); - image_info = CloneImageInfo((ImageInfo *) NULL); - /* GetImageInfo(image_info) ; */ - (void) strcpy(image_info->filename, String_val(input_image_name)); - - Field(image_bloc,1) = (value) ReadImage(image_info, &exception); - DestroyImageInfo(image_info); - - if (exception.severity != UndefinedException) { - if ( (Image *)Field(image_bloc,1) != (Image *) NULL) { - DestroyImage((Image *) Field(image_bloc,1)); /* TODO: test me */ - } - failwith( exception.reason ); - /* @TODO exception.description */ - } - - DestroyExceptionInfo(&exception); - - if ((Image *) Field(image_bloc,1) == (Image *) NULL) { - /* exit(1) ; */ - failwith("read_image failed"); - } - - CAMLreturn( image_bloc ); -} -/* }}} */ -/* {{{ im_getimagecanvas() */ -CAMLprim value -im_getimagecanvas(value width, value height, value color) -{ - CAMLparam3(width, height, color); - - CAMLlocal1(image_bloc); - - char - str_buffer[ MaxTextExtent ]; - - int str_len; - - ExceptionInfo - exception; - - ImageInfo - *image_info; - - image_info = CloneImageInfo((ImageInfo *) NULL); - - /* - typedef struct _ImageInfo - { - ... - char *size; - char filename[MaxTextExtent]; - ... - } ImageInfo - */ - - /* Give image size */ - str_len = snprintf( str_buffer, MaxTextExtent, "%ldx%ld", Long_val(width), Long_val(height) ); - (void) CloneString(&image_info->size, str_buffer); - - /* Give image color */ - str_len = snprintf( str_buffer, MaxTextExtent, "xc:%s", String_val(color) ); - strncpy( image_info->filename, str_buffer, str_len ); - - - image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - GetExceptionInfo(&exception); - - Field(image_bloc,1) = (value) ReadImage(image_info, &exception); - DestroyImageInfo(image_info); - - if (exception.severity != UndefinedException) { - - if ( (Image *)Field(image_bloc,1) != (Image *) NULL) { - DestroyImage((Image *) Field(image_bloc,1)); /* TODO: test me */ - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - if ((Image *) Field(image_bloc,1) == (Image *) NULL) { - /* exit(1) ; */ - failwith("get_canvas failed"); - } - - CAMLreturn (image_bloc); -} -/* }}} */ -/* {{{ im_create_image() */ -CAMLprim value -im_create_image( value width, value height, value format ) -{ - CAMLparam3( width, height, format ); - - CAMLlocal1( image_bloc ); - - char - str_buffer[ MaxTextExtent ]; - - int - str_len; - - ExceptionInfo - exception; - - ImageInfo - *image_info; - - image_info = CloneImageInfo((ImageInfo *) NULL); - - /* Give image size */ - str_len = snprintf( str_buffer, MaxTextExtent, "%ldx%ld", Long_val(width), Long_val(height) ); - (void) CloneString(&image_info->size, str_buffer); - - /* Give image format */ - str_len = snprintf( str_buffer, MaxTextExtent, "%s", String_val(format) ); - strncpy( image_info->filename, str_buffer, str_len ); - - - image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - GetExceptionInfo(&exception); - - Field(image_bloc,1) = (value) ReadImage(image_info, &exception); - DestroyImageInfo(image_info); - - if (exception.severity != UndefinedException) { - - if ( (Image *)Field(image_bloc,1) != (Image *) NULL) { - DestroyImage((Image *) Field(image_bloc,1)); /* TODO: test me */ - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - if ((Image *) Field(image_bloc,1) == (Image *) NULL) { - /* exit(1) ; */ - failwith("create_image failed"); - } - - CAMLreturn( image_bloc ); -} -/* }}} */ - -#if 0 -/* {{{ imper_constituteimage() - * - * image = ConstituteImage(640, 480, "RGB", CharPixel, pixels, &exception); - * - * Image *ConstituteImage( - * const unsigned long columns, - * const unsigned long rows, - * const char *map, - * const StorageType storage, - * const void *pixels, - * ExceptionInfo *exception ) - */ - -CAMLprim value imper_constituteimage(value columns, value rows, value map) -{ - CAMLparam3(columns, rows, map); - - CAMLlocal1(image_bloc); - - ExceptionInfo - exception; - - const void - *pixels = malloc(sizeof(CharPixel) * Long_val(columns) * Long_val(rows)); - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); - Field(image_bloc,1) = (value) alloc_image(); - - GetExceptionInfo(&exception); - -#if DEBUG - printf("before ConstituteImage call\n"); fflush(stdout); -#endif - Field(image_bloc,1) = ConstituteImage(Long_val(columns), Long_val(rows), - String_val(map), CharPixel, pixels, - &exception ); -#if DEBUG - printf("after ConstituteImage call\n"); fflush(stdout); -#endif - - if (exception.severity != UndefinedException) { - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - if ((Image *) Field(image_bloc,1) == (Image *) NULL) { - exit(1); - } - - CAMLreturn (image_bloc); -} -/* }}} */ -/* {{{ imper_newmagickimage() - * - * Image *NewMagickImage(const ImageInfo *image_info, - * const unsigned long width, const unsigned long height, - * const MagickPixelPacket *background) - -typedef struct _MagickPixelPacket -{ - ColorspaceType - colorspace; - - MagickBooleanType - matte; - - double - fuzz; - - unsigned long - depth; - - MagickRealType - red, - green, - blue, - opacity, - index; -} MagickPixelPacket; - - */ -CAMLprim value -imper_newmagickimage_native( value width, value height, - value background_red, - value background_green, - value background_blue, - value background_opacity ) -{ - CAMLparam5( width, height, background_red, background_green, background_blue ); - CAMLxparam1( background_opacity ); - - CAMLlocal1(image_bloc); - - ImageInfo - *image_info; - - MagickPixelPacket - background; - /* - void GetMagickPixelPacket(const Image *image, MagickPixelPacket *pixel); - */ - GetMagickPixelPacket( (Image *) NULL, &background); - - background.colorspace = (ColorspaceType) RGBColorspace; - background.matte = (MagickBooleanType) MagickTrue; - background.fuzz = (double) 0.2; - background.depth = (unsigned long) 16; - - background.red = (MagickRealType) Int_val(background_red); - background.green = (MagickRealType) Int_val(background_green); - background.blue = (MagickRealType) Int_val(background_blue); - background.opacity = (MagickRealType) Int_val(background_opacity); - background.index = (MagickRealType) 0; - - image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - Field(image_bloc,1) = (value) alloc_image(); /* alloc_image() */ - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - image_info = CloneImageInfo((ImageInfo *) NULL); - /* GetImageInfo(image_info); */ - /* (void) strcpy(image_info->filename, String_val(input_image_name)); */ - - Field(image_bloc,1) = (value) NewMagickImage(image_info, - Long_val(width), Long_val(height), - &background ); - - DestroyImageInfo(image_info); - - if ((Image *) Field(image_bloc,1) == (Image *) NULL) { - failwith("newmagickimage failed"); - } - - CAMLreturn (image_bloc); -} - -CAMLprim value -imper_newmagickimage_bytecode(value * argv, int argn) -{ - return imper_newmagickimage_native( - argv[0], argv[1], argv[2], - argv[3], argv[4], argv[5] ); -} -/* }}} */ -/* old: */ -/* {{{ imper_newmagickimage() - * - * Image *NewMagickImage(const ImageInfo *image_info, - * const unsigned long width, const unsigned long height, - * const MagickPixelPacket *background) - -typedef struct _MagickPixelPacket -{ - ColorspaceType - colorspace; - - MagickBooleanType - matte; - - double - fuzz; - - unsigned long - depth; - - MagickRealType - red, - green, - blue, - opacity, - index; -} MagickPixelPacket; - - */ -CAMLprim value -imper_newmagickimage_native( value width, value height, - value background_red, - value background_green, - value background_blue, - value background_opacity ) -{ - CAMLparam5( width, height, background_red, background_green, background_blue ) ; - CAMLxparam1( background_opacity ) ; - - CAMLlocal1(image_bloc) ; - /* - value - image_bloc ; - */ - - ImageInfo - *image_info ; - - MagickPixelPacket - *background ; - - MagickPixelPacket - pixel ; - - PixelGetMagickColor(background, &pixel); - /* - background->colorspace = (ColorspaceType) RGBColorspace; - - background->matte = (MagickBooleanType) MagickTrue; - background->fuzz = (double) 0.2; - background->depth = (unsigned long) 1; - - background->red = (MagickRealType) Int_val(background_red); - background->green = (MagickRealType) Int_val(background_green); - background->blue = (MagickRealType) Int_val(background_blue); - background->opacity = (MagickRealType) Int_val(background_opacity); - background->index = (MagickRealType) 1; - */ - - image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - Field(image_bloc,1) = (value) alloc_image(); /* alloc_image() */ - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - image_info = CloneImageInfo((ImageInfo *) NULL); - /* GetImageInfo(image_info); */ - /* (void) strcpy(image_info->filename, String_val(input_image_name)); */ - - Field(image_bloc,1) = (value) NewMagickImage(image_info, - Long_val(width), Long_val(height), - &pixel ); - - DestroyImageInfo(image_info); - - - - if ((Image *) Field(image_bloc,1) == (Image *) NULL) { - /* printf("newmagickimage failed\n") ; fflush(stdout) ; */ - failwith("newmagickimage failed"); - /* exit(1) ; */ - } - - CAMLreturn (image_bloc) ; -} - -CAMLprim value -imper_newmagickimage_bytecode(value * argv, int argn) -{ - return imper_newmagickimage_native( - argv[0], argv[1], argv[2], - argv[3], argv[4], argv[5] ) ; -} -/* }}} */ -#endif - -/* {{{ im_writeimage() - * - * MagickBooleanType WriteImage(const ImageInfo *image_info, Image *image); - */ - -CAMLprim value -im_writeimage(value image_bloc, value output_image_name) -{ - CAMLparam2(image_bloc, output_image_name); - - Image - *image; - - ImageInfo - *image_info; - - MagickBooleanType - ret; - - image = (Image *) Field(image_bloc,1); - - (void) strcpy(image->filename, String_val(output_image_name)); - image_info = CloneImageInfo((ImageInfo *) NULL); - - ret = WriteImage(image_info, image); /* WriteImage() */ - - if (ret == MagickFalse) { - failwith("write_image failed"); - } - DestroyImageInfo(image_info); - - CAMLreturn( Val_unit ); -} -/* }}} */ -/* {{{ im_displayimages() - * - * MagickBooleanType DisplayImages(const ImageInfo *image_info, Image *images) - */ - -CAMLprim value -im_displayimages(value image_bloc) -{ - CAMLparam1(image_bloc) ; - - Image - *image ; - - ImageInfo - *image_info ; - - MagickBooleanType - ret ; - - image = (Image *) Field(image_bloc,1) ; - - image_info = CloneImageInfo((ImageInfo *) NULL) ; - ret = DisplayImages(image_info, image) ; /* DisplayImages() */ - DestroyImageInfo(image_info) ; - - /* @TODO check this exception. */ - if (ret == MagickFalse) { - /* - * DisplayImages() displays an image sequence to any X window screen. - * It returns a value other than 0 if successful. - * Check the exception member of image to determine the reason for any failure. - */ - - /* - failwith( image_info.exception ) ; - failwith( image.exception ) ; - */ - - failwith("display failed") ; - } - - CAMLreturn (Val_unit) ; -} -/* }}} */ -/* {{{ im_cloneimage() - * - * Image *CloneImage(const Image *image, const unsigned long columns, - * const unsigned long rows, const MagickBooleanType orphan, - * ExceptionInfo *exception) - */ -CAMLprim value -im_cloneimage(value image_bloc) -{ - CAMLparam1(image_bloc); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(new_image_bloc,1) = (value) CloneImage( - (Image *) Field(image_bloc,1), - 0, 0, 1, - &exception ); - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - -/* }}} */ - - -/* {{{ @TODO: PlasmaImage() | - -PlasmaImage() initializes an image with plasma fractal values. -The image must be initialized with a base color and the random number generator seeded before this method is called. - - -image: The image. -segment: Define the region to apply plasma fractals values. -attenuate: Define the plasma attenuation factor. -depth: Limit the plasma recursion depth. - -}}} */ -/* {{{ imper_plasmaimage() - * - * MagickBooleanType PlasmaImage(Image *image, const SegmentInfo *segment, - * unsigned long attenuate, unsigned long depth ) - */ -CAMLprim value -imper_plasmaimage_native( - value image_bloc, - value x1, value y1, - value x2, value y2, - value attenuate, - value depth ) -{ - CAMLparam5( image_bloc, x1, y1, x2, y2 ); - CAMLxparam2( attenuate, depth ); - - MagickBooleanType - ret; - - SegmentInfo - segment_info; - - /* - typedef struct _SegmentInfo - { - double - x1, - y1, - x2, - y2; - } SegmentInfo; - */ - segment_info.x1 = (double) Long_val(x1); - segment_info.y1 = (double) Long_val(y1); - segment_info.x2 = (double) Long_val(x2); - segment_info.y2 = (double) Long_val(y2); - - - ret = PlasmaImage( - (Image *) Field(image_bloc,1), - &segment_info, - (unsigned long) Long_val(attenuate), - (unsigned long) Long_val(depth) ); - - - if (ret == MagickFalse) { - failwith("get_plasma_image failed"); - } - - if ((Image *) Field(image_bloc,1) == (Image *) NULL) { - /* exit(1) ; */ - failwith("get_plasma_image failed"); - } - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_plasmaimage_bytecode(value * argv, int argn) -{ - return imper_plasmaimage_native( - argv[0], argv[1], argv[2], argv[3], - argv[4], argv[5], argv[6] ); -} -/* }}} */ - -/* -\define CONVALparam1(p) CAMLparam1(p) -*/ -#define CONVALparam1(p) /*CAMLparam1(p)*/ - -/* {{{ CompositeOperator_val() */ - -static int -CompositeOperator_val( value param ) -{ - CONVALparam1 (param); - -#if TYPE_CHECKING - assert (Is_long (param)); -#endif - - switch (Int_val (param)) - { - /* {{{ cases */ - case 0: return UndefinedCompositeOp; - case 1: return NoCompositeOp; - case 2: return AddCompositeOp; - case 3: return AtopCompositeOp; - case 4: return BlendCompositeOp; - case 5: return BumpmapCompositeOp; - case 6: return ClearCompositeOp; - case 7: return ColorBurnCompositeOp; - case 8: return ColorDodgeCompositeOp; - case 9: return ColorizeCompositeOp; - case 10: return CopyBlackCompositeOp; - case 11: return CopyBlueCompositeOp; - case 12: return CopyCompositeOp; - case 13: return CopyCyanCompositeOp; - case 14: return CopyGreenCompositeOp; - case 15: return CopyMagentaCompositeOp; - case 16: return CopyOpacityCompositeOp; - case 17: return CopyRedCompositeOp; - case 18: return CopyYellowCompositeOp; - case 19: return DarkenCompositeOp; - case 20: return DstAtopCompositeOp; - case 21: return DstCompositeOp; - case 22: return DstInCompositeOp; - case 23: return DstOutCompositeOp; - case 24: return DstOverCompositeOp; - case 25: return DifferenceCompositeOp; - case 26: return DisplaceCompositeOp; - case 27: return DissolveCompositeOp; - case 28: return ExclusionCompositeOp; - case 29: return HardLightCompositeOp; - case 30: return HueCompositeOp; - case 31: return InCompositeOp; - case 32: return LightenCompositeOp; - case 33: return LuminizeCompositeOp; - case 34: return MinusCompositeOp; - case 35: return ModulateCompositeOp; - case 36: return MultiplyCompositeOp; - case 37: return OutCompositeOp; - case 38: return OverCompositeOp; - case 39: return OverlayCompositeOp; - case 40: return PlusCompositeOp; - case 41: return ReplaceCompositeOp; - case 42: return SaturateCompositeOp; - case 43: return ScreenCompositeOp; - case 44: return SoftLightCompositeOp; - case 45: return SrcAtopCompositeOp; - case 46: return SrcCompositeOp; - case 47: return SrcInCompositeOp; - case 48: return SrcOutCompositeOp; - case 49: return SrcOverCompositeOp; - case 50: return SubtractCompositeOp; - case 51: return ThresholdCompositeOp; - case 52: return XorCompositeOp; - /* }}} */ - default: -#if DEBUG - fprintf(stderr, "CompositeOperator_val() failed\n"); fflush(stderr); -#endif - abort(); - } -} - -/* }}} */ -/* {{{ imper_compositeimage() - * - * MagickBooleanType CompositeImage(Image *image, - * const CompositeOperator compose,const Image *composite_image, - * const long x_offset, const long y_offset) - */ -CAMLprim value imper_compositeimage( - value image_bloc, - value composite_image_bloc, - value x_offset, - value y_offset, - value composite_operator ) -{ - CAMLparam5(image_bloc, composite_image_bloc, x_offset, y_offset, composite_operator) ; - - /* - unsigned int - ret ; - */ - MagickBooleanType - ret ; - -#if CHECK_VALS - if () - { - /* - invalid_argument(""); - */ - } -#endif - - /* - ret = CompositeImage( - (Image *) Field(image_bloc,1), - Int_val(composite_operator), - (Image *) Field(composite_image_bloc,1), - Long_val(x_offset), - Long_val(y_offset) ) ; - */ - ret = CompositeImage( - (Image *) Field(image_bloc,1), - CompositeOperator_val(composite_operator), - (Image *) Field(composite_image_bloc,1), - Long_val(x_offset), - Long_val(y_offset) ) ; - - /* @TODO check this exception. */ - if (ret == MagickFalse) { - failwith("composite_image failed"); - } - - CAMLreturn( Val_unit ); -} - -/* }}} */ - -/* {{{ @TODO: for ChopImage() | - * raise invalid_argument rather than produce a failure - * if the geometry is out of the dimention of the image. - */ -#if CHECK_VALS - if () /* invalid_argument(""); */ -#endif -/* }}} */ - -/* {{{ imper_textureimage() - * - * MagickBooleanType TextureImage(Image *image, const Image *texture) - * - */ -CAMLprim value imper_textureimage( - value image_bloc, - value texture_image_bloc ) -{ - CAMLparam2(image_bloc, texture_image_bloc); - - MagickBooleanType - ret; - - ret = TextureImage( - (Image *) Field(image_bloc,1), - (Image *) Field(texture_image_bloc,1) ); - - /* @TODO check this exception. */ - if (ret == MagickFalse) { - failwith("texture_image failed"); - } - - CAMLreturn( Val_unit ); -} - -/* }}} */ - - -/* {{{ imper_colorizeimage() - * - * Image *ColorizeImage(const Image *image, const char *opacity, const PixelPacket target, ExceptionInfo *exception) - */ - -CAMLprim value -imper_colorizeimage_native( - value image_bloc, - value opacity, - value target_red, - value target_green, - value target_blue, - value target_opacity ) -{ - CAMLparam5( image_bloc, opacity, target_red, target_green, target_blue ); - CAMLxparam1( target_opacity ); - - Image - *new_image; - - ExceptionInfo - exception; - - PixelPacket - target; - - GetExceptionInfo(&exception); - - target.red = (Quantum) Long_val(target_red); - target.green = (Quantum) Long_val(target_green); - target.blue = (Quantum) Long_val(target_blue); - target.opacity = (Quantum) Long_val(target_opacity); - - /* QueryColorDatabase( color, target, &handle->exception ); */ - - new_image = ColorizeImage( - (Image *) Field(image_bloc,1), - String_val(opacity), - target, - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_colorizeimage_bytecode(value * argv, int argn) -{ - return imper_colorizeimage_native( - argv[0], argv[1], argv[2], - argv[3], argv[4], argv[5] ); -} - -/* }}} */ - - -/* {{{ imper_acquireonepixel() - * - * PixelPacket AcquireOnePixel(const Image image, - * const long x, const long y, - * ExceptionInfo exception) - */ - -CAMLprim value -imper_acquireonepixel( - value image_bloc, - value x, - value y ) -{ - CAMLparam3( image_bloc, x, y ); - - CAMLlocal1( tuple_color ); - - ExceptionInfo - exception; - - PixelPacket - pixel; - - GetExceptionInfo(&exception); - - /* DEPR - pixel = AcquireOnePixel( - (Image *) Field(image_bloc,1), - Long_val(x), - Long_val(y), - &exception ); - */ - - GetOneVirtualPixel( - (Image *) Field(image_bloc,1), - Long_val(x), - Long_val(y), - &pixel, - &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - value pixel_red = Val_int( (int) pixel.red ); - value pixel_green = Val_int( (int) pixel.green ); - value pixel_blue = Val_int( (int) pixel.blue ); - value pixel_alpha = Val_int( (int) (MaxMap - pixel.opacity) ); - - tuple_color = alloc_tuple(4) ; - - Store_field(tuple_color, 0, pixel_red ); - Store_field(tuple_color, 1, pixel_green ); - Store_field(tuple_color, 2, pixel_blue ); - Store_field(tuple_color, 3, pixel_alpha ); - - CAMLreturn( tuple_color ); -} - -/* }}} */ -/* {{{ imper_acquireonepixel_opacity() - * - * PixelPacket AcquireOnePixel(const Image image, - * const long x, const long y, - * ExceptionInfo exception) - */ - -CAMLprim value -imper_acquireonepixel_opacity( - value image_bloc, - value x, - value y ) -{ - CAMLparam3( image_bloc, x, y ); - - CAMLlocal1( tuple_color ); - - ExceptionInfo - exception; - - PixelPacket - pixel; - - GetExceptionInfo(&exception); - - /* DEPR - pixel = AcquireOnePixel( - (Image *) Field(image_bloc,1), - Long_val(x), - Long_val(y), - &exception ); - */ - - GetOneVirtualPixel( - (Image *) Field(image_bloc,1), - Long_val(x), - Long_val(y), - &pixel, - &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - value pixel_red = Val_int( (int) pixel.red ); - value pixel_green = Val_int( (int) pixel.green ); - value pixel_blue = Val_int( (int) pixel.blue ); - value pixel_opacity = Val_int( (int) pixel.opacity ); - - tuple_color = alloc_tuple(4); - - Store_field(tuple_color, 0, pixel_red ); - Store_field(tuple_color, 1, pixel_green ); - Store_field(tuple_color, 2, pixel_blue ); - Store_field(tuple_color, 3, pixel_opacity ); - - CAMLreturn( tuple_color ); -} - -/* }}} */ - - -/* {{{ @TODO: - * Perhaps the _image structures in ping functions should be freed at the end? - * }}} */ -/* {{{ imper_ping_image_infos() - * - * Image *PingImage(const ImageInfo *image_info, ExceptionInfo *exception) - */ - -CAMLprim value -imper_ping_image_infos(value input_image_name) -{ - CAMLparam1( input_image_name ); - CAMLlocal2( pong_tuple, mimetype ); - - Image *_image; - - ExceptionInfo - exception; - - ImageInfo - *image_info; - - char* - mime_type; - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - GetExceptionInfo(&exception); - image_info = CloneImageInfo((ImageInfo *) NULL); - (void) strcpy(image_info->filename, String_val(input_image_name)); - - _image = PingImage(image_info, &exception); - DestroyImageInfo(image_info); - - if (exception.severity != UndefinedException) { - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - if (!_image) { - failwith("ping_image_infos failed"); - } - - mime_type = MagickToMime(_image->magick); - - value width = Val_long(_image->columns); - value height = Val_long(_image->rows); - value depth = Val_long(_image->depth); - value colors = Val_long(_image->colors); - value quality = Val_long(_image->quality); - mimetype = copy_string( mime_type ); - - /* TODO - * BUG XXX FIXME - * Perhaps the _image structure should be freed at this point? - */ - - pong_tuple = alloc_tuple(6); - - Store_field(pong_tuple, 0, width ); - Store_field(pong_tuple, 1, height ); - Store_field(pong_tuple, 2, depth ); - Store_field(pong_tuple, 3, colors ); - Store_field(pong_tuple, 4, quality ); - Store_field(pong_tuple, 5, mimetype ); - - CAMLreturn( pong_tuple ); -} -/* }}} */ -/* {{{ imper_ping_image() - * - * Image *PingImage(const ImageInfo *image_info, ExceptionInfo *exception) - */ - -CAMLprim value -imper_ping_image(value input_image_name) -{ - CAMLparam1(input_image_name); - - Image *_image; - - ExceptionInfo - exception; - - ImageInfo - *image_info; - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - GetExceptionInfo(&exception); - image_info = CloneImageInfo((ImageInfo *) NULL); - (void) strcpy(image_info->filename, String_val(input_image_name)); - - _image = PingImage(image_info, &exception); - DestroyImageInfo(image_info); - - if (exception.severity != UndefinedException) { - - CAMLreturn( Val_false ); - } - - DestroyExceptionInfo(&exception); - - if (!_image) { - CAMLreturn( Val_false ); - } - - /* TODO - * BUG XXX FIXME - * Perhaps the _image structure should be freed at this point? - */ - - CAMLreturn( Val_true ); -} -/* }}} */ - - -/* {{{ @NOTICE: - the getnumbercolors and getimagehistogram have been swapped - between the libMagick and the OCaml-binding, because - getnumbercolors returns an image histogram, and - getimagehistogram only returns the number of colors. }}} */ -/* {{{ imper_getnumbercolors() - * - * unsigned long GetNumberColors(const Image *image, FILE *file, ExceptionInfo *exception) - */ -CAMLprim value -imper_getnumbercolors(value image_bloc, value hist_file) -{ - CAMLparam2(image_bloc, hist_file); - - FILE* fp; - - unsigned long - unique_colors; /* the number of unique colors */ - - ExceptionInfo exception; - - fp = fopen( String_val(hist_file), "w" ); - if ( !fp ) { - failwith("could not write to histogram file"); - } - - GetExceptionInfo(&exception); - - unique_colors = GetNumberColors( - (Image *) Field(image_bloc,1), - fp, - &exception ); - fclose( fp ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( Val_long(unique_colors) ); -} -/* }}} */ -/* {{{ imper_getimagehistogram() - * - * ColorPacket *GetImageHistogram(const Image *image, unsigned long *number_colors, ExceptionInfo *exception); - */ -CAMLprim value -imper_getimagehistogram(value image_bloc) -{ - CAMLparam1(image_bloc); - - ColorPacket* color_packet; - - unsigned long - unique_colors; /* the number of unique colors */ - - ExceptionInfo exception; - - GetExceptionInfo(&exception); - - color_packet = GetImageHistogram( - (Image *) Field(image_bloc,1), - &unique_colors, - &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( Val_long(unique_colors) ); -} -/* }}} */ - - -/* {{{ imper_getmaxcolormap() - * - * magick-type.h - * #define MaxMap N - */ -CAMLprim value -imper_getmaxcolormap( value unit ) -{ - CAMLparam1(unit); - - CAMLreturn( Val_long( MaxMap )); -} -/* }}} */ - - -/* {{{ ImageType_val() */ - -static int -ImageType_val( value param ) -{ - CONVALparam1 (param); - -#if TYPE_CHECKING - assert(Is_long(param)); -#endif - - switch (Int_val(param)) - { - case 0: return UndefinedType; - case 1: return BilevelType; - case 2: return GrayscaleType; - case 3: return GrayscaleMatteType; - case 4: return PaletteType; - case 5: return PaletteMatteType; - case 6: return TrueColorType; - case 7: return TrueColorMatteType; - case 8: return ColorSeparationType; - case 9: return ColorSeparationMatteType; - case 10: return OptimizeType; - default: -#if DEBUG - fprintf(stderr, "ImageType_val() failed\n"); fflush(stderr); -#endif - abort(); - } -} - -/* }}} */ - -/* {{{ Val_ImageType() - * - * ImageType GetImageType(const Image *image, ExceptionInfo *exception) - */ -int -Val_ImageType(ImageType image_type) -{ -/* -typedef enum -{ - UndefinedType, - BilevelType, - GrayscaleType, - GrayscaleMatteType, - PaletteType, - PaletteMatteType, - TrueColorType, - TrueColorMatteType, - ColorSeparationType, - ColorSeparationMatteType, - OptimizeType -} ImageType; -*/ - switch (image_type) - { - case UndefinedType: return 0; - case BilevelType: return 1; - case GrayscaleType: return 2; - case GrayscaleMatteType: return 3; - case PaletteType: return 4; - case PaletteMatteType: return 5; - case TrueColorType: return 6; - case TrueColorMatteType: return 7; - case ColorSeparationType: return 8; - case ColorSeparationMatteType: return 9; - case OptimizeType: return 10; - default: return 11; /* Error */ - } -} - -/* }}} */ - -/* {{{ imper_getimagetype() - * - * ImageType GetImageType(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value -imper_getimagetype(value image_bloc) -{ - CAMLparam1(image_bloc); - - ExceptionInfo exception; - - ImageType image_type; - int image_type_code; - - GetExceptionInfo(&exception); - - image_type = GetImageType( - (Image *) Field(image_bloc,1), - &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - image_type_code = Val_ImageType(image_type); - - if ( image_type_code == 11 ) { - failwith("get_image_type failed: the ImageType structure of the MagickCore has been upgraded"); - } - - CAMLreturn( Val_int(image_type_code) ); -} -/* }}} */ -/* {{{ imper_setimagetype() - * - * MagickBooleanType SetImageType(Image *image, const ImageType image_type) - */ - -CAMLprim value -imper_setimagetype(value image_bloc, value image_type) -{ - CAMLparam2(image_bloc, image_type); - - MagickBooleanType - ret; - - ret = SetImageType( - (Image *) Field(image_bloc,1), - ImageType_val(image_type) ); - - if (ret == MagickFalse) { - failwith("set_image_type failed"); - } - - CAMLreturn( Val_unit ); -} -/* }}} */ - -/* Work in Progress */ - -CAMLprim value -imper_setimagetype__(value image_bloc) -{ - CAMLparam1(image_bloc); - - MagickBooleanType - ret; - - ret = SetImageType( - (Image *) Field(image_bloc,1), - TrueColorMatteType ); - - if (ret == MagickFalse) { - failwith("set_image_type failed"); - } - - CAMLreturn( Val_unit ); -} - -/* {{{ _Val_AffineMatrix() - -typedef struct _AffineMatrix -{ - double - sx, - rx, - ry, - sy, - tx, - ty; -} AffineMatrix; - - */ -void -_Val_AffineMatrix( - AffineMatrix *affine_matrix, - double sx, - double rx, - double ry, - double sy, - double tx, - double ty ) -{ - affine_matrix->sx = sx; - affine_matrix->rx = rx; - affine_matrix->ry = ry; - affine_matrix->sy = sy; - affine_matrix->tx = tx; - affine_matrix->ty = ty; -} - -void -Inspect_AffineMatrix( AffineMatrix *affine_matrix ) -{ - printf(" AffineMatrix\n" - " sx:%g\n" - " rx:%g\n" - " ry:%g\n" - " sy:%g\n" - " tx:%g\n" - " ty:%g\n", - affine_matrix->sx, - affine_matrix->rx, - affine_matrix->ry, - affine_matrix->sy, - affine_matrix->tx, - affine_matrix->ty ); -} -/* }}} */ -/* {{{ imper_affinetransformimage() - * - * Image *AffineTransformImage(const Image *image, AffineMatrix *affine, ExceptionInfo *exception) - */ -CAMLprim value -imper_affinetransformimage_native( - value image_bloc, - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, sx, rx, ry, sy ); - CAMLxparam2( tx, ty ); - - ExceptionInfo - exception; - - AffineMatrix - affine_matrix; - - Image - *new_image; - - GetExceptionInfo(&exception); - - - _Val_AffineMatrix( &affine_matrix, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - - /* - Inspect_AffineMatrix( &affine_matrix ); - */ - - new_image = AffineTransformImage( - (Image *) Field(image_bloc,1), - &affine_matrix, - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - CAMLreturn( Val_unit ); -} - - -CAMLprim value -imper_affinetransformimage_bytecode(value * argv, int argn) -{ - return imper_affinetransformimage_native( - argv[0], argv[1], argv[2], argv[3], - argv[4], argv[5], argv[6] ); -} - -/* }}} */ -/* {{{ fun_affinetransformimage() - * - * Image *AffineTransformImage(const Image *image, AffineMatrix *affine, ExceptionInfo *exception) - */ -CAMLprim value -fun_affinetransformimage_native( - value image_bloc, - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, sx, rx, ry, sy ); - CAMLxparam2( tx, ty ); - CAMLlocal1(new_image_bloc); - - ExceptionInfo - exception; - - AffineMatrix - affine_matrix; - - GetExceptionInfo(&exception); - - - new_image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - _Val_AffineMatrix( &affine_matrix, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - - /* - Inspect_AffineMatrix( &affine_matrix ); - */ - - Field(new_image_bloc,1) = - (value) AffineTransformImage( - (Image *) Field(image_bloc,1), - &affine_matrix, - &exception ); - - - if (exception.severity != UndefinedException) - { - if ( Field(new_image_bloc,1) ) - { - DestroyImage( (Image *) Field(new_image_bloc,1) ); - } - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - CAMLreturn( new_image_bloc ); -} - - -CAMLprim value -fun_affinetransformimage_bytecode(value * argv, int argn) -{ - return fun_affinetransformimage_native( - argv[0], argv[1], argv[2], argv[3], - argv[4], argv[5], argv[6] ); -} - -/* }}} */ - - -/* {{{ imper_setimageopacity() - * - * void SetImageOpacity(Image *image, const Quantum opacity) - */ -CAMLprim value -imper_setimageopacity( - value image_bloc, - value opacity ) -{ - CAMLparam2( image_bloc, opacity ); - - SetImageOpacity( - (Image *) Field(image_bloc,1), - (Quantum) Long_val(opacity) ); - - CAMLreturn( Val_unit ); -} -/* }}} */ - -/* {{{ ==== GET INFOS ==== */ - -/* {{{ imper_getimagewidth() - * - * image->columns - */ -CAMLprim value -imper_getimagewidth( value image_bloc ) -{ - CAMLparam1(image_bloc); - - CAMLreturn( Val_long( - ((Image *) Field(image_bloc,1))->columns - ) ); -} - -/* }}} */ -/* {{{ imper_getimageheight() - * - * image->rows - */ -CAMLprim value -imper_getimageheight( value image_bloc ) -{ - CAMLparam1(image_bloc); - - CAMLreturn( Val_long( - ((Image *) Field(image_bloc,1))->rows - ) ); -} - -/* }}} */ -/* {{{ imper_getimagedepth() - * - * image->depth - */ -CAMLprim value -imper_getimagedepth( value image_bloc ) -{ - CAMLparam1(image_bloc); - - CAMLreturn( Val_long( - ((Image *) Field(image_bloc,1))->depth - ) ); -} - -/* }}} */ -/* {{{ imper_getimagecolors() - * - * image->colors - */ -CAMLprim value -imper_getimagecolors( value image_bloc ) -{ - CAMLparam1(image_bloc); - - CAMLreturn( Val_long( - ((Image *) Field(image_bloc,1))->colors - ) ); -} - -/* }}} */ -/* {{{ imper_getimagecolorspace() - * - * image->colorspace - */ -CAMLprim value -imper_getimagecolorspace( value image_bloc ) -{ - CAMLparam1(image_bloc); - - CAMLreturn( Val_long( - ((Image *) Field(image_bloc,1))->colorspace - ) ); -} - -/* }}} */ -/* {{{ imper_getimagequality() - * - * image->quality - */ -CAMLprim value -imper_getimagequality( value image_bloc ) -{ - CAMLparam1(image_bloc); - - CAMLreturn( Val_long( - ((Image *) Field(image_bloc,1))->quality - ) ); -} - -/* }}} */ - -/* {{{ imper_setimagecolors() - * - * image->colors - */ -CAMLprim value -imper_setimagecolors( value image_bloc, value colors ) -{ - CAMLparam2(image_bloc, colors); - - /* @TODO test this function */ - - ((Image *) Field(image_bloc,1))->colors = Long_val(colors); - - CAMLreturn( Val_unit ); -} - -/* }}} */ -/* {{{ imper_setcompressionquality() - * - * image->quality - */ -CAMLprim value -imper_setcompressionquality( value image_bloc, value compression_quality ) -{ - CAMLparam2(image_bloc, compression_quality); - - /* @TODO check this function */ - - ((Image *) Field(image_bloc,1))->quality = Long_val(compression_quality); - - CAMLreturn( Val_unit ); -} - -/* }}} */ - -/* {{{ imper_getimagemimetype() - * - */ -CAMLprim value -imper_getimagemimetype( value image_bloc ) -{ - CAMLparam1(image_bloc); - - char* - mime_type; - - mime_type = MagickToMime( - ((Image *) Field(image_bloc,1))->magick - ); - - CAMLreturn( copy_string( mime_type ) ); -} - -/* }}} */ -/* {{{ imper_getimagesize() - * - * image->columns - * image->rows - */ -CAMLprim value -imper_getimagesize( value image_bloc ) -{ - CAMLparam1(image_bloc); - - unsigned long - width, height; - - char* - size; - - int ret; - - if ( (size = malloc(256)) == NULL ) { - failwith("get_image_size failed") ; - } - - width = ((Image *) Field(image_bloc,1))->columns; - height = ((Image *) Field(image_bloc,1))->rows; - - ret = snprintf(size, 256, "width='%lu' height='%lu'", width, height); - - CAMLreturn( copy_string( size ) ); -} - -/* }}} */ - -/* }}} */ - -/* {{{ ==== TESTS ==== */ - -/* {{{ imper_isgrayimage() - * - * MagickBooleanType IsGrayImage(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value -imper_isgrayimage(value image_bloc) -{ - CAMLparam1(image_bloc); - - MagickBooleanType - ret; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - ret = IsGrayImage( (Image *) Field(image_bloc,1), &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - if ( ret == MagickTrue ) - { - CAMLreturn( Val_true ); - } else { - CAMLreturn( Val_false ); - } -} -/* }}} */ -/* {{{ imper_ismonochromeimage() - * - * MagickBooleanType IsMonochromeImage(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value -imper_ismonochromeimage(value image_bloc) -{ - CAMLparam1(image_bloc); - - MagickBooleanType - ret; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - ret = IsMonochromeImage( (Image *) Field(image_bloc,1), &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - if ( ret == MagickTrue ) - { - CAMLreturn( Val_true ); - } else { - CAMLreturn( Val_false ); - } -} -/* }}} */ -/* {{{ imper_isopaqueimage() - * - * MagickBooleanType IsOpaqueImage(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value -imper_isopaqueimage(value image_bloc) -{ - CAMLparam1(image_bloc); - - MagickBooleanType - ret; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - ret = IsOpaqueImage( (Image *) Field(image_bloc,1), &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - if ( ret == MagickTrue ) - { - CAMLreturn( Val_true ); - } else { - CAMLreturn( Val_false ); - } -} -/* }}} */ -/* {{{ imper_ispaletteimage() - * - * MagickBooleanType IsPaletteImage(const Image *image, ExceptionInfo *exception) - */ -CAMLprim value -imper_ispaletteimage(value image_bloc) -{ - CAMLparam1(image_bloc); - - MagickBooleanType - ret; - - ExceptionInfo - exception; - - GetExceptionInfo(&exception); - - ret = IsPaletteImage( (Image *) Field(image_bloc,1), &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - if ( ret == MagickTrue ) - { - CAMLreturn( Val_true ); - } else { - CAMLreturn( Val_false ); - } -} -/* }}} */ -/* {{{ imper_istaintimage() - * - * MagickBooleanType IsTaintImage(const Image *image) - */ -CAMLprim value -imper_istaintimage(value image_bloc) -{ - CAMLparam1(image_bloc); - - MagickBooleanType - ret; - - ret = IsTaintImage( (Image *) Field(image_bloc,1) ); - - if ( ret == MagickTrue ) - { - CAMLreturn( Val_true ); - } else { - CAMLreturn( Val_false ); - } -} -/* }}} */ -/* {{{ imper_isimagesequal() - * - * MagickBooleanType IsImagesEqual(Image *image, const Image *reconstruct_image) - */ -CAMLprim value -imper_isimagesequal(value image_bloc, value comp_image_bloc) -{ - CAMLparam2( image_bloc, comp_image_bloc ); - CAMLlocal4( - tuple_errors, - mean_error_per_pixel, - normalized_mean_error, - normalized_maximum_error ); - - MagickBooleanType - ret; - - ret = IsImagesEqual( - (Image *) Field(image_bloc,1), - (Image *) Field(comp_image_bloc,1) ); - - tuple_errors = alloc_tuple(4); - - if ( ret == MagickTrue ) { - Store_field(tuple_errors, 0, Val_true ); - } else { - Store_field(tuple_errors, 0, Val_false ); - } - - Image *image; - image = (Image *) Field(image_bloc,1); - - /* OLD - value mean_error_per_pixel = copy_double((double)image->error.mean_error_per_pixel); - value normalized_mean_error = copy_double((double)image->error.normalized_mean_error); - value normalized_maximum_error = copy_double((double)image->error.normalized_maximum_error); - */ - - /* - mean_error_per_pixel = caml_copy_double((double)image->error.mean_error_per_pixel); - normalized_mean_error = caml_copy_double((double)image->error.normalized_mean_error); - normalized_maximum_error = caml_copy_double((double)image->error.normalized_maximum_error); - - Store_field(tuple_errors, 1, mean_error_per_pixel ); - Store_field(tuple_errors, 2, normalized_mean_error ); - Store_field(tuple_errors, 3, normalized_maximum_error ); - */ - - Store_field(tuple_errors, 1, caml_copy_double( image->error.mean_error_per_pixel ) ); - Store_field(tuple_errors, 2, caml_copy_double( image->error.normalized_mean_error ) ); - Store_field(tuple_errors, 3, caml_copy_double( image->error.normalized_maximum_error ) ); - - CAMLreturn( tuple_errors ); -} -/* }}} */ - -/* }}} */ - -/* {{{ ==== ABOUT IM ==== */ - -/* {{{ imper_getmagickcopyright() - * - * const char *GetMagickCopyright(void) - */ -CAMLprim value -imper_getmagickcopyright( value unit ) -{ - CAMLparam1(unit); - const char* copyright; - - copyright = GetMagickCopyright(); - - CAMLreturn(copy_string( copyright )); -} -/* }}} */ -/* {{{ imper_getmagickhomeurl() - * - * char *GetMagickHomeURL(void) - */ -CAMLprim value -imper_getmagickhomeurl( value unit ) -{ - CAMLparam1(unit); - - CAMLreturn(copy_string( - GetMagickHomeURL() - )); -} -/* }}} */ -/* {{{ imper_getmagickquantumdepth() - * - * const char *GetMagickQuantumDepth(unsigned long *depth) - */ -CAMLprim value -imper_getmagickquantumdepth( value unit ) -{ - CAMLparam1(unit); - CAMLlocal2( tuple_quantum_depth, str_quantum_depth ); /* bug-fixed. found in V0.19 by F.Le Fessant */ - - const char* quantum_depth; - unsigned long *depth; - - depth = (unsigned long *)NULL; - - quantum_depth = GetMagickQuantumDepth(depth); - - value int_quantum_depth = Val_int( (int) depth ); - str_quantum_depth = copy_string( quantum_depth ); - - tuple_quantum_depth = alloc_tuple(2); - - Store_field(tuple_quantum_depth, 0, int_quantum_depth); - Store_field(tuple_quantum_depth, 1, str_quantum_depth); - - CAMLreturn( tuple_quantum_depth ); -} -/* }}} */ -/* {{{ imper_getmagickquantumrange() - * - * const char *GetMagickQuantumRange(unsigned long *range) - */ -CAMLprim value -imper_getmagickquantumrange( value unit ) -{ - CAMLparam1(unit); - CAMLlocal1( tuple_quantum_range ); - - const char* quantum_range; - unsigned long *range; - - range = (unsigned long *)NULL; - - quantum_range = GetMagickQuantumRange(range); - - value int_quantum_range = Val_int( (int) range ); - value str_quantum_range = copy_string( quantum_range ); - - tuple_quantum_range = alloc_tuple(2); - - Store_field(tuple_quantum_range, 0, int_quantum_range); - Store_field(tuple_quantum_range, 1, str_quantum_range); - - CAMLreturn( tuple_quantum_range ); -} -/* }}} */ -/* {{{ imper_getmagickreleasedate() - * - * const char *GetMagickReleaseDate(void) - */ -CAMLprim value -imper_getmagickreleasedate( value unit ) -{ - CAMLparam1(unit); - - CAMLreturn(copy_string( - GetMagickReleaseDate() - )); -} -/* }}} */ -/* {{{ imper_getmagickversion() - * - * const char *GetMagickVersion(unsigned long *version) - */ -CAMLprim value -imper_getmagickversion( value unit ) -{ - CAMLparam1(unit); - CAMLlocal3( tuple_magick_version, int_version, str_version ); - - const char* char_version; - unsigned long *version; - - version = (unsigned long *)NULL; - - char_version = GetMagickVersion(version); - - int_version = Val_int( *version ); - str_version = copy_string( char_version ); - - tuple_magick_version = alloc_tuple(2); - - Store_field(tuple_magick_version, 0, int_version); - Store_field(tuple_magick_version, 1, str_version); - - CAMLreturn( tuple_magick_version ); -} -/* }}} */ -/* {{{ imper_getbindingversion() - * - * #define OCAML_IMAGEMAGICK_VERSION "X" - */ -CAMLprim value -imper_getbindingversion( value unit ) -{ - CAMLparam1(unit); - - CAMLreturn(copy_string( - OCAML_IMAGEMAGICK_VERSION - )); -} -/* }}} */ - -/* TODO: find why getmagickname does not work */ -#if 0 -/* {{{ imper_getmagickname() - * - * const char *GetMagickName(void) - */ -CAMLprim value -imper_getmagickname( value unit ) -{ - CAMLparam1(unit); - - CAMLreturn(caml_copy_string( - GetMagickName() - )); -} -/* }}} */ -#endif - -/* }}} */ - -/* {{{ ==== DRAWINGS ==== */ - -#define MAKE_DESTROY_DRAWINFO 1 - -/* TODO: test the affine_matrix parameter */ - -/* {{{ LineCap_val() */ - -static int -LineCap_val( value param ) -{ - CONVALparam1 (param); - -#if TYPE_CHECKING - assert (Is_long (param)); -#endif - - switch (Int_val (param)) - { - case 0: return UndefinedCap; - case 1: return ButtCap; - case 2: return RoundCap; - case 3: return SquareCap; - default: -#if DEBUG - fprintf(stderr, "LineCap_val() failed\n"); fflush(stderr); -#endif - abort(); - } -} - -/* }}} */ -/* {{{ LineJoin_val() */ - -static int -LineJoin_val( value param ) -{ - CONVALparam1 (param); - -#if TYPE_CHECKING - assert (Is_long (param)); -#endif - - switch (Int_val (param)) - { - case 0: return UndefinedJoin; - case 1: return MiterJoin; - case 2: return RoundJoin; - case 3: return BevelJoin; - default: -#if DEBUG - fprintf(stderr, "LineJoin_val() failed\n"); fflush(stderr); -#endif - abort(); - } -} - -/* }}} */ -/* {{{ fill_AffineMatrix() */ - -void -fill_AffineMatrix( - AffineMatrix *affine, - double sx, - double rx, - double ry, - double sy, - double tx, - double ty ) -{ -/* typedef struct _AffineMatrix - { - double - sx, rx, ry, sy, tx, ty; - - } AffineMatrix; */ - - affine->sx = sx; - affine->rx = rx; - affine->ry = ry; - affine->sy = sy; - affine->tx = tx; - affine->ty = ty; -} -/* }}} */ - -/* {{{ imper_querycolordatabase() - * - * MagickBooleanType QueryColorDatabase( - * const char *name, - * PixelPacket *color, - * ExceptionInfo *exception ); - */ - -CAMLprim value -imper_querycolordatabase(value color_string) -{ - CAMLparam1( color_string ); - CAMLlocal1( color_tuple ); - - ExceptionInfo - exception; - - MagickBooleanType - ret; - - PixelPacket - color; - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - GetExceptionInfo(&exception); - - - ret = QueryColorDatabase( - String_val(color_string), - &color, - &exception ); - - - if (ret == MagickFalse) { - failwith("color_of_string failed"); - } - - if (exception.severity != UndefinedException) { - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - /* @TODO: Should the color PixelPacket be freed or not at this point??? - */ - - value red = Val_long(color.red ); - value green = Val_long(color.green ); - value blue = Val_long(color.blue ); - value opacity = Val_long(color.opacity ); - - color_tuple = alloc_tuple(4); - - Store_field(color_tuple, 0, red ); - Store_field(color_tuple, 1, green ); - Store_field(color_tuple, 2, blue ); - Store_field(color_tuple, 3, opacity ); - - CAMLreturn( color_tuple ); -} -/* }}} */ - - /* {{{ DrawInfo struct - - typedef struct _DrawInfo - { - char - *primitive, - *geometry; - - RectangleInfo - viewbox; - - AffineMatrix - affine; - - GravityType - gravity; - - PixelPacket - fill, - stroke; - - double - stroke_width; - - GradientInfo - gradient; - - Image - *fill_pattern, - *tile, - *stroke_pattern; - - MagickBooleanType - stroke_antialias, - text_antialias; - - FillRule - fill_rule; - - LineCap - linecap; - - LineJoin - linejoin; - - unsigned long - miterlimit; - - double - dash_offset; - - DecorationType - decorate; - - CompositeOperator - compose; - - char - *text; - - unsigned long - face; - - char - *font, - *metrics, - *family; - - StyleType - style; - - StretchType - stretch; - - unsigned long - weight; - - char - *encoding; - - double - pointsize; - - char - *density; - - AlignType - align; - - PixelPacket - undercolor, - border_color; - - char - *server_name; - - double - *dash_pattern; - - char - *clip_path; - - SegmentInfo - bounds; - - ClipPathUnits - clip_units; - - Quantum - opacity; - - MagickBooleanType - render; - - ElementReference - element_reference; - - MagickBooleanType - debug; - - unsigned long - signature; - - } DrawInfo; - - \* }}} ======== */ - -/* {{{ imper_draw_point() - * - * (DrawInfo *)->primitive = "point x,y" - */ - -CAMLprim value -imper_draw_point_native( - value image_bloc, - value x, value y, - value red, - value green, - value blue, - value opacity ) -{ - CAMLparam5( image_bloc, x, y, red, green ); - CAMLxparam2( blue, opacity ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_point failed"); - } - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(red); - fill.green = (Quantum) Long_val(green); - fill.blue = (Quantum) Long_val(blue); - fill.opacity = (Quantum) Long_val(opacity); - - draw_info->fill = fill; - - - char str_buffer[ MaxTextExtent ]; - int str_len; - - /* Feed the primitive "point X,Y" */ - str_len = snprintf( str_buffer, MaxTextExtent, "point %ld,%ld", Long_val(x), Long_val(y) ); - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_point failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_point_bytecode(value * argv, int argn) -{ - return imper_draw_point_native( - argv[0], argv[1], argv[2], - argv[3], argv[4], argv[5], argv[6] ); -} -/* }}} */ -/* {{{ imper_draw_line() - * - * (DrawInfo *)->primitive = "line x0,y0 x1,y1" - */ - -CAMLprim value -imper_draw_line_native( - value image_bloc, - value x0, value y0, - value x1, value y1, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_antialias, - - value width, - value line_cap ) -{ - CAMLparam5( image_bloc, x0, y0, x1, y1 ); - CAMLxparam5( fill_red, fill_green, fill_blue, fill_alpha, stroke_red ); - CAMLxparam5( stroke_green, stroke_blue, stroke_alpha, stroke_antialias, width); - CAMLxparam1( line_cap ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_line failed"); - } - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket - stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - LineCap linecap; - LineJoin linejoin; - ... - } DrawInfo; - */ - draw_info->stroke = stroke; - - draw_info->stroke_width = Double_val(width); - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - - draw_info->linecap = LineCap_val(line_cap); - - - char str_buffer[ MaxTextExtent ]; - int str_len; - - /* - * Feed the primitive "line x0,y0 x1,y1" - */ - str_len = snprintf( str_buffer, MaxTextExtent, "line %ld,%ld %ld,%ld", - Long_val(x0), Long_val(y0), Long_val(x1), Long_val(y1) ); - - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_line failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_line_bytecode(value * argv, int argn) -{ - return imper_draw_line_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], argv[6], argv[7], - argv[8], argv[9], argv[10], argv[11], argv[12], argv[13], argv[14], argv[15] ); -} -/* }}} */ -/* {{{ imper_draw_rectangle() - * - * (DrawInfo *)->primitive = "rectangle x0,y0 x1,y1" - */ - -CAMLprim value -imper_draw_rectangle_native( - value image_bloc, - value x0, value y0, - value x1, value y1, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_antialias, - value stroke_width, - value line_join, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, x0, y0, x1, y1 ); - CAMLxparam5( fill_red, fill_green, fill_blue, fill_alpha, stroke_red ); - CAMLxparam5( stroke_green, stroke_blue, stroke_alpha, stroke_antialias, stroke_width ); - CAMLxparam5( line_join, sx, rx, ry, sy ); - CAMLxparam2( tx, ty ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_rectangle failed"); - } - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket - stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - LineCap linecap; - LineJoin linejoin; - AffineMatrix affine; - ... - } DrawInfo; - */ - draw_info->stroke = stroke; - draw_info->stroke_width = Double_val(stroke_width); - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - - draw_info->linejoin = LineJoin_val(line_join); - - /* TODO - printf(" %d\n", draw_info->compose); - draw_info->compose = CompositeOperator_val(composite_operator); - printf(" %d\n", draw_info->compose); - */ - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - char str_buffer[ MaxTextExtent ]; - int str_len; - - /* - * Feed the primitive "rectangle x0,y0 x1,y1" - */ - str_len = snprintf( str_buffer, MaxTextExtent, "rectangle %ld,%ld %ld,%ld", - Long_val(x0), Long_val(y0), Long_val(x1), Long_val(y1) ); - - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_rectangle failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_rectangle_bytecode(value * argv, int argn) -{ - return imper_draw_rectangle_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], - argv[12], argv[13], argv[14], argv[15], argv[16], argv[17], - argv[18], argv[19], argv[20], argv[21] ); -} -/* }}} */ -/* {{{ imper_draw_roundrectangle() - * - * (DrawInfo *)->primitive = "roundRectangle x0,y0 x1,y1 wc,hc" - */ - -CAMLprim value -imper_draw_roundrectangle_native( - value image_bloc, - value x0, value y0, - value x1, value y1, - value wc, value hc, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_antialias, - value stroke_width, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, x0, y0, x1, y1 ); - CAMLxparam5( wc, hc, fill_red, fill_green, fill_blue ); - CAMLxparam5( fill_alpha, stroke_red, stroke_green, stroke_blue, stroke_alpha ); - CAMLxparam5( stroke_antialias, stroke_width, sx, rx, ry ); - CAMLxparam3( sy, tx, ty ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_round_rectangle failed"); - } - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket - stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - LineCap linecap; - LineJoin linejoin; - ... - } DrawInfo; - */ - draw_info->stroke = stroke; - draw_info->stroke_width = Double_val(stroke_width); - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - - char str_buffer[ MaxTextExtent ]; - int str_len; - - /* - * Feed the primitive "roundRectangle x0,y0 x1,y1 wc,hc" - */ - str_len = snprintf( str_buffer, MaxTextExtent, "roundRectangle %ld,%ld %ld,%ld %ld,%ld", - Long_val(x0), Long_val(y0), Long_val(x1), Long_val(y1), Long_val(wc), Long_val(hc) ); - - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_round_rectangle failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_roundrectangle_bytecode(value * argv, int argn) -{ - return imper_draw_roundrectangle_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], - argv[12], argv[13], argv[14], argv[15], argv[16], argv[17], - argv[18], argv[19], argv[20], argv[21], argv[22] ); -} -/* }}} */ -/* {{{ imper_draw_arc() - * - * (DrawInfo *)->primitive = "arc x0,y0 x1,y1 a0,a1" - */ - -CAMLprim value -imper_draw_arc_native( - value image_bloc, - value x0, value y0, - value x1, value y1, - value a0, value a1, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_antialias, - value stroke_width, - value line_cap, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, x0, y0, x1, y1 ); - CAMLxparam5( a0, a1, fill_red, fill_green, fill_blue ); - CAMLxparam5( fill_alpha, stroke_red, stroke_green, stroke_blue, stroke_alpha ); - CAMLxparam5( stroke_antialias, stroke_width, line_cap, sx, rx ); - CAMLxparam4( ry, sy, tx, ty ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_arc failed"); - } - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket - stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - LineCap linecap; - LineJoin linejoin; - ... - } DrawInfo; - */ - draw_info->stroke = stroke; - draw_info->stroke_width = Double_val(stroke_width); - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - - draw_info->linecap = LineCap_val(line_cap); - - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - - char str_buffer[ MaxTextExtent ]; - int str_len; - - /* - * Feed the primitive "arc x0,y0 x1,y1 a0,a1" - */ - str_len = snprintf( str_buffer, MaxTextExtent, "arc %ld,%ld %ld,%ld %ld,%ld", - Long_val(x0), Long_val(y0), Long_val(x1), Long_val(y1), Long_val(a0), Long_val(a1) ); - - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_arc failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_arc_bytecode(value * argv, int argn) -{ - return imper_draw_arc_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], - argv[12], argv[13], argv[14], argv[15], argv[16], argv[17], - argv[18], argv[19], argv[20], argv[21], argv[22], argv[23] ); -} -/* }}} */ -/* {{{ imper_draw_circle() - * - * (DrawInfo *)->primitive = "circle x0,y0 x1,y1" - */ - -CAMLprim value -imper_draw_circle_native( - value image_bloc, - value x0, value y0, - value x1, value y1, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_antialias, - value stroke_width, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, x0, y0, x1, y1 ); - CAMLxparam5( fill_red, fill_green, fill_blue, fill_alpha, stroke_red ); - CAMLxparam5( stroke_green, stroke_blue, stroke_alpha, stroke_antialias, stroke_width ); - CAMLxparam5( sx, rx, ry, sy, tx ); - CAMLxparam1( ty ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_circle failed"); - } - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket - stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - LineCap linecap; - LineJoin linejoin; - ... - } DrawInfo; - */ - draw_info->stroke = stroke; - draw_info->stroke_width = Double_val(stroke_width); - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - - char str_buffer[ MaxTextExtent ]; - int str_len; - - /* - * Feed the primitive "circle x0,y0 x1,y1" - */ - str_len = snprintf( str_buffer, MaxTextExtent, "circle %ld,%ld %ld,%ld", - Long_val(x0), Long_val(y0), Long_val(x1), Long_val(y1) ); - - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_circle failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_circle_bytecode(value * argv, int argn) -{ - return imper_draw_circle_native( - argv[0], argv[1], argv[2], argv[3], argv[4], - argv[5], argv[6], argv[7], argv[8], argv[9], - argv[10], argv[11], argv[12], argv[13], argv[14], - argv[15], argv[16], argv[17], argv[18], argv[19], - argv[20] ); -} -/* }}} */ -/* {{{ imper_draw_ellipse() - * - * (DrawInfo *)->primitive = "ellipse x0,y0 rx,ry a0,a1" - */ - -CAMLprim value -imper_draw_ellipse_native( - value image_bloc, - value x0, value y0, - value x1, value y1, - value a0, value a1, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_antialias, - value stroke_width, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, x0, y0, x1, y1 ); - CAMLxparam5( a0, a1, fill_red, fill_green, fill_blue ); - CAMLxparam5( fill_alpha, stroke_red, stroke_green, stroke_blue, stroke_alpha ); - CAMLxparam5( stroke_antialias, stroke_width, sx, rx, ry ); - CAMLxparam3( sy, tx, ty ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_ellipse failed"); - } - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket - stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - LineCap linecap; - LineJoin linejoin; - ... - } DrawInfo; - */ - draw_info->stroke = stroke; - draw_info->stroke_width = Double_val(stroke_width); - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - - char str_buffer[ MaxTextExtent ]; - int str_len; - - /* - * Feed the primitive "ellipse x0,y0 rx,ry a0,a1" - */ - str_len = snprintf( str_buffer, MaxTextExtent, "ellipse %ld,%ld %ld,%ld %ld,%ld", - Long_val(x0), Long_val(y0), Long_val(x1), Long_val(y1), Long_val(a0), Long_val(a1) ); - - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_ellipse failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_ellipse_bytecode(value * argv, int argn) -{ - return imper_draw_ellipse_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], - argv[12], argv[13], argv[14], argv[15], argv[16], argv[17], - argv[18], argv[19], argv[20], argv[21], argv[22] ); -} -/* }}} */ -/* {{{ imper_draw_polyline() - * - * (DrawInfo *)->primitive = "polyline x0,y0 ... xn,yn" - */ - -CAMLprim value -imper_draw_polyline_native( - value image_bloc, - value array, - value array_length, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_antialias, - value width, - value line_join, - value line_cap, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, array, array_length, fill_red, fill_green ); - CAMLxparam5( fill_blue, fill_alpha, stroke_red, stroke_green, stroke_blue ); - CAMLxparam5( stroke_alpha, stroke_antialias, width, line_join, line_cap ); - CAMLxparam5( sx, rx, ry, sy, tx ); - CAMLxparam1( ty ); - - CAMLlocal1( coords ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - int i; - int array_len = Int_val(array_length); - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_polyline failed"); - } - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket - stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - LineCap linecap; - LineJoin linejoin; - ... - } DrawInfo; - */ - draw_info->stroke = stroke; - - draw_info->stroke_width = Double_val(width); - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - - draw_info->linecap = LineCap_val(line_cap); - draw_info->linejoin = LineJoin_val(line_join); - - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - - char str_buffer[ MaxTextExtent ]; - char str_buffer_tmp[ MaxTextExtent ]; - int str_len; - - /* - * Feed the primitive "polyline x0,y0 ... xn,yn" - */ - str_len = snprintf( str_buffer, MaxTextExtent, "polyline" ); - - for (i=0; i < array_len; i++) { - - coords = Field(array, i); - - strcpy( str_buffer_tmp, str_buffer ); - - str_len = snprintf( str_buffer, MaxTextExtent, "%s %ld,%ld", - str_buffer_tmp, - Long_val(Field(coords,0)), - Long_val(Field(coords,1)) ); - } - - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_polyline failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_polyline_bytecode(value * argv, int argn) -{ - return imper_draw_polyline_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], - argv[12], argv[13], argv[14], argv[15], argv[16], argv[17], - argv[18], argv[19], argv[20] ); -} -/* }}} */ -/* {{{ imper_draw_polygon() - * - * (DrawInfo *)->primitive = "polygon x0,y0 ... xn,yn" - */ - -CAMLprim value -imper_draw_polygon_native( - value image_bloc, - value array, - value array_length, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_antialias, - value width, - value line_join, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, array, array_length, fill_red, fill_green ); - CAMLxparam5( fill_blue, fill_alpha, stroke_red, stroke_green, stroke_blue ); - CAMLxparam5( stroke_alpha, stroke_antialias, width, line_join, sx ); - CAMLxparam5( rx, ry, sy, tx, ty ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - int i; - int array_len = Int_val(array_length); - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_polygon failed"); - } - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket - stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - LineCap linecap; - LineJoin linejoin; - ... - } DrawInfo; - */ - draw_info->stroke = stroke; - - draw_info->stroke_width = Double_val(width); - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - - draw_info->linejoin = LineJoin_val(line_join); - - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - - char str_buffer[ MaxTextExtent ]; - char str_buffer_tmp[ MaxTextExtent ]; - int str_len; - value coords; - - /* - * Feed the primitive "polygon x0,y0 ... xn,yn" - */ - str_len = snprintf( str_buffer, MaxTextExtent, "polygon" ); - - for (i=0; i < array_len; i++) { - - coords = Field(array, i); - - strcpy( str_buffer_tmp, str_buffer ); - - str_len = snprintf( str_buffer, MaxTextExtent, "%s %ld,%ld", - str_buffer_tmp, - Long_val(Field(coords,0)), - Long_val(Field(coords,1)) ); - } - - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_polygon failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_polygon_bytecode(value * argv, int argn) -{ - return imper_draw_polygon_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], - argv[12], argv[13], argv[14], argv[15], argv[16], argv[17], - argv[18], argv[19] ); -} -/* }}} */ -/* {{{ imper_draw_bezier() - * - * (DrawInfo *)->primitive = "Bezier x0,y0 ... xn,yn" - */ - -CAMLprim value -imper_draw_bezier_native( - value image_bloc, - value array, - value array_length, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_antialias, - value width, - value line_cap, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, array, array_length, fill_red, fill_green ); - CAMLxparam5( fill_blue, fill_alpha, stroke_red, stroke_green, stroke_blue ); - CAMLxparam5( stroke_alpha, stroke_antialias, width, line_cap, sx ); - CAMLxparam5( rx, ry, sy, tx, ty ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - int i; - int array_len = Int_val(array_length); - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_bezier failed"); - } - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket - stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - LineCap linecap; - LineJoin linejoin; - ... - } DrawInfo; - */ - draw_info->stroke = stroke; - - draw_info->stroke_width = Double_val(width); - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - - draw_info->linecap = LineCap_val(line_cap); - - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - - char str_buffer[ MaxTextExtent ]; - char str_buffer_tmp[ MaxTextExtent ]; - int str_len; - value coords; - - /* - * Feed the primitive "Bezier x0,y0 ... xn,yn" - */ - str_len = snprintf( str_buffer, MaxTextExtent, "bezier" ); - - for (i=0; i < array_len; i++) { - - coords = Field(array, i); - - strcpy( str_buffer_tmp, str_buffer ); - - str_len = snprintf( str_buffer, MaxTextExtent, "%s %ld,%ld", - str_buffer_tmp, - Long_val(Field(coords,0)), - Long_val(Field(coords,1)) ); - } - - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_bezier failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_bezier_bytecode(value * argv, int argn) -{ - return imper_draw_bezier_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], - argv[12], argv[13], argv[14], argv[15], argv[16], argv[17], - argv[18], argv[19] ); -} -/* }}} */ - -/* {{{ imper_draw_path() - * - * (DrawInfo *)->primitive - * path path specification (SVG string path) - */ - -CAMLprim value -imper_draw_path_native( - value image_bloc, - value path, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_antialias, - value stroke_width, - value line_join, - value line_cap, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, path, fill_red, fill_green, fill_blue ); - CAMLxparam5( fill_alpha, stroke_red, stroke_green, stroke_blue, stroke_alpha ); - CAMLxparam5( stroke_antialias, stroke_width, line_join, line_cap, sx ); - CAMLxparam5( rx, ry, sy, tx, ty ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_path failed"); - } - - - PixelPacket - fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket - stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - draw_info->stroke = stroke; - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - LineCap linecap; - LineJoin linejoin; - ... - } DrawInfo; - */ - - draw_info->stroke_width = Double_val(stroke_width); - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - - draw_info->linecap = LineCap_val(line_cap); - draw_info->linejoin = LineJoin_val(line_join); - - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - - char str_buffer[ MaxTextExtent ]; - int str_len; - - /* Feed the primitive "path spec" */ - str_len = snprintf( str_buffer, MaxTextExtent, "path '%s'", String_val(path) ); - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_path failed"); - } - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_path_bytecode(value * argv, int argn) -{ - return imper_draw_path_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], - argv[12], argv[13], argv[14], argv[15], argv[16], argv[17], - argv[18], argv[19] ); -} -/* }}} */ - - -/* {{{ StyleType_val() */ - -static int -StyleType_val( value param ) -{ - CONVALparam1 (param); - -#if TYPE_CHECKING - assert( Is_long(param) ); -#endif - - switch (Int_val (param)) - { - case 0: return UndefinedStyle; - case 1: return NormalStyle; - case 2: return ItalicStyle; - case 3: return ObliqueStyle; - case 4: return AnyStyle; - default: -#if DEBUG - fprintf(stderr, "StyleType_val() failed\n"); fflush(stderr); - abort(); -#else - return UndefinedStyle; -#endif - } -} - -/* }}} */ -/* {{{ DecorationType_val() */ - -static int -DecorationType_val( value param ) -{ - CONVALparam1 (param); - -#if TYPE_CHECKING - assert (Is_long (param)); -#endif - - switch (Int_val (param)) - { - case 0: return UndefinedDecoration; - case 1: return NoDecoration; - case 2: return UnderlineDecoration; - case 3: return OverlineDecoration; - case 4: return LineThroughDecoration; - default: -#if DEBUG - fprintf(stderr, "DecorationType_val() failed\n"); fflush(stderr); - abort(); -#else - return UndefinedDecoration; -#endif - } -} - -/* }}} */ - - -/* {{{ StretchType_val() */ - -static int -StretchType_val( value param ) -{ - CONVALparam1 (param); - -#if TYPE_CHECKING - assert (Is_long (param)); -#endif - - switch (Int_val (param)) - { - case 0: return UndefinedStretch; - case 1: return NormalStretch; - case 2: return UltraCondensedStretch; - case 3: return ExtraCondensedStretch; - case 4: return CondensedStretch; - case 5: return SemiCondensedStretch; - case 6: return SemiExpandedStretch; - case 7: return ExpandedStretch; - case 8: return ExtraExpandedStretch; - case 9: return UltraExpandedStretch; - case 10: return AnyStretch; - default: -#if DEBUG - fprintf(stderr, "StretchType_val() failed\n"); fflush(stderr); - abort(); -#else - return UndefinedStretch; -#endif - } -} - -/* }}} */ - -/* {{{ imper_draw_text() */ - -CAMLprim value -imper_draw_text_native( - value image_bloc, - value text, - value font, - - value x, - value y, - value pointsize, - value density_x, - value density_y, - value style, - value weight, - value decoration, - value stretch, - - value fill_red, - value fill_green, - value fill_blue, - value fill_alpha, - - value stroke_red, - value stroke_green, - value stroke_blue, - value stroke_alpha, - - value stroke_width, - value stroke_antialias, - value text_antialias, - value encoding, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, text, font, x, y ); - CAMLxparam5( pointsize, density_x, density_y, style, weight ); - CAMLxparam5( decoration, stretch, fill_red, fill_green, fill_blue ); - CAMLxparam5( fill_alpha, stroke_red, stroke_green, stroke_blue, stroke_alpha ); - CAMLxparam5( stroke_width, stroke_antialias, text_antialias, encoding, sx ); - CAMLxparam5( rx, ry, sy, tx, ty ); - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - char - str_buffer[ MaxTextExtent ]; - - int str_len; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_text failed"); - } - - - PixelPacket fill; - - fill.red = (Quantum) Long_val(fill_red); - fill.green = (Quantum) Long_val(fill_green); - fill.blue = (Quantum) Long_val(fill_blue); - fill.opacity = (Quantum) Long_val(fill_alpha); - - draw_info->fill = fill; - - - PixelPacket stroke; - - stroke.red = (Quantum) Long_val(stroke_red); - stroke.green = (Quantum) Long_val(stroke_green); - stroke.blue = (Quantum) Long_val(stroke_blue); - stroke.opacity = (Quantum) Long_val(stroke_alpha); - - draw_info->stroke = stroke; - - /* typedef struct _DrawInfo - { - CompositeOperator compose; - ... - } DrawInfo; */ - - draw_info->stroke_width = Double_val(stroke_width); - - draw_info->stroke_antialias = MagickBoolean_val(stroke_antialias); - draw_info->text_antialias = MagickBoolean_val(text_antialias); - - draw_info->pointsize = Double_val(pointsize); - draw_info->style = StyleType_val(style); - - draw_info->weight = (unsigned long) Long_val(weight); - - - draw_info->render = MagickTrue; /* @TODO: find what is this ! */ - - - /* TODO */ -#if 0 - draw_info->text /* for the actual text to draw */ - draw_info->undercolor /* to draw a box under the text */ - draw_info->family /* to specify the font family to draw text with */ - draw_info->encoding /* to set the font encoding */ - draw_info->metrics = ""; -#endif - - /* {{{ DrawInfo - - typedef struct _DrawInfo - { - char - *primitive, - *geometry; - - RectangleInfo - viewbox; - - AffineMatrix - affine; - - GravityType - gravity; - - PixelPacket - fill, - stroke; - - double - stroke_width; - - GradientInfo - gradient; - - Image - *fill_pattern, - *tile, - *stroke_pattern; - - MagickBooleanType - stroke_antialias, - text_antialias; - - FillRule - fill_rule; - - LineCap - linecap; - - LineJoin - linejoin; - - unsigned long - miterlimit; - - double - dash_offset; - - DecorationType - decorate; - - CompositeOperator - compose; - - char - *text; - - unsigned long - face; - - char - *font, - *metrics, - *family; - - StyleType - style; - - StretchType - stretch; - - unsigned long - weight; - - char - *encoding; - - double - pointsize; - - char - *density; - - AlignType - align; - - PixelPacket - undercolor, - border_color; - - char - *server_name; - - double - *dash_pattern; - - char - *clip_path; - - SegmentInfo - bounds; - - ClipPathUnits - clip_units; - - Quantum - opacity; - - MagickBooleanType - render; - - ElementReference - element_reference; - - MagickBooleanType - debug; - - unsigned long - signature; - } DrawInfo; - - \* }}} ======== */ - - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - - if ( strlen(String_val(font)) ) { - (void) CloneString(&draw_info->font, String_val(font) ); - } - - if ( strlen(String_val(encoding)) ) { - (void) CloneString(&draw_info->encoding, String_val(encoding) ); - } - - /* set the font resolution (default: "72x72") */ - str_len = snprintf( str_buffer, MaxTextExtent, "%ldx%ld", Long_val(density_x), Long_val(density_y) ); - (void) CloneString(&draw_info->density, str_buffer); - - draw_info->decorate = DecorationType_val(decoration); - - - /* TODO - - unsigned long - face; - */ - - /* @TODO: I don't see any effect with any stretch. */ - draw_info->stretch = StretchType_val(stretch); -#if DEBUG - printf(" Stretch = '%d'\n", draw_info->stretch); fflush(stdout); -#endif - - - /* Feed the primitive "text spec" */ - str_len = snprintf( str_buffer, MaxTextExtent, "text %ld,%ld '%s'", - Long_val(x), Long_val(y), String_val(text) ); - (void) CloneString(&draw_info->primitive, str_buffer); - - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_text failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -CAMLprim value -imper_draw_text_bytecode(value * argv, int argn) -{ - return imper_draw_text_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], - argv[12], argv[13], argv[14], argv[15], argv[16], argv[17], - argv[18], argv[19], argv[20], argv[21], argv[22], argv[23], - argv[24], argv[25], argv[26], argv[27], argv[28], argv[29] ); -} -/* }}} */ - -/* {{{ imper_get_metrics() */ - -CAMLprim value -imper_get_metrics_native( - value image_bloc, - value text, - value font, - - value x, - value y, - value pointsize, - value density_x, - value density_y, - - value style, - value weight, - value decoration, - value stretch, - - value stroke_width, - - value sx, - value rx, - value ry, - value sy, - value tx, - value ty ) -{ - CAMLparam5( image_bloc, text, font, x, y ); - CAMLxparam5( pointsize, density_x, density_y, style, weight ); - CAMLxparam5( decoration, stretch, stroke_width, sx, rx ); - CAMLxparam4( ry, sy, tx, ty ); - - CAMLlocal5( - tuple_metrics, - ascent, descent, - width, height ); - CAMLlocal5( - max_advance, - underline_position, - underline_thickness, - x_, y_ ); - CAMLlocal4( x1, y1, x2, y2 ); - - - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - char - str_buffer[ MaxTextExtent ]; - - int str_len; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_text failed"); - } - - /* - typedef struct _DrawInfo - { - PixelPacket fill, stroke; - double stroke_width; - CompositeOperator compose; - ... - } DrawInfo; - */ - - draw_info->stroke_width = Double_val(stroke_width); - draw_info->stroke_antialias = MagickTrue; - - draw_info->text_antialias = MagickTrue; - draw_info->pointsize = Double_val(pointsize); - draw_info->style = StyleType_val(style); - - draw_info->weight = (unsigned long) Long_val(weight); - - - draw_info->render = MagickTrue; /* @TODO: find what is this ! */ - - - if ( strlen(String_val(font)) ) { - (void) CloneString(&draw_info->font, String_val(font) ); - } - - - AffineMatrix affine; - fill_AffineMatrix( &affine, - Double_val(sx), - Double_val(rx), - Double_val(ry), - Double_val(sy), - Double_val(tx), - Double_val(ty) ); - draw_info->affine = affine; - - - /* @TODO: - - draw_info->metrics = ""; - draw_info->family = ""; - - char - *metrics, - *family; - */ - - /* density example: "72x72" */ - str_len = snprintf( str_buffer, MaxTextExtent, "%ldx%ld", Long_val(density_x), Long_val(density_y) ); - (void) CloneString(&draw_info->density, str_buffer); - - draw_info->decorate = DecorationType_val(decoration); - - /* @TODO: I don't see any effect with any stretch. */ - draw_info->stretch = StretchType_val(stretch); -#if DEBUG - printf(" stretch = '%d'\n", draw_info->stretch); -#endif - - /* TODO - - unsigned long - face; - */ - - - /* Feed the primitive "text spec" */ - str_len = snprintf( str_buffer, MaxTextExtent, "text %ld,%ld '%s'", - Long_val(x), Long_val(y), String_val(text) ); - (void) CloneString(&draw_info->primitive, str_buffer); - - - TypeMetric metrics_infos; - - (void) CloneString(&draw_info->text, String_val(text) ); - - ret = GetMultilineTypeMetrics((Image *) Field(image_bloc,1), draw_info, &metrics_infos); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "GetMultilineTypeMetrics() failed\n"); fflush(stderr); -#endif - failwith("get_text_metrics failed"); - } - - /* {{{ dev */ - -#if 0 -#if DEBUG - printf("\n\ - ascent %f\n\ - descent %f\n\ - width %f\n\ - height %f\n\ - max_advance %f\n\ - underline_position %f\n\ - underline_thickness %f\n\ -\n", - (double) metrics_infos->ascent, - (double) metrics_infos->descent, - (double) metrics_infos->width, - (double) metrics_infos->height, - (double) metrics_infos->max_advance, - (double) metrics_infos->underline_position, - (double) metrics_infos->underline_thickness ); -#endif -#endif - -/* -typedef struct _TypeMetric -{ - PointInfo - pixels_per_em; - - double - ascent, - descent, - width, - height, - max_advance, - underline_position, - underline_thickness; - - SegmentInfo - bounds; -} TypeMetric; - - -typedef struct _PointInfo -{ - double - x, - y; -} PointInfo; - - -typedef struct _SegmentInfo -{ - double - x1, - y1, - x2, - y2; -} SegmentInfo; -*/ - -/* en: ascent descent advance thickness - fr: montée descente avancée épaisseur - - example: - ascent: 21.0 - descent: -6.0 - width: 267.0 - height: 28.0 - max_advance: 30.0 - underline_position: -1.953125 - underline_thickness: 0.937500 -*/ - - /* }}} */ - - ascent = copy_double( (double) metrics_infos.ascent ); - descent = copy_double( (double) metrics_infos.descent ); - width = copy_double( (double) metrics_infos.width ); - height = copy_double( (double) metrics_infos.height ); - max_advance = copy_double( (double) metrics_infos.max_advance ); - underline_position = copy_double( (double) metrics_infos.underline_position ); - underline_thickness = copy_double( (double) metrics_infos.underline_thickness ); - - x_ = copy_double( (double) metrics_infos.pixels_per_em.x ); - y_ = copy_double( (double) metrics_infos.pixels_per_em.y ); - - x1 = copy_double( (double) metrics_infos.bounds.x1 ); - y1 = copy_double( (double) metrics_infos.bounds.y1 ); - x2 = copy_double( (double) metrics_infos.bounds.x2 ); - y2 = copy_double( (double) metrics_infos.bounds.y2 ); - - tuple_metrics = alloc_tuple(13); - - Store_field(tuple_metrics, 0, ascent ); - Store_field(tuple_metrics, 1, descent ); - Store_field(tuple_metrics, 2, width ); - Store_field(tuple_metrics, 3, height ); - Store_field(tuple_metrics, 4, max_advance ); - Store_field(tuple_metrics, 5, underline_position ); - Store_field(tuple_metrics, 6, underline_thickness ); - - Store_field(tuple_metrics, 7, x_ ); - Store_field(tuple_metrics, 8, y_ ); - Store_field(tuple_metrics, 9, x1 ); - Store_field(tuple_metrics, 10, y1 ); - Store_field(tuple_metrics, 11, x2 ); - Store_field(tuple_metrics, 12, y2 ); - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( tuple_metrics ); -} - -CAMLprim value -imper_get_metrics_bytecode(value * argv, int argn) -{ - return imper_get_metrics_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10], argv[11], - argv[12], argv[13], argv[14], argv[15], argv[16], argv[17], - argv[18] ); -} -/* }}} */ - - -/* {{{ imper_draw_text_new1() - * - * draw_info->text for the actual text to draw - * draw_info->undercolor to draw a box under the text - * draw_info->affine to rotate, scale, translate the text - * draw_info->font to specify the font to draw text with - * draw_info->family to specify the font family to draw text with - * draw_info->density to set the font resolution (defaults to 72x72) - * draw_info->pointsize to set the font pointsize - * draw_info->encoding to set the font encoding - * draw_info->fill to set the text fill color - * draw_info->stroke to set the text stroke color - * draw_info->text_antialias to set text antialiasing - */ -CAMLprim value -imper_draw_text_new1( - value image_bloc, - value text ) -{ - CAMLparam2(image_bloc, text); - - MagickBooleanType - ret; - - DrawInfo - *draw_info; - - ImageInfo - *image_info; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_text failed"); - } - -#if 0 - -Typedef struct _DrawInfo -{ - char - *primitive, - *geometry; - - RectangleInfo - viewbox; - - AffineMatrix - affine; - - GravityType - gravity; - - PixelPacket - fill, - stroke; - - double - stroke_width; - - GradientInfo - gradient; - - Image - *fill_pattern, - *tile, - *stroke_pattern; - - MagickBooleanType - stroke_antialias, - text_antialias; - - FillRule - fill_rule; - - LineCap - linecap; - - LineJoin - linejoin; - - unsigned long - miterlimit; - - double - dash_offset; - - DecorationType - decorate; - - CompositeOperator - compose; - - char - *text; - - unsigned long - face; - - char - *font, - *metrics, - *family; - - StyleType - style; - - StretchType - stretch; - - unsigned long - weight; - - char - *encoding; - - double - pointsize; - - char - *density; - - AlignType - align; - - PixelPacket - undercolor, - border_color; - - char - *server_name; - - double - *dash_pattern; - - char - *clip_path; - - SegmentInfo - bounds; - - ClipPathUnits - clip_units; - - Quantum - opacity; - - MagickBooleanType - render; - - ElementReference - element_reference; - - MagickBooleanType - debug; - - unsigned long - signature; -} DrawInfo; - - draw_info->text /* for the actual text to draw */ - draw_info->undercolor /* to draw a box under the text */ - draw_info->affine /* to rotate, scale, translate the text */ - draw_info->font /* to specify the font to draw text with */ - draw_info->family /* to specify the font family to draw text with */ - draw_info->density /* to set the font resolution (defaults to 72x72) */ - draw_info->pointsize /* to set the font pointsize */ - draw_info->encoding /* to set the font encoding */ - draw_info->fill /* to set the text fill color */ - draw_info->stroke /* to set the text stroke color */ - draw_info->text_antialias /* to set text antialiasing */ -#endif - - (void) CloneString(&draw_info->text, String_val(text) ); - (void) CloneString(&draw_info->geometry, "20x20"); - - if (draw_info->font == (char *) NULL) { - printf(" font uninitiatized\n"); fflush(stdout); - } else { - printf(" font set to: '%s'\n", draw_info->font ); fflush(stdout); - } - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_text failed"); - } - - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - - CAMLreturn( Val_unit ); -} - -/* }}} */ - - /* {{{ Primitives TODO - * - * image operator x0,y0 w,h filename - * }}} */ - /* {{{ from the doc - * - * point x,y - * line x0,y0 x1,y1 - * rectangle x0,y0 x1,y1 - * roundRectangle x0,y0 x1,y1 wc,hc - * arc x0,y0 x1,y1 a0,a1 - * ellipse x0,y0 rx,ry a0,a1 - * circle x0,y0 x1,y1 - * polyline x0,y0 ... xn,yn - * polygon x0,y0 ... xn,yn - * Bezier x0,y0 ... xn,yn - * path path specification - * image operator x0,y0 w,h filename - * - * }}} */ - /* {{{ from the sources - * affine d,d,d,d,d,d - * arc - * bezier - * clip-path - * clip-rule - * clip-units - * circle - * color - * decorate - * ellipse - * encoding - * fill - * fill-rule - * fill-opacity - * font - * font-family - * font-size - * font-stretch - * font-style - * font-weight - * gradient-units - * gravity - * image - * line - * matte - * offset - * opacity - * path - * point - * polyline - * polygon - * pop - * clip-path - * defs - * gradient - * graphic-context - * pattern - * push - * clip-path - * pop - * clip-path - * gradient - * radial - * pop - * gradient - * pattern d,d,d,d - * graphic-context - * rectangle - * rotate - * roundRectangle - * scale - * skewX - * skewY - * stop-color - * stroke - * stroke-antialias - * stroke-dasharray - * stroke-dashoffset - * stroke-linecap - * stroke-linejoin - * stroke-miterlimit - * stroke-opacity - * stroke-width - * text - * text-align - * text-anchor - * text-antialias - * text-undercolor - * translate d,d - * viewbox d,d,d,d - * - * }}} */ - -/* {{{ imper_draw_mvg() - */ - -CAMLprim value -imper_draw_mvg( - value image_bloc, - value mvg ) -{ - CAMLparam2( image_bloc, mvg ); - - MagickBooleanType - ret; - - DrawInfo - *draw_info; - - { - ImageInfo - *image_info; - - image_info = CloneImageInfo((ImageInfo *) NULL); - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - } - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("draw_mvg failed"); - } - - (void) CloneString(&draw_info->primitive, String_val(mvg) ); - - ret = DrawImage((Image *) Field(image_bloc,1), draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("draw_mvg failed"); - } - - /* @FIXME: draw_info should be freed - * but sometimes it produces a Segmentation fault - */ -#if MAKE_DESTROY_DRAWINFO - DestroyDrawInfo(draw_info); -#endif - - CAMLreturn( Val_unit ); -} -/* }}} */ - -#if 0 -/* {{{ imper_setimagepixel() - * - * PixelPacket *SetImagePixels(Image *image, const long x, const long y, - * const unsigned long columns, - * const unsigned long rows) - * - * MagickBooleanType SyncImagePixels(Image *image) - */ - -CAMLprim value -imper_setimagepixel( - value image_bloc, - value x, - value y ) -{ - CAMLparam3( image_bloc, x, y ); - - PixelPacket - *pixels; - - /* - PixelPacket - pixel; - */ - - MagickBooleanType - ret; - - Image *img; - - pixels = GetImagePixels( - (Image *) Field(image_bloc,1), - Long_val(x), - Long_val(y), - 1, 1); - - if (pixels == (PixelPacket *) NULL) { - failwith("setimagepixel failed") ; - } - - /* - printf("\tsizeof pixels = %d\n", sizeof(pixels)); - */ - - printf("\tR G B = %d %d %d\n", - pixels[0].red, - pixels[0].green, - pixels[0].blue ); - - pixels->red = 0; - pixels->green = 0; - pixels->blue = 0; - pixels->opacity = 0; - - img = ( (Image *) Field(image_bloc,1) ) ; - - printf("\tR G B = %d %d %d\n", - pixels[0].red, - pixels[0].green, - pixels[0].blue ); - - /* ret = SyncImagePixels( (Image *) Field(image_bloc,1) ); */ - /* ret = SyncImage( (Image *) Field(image_bloc,1) ); */ - /* ret = SyncCache( (Image *) Field(image_bloc,1) ); */ - ret = SyncImagePixels( img ); - - if (ret == MagickFalse) { - failwith("setimagepixel failed") ; - } - - CAMLreturn( Val_unit ); -} - -/* }}} */ -/* {{{ imper_loadimage() - */ - -CAMLprim value -imper_loadimage( - value width, - value height, - value color ) -{ - CAMLparam3( width, height, color ); - - CAMLlocal1(image_bloc); - - long x = Long_val(width); - long y = Long_val(height); - - ExceptionInfo - exception; - - ImageInfo - *image_info; - - image_info = CloneImageInfo((ImageInfo *) NULL); - - -#if DEBUG - image_bloc = alloc_final(3, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ -#else - image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ -#endif - - Field(image_bloc,1) = (value) alloc_image(); - - -#if DEBUG - Field(image_bloc,2) = malloc(sizeof(char) * strlen("loaded image")); - Field(image_bloc,2) = "loaded image"; -#endif - - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - const unsigned int _color = Int_val(color); - unsigned int *pixels; - register unsigned int *p; - StorageType storage = IntegerPixel; - - /* - double *pixels; - register double *p; - StorageType storage = DoublePixel; - */ - - const char *map; - map = "RGBA"; - - long i; - register long j; - register short m; - short map_len = strlen(map); - - pixels = malloc(x * y * sizeof(unsigned int) * map_len); - p = pixels; - - printf("\t color = '%d'\n", _color); fflush(stdout); - - for (i=0; i < y; ++i) - for (j=0; j < x; ++j) - for (m=0; m < map_len; ++m) - { - *p = _color; - p++; - } - - printf("\t pixels [0] = '%d'\n", pixels[0]); - printf("\t pixels [1] = '%d'\n", pixels[1]); - printf("\t pixels [2] = '%d'\n", pixels[2]); fflush(stdout); - - /* Image *ConstituteImage(const unsigned long columns, const unsigned long rows, - * const char *map, const StorageType storage, - * const void *pixels, ExceptionInfo *exception ) - */ - GetExceptionInfo(&exception); - /* - Field(image_bloc,1) = (value) ConstituteImage(x, y, map, storage, pixels, &exception); - */ - Field(image_bloc,1) = (value) ConstituteImage(x, y, "RGBA", IntegerPixel, pixels, &exception); - DestroyImageInfo(image_info); - - if (exception.severity != UndefinedException) { - failwith( exception.reason ); - /* @TODO exception.description */ - } - - DestroyExceptionInfo(&exception); - - if ((Image *) Field(image_bloc,1) == (Image *) NULL) { - failwith("load_image failed"); - } - - CAMLreturn( image_bloc ); -} -/* }}} */ -#endif - -/* }}} */ - -/* {{{ ==== RAWS ==== */ - -/* {{{ imper_get_raw() - * - * const PixelPacket *AcquireImagePixels(const Image *image, - * const long x, const long y, - * const unsigned long columns, const unsigned long rows, - * ExceptionInfo *exception) - */ - -CAMLprim value -imper_get_raw( value image_bloc ) -{ - CAMLparam1( image_bloc ); - CAMLlocal3( pixel_matrix, column_array, color_tuple ); - unsigned long x, y; - unsigned long columns, rows; - - ExceptionInfo - exception; - - PixelPacket - pixel; - - columns = ((Image *) Field(image_bloc,1))->columns; - rows = ((Image *) Field(image_bloc,1))->rows; - - GetExceptionInfo(&exception); - - const PixelPacket * pixel_packet_array; - - /* DEPR - pixel_packet_array = - AcquireImagePixels( - (Image *) Field(image_bloc,1), - 0, 0, - columns, rows, - &exception ); - */ - - pixel_packet_array = - GetVirtualPixels( - (Image *) Field(image_bloc,1), - 0, 0, - columns, rows, - &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - /* alloc_array(f, a) allocates an array of values, calling function f - * over each element of the input array a to transform it into a value. - * The array a is an array of pointers terminated by the null pointer. - * The function f receives each pointer as argument, and returns a value. - * The zero-tagged block returned by alloc_array(f, a) is filled with the values - * returned by the successive calls to f. - * (This function must not be used to build an array of floating-point numbers.) - */ - /* - PixelPacket init_columns[columns]; - PixelPacket init_rows[rows]; - - pixel_matrix = alloc_array(fill_raw, init_columns); - column_array = alloc_array(fill_raw, init_rows); - */ - - pixel_matrix = alloc_tuple(columns); - - for (x=0; x < columns; ++x) { - - column_array = alloc_tuple(rows); - - for (y=0; y < rows; ++y) { - - pixel = pixel_packet_array[(columns * y) + x]; - - color_tuple = alloc_tuple(4); - - Store_field(color_tuple, 0, Val_long( (long) pixel.red )); - Store_field(color_tuple, 1, Val_long( (long) pixel.green )); - Store_field(color_tuple, 2, Val_long( (long) pixel.blue )); - Store_field(color_tuple, 3, Val_long( MaxMap - - (long) pixel.opacity )); - - Store_field(column_array, y, color_tuple); - } - Store_field(pixel_matrix, x, column_array); - } - - CAMLreturn( pixel_matrix ); -} - -/* }}} */ -/* {{{ imper_get_raw_opacity() - * - * const PixelPacket *AcquireImagePixels(const Image *image, - * const long x, const long y, - * const unsigned long columns, const unsigned long rows, - * ExceptionInfo *exception) - */ - -CAMLprim value -imper_get_raw_opacity( value image_bloc ) -{ - CAMLparam1( image_bloc ); - CAMLlocal3( pixel_matrix, column_array, color_tuple ); - unsigned long x, y; - unsigned long columns, rows; - - ExceptionInfo - exception; - - PixelPacket - pixel; - - columns = ((Image *) Field(image_bloc,1))->columns; - rows = ((Image *) Field(image_bloc,1))->rows; - - GetExceptionInfo(&exception); - - const PixelPacket * pixel_packet_array; - - /* DEPR - pixel_packet_array = - AcquireImagePixels( - (Image *) Field(image_bloc,1), - 0, 0, - columns, rows, - &exception ); - */ - - pixel_packet_array = - GetVirtualPixels( - (Image *) Field(image_bloc,1), - 0, 0, - columns, rows, - &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - /* alloc_array(f, a) allocates an array of values, calling function f - * over each element of the input array a to transform it into a value. - * The array a is an array of pointers terminated by the null pointer. - * The function f receives each pointer as argument, and returns a value. - * The zero-tagged block returned by alloc_array(f, a) is filled with the values - * returned by the successive calls to f. - * (This function must not be used to build an array of floating-point numbers.) - */ - /* - PixelPacket init_columns[columns]; - PixelPacket init_rows[rows]; - - pixel_matrix = alloc_array(fill_raw, init_columns); - column_array = alloc_array(fill_raw, init_rows); - */ - - pixel_matrix = alloc_tuple(columns); - - for (x=0; x < columns; ++x) { - - column_array = alloc_tuple(rows); - - for (y=0; y < rows; ++y) { - - pixel = pixel_packet_array[(columns * y) + x]; - - color_tuple = alloc_tuple(4); - - Store_field(color_tuple, 0, Val_long( (long) pixel.red )); - Store_field(color_tuple, 1, Val_long( (long) pixel.green )); - Store_field(color_tuple, 2, Val_long( (long) pixel.blue )); - Store_field(color_tuple, 3, Val_long( (long) pixel.opacity )); - - Store_field(column_array, y, color_tuple); - } - Store_field(pixel_matrix, x, column_array); - } - - CAMLreturn( pixel_matrix ); -} - -/* }}} */ -/* {{{ imper_get_raw_without_alpha() - * - * const PixelPacket *AcquireImagePixels(const Image *image, - * const long x, const long y, - * const unsigned long columns, const unsigned long rows, - * ExceptionInfo *exception) - */ - -CAMLprim value -imper_get_raw_without_alpha( value image_bloc ) -{ - CAMLparam1( image_bloc ); - CAMLlocal3( pixel_matrix, column_array, color_tuple ); - unsigned long x, y; - unsigned long columns, rows; - - ExceptionInfo - exception; - - PixelPacket - pixel; - - columns = ((Image *) Field(image_bloc,1))->columns; - rows = ((Image *) Field(image_bloc,1))->rows; - - GetExceptionInfo(&exception); - - const PixelPacket * pixel_packet_array; - - /* DEPR - pixel_packet_array = - AcquireImagePixels( - (Image *) Field(image_bloc,1), - 0, 0, - columns, rows, - &exception ); - */ - - pixel_packet_array = - GetVirtualPixels( - (Image *) Field(image_bloc,1), - 0, 0, - columns, rows, - &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - /* alloc_array(f, a) allocates an array of values, calling function f - * over each element of the input array a to transform it into a value. - * The array a is an array of pointers terminated by the null pointer. - * The function f receives each pointer as argument, and returns a value. - * The zero-tagged block returned by alloc_array(f, a) is filled with the values - * returned by the successive calls to f. - * (This function must not be used to build an array of floating-point numbers.) - */ - /* - PixelPacket init_columns[columns]; - PixelPacket init_rows[rows]; - - pixel_matrix = alloc_array(fill_raw, init_columns); - column_array = alloc_array(fill_raw, init_rows); - */ - - pixel_matrix = alloc_tuple(columns); - - for (x=0; x < columns; ++x) { - - column_array = alloc_tuple(rows); - - for (y=0; y < rows; ++y) { - - pixel = pixel_packet_array[(columns * y) + x]; - - color_tuple = alloc_tuple(3); - - Store_field(color_tuple, 0, Val_long( (long) pixel.red )); - Store_field(color_tuple, 1, Val_long( (long) pixel.green )); - Store_field(color_tuple, 2, Val_long( (long) pixel.blue )); - - Store_field(column_array, y, color_tuple); - } - Store_field(pixel_matrix, x, column_array); - } - - CAMLreturn( pixel_matrix ); -} - -/* }}} */ -/* {{{ imper_get_raw2() - * - * PixelPacket AcquireOnePixel(const Image image, - * const long x, const long y, - * ExceptionInfo exception) - */ - -CAMLprim value -imper_get_raw2( value image_bloc ) -{ - CAMLparam1( image_bloc ); - CAMLlocal3( pixel_matrix, column_array, color_tuple ); - unsigned long x, y; - unsigned long width, height; - - ExceptionInfo - exception; - - PixelPacket - pixel; - - width = ((Image *) Field(image_bloc,1))->columns; - height = ((Image *) Field(image_bloc,1))->rows; - - GetExceptionInfo(&exception); - - /* alloc_array(f, a) allocates an array of values, calling function f - * over each element of the input array a to transform it into a value. - * The array a is an array of pointers terminated by the null pointer. - * The function f receives each pointer as argument, and returns a value. - * The zero-tagged block returned by alloc_array(f, a) is filled with the values - * returned by the successive calls to f. - * (This function must not be used to build an array of floating-point numbers.) - */ - /* - PixelPacket init_width[width]; - PixelPacket init_height[height]; - pixel_matrix = alloc_array(fill_raw, init_width); - column_array = alloc_array(fill_raw, init_height); - */ - - pixel_matrix = alloc_tuple(width); - /* - pixel_matrix = alloc(width, 0); - */ - - for (x=0; x < width; ++x) { - - column_array = alloc_tuple(height); - /* - column_array = alloc(height,0); - */ - - for (y=0; y < height; ++y) { - - /* DEPR - pixel = AcquireOnePixel( - (Image *) Field(image_bloc,1), - x, y, &exception ); - */ - - GetOneVirtualPixel( - (Image *) Field(image_bloc,1), - Long_val(x), - Long_val(y), - &pixel, - &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - - color_tuple = alloc_tuple(4); - - Store_field(color_tuple, 0, Val_long( (long) pixel.red )); - Store_field(color_tuple, 1, Val_long( (long) pixel.green )); - Store_field(color_tuple, 2, Val_long( (long) pixel.blue )); - Store_field(color_tuple, 3, Val_long( MaxMap - - (long) pixel.opacity )); - - Store_field(column_array, y, color_tuple); - } - Store_field(pixel_matrix, x, column_array); - } - DestroyExceptionInfo(&exception); - - CAMLreturn( pixel_matrix ); -} - -/* }}} */ - - -/* {{{ imper_get_raw_gl_indexed() - * - * const PixelPacket *AcquireImagePixels(const Image *image, - * const long x, const long y, - * const unsigned long columns, const unsigned long rows, - * ExceptionInfo *exception) - */ - -CAMLprim value -imper_get_raw_gl_indexed( value image_bloc ) -{ - CAMLparam1( image_bloc ); - CAMLlocal3( pixel_matrix, column_array, color_tuple ); - unsigned long x, y; - unsigned long columns, rows; - - ExceptionInfo - exception; - - PixelPacket - pixel; - - columns = ((Image *) Field(image_bloc,1))->columns; - rows = ((Image *) Field(image_bloc,1))->rows; - - GetExceptionInfo(&exception); - - const PixelPacket * pixel_packet_array; - - /* DEPR - pixel_packet_array = - AcquireImagePixels( - (Image *) Field(image_bloc,1), - 0, 0, - columns, rows, - &exception ); - */ - - pixel_packet_array = - GetVirtualPixels( - (Image *) Field(image_bloc,1), - 0, 0, - columns, rows, - &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - /* alloc_array(f, a) allocates an array of values, calling function f - * over each element of the input array a to transform it into a value. - * The array a is an array of pointers terminated by the null pointer. - * The function f receives each pointer as argument, and returns a value. - * The zero-tagged block returned by alloc_array(f, a) is filled with the values - * returned by the successive calls to f. - * (This function must not be used to build an array of floating-point numbers.) - */ - /* - PixelPacket init_columns[columns]; - PixelPacket init_rows[rows]; - - pixel_matrix = alloc_array(fill_raw, init_columns); - column_array = alloc_array(fill_raw, init_rows); - */ - - pixel_matrix = alloc_tuple(columns * rows); - - for (x=0; x < columns; ++x) { - - for (y=0; y < rows; ++y) { - - pixel = pixel_packet_array[(columns * y) + x]; - - color_tuple = alloc_tuple(4); - - Store_field(color_tuple, 0, Val_long( (long) pixel.red )); - Store_field(color_tuple, 1, Val_long( (long) pixel.green )); - Store_field(color_tuple, 2, Val_long( (long) pixel.blue )); - Store_field(color_tuple, 3, Val_long( MaxMap - - (long) pixel.opacity )); - - Store_field(pixel_matrix, (x * rows) + y, color_tuple); - } - } - - CAMLreturn( pixel_matrix ); -} - -/* }}} */ -/* {{{ imper_get_raw_gl_indexed_without_alpha() - * - * const PixelPacket *AcquireImagePixels(const Image *image, - * const long x, const long y, - * const unsigned long columns, const unsigned long rows, - * ExceptionInfo *exception) - */ - -CAMLprim value -imper_get_raw_gl_indexed_without_alpha( value image_bloc ) -{ - CAMLparam1( image_bloc ); - CAMLlocal3( pixel_matrix, column_array, color_tuple ); - unsigned long x, y; - unsigned long columns, rows; - - ExceptionInfo - exception; - - PixelPacket - pixel; - - columns = ((Image *) Field(image_bloc,1))->columns; - rows = ((Image *) Field(image_bloc,1))->rows; - - GetExceptionInfo(&exception); - - const PixelPacket * pixel_packet_array; - - /* DEPR - pixel_packet_array = - AcquireImagePixels( - (Image *) Field(image_bloc,1), - 0, 0, - columns, rows, - &exception ); - */ - - pixel_packet_array = - GetVirtualPixels( - (Image *) Field(image_bloc,1), - 0, 0, - columns, rows, - &exception ); - - if (exception.severity != UndefinedException) - { - failwith( exception.reason ); - } - DestroyExceptionInfo(&exception); - - /* alloc_array(f, a) allocates an array of values, calling function f - * over each element of the input array a to transform it into a value. - * The array a is an array of pointers terminated by the null pointer. - * The function f receives each pointer as argument, and returns a value. - * The zero-tagged block returned by alloc_array(f, a) is filled with the values - * returned by the successive calls to f. - * (This function must not be used to build an array of floating-point numbers.) - */ - /* - PixelPacket init_columns[columns]; - PixelPacket init_rows[rows]; - - pixel_matrix = alloc_array(fill_raw, init_columns); - column_array = alloc_array(fill_raw, init_rows); - */ - - pixel_matrix = alloc_tuple(columns * rows); - - for (x=0; x < columns; ++x) { - - for (y=0; y < rows; ++y) { - - pixel = pixel_packet_array[(columns * y) + x]; - - color_tuple = alloc_tuple(3); - - Store_field(color_tuple, 0, Val_long( (long) pixel.red )); - Store_field(color_tuple, 1, Val_long( (long) pixel.green )); - Store_field(color_tuple, 2, Val_long( (long) pixel.blue )); - - Store_field(pixel_matrix, (x * rows) + y, color_tuple); - } - } - - CAMLreturn( pixel_matrix ); -} - -/* }}} */ - - -/* Does not work! */ -/* {{{ set_pixel() - * - * (DrawInfo *)->primitive = "point x,y" - */ -void -set_pixel( - Image *image, - unsigned long x, - unsigned long y, - PixelPacket pixel ) -{ - MagickBooleanType - ret; - - ImageInfo - *image_info; - - DrawInfo - *draw_info; - - image_info = CloneImageInfo((ImageInfo *) NULL); - - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); - DestroyImageInfo(image_info); - - if ( !draw_info ) { -#if DEBUG - fprintf(stderr, "CloneDrawInfo() failed\n"); fflush(stderr); -#endif - failwith("set_raw failed"); - } - - draw_info->fill = pixel; - - char str_buffer[ MaxTextExtent ]; - int str_len; - - /* Feed the primitive "point X,Y" */ - str_len = snprintf( str_buffer, MaxTextExtent, "point %ld,%ld", Long_val(x), Long_val(y) ); - (void) CloneString(&draw_info->primitive, str_buffer); - - ret = DrawImage(image, draw_info); - - if (ret == MagickFalse) { -#if DEBUG - fprintf(stderr, "DrawImage() failed\n"); fflush(stderr); -#endif - failwith("set_raw failed"); - } - - /* @FIXME: draw_info should be freed - * but this line produce a Segmentation fault - * DestroyDrawInfo(draw_info); - */ -} -/* }}} */ -/* {{{ imper_set_raw_c() - * - * PixelPacket *SetImagePixels(Image *image, const long x, const long y, - * const unsigned long columns, const unsigned long rows); - */ -CAMLprim value -imper_set_raw_c( - value raw, - value width, - value height ) -{ - CAMLparam3( raw, width, height ); - CAMLlocal3( column_array, color_tuple, image_bloc ); - - const unsigned long columns = Long_val(width); - const unsigned long rows = Long_val(height); - - /* {{{ new_image */ - { - char - str_buffer[ MaxTextExtent ]; - - int str_len; - - ExceptionInfo - exception; - - ImageInfo - *image_info; - - image_info = CloneImageInfo((ImageInfo *) NULL); - - /* image size */ - str_len = snprintf(str_buffer, MaxTextExtent, "%ldx%ld", columns, rows); - (void) CloneString(&image_info->size, str_buffer); - - /* image color */ - strcpy( image_info->filename, "xc:#7F7F7F7F"); - - image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(image_bloc,1) = (value) alloc_image(); /* alloc_image() */ - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - GetExceptionInfo(&exception); - - Field(image_bloc,1) = (value) ReadImage(image_info, &exception); - DestroyImageInfo(image_info); - - if (exception.severity != UndefinedException) { - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - if ((Image *) Field(image_bloc,1) == (Image *) NULL) { - /* exit(1) ; */ - failwith("set_raw failed"); - } - } - /* }}} */ - - /* - PixelPacket - *pixel_array; - - pilxel_array = SetImagePixels(Field(image_bloc,1), 0, 0, columns, rows); - - if (pixel_array == (PixelPacket *)NULL) { - failwith("set_raw failed") ; - } - */ - - unsigned long x, y; - - PixelPacket - pixel; - - /* - printf(" sizeof(pixel_array[0]) = %d\n", sizeof(pixel_array[0])); - printf(" PixelPacket = %d\n", sizeof(PixelPacket)); - */ - - for (x=0; x < columns; x++) { - - column_array = Field(raw, x); - - for (y=0; y < rows; y++) { - - color_tuple = Field(column_array, y); - - pixel.red = Field(color_tuple, 0); - pixel.green = Field(color_tuple, 0); - pixel.blue = Field(color_tuple, 0); - pixel.opacity = Field(color_tuple, 0); /* o = max - a */ - - /* - printf("ImageMagick: recording pixel y=%d into array", y); fflush(stdout); - pixel_array[x * columns + y] = pixel; - printf(" OK\n"); fflush(stdout); - */ - set_pixel( (Image *) Field(image_bloc,1), x, y, pixel); - } - printf("."); fflush(stdout); - } - printf("\n"); fflush(stdout); - -#if 0 - /* {{{ SyncImagePixels() - * - * MagickBooleanType SyncImagePixels(Image *image); - */ - { - MagickBooleanType - ret; - - ret = SyncImagePixels(Field(image_bloc,1)); - - if (ret == MagickFalse) { -#if DEBUG - printf("ImageMagick: SyncImagePixels() failed\n"); fflush(stdout); -#endif - failwith("set_raw failed"); - } - } - /* }}} */ - printf("ImageMagick: After Sync!\n"); fflush(stdout); -#endif - - CAMLreturn( image_bloc ); -} -/* }}} */ - -/* }}} */ - - -/* {{{ @TODO: IMAGE LISTS - * - * MagickBooleanType AnimateImages(const ImageInfo *, Image *); - * Image *AppendImages(const Image *, const MagickBooleanType,ExceptionInfo *); - * Image *AverageImages(const Image *, ExceptionInfo *); - * - * in - * - * }}} */ -/* TODO: the images added in a list are not clones, these are pointers. - * So if images are freed by the GC, there will be problems. - * (A solution could be to add a field to the image_bloc which says if the image - * is part of an image_list or not, and keep track of when the image or the list - * have been reclaimed by the GC.) - */ -/* {{{ ==== IMAGE LISTS ==== */ - -/* {{{ imper_new_image_list() - * - * Image *NewImageList(void); - */ -CAMLprim value -imper_new_image_list(value unit) -{ - CAMLparam1(unit); - - CAMLlocal1(images_list_bloc); - - - images_list_bloc = alloc_final(2, finalize_images_list, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - Field(images_list_bloc,1) = (value) NewImageList(); - /* - Field(images_list_bloc,1) = NewImageList(); - */ - - - if ((Image *) &Field(images_list_bloc,1) == (Image *) NULL) { - /* exit(1) ; */ - failwith("new_images_list failed"); - } - - CAMLreturn (images_list_bloc); -} -/* }}} */ -/* {{{ imper_appendimagetolist() - * - * AppendImageToList(Image *images, const Image *image); - */ -CAMLprim value -imper_appendimagetolist( - value images_list_bloc, - value image_bloc, - value delay ) -{ - CAMLparam3( images_list_bloc, image_bloc, delay ); - - Image *img; - - img = (Image *) Field(image_bloc,1); - img->delay = (unsigned long) Long_val(delay); - - - AppendImageToList( - (Image **) &Field(images_list_bloc,1), - (Image *) Field(image_bloc,1) ); - - - CAMLreturn( Val_unit ); -} -/* }}} */ -/* {{{ imper_getimagelistlength() - * - * unsigned long GetImageListLength(const Image *images); - */ -CAMLprim value -imper_getimagelistlength( - value images_list_bloc ) -{ - CAMLparam1( images_list_bloc ); - - CAMLreturn( Val_long( - GetImageListLength( (Image *) Field(images_list_bloc,1) ) - )); -} -/* }}} */ -/* {{{ imper_animateimages() - * - * MagickBooleanType AnimateImages(const ImageInfo *image_info, Image *images); - */ -CAMLprim value -imper_animateimages( - value images_list_bloc ) -{ - CAMLparam1( images_list_bloc ); - - ImageInfo - *image_info; - - MagickBooleanType - ret; - - image_info = CloneImageInfo((ImageInfo *) NULL); - - - ret = AnimateImages(image_info, (Image *) Field(images_list_bloc,1) ); - - - if (ret == MagickFalse) { - failwith("animate_images failed"); - } - DestroyImageInfo(image_info); - - CAMLreturn( Val_unit ); -} -/* }}} */ - -/* {{{ imper_getlastimageinlist() - * - * Image *GetLastImageInList(const Image *images); - */ -CAMLprim value -imper_getlastimageinlist( - value images_list_bloc ) -{ - CAMLparam1( images_list_bloc ); - - CAMLlocal1( image_bloc ); - - - Field(image_bloc,1) = (value) GetLastImageInList( (Image *) &Field(images_list_bloc,1) ); - - - CAMLreturn( image_bloc ); -} -/* }}} */ -/* {{{ imper_getfirstimageinlist() - * - * Image *GetFirstImageInList(const Image *images); - */ -CAMLprim value -imper_getfirstimageinlist( - value images_list_bloc ) -{ - CAMLparam1( images_list_bloc ); - - CAMLlocal1( image_bloc ); - - - Field(image_bloc,1) = (value) GetFirstImageInList( (Image *) &Field(images_list_bloc,1) ); - - - CAMLreturn( image_bloc ); -} -/* }}} */ - -/* {{{ imper_averageimages() - * - * Image *AverageImages(Image *image, ExceptionInfo *exception) - */ -CAMLprim value -imper_averageimages( - value image_list_bloc, - value image_bloc ) -{ - CAMLparam2(image_list_bloc, image_bloc); - - Image *new_image; - - ExceptionInfo exception; - - - GetExceptionInfo(&exception); - - new_image = AverageImages( - (Image *) Field(image_list_bloc,1), - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn( Val_unit ); -} - -/* }}} */ - -/* TEMP */ -/* Just a work-around to prevent an image in an image_list - to be garbage collected */ -/* {{{ imper_no_op() */ -CAMLprim value -imper_no_op(value image_bloc) -{ - CAMLparam1( image_bloc ); - Image *image; - - image = (Image *) Field(image_bloc,1); - - CAMLreturn( Val_unit ); -} -/* }}} */ - -/* {{{ imper_has_link() */ - -/* {{{ int has_link(Image *img) */ - -/* {{{ int has_link(Image *img) OLD */ -#if 0 -int has_link(Image *img) -{ -/* struct _Image - *previous, - *list, - *next */ - - if ( img->previous == (Image *) NULL - && img->next == (Image *) NULL - && img->list == (Image *) NULL ) - { - return 0; - } else { - return 1; - } -} -#endif -/* }}} */ - -int has_link(Image *img) -{ -/* struct _Image - *previous, - *list, - *next */ - - if ( img->previous != (Image *) NULL ) - { - return 1; - } - - if ( img->next != (Image *) NULL ) - { - return 2; - } - - if ( img->list != (Image *) NULL ) - { - return 3; - } - - return 0; -} -/* }}} */ - -CAMLprim value -imper_has_link( value image_bloc ) -{ - CAMLparam1(image_bloc); - Image *img; - - img = (Image *) Field(image_bloc,1); - - switch ( has_link(img) ) - { - case 0: -#if DEBUG - printf("ImageMagick.has_link: image doesn't have any link to other image\n"); fflush(stdout); -#endif - CAMLreturn( Val_false ); - break; - case 1: -#if DEBUG - printf("ImageMagick.has_link: image has previous\n"); fflush(stdout); -#endif - CAMLreturn( Val_true ); - break; - case 2: -#if DEBUG - printf("ImageMagick.has_link: image has next\n"); fflush(stdout); -#endif - CAMLreturn( Val_true ); - break; - case 3: -#if DEBUG - printf("ImageMagick.has_link: image has list\n"); fflush(stdout); -#endif - CAMLreturn( Val_true ); - break; - default: - failwith("has_link failed"); - } -} -/* }}} */ - -#define CAML_ALLOC_WITH_0_SIZE 1 - -/* {{{ imper_appendimages() - * - * Image *AppendImages(const Image *image,const MagickBooleanType stack, ExceptionInfo *exception); - */ -CAMLprim value -__imper_appendimages( - value image_list_bloc, - value ml_stack ) -{ - CAMLparam2(image_list_bloc, ml_stack ); - - CAMLlocal1(image_bloc); - - Image *new_image; - - ExceptionInfo exception; - - MagickBooleanType stack; - stack = MagickBoolean_val( ml_stack ); - - GetExceptionInfo(&exception); - - image_bloc = alloc_final(2, (*finalize_image), sizeof(Image), MAX_AMOUNT); /* finalize_image() */ -#if CAML_ALLOC_WITH_0_SIZE -#endif - - new_image = AppendImages( - (Image *) Field(image_list_bloc,1), - stack, - &exception ); - - if (exception.severity != UndefinedException) - { if ( new_image ) - { - DestroyImage( new_image ); - } - failwith( exception.reason ); - } - - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn( Val_unit ); -} - -/* }}} */ -/* {{{ imper_appendimages() - * - * Image *AppendImages(const Image *image,const MagickBooleanType stack, ExceptionInfo *exception); - */ -CAMLprim value -imper_appendimages( - value image_list_bloc, - value ml_stack, - value image_bloc ) -{ - CAMLparam3( image_list_bloc, ml_stack, image_bloc ); - - Image *new_image; - - ExceptionInfo exception; - - - GetExceptionInfo(&exception); - - MagickBooleanType stack; - stack = MagickBoolean_val( ml_stack ); - - new_image = AppendImages( - (Image *) Field(image_list_bloc,1), - stack, - &exception ); - - if (exception.severity != UndefinedException) - { - if ( new_image ) - { - DestroyImage( new_image ); - } - - failwith( exception.reason ); - } - - DestroyImage( (Image *) Field(image_bloc,1) ); - Field(image_bloc,1) = (value) new_image; - - DestroyExceptionInfo(&exception); - - CAMLreturn( Val_unit ); -} - -/* }}} */ - -/* }}} */ - - -/* {{{ ==== BLOBS ==== */ - -/* - * extern MagickExport unsigned char - * *FileToBlob(const char *, const size_t,size_t *, ExceptionInfo *), - * *GetBlobStreamData(const Image *), - * *ImageToBlob(const ImageInfo *, Image *, size_t *, ExceptionInfo *), - * *ImagesToBlob(const ImageInfo *, Image *, size_t *, ExceptionInfo *); - */ - -/* {{{ imper_imagetoblob_stdout() - * - * unsigned char *ImageToBlob(const ImageInfo *image_info, Image *image, - * size_t *length, ExceptionInfo *exception) - */ -CAMLprim value -imper_imagetoblob_stdout(value image_bloc) -{ - CAMLparam1( image_bloc ); - - ImageInfo - *image_info; - - ExceptionInfo - exception; - - char* - mime_type; - - unsigned char *blob_data; /* the image BLOB data */ - size_t blob_size; /* the size of the image BLOB */ - - GetExceptionInfo(&exception); - image_info = CloneImageInfo((ImageInfo *) NULL) ; - - blob_data = ImageToBlob( - image_info, - (Image *) Field(image_bloc,1), - &blob_size, - &exception ); - - /* - printf("%s", blob_data ); fflush(stdout); - fputs(blob_data, stdout); fflush(stdout); - */ - - /* - unsigned long i; - for (i=0; i < blob_size; i++) { - //(void) fputc(blob_data[i], stdout); - (void) putc(blob_data[i], stdout); - } - fflush(stdout); - */ - if (exception.severity != UndefinedException) { - - failwith( exception.reason ); - } - - mime_type = MagickToMime( - ((Image *) Field(image_bloc,1))->magick ); - - printf("Content-Type: %s\n" - "Content-Length: %d\n" - "\n", mime_type, blob_size); - /* - fwrite(blob_data, 1, blob_size, stdout); - */ - fwrite(blob_data, blob_size, 1, stdout); - - DestroyImageInfo(image_info); - DestroyExceptionInfo(&exception); - - CAMLreturn( Val_unit ); -} -/* }}} */ -/* {{{ imper_imagetoblob_bytes() - * - * unsigned char *ImageToBlob(const ImageInfo *image_info, Image *image, - * size_t *length, ExceptionInfo *exception) - */ -CAMLprim value -imper_imagetoblob_bytes(value image_bloc) -{ - CAMLparam1( image_bloc ); - CAMLlocal1( byte_array ); - - ImageInfo - *image_info; - - ExceptionInfo - exception; - - unsigned char *blob_data; /* the image BLOB data */ - size_t blob_size; /* the size of the image BLOB */ - - GetExceptionInfo(&exception); - image_info = CloneImageInfo((ImageInfo *) NULL) ; - - blob_data = ImageToBlob( - image_info, - (Image *) Field(image_bloc,1), - &blob_size, - &exception ); - - if (exception.severity != UndefinedException) { - - failwith( exception.reason ); - } - DestroyImageInfo(image_info); - DestroyExceptionInfo(&exception); - - - byte_array = alloc_tuple(blob_size); - - unsigned long blob_len; - - puts(" A"); fflush(stdout); - blob_len = blob_size; - puts(" B"); fflush(stdout); - printf(" blob-size = '%lu'\n", blob_len); fflush(stdout); - puts(" C"); fflush(stdout); - - unsigned long i; - for (i=0; i < blob_len; i++) { - printf("."); fflush(stdout); - Store_field(byte_array, i, Val_int((unsigned int) blob_data[i])); - } - puts("\n D"); fflush(stdout); - - CAMLreturn( byte_array ); -} -/* }}} */ - -/* }}} */ - -/* {{{ ==== IMPORT ==== */ - -/* -typedef struct _XImportInfo -{ - MagickBooleanType - frame, - borders, - screen, - descend, - silent; -} XImportInfo; - -extern MagickExport Image - *XImportImage(const ImageInfo *,XImportInfo *); - -extern MagickExport void - XGetImportInfo(XImportInfo *); - */ - -/* {{{ imper_importimage() - * - * Image *XImportImage(const ImageInfo *, XImportInfo *); - */ -CAMLprim value -imper_importimage(value width, value height, value color) -{ - CAMLparam3(width, height, color); - - CAMLlocal1(image_bloc); - - char - str_buffer[ MaxTextExtent ]; - - int str_len; - - ExceptionInfo - exception; - - ImageInfo - *image_info; - - - image_info = CloneImageInfo((ImageInfo *) NULL); - - /* Give image size */ - str_len = snprintf( str_buffer, MaxTextExtent, "%ldx%ld", Long_val(width), Long_val(height) ); - (void) CloneString(&image_info->size, str_buffer); - - /* Give image color */ - str_len = snprintf( str_buffer, MaxTextExtent, "xc:%s", String_val(color) ); - strncpy( image_info->filename, str_buffer, str_len ); - - - image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - Field(image_bloc,1) = (value) alloc_image(); /* alloc_image() */ - - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - GetExceptionInfo(&exception); - - Field(image_bloc,1) = (value) ReadImage(image_info, &exception); - DestroyImageInfo(image_info); - - /****************/ - - /* { MagickBooleanType - frame, - borders, - screen, - descend, - silent; - } XImportInfo; */ - XImportInfo - *import_info; - import_info = (XImportInfo *)NULL; - - Field(image_bloc,1) = (value) XImportImage(image_info, import_info); - - /****************/ - - if (exception.severity != UndefinedException) { - - failwith( exception.reason ); - } - - DestroyExceptionInfo(&exception); - - if ((Image *) Field(image_bloc,1) == (Image *) NULL) { - /* exit(1) ; */ - failwith("import failed"); - } - - CAMLreturn (image_bloc); -} -/* }}} */ - -/* }}} */ - - -/* {{{ ==== BIG-ARRAY ==== */ - - -/* {{{ im_sizeof_quantum() */ - -CAMLprim value -im_sizeof_quantum(value unit) -{ - CAMLparam0(); - CAMLreturn( Val_int(sizeof(Quantum)) ); -} - -CAMLprim value -im_sizeof_quantum_bit(value unit) -{ - CAMLparam0(); - CAMLreturn( Val_int(sizeof(Quantum) * CHAR_BIT) ); -} - -/* }}} */ - -/* {{{ inspect BigArray */ - -CAMLprim value -ml_big_array_test(value v) -{ - CAMLparam1( v ); - - /* number of dimensions should be 2 */ - if (Bigarray_val(v)->num_dims != 2) { - failwith("the Bigarray should have 2 dimensions"); - } - - /* kind of array elements */ - printf(" Bigarray kind: "); - switch (Bigarray_val(v)->flags & BIGARRAY_KIND_MASK) - /* {{{ cases: */ - { - case BIGARRAY_FLOAT32: printf(" FLOAT32: Single-precision floats \n"); break; - case BIGARRAY_FLOAT64: printf(" FLOAT64: Double-precision floats \n"); break; - case BIGARRAY_SINT8: printf(" SINT8: Signed 8-bit integers \n"); break; - case BIGARRAY_UINT8: printf(" UINT8: Unsigned 8-bit integers \n"); break; - case BIGARRAY_SINT16: printf(" SINT16: Signed 16-bit integers \n"); break; - case BIGARRAY_UINT16: printf(" UINT16: Unsigned 16-bit integers\n"); break; - case BIGARRAY_INT32: printf(" INT32: Signed 32-bit integers \n"); break; - case BIGARRAY_INT64: printf(" INT64: Signed 64-bit integers \n"); break; - case BIGARRAY_CAML_INT: printf(" CAML_INT: Caml-style integers (signed 31 or 63 bits) \n"); break; - case BIGARRAY_NATIVE_INT: printf(" NATIVE_INT: Platform-native long integers (32 or 64 bits)\n"); break; - case BIGARRAY_COMPLEX32: printf(" COMPLEX32: Single-precision complex\n"); break; - case BIGARRAY_COMPLEX64: printf(" COMPLEX64: Double-precision complex\n"); break; - } - /* }}} */ - - unsigned long X_ = (unsigned long) Bigarray_val(v)->dim[0]; - unsigned long Y_ = (unsigned long) Bigarray_val(v)->dim[1]; - Quantum *arr; - arr = Data_bigarray_val(v); - - printf(" sizeof array %d bytes, %d bits\n", - sizeof(arr[0]), - sizeof(arr[0]) * CHAR_BIT); - printf(" sizeof Quantum %d bytes, %d bits (char %d bits)\n", - sizeof(Quantum), - sizeof(Quantum) * CHAR_BIT, CHAR_BIT); - - unsigned long x, y; - for (x=0; x < X_; x++) { - for (y=0; y < Y_; y++) { - if(x==1 && y==3) arr[y+x*Y_] = 6; - printf(" %lu,%lu", x, y ); - printf(":%3d", (Quantum) arr[y+x*Y_] ); - //printf(":%d", *arr ); - //arr++; - } - printf("\n"); - } - - fflush(stdout); - - CAMLreturn( Val_unit ); -} -/* }}} */ - -/* {{{ constituteimage_from_big_array_char() - * - * image = ConstituteImage(640, 480, "RGB", CharPixel, pixels, exception); - * - * Image *ConstituteImage( - * const unsigned long columns, - * const unsigned long rows, - * const char *map, - * const StorageType storage, - * const void *pixels, - * ExceptionInfo *exception ); - */ -CAMLprim value -constituteimage_from_big_array_char(value array) -{ - CAMLparam1( array ); - CAMLlocal1( image_bloc ); - ExceptionInfo *exception; - - if ( (Bigarray_val(array)->flags & BIGARRAY_KIND_MASK) != BIGARRAY_UINT8) { - failwith("The bigarray should contain unsigned 8-bit integers"); - } - if (Bigarray_val(array)->num_dims != 3) { - failwith("the Bigarray should have 3 dimensions"); - } - unsigned long width = (unsigned long) Bigarray_val(array)->dim[0]; - unsigned long height = (unsigned long) Bigarray_val(array)->dim[1]; - /* - unsigned short cells = (unsigned short)Bigarray_val(array)->dim[2]; - */ - - //unsigned char *data; - void *data; - data = Data_bigarray_val(array); - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - image_bloc = alloc_final(2, finalize_image, sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - /* - unsigned char *pixels; - pixels = malloc(width * height * sizeof(char) * cells); - unsigned long x, y; - unsigned short p; - unsigned long long k=0; - for (x=0; x < width; x++) - for (y=0; y < height; y++) - for (p=0; p < cells; p++) { pixels[k] = *data; data++; k++; } - - exception = AcquireExceptionInfo(); - Field(image_bloc,1) = - (value) ConstituteImage(width, height, "RGB", CharPixel, pixels, exception); - free(pixels); - */ - - char map[] = "RGB"; - - /* TODO - assert( strlen(map) == cells ); - */ - - exception = AcquireExceptionInfo(); - Field(image_bloc,1) = - (value) ConstituteImage(width, height, map, CharPixel, data, exception); - - - if (exception->severity != UndefinedException) { - if ( (Image *)Field(image_bloc,1) != (Image *) NULL) { - DestroyImage((Image *) Field(image_bloc,1)); - } - failwith( exception->reason ); - } - exception = DestroyExceptionInfo(exception); - - if ( (Image *)Field(image_bloc,1) == (Image *) NULL) { - failwith("image_of_bigarray failed"); - } - - CAMLreturn( image_bloc ); -} -/* }}} */ - -/* }}} */ - - -/* {{{ ==== TMP: LINEAR GRADIENT ==== */ - -#include -#include - -/* {{{ Mathematic utilities */ - -/* returns the length of the vector */ -long double -vector_length( - long long x, - long long y) -{ - return sqrt((x*x) + (y*y)); -} - -/* returns the scalar product of 2 vectors */ -long long -scalar_product( - long long a_x, - long long a_y, - long long b_x, - long long b_y) -{ - return (a_x * b_x) + (a_y * b_y); -} - -/* returns the cosinus of the angle between the 2 vectors 'ab' and 'cd' */ -long double -get_cos( - long long ab_x, - long long ab_y, - long long cd_x, - long long cd_y) -{ - long long _scal = scalar_product(ab_x,ab_y, cd_x,cd_y); - long double _len = vector_length(ab_x,ab_y) * vector_length(cd_x,cd_y); - return (long double)_scal / _len; -} - -/* returns the vector (a - b) */ -void -vector_substract( - long long *result_x, - long long *result_y, - - unsigned long a_x, - unsigned long a_y, - unsigned long b_x, - unsigned long b_y) -{ - *result_x = (long long)a_x - (long long)b_x; - *result_y = (long long)a_y - (long long)b_y; -} - -/* returns the vector (a + b) */ -void -vector_add( - long *result_x, - long *result_y, - - unsigned long a_x, - unsigned long a_y, - unsigned long b_x, - unsigned long b_y) -{ - *result_x = a_x + b_x; - *result_y = a_y + b_y; -} - -/* returns the coordinate of 'c' - in the 1D (one dimention) system defined by the vector 'ab'. */ -long double -get_y_of_A_B( - unsigned long a_x, unsigned long a_y, - unsigned long b_x, unsigned long b_y, - unsigned long c_x, unsigned long c_y) -{ - long long ab_x, ab_y; - vector_substract(&ab_x,&ab_y, b_x,b_y, a_x,a_y); - - long long ac_x, ac_y; - vector_substract(&ac_x,&ac_y, c_x,c_y, a_x,a_y); - - return vector_length(ac_x,ac_y) * get_cos(ab_x,ab_y, ac_x,ac_y); -} - -/* multiply a vector by 'k' */ -void -vector_multiply( - unsigned long *result_x, - unsigned long *result_y, - long double k, - unsigned long x, - unsigned long y) -{ - *result_x = (unsigned long)(k * (long double)x); - *result_y = (unsigned long)(k * (long double)y); -} - -void -test_math_utilities(void) -{ - - /* {{{ scalar_product() */ - if ( - scalar_product(50, 40, 150, 110) == 11900 && - scalar_product(10, 208, 448, 32) == 11136 && - scalar_product(1541, 2, 7, 3129) == 17045 ) - { - printf(" scalar_product() is OK!\n"); - } else { - printf(" scalar_product() is WRONG!\n"); - } - /* }}} */ - /* {{{ vector_length() */ - if ( - vector_length(12, 16) == 20.0 && - vector_length(18, 24) == 30.0 && - (int)(vector_length(48, 231)) == 235 ) - { - printf(" vector_length() is OK!\n"); - } else { - printf(" vector_length() is WRONG!\n"); - } - /* }}} */ - /* {{{ get_cos() */ - if ( - get_cos(1,0, 0,1) == 0.0 && - get_cos(1,0, 1,0) == 1.0 && - ((int)(10000.0 * get_cos(5,2, 7,9))) == 8631 - ) - { - printf(" get_cos() is OK!\n"); - } else { - printf(" get_cos() is WRONG!\n"); - } - /* }}} */ - -} -/* }}} */ - -/* {{{ _set_pixel() */ - -#define _set_pixel(image, x, y, px_color) \ - draw_info->fill = px_color; \ - str_len=snprintf(str_buffer,MaxTextExtent,"point %lu,%lu", x,y); \ - (void) CloneString(&draw_info->primitive, str_buffer); \ - ret=DrawImage(image, draw_info); \ - if(ret==MagickFalse) fprintf(stderr, "DrawImage() failed\n"); - -/* }}} */ - -/* en: http://www.w3.org/TR/SVG/pservers.html#LinearGradients */ -/* fr: http://www.yoyodesign.org/doc/w3c/svg1/pservers.html#LinearGradients */ - -/* {{{ proto and type */ - -typedef enum -{ - Pad_SpreadMethod, - Repeat_SpreadMethod, - Reflect_SpreadMethod -} Gradient_SpreadMethod; - -/* {{{ SpreadMethod_val() */ - -static int -SpreadMethod_val( value param ) -{ - CONVALparam1( param ); - -#if TYPE_CHECKING - assert(Is_long( param )); -#endif - - switch (Int_val( param )) - { - case 0: return Pad_SpreadMethod; - case 1: return Repeat_SpreadMethod; - case 2: return Reflect_SpreadMethod; - default: -#if DEBUG - fprintf(stderr, "Error: Gradient SpreadMethod unrecognized\n"); fflush(stderr); - abort(); - /* - return -1; - failwith("Gradient SpreadMethod unrecognized"); - // failwith() does not work in sub-functions - */ -#else - fprintf(stderr, "Warning: Gradient SpreadMethod unrecognized\n"); fflush(stderr); - return Pad_SpreadMethod; -#endif - } -} - -/* }}} */ - -typedef enum -{ - Gradient_UserSpaceOnUse, - /* If gradientUnits="userSpaceOnUse", x1, y1, x2, y2 represent values - * in the coordinate system that results from taking the current user - * coordinate system in place at the time when the gradient element is - * referenced (i.e., the user coordinate system for the element - * referencing the gradient element via a 'fill' or 'stroke' property) - * and then applying the transform specified by attribute gradientTransform. - */ - Gradient_ObjectBoundingBox - /* gradientUnits="objectBoundingBox" - * Indicates that the attributes which specify the gradient vector (x1, y1, x2, y2) - * represent fractions or percentages of the bounding box of the element to which the gradient is applied. - */ -} Gradient_Units; - -typedef struct _BoundingBox -{ - unsigned long - x, y, - width, height; -} BoundingBox; - -void _linearGradientMagick( - Image *image, - unsigned long width, - unsigned long height, - BoundingBox bounding_box, - char *colors_strings[], - long double stop[], - int stop_nb, - Gradient_SpreadMethod spreadMethod, - long double matrix[3][3], - Gradient_Units gradientUnits, - unsigned long a_x, - unsigned long a_y, - unsigned long b_x, - unsigned long b_y ); - -void linearGradientMagick( - Image *image, - unsigned long width, - unsigned long height, - BoundingBox bounding_box, - char *colors_strings[], - long double stop[], - int stop_nb, - Gradient_SpreadMethod spreadMethod, - long double matrix[3][3], - Gradient_Units gradientUnits, - unsigned long a_x, - unsigned long a_y, - unsigned long b_x, - unsigned long b_y ); - -/* }}} */ - -/* {{{ _linear_gradient() */ - -CAMLprim value -_linear_gradient_native( - value ml_width, - value ml_height, - - value ml_a_x, - value ml_a_y, - value ml_b_x, - value ml_b_y, - - value ml_spreadMethod, - - value bounding_box_x, - value bounding_box_y, - value bounding_box_width, - value bounding_box_height ) -{ - CAMLparam5( ml_width, ml_height, ml_a_x, ml_a_y, ml_b_x ); - CAMLxparam5( ml_b_y, ml_spreadMethod, bounding_box_x, bounding_box_y, bounding_box_width ); - CAMLxparam1( bounding_box_height ); - CAMLlocal1(image_bloc); - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - - unsigned long width = Int_val(ml_width); - unsigned long height = Int_val(ml_height); - - BoundingBox - bounding_box; - - bounding_box.x = Int_val(bounding_box_x); - bounding_box.y = Int_val(bounding_box_y); - bounding_box.width = Int_val(bounding_box_width); - bounding_box.height = Int_val(bounding_box_height); - - if (bounding_box.x + bounding_box.width > width) { - //bounding_box.width = width - bounding_box.x; - printf(" bounding-box width overflow\n"); fflush(stdout); - } - if (bounding_box.y + bounding_box.height > height) { - //bounding_box.height = height - bounding_box.y; - printf(" bounding-box height overflow\n"); fflush(stdout); - } - - unsigned long - a_x, a_y, - b_x, b_y; - - a_x = Int_val(ml_a_x); a_y = Int_val(ml_a_y); - b_x = Int_val(ml_b_x); b_y = Int_val(ml_b_y); - - - int stop_nb = 4; - - long double *stop; - stop = malloc(stop_nb * sizeof(long double)); - stop[0] = 0.1; - stop[1] = 0.3; - stop[2] = 0.8; - stop[3] = 0.9; - - char - *colors_strings[4] = { - "#1D5", - "#00F", - "#F00", - "#F91", - }; - - Gradient_SpreadMethod spreadMethod; - - spreadMethod = SpreadMethod_val( ml_spreadMethod ); - - long double matrix[3][3] = { - /* the identity matrix */ - { 1.0, 0.0, 0.0 }, - { 0.0, 1.0, 0.0 }, - { 0.0, 0.0, 1.0 }, - }; - - - image_bloc = alloc_final(2, (*finalize_image), sizeof(Image), MAX_AMOUNT); /* finalize_image() */ - - /* {{{ Create the base canvas */ - ImageInfo *image_info; - image_info = CloneImageInfo((ImageInfo *) NULL); - { - ExceptionInfo exception; - char str_buffer[MaxTextExtent]; - GetExceptionInfo(&exception); - (void) snprintf(str_buffer,MaxTextExtent,"%lux%lu", width, height); - (void) CloneString(&image_info->size, str_buffer); - strcpy(image_info->filename,"xc:#888"); - Field(image_bloc,1) = (value) ReadImage(image_info,&exception); - if (exception.severity != UndefinedException) CatchException(&exception); - if ((Image *) Field(image_bloc,1) == (Image *) NULL) failwith("test_linear_gradient failed"); - DestroyExceptionInfo(&exception); - } - /* }}} */ - - Gradient_Units gradientUnits; - gradientUnits = Gradient_UserSpaceOnUse; - - _linearGradientMagick( - (Image *) Field(image_bloc,1), - width, height, - bounding_box, - colors_strings, - stop, stop_nb, - spreadMethod, - matrix, - gradientUnits, - a_x, a_y, - b_x, b_y ); - - free(stop); - - //DisplayImages(image_info, (Image *) Field(image_bloc,1) ); - - image_info=DestroyImageInfo(image_info); - - CAMLreturn( image_bloc ); -} - -CAMLprim value -_linear_gradient_bytecode(value * argv, int argn) -{ - return _linear_gradient_native( - argv[0], argv[1], argv[2], argv[3], argv[4], argv[5], - argv[6], argv[7], argv[8], argv[9], argv[10] ); -} - -/* }}} */ -/* {{{ _linearGradientMagick */ - -void -_linearGradientMagick( - Image *image, - - unsigned long width, /* size of the image */ - unsigned long height, - - BoundingBox bounding_box, - - char *colors_strings[], /* colors */ - long double stop[], /* positions of colors (0.0 < percentage < 1.0) */ - int stop_nb, /* number of colors */ - - Gradient_SpreadMethod spreadMethod, - - /* en: http://www.w3.org/TR/SVG/coords.html#TransformAttribute - fr: http://www.yoyodesign.org/doc/w3c/svg1/coords.html#TransformAttribute */ - long double matrix[3][3], - Gradient_Units gradientUnits, - - /* Percentages are allowed for x1, y1, x2, y2. - For gradientUnits="userSpaceOnUse", percentages represent values relative - to the current viewport. - For gradientUnits="objectBoundingBox", percentages represent values relative - to the bounding box for the object. */ - unsigned long a_x, /* point A */ - unsigned long a_y, - - unsigned long b_x, /* point B */ - unsigned long b_y ) -{ - MagickBooleanType ret; - - ExceptionInfo - exception; - - ImageInfo - *image_info; - - GetExceptionInfo(&exception); - image_info=CloneImageInfo((ImageInfo *) NULL); - - unsigned long _x = bounding_box.x; - unsigned long _y = bounding_box.y; - unsigned long last_x = bounding_box.width + _x; - unsigned long last_y = bounding_box.height + _y; - - /* {{{ linearGradient Core */ - { - PixelPacket - *color; - - color = malloc(stop_nb * sizeof(PixelPacket)); - - long double /* make the cast only once */ - *red, *green, *blue, *opacity; - - red = malloc(stop_nb * sizeof(long double)); - green = malloc(stop_nb * sizeof(long double)); - blue = malloc(stop_nb * sizeof(long double)); - opacity = malloc(stop_nb * sizeof(long double)); - - int stop_i, stop_j; - - for (stop_i = 0; stop_i < stop_nb; stop_i++) - { - ret = QueryColorDatabase(colors_strings[stop_i],&color[stop_i],&exception); - if (ret == MagickFalse) - fprintf(stderr, "QueryColorDatabase() failed\n"); - if (exception.severity != UndefinedException) - CatchException(&exception); - - red[stop_i] = (long double)color[stop_i].red; - green[stop_i] = (long double)color[stop_i].green; - blue[stop_i] = (long double)color[stop_i].blue; - opacity[stop_i] = (long double)color[stop_i].opacity; - } - - long long ab_x, ab_y; - - vector_substract(&ab_x,&ab_y, b_x,b_y, a_x,a_y); - long double len_ab = vector_length(ab_x, ab_y); - - /* {{{ foreach pixel of the image */ - { - register - unsigned long x; - unsigned long y; - long double percent, pos, percent_opposite; - PixelPacket px_color; - char str_buffer[MaxTextExtent]; - int str_len; - - DrawInfo *draw_info; // tmp - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); // tmp - if (!draw_info) fprintf(stderr, "CloneDrawInfo() failed\n"); // tmp - - for (y = _y; y < last_y; y++) { - for (x = _x; x < last_x; x++) { - /* {{{ pos */ - if (a_x == x && a_y == y) { - pos = 0.0; - } else { - pos = get_y_of_A_B(a_x,a_y, b_x,b_y, x,y) / len_ab; - } - /* }}} */ - /* {{{ pos over spread */ - switch (spreadMethod) - { - case Pad_SpreadMethod: - break; - - case Repeat_SpreadMethod: - if (pos < 0.0) - pos = 1.0 - fmod(- pos, 1.0); - else - pos = fmod(pos, 1.0); - break; - - case Reflect_SpreadMethod: - if (pos < 0.0) pos = - pos; - if ( ((int)pos % 2) == 0 ) - pos = fmod(pos, 1.0); - else - pos = 1.0 - fmod(pos, 1.0); - break; - } - /* }}} */ - - for (stop_i = 0; stop_i < stop_nb; stop_i++) - if (pos < stop[stop_i]) - break; - - if (stop_i == 0) { - px_color = color[0]; - - } else if (stop_i == stop_nb) { - px_color = color[stop_nb - 1]; - - } else { - stop_j = stop_i; - --stop_i; - - percent = ( - (pos - stop[stop_i]) / - (stop[stop_j] - stop[stop_i]) - ); - - percent_opposite = 1.0L - percent; - - /* {{{ pixel calculation */ - if ( spreadMethod == Pad_SpreadMethod && - (pos < 0.0L || pos > 1.0L) ) - { - if (pos < 0.0L) - px_color = color[0]; - else px_color = color[stop_nb - 1]; - - } else { - px_color.red = (Quantum)((red[stop_i] * percent_opposite) + (red[stop_j] * percent)); - px_color.green = (Quantum)((green[stop_i] * percent_opposite) + (green[stop_j] * percent)); - px_color.blue = (Quantum)((blue[stop_i] * percent_opposite) + (blue[stop_j] * percent)); - px_color.opacity = (Quantum)((opacity[stop_i] * percent_opposite) + (opacity[stop_j] * percent)); - } - /* }}} */ - } - - _set_pixel(image, x, y, px_color); // tmp - } - } - (void) DestroyDrawInfo(draw_info); // tmp - } - /* }}} */ - free(color); - free(red); - free(green); - free(blue); - free(opacity); - } - /* }}} */ - - image_info=DestroyImageInfo(image_info); - DestroyExceptionInfo(&exception); -} - -/* }}} */ - -/* {{{ test_linear_gradient() */ - -CAMLprim value -linear_gradient_native( - value image_bloc, - - value ml_width, - value ml_height, - - value ml_a_x, - value ml_a_y, - value ml_b_x, - value ml_b_y, - - value ml_spreadMethod, - - value ml_stop_list, - value ml_stop_nb, - - value _a, value _b, value _c, - value _d, value _e, value _f, - value _g, value _h, value _i, - - value bounding_box_x, - value bounding_box_y, - value bounding_box_width, - value bounding_box_height ) -{ - CAMLparam5( image_bloc, ml_width, ml_height, ml_a_x, ml_a_y ); - CAMLxparam5( ml_b_x, ml_b_y, ml_spreadMethod, ml_stop_list, ml_stop_nb ); - CAMLxparam5( _a, _b, _c, _d, _e ); - CAMLxparam5( _f, _g, _h, _i, bounding_box_x ); - CAMLxparam3( bounding_box_y, bounding_box_width, bounding_box_height ); - - if (IsMagickInstantiated() == MagickFalse) { - MagickCoreGenesis(getenv("PWD"), MagickTrue); - } - - unsigned long width = Int_val(ml_width); - unsigned long height = Int_val(ml_height); - - BoundingBox - bounding_box; - - bounding_box.x = Int_val(bounding_box_x); - bounding_box.y = Int_val(bounding_box_y); - bounding_box.width = Int_val(bounding_box_width); - bounding_box.height = Int_val(bounding_box_height); - - if (bounding_box.x + bounding_box.width > width) { - //bounding_box.width = width - bounding_box.x; - printf(" bounding-box width overflow\n"); fflush(stdout); - } - if (bounding_box.y + bounding_box.height > height) { - //bounding_box.height = height - bounding_box.y; - printf(" bounding-box height overflow\n"); fflush(stdout); - } - - unsigned long - a_x, a_y, - b_x, b_y; - - a_x = Int_val(ml_a_x); a_y = Int_val(ml_a_y); - b_x = Int_val(ml_b_x); b_y = Int_val(ml_b_y); - - - int stop_nb = Int_val(ml_stop_nb); - - long double *stop_offset; - stop_offset = malloc(stop_nb * sizeof(long double)); - - char - **colors_strings; - colors_strings = malloc(stop_nb * sizeof(char *)); - int i; - - CAMLlocal3( ml_item, ml_stop_offset, ml_stop_color ); - - i = 0; - while ( ml_stop_list != Val_emptylist ) - { - ml_item = Field(ml_stop_list,0); - - ml_stop_offset = Field(ml_item,0); - ml_stop_color = Field(ml_item,1); - - stop_offset[i] = Double_val(ml_stop_offset); - - int len = strlen(String_val(ml_stop_color)); - colors_strings[i] = malloc(len * sizeof(char)); - strcpy(colors_strings[i], String_val(ml_stop_color)); - - ml_stop_list = Field(ml_stop_list,1); - i++; - } - - - Gradient_SpreadMethod spreadMethod; - - spreadMethod = SpreadMethod_val( ml_spreadMethod ); - - long double matrix[3][3] = { - /* the transformation matrix */ - { Double_val(_a), Double_val(_b), Double_val(_c) }, - { Double_val(_d), Double_val(_e), Double_val(_f) }, - { Double_val(_g), Double_val(_h), Double_val(_i) }, - /* TODO: not used yet */ - }; - - - Gradient_Units gradientUnits; - gradientUnits = Gradient_UserSpaceOnUse; - - linearGradientMagick( - (Image *) Field(image_bloc,1), - width, height, - bounding_box, - colors_strings, - stop_offset, stop_nb, - spreadMethod, - matrix, - gradientUnits, - a_x, a_y, - b_x, b_y ); - - - free(stop_offset); - - for (i=0; iseverity != UndefinedException) - CatchException(exception); - - red[stop_i] = (long double)color[stop_i].red; - green[stop_i] = (long double)color[stop_i].green; - blue[stop_i] = (long double)color[stop_i].blue; - opacity[stop_i] = (long double)color[stop_i].opacity; - } - - long long ab_x, ab_y; - - vector_substract(&ab_x,&ab_y, b_x,b_y, a_x,a_y); - long double len_ab = vector_length(ab_x, ab_y); - /*}}}*/ - - /* foreach pixel of the image */ - { - register - unsigned long x; - unsigned long y; - long double percent, pos, percent_opposite; - PixelPacket px_color; - - char str_buffer[MaxTextExtent]; // tmp - int str_len; // tmp - DrawInfo *draw_info; // tmp - draw_info = CloneDrawInfo( image_info, ( DrawInfo* )NULL ); // tmp - if (!draw_info) fprintf(stderr, "CloneDrawInfo() failed\n"); // tmp - - switch (spreadMethod) { - case Pad_SpreadMethod: - /*{{{*/ - for (y = _y; y < _height; y++) { - for (x = _x; x < _width; x++) { - - if (a_x == x && a_y == y) { - pos = 0.0; - } else { - pos = get_y_of_A_B(a_x,a_y, b_x,b_y, x,y) / len_ab; - } - - /* find the stop range */ - for (stop_i = 0; stop_i < stop_nb; stop_i++) - if (pos < stop[stop_i]) - break; - - if (pos < 0.0L || stop_i == 0) { - px_color = color[0]; - - } else if (pos > 1.0L || stop_i == stop_nb) { - px_color = color[stop_nb - 1]; - - } else { - stop_j = stop_i; - --stop_i; - - percent = - (pos - stop[stop_i]) / - (stop[stop_j] - stop[stop_i]); - - percent_opposite = 1.0L - percent; - - /* pixel calculation */ - px_color.red = (Quantum)((red[stop_i] * percent_opposite) + (red[stop_j] * percent)); - px_color.green = (Quantum)((green[stop_i] * percent_opposite) + (green[stop_j] * percent)); - px_color.blue = (Quantum)((blue[stop_i] * percent_opposite) + (blue[stop_j] * percent)); - px_color.opacity = (Quantum)((opacity[stop_i] * percent_opposite) + (opacity[stop_j] * percent)); - } - - _set_pixel(image, x, y, px_color); // tmp - } - } - /*}}}*/ - break; - case Repeat_SpreadMethod: - /*{{{*/ - for (y = _y; y < _height; y++) { - for (x = _x; x < _width; x++) { - - long double y_on_ab, y_mod; - char do_antialias; - if (a_x == x && a_y == y) { - pos = 0.0; - } else { - y_on_ab = get_y_of_A_B(a_x,a_y, b_x,b_y, x,y); - y_mod = fmod(y_on_ab, len_ab); - - /* pos over spread */ - if (y_mod < 0.0) - y_mod = len_ab - fmod(- y_mod, len_ab); - else - y_mod = fmod(y_on_ab, len_ab); - - if (y_mod < len_ab && y_mod + 1 > len_ab) { - do_antialias = 1; - } else { - do_antialias = 0; - } - pos = y_mod / len_ab; - } - - /* find the offset */ - for (stop_i = 0; stop_i < stop_nb; stop_i++) - if (pos < stop[stop_i]) - break; - - if (stop_i == 0) { - px_color = color[0]; - - } else if (stop_i == stop_nb) { - px_color = color[stop_nb - 1]; - - } else { - stop_j = stop_i; - --stop_i; - - percent = - (pos - stop[stop_i]) / - (stop[stop_j] - stop[stop_i]); - - if (do_antialias) { - percent = len_ab - y_mod; - stop_i = 0; - stop_j = stop_nb - 1; - } - - percent_opposite = 1.0L - percent; - - /* pixel calculation */ - px_color.red = (Quantum)((red[stop_i] * percent_opposite) + (red[stop_j] * percent)); - px_color.green = (Quantum)((green[stop_i] * percent_opposite) + (green[stop_j] * percent)); - px_color.blue = (Quantum)((blue[stop_i] * percent_opposite) + (blue[stop_j] * percent)); - px_color.opacity = (Quantum)((opacity[stop_i] * percent_opposite) + (opacity[stop_j] * percent)); - } - - _set_pixel(image, x, y, px_color); // tmp - } - } - /*}}}*/ - break; - case Reflect_SpreadMethod: - /*{{{*/ - for (y = _y; y < _height; y++) { - for (x = _x; x < _width; x++) { - - if (a_x == x && a_y == y) { - pos = 0.0; - } else { - pos = get_y_of_A_B(a_x,a_y, b_x,b_y, x,y) / len_ab; - } - - /* pos over spread */ - if (pos < 0.0) pos = - pos; - //if ( ((int)pos % 2) == 0 ) - if ( (int)fmod(pos, 2) == 0 ) - pos = fmod(pos, 1.0); - else - pos = 1.0 - fmod(pos, 1.0); - - /* find the stop range */ - for (stop_i = 0; stop_i < stop_nb; stop_i++) - if (pos < stop[stop_i]) - break; - - if (stop_i == 0) { - px_color = color[0]; - - } else if (stop_i == stop_nb) { - px_color = color[stop_nb - 1]; - - } else { - stop_j = stop_i; - --stop_i; - - percent = - (pos - stop[stop_i]) / - (stop[stop_j] - stop[stop_i]); - - percent_opposite = 1.0L - percent; - - /* pixel calculation */ - px_color.red = (Quantum)((red[stop_i] * percent_opposite) + (red[stop_j] * percent)); - px_color.green = (Quantum)((green[stop_i] * percent_opposite) + (green[stop_j] * percent)); - px_color.blue = (Quantum)((blue[stop_i] * percent_opposite) + (blue[stop_j] * percent)); - px_color.opacity = (Quantum)((opacity[stop_i] * percent_opposite) + (opacity[stop_j] * percent)); - } - - _set_pixel(image, x, y, px_color); // tmp - } - } - /*}}}*/ - break; - } - - (void) DestroyDrawInfo(draw_info); // tmp - } - free(color); - free(red); - free(green); - free(blue); - free(opacity); - } - - /* Finalize */ - image_info=DestroyImageInfo(image_info); - exception=DestroyExceptionInfo(exception); -} - -/* }}} */ - -/* }}} */ - - -/* vim:cindent sw=4 ts=4 sts=4 et fdm=marker - */ diff --git a/magick.ml b/magick.ml deleted file mode 100644 index 4b16cd7..0000000 --- a/magick.ml +++ /dev/null @@ -1,2197 +0,0 @@ -(* {{{ COPYING *) -(* - * +-----------------------------------------------------------------+ - * | Copyright (C) 2004 2005 2006 Florent Monnier | - * +-----------------------------------------------------------------+ - * | This binding aims to provide the ImageMagick methods to OCaml. | - * +-----------------------------------------------------------------+ - * | This software is provided 'as-is', without any express or | - * | implied warranty. In no event will the authors be held liable | - * | for any damages arising from the use of this software. | - * | | - * | Permission is granted to anyone to use this software for any | - * | purpose, including commercial applications, and to alter it and | - * | redistribute it freely. | - * +-----------------------------------------------------------------+ - * - * }}} *) - - -external sizeof_quantum: unit -> int = "im_sizeof_quantum" -external sizeof_quantum_bit: unit -> int = "im_sizeof_quantum_bit" - - -type image_handle - - -(* {{{ root functions *) - -(* external constituteimage : int -> int -> string -> image_handle = "imper_constituteimage" *) - -external read_image : filename:string -> image_handle = "im_readimage" - -(* external freeimage : image_handle -> unit = "imper_freeimage" *) - -(* external newmagickimage : int -> int -> int -> int -> int -> int -> image_handle - = "imper_newmagickimage_bytecode" "imper_newmagickimage_native" *) - -external get_canvas : width:int -> height:int -> color:string -> image_handle = "im_getimagecanvas" -external create_image : width:int -> height:int -> pseudo_format:string -> image_handle = "im_create_image" - -external clone_image : image_handle -> image_handle = "im_cloneimage" - - - -external write_image : image_handle -> filename:string -> unit = "im_writeimage" - -external display : image_handle -> unit = "im_displayimages" - - -(* blobs *) - -external image_to_stdout : image_handle -> unit = "imper_imagetoblob_stdout" -external blob_of_image : image_handle -> int list = "imper_imagetoblob_bytes" - - -let dump_to_stdout t_img = - let rec dumper = function - oo, [] -> close_out oo - | oo, b::l -> begin output_byte oo b; dumper(oo,l) end - in - dumper(stdout, blob_of_image t_img) -;; - - -(* get infos on images *) - -external get_image_width: image_handle -> int = "imper_getimagewidth" -external get_image_height: image_handle -> int = "imper_getimageheight" -external get_image_depth: image_handle -> int = "imper_getimagedepth" -external get_image_quality: image_handle -> int = "imper_getimagequality" - -external get_image_mimetype: image_handle -> string = "imper_getimagemimetype" -external get_image_size: image_handle -> string = "imper_getimagesize" - -external get_image_colors: image_handle -> int = "imper_getimagecolors" -external get_image_colorspace: image_handle -> int = "imper_getimagecolorspace" - - -external ping_image_infos : string -> int * int * int * int * int * string = "imper_ping_image_infos" -external ping_image : string -> bool = "imper_ping_image" - - -(* Please notice that getnumbercolors and getimagehistogram have been swapped - between the libMagick and the OCaml-binding, - because getnumbercolors returns an image histogram, - and getimagehistogram only returns the number of colors. *) -external get_number_colors : image_handle -> int = "imper_getimagehistogram" -external get_image_histogram : image_handle -> histogram_file:string -> int = "imper_getnumbercolors" - -external get_max_colormap : unit -> int = "imper_getmaxcolormap" - -type image_type = - | Undefined_image_type - | Bilevel - | Grayscale - | GrayscaleMatte - | Palette - | PaletteMatte - | TrueColor - | TrueColorMatte - | ColorSeparation - | ColorSeparationMatte - | Optimize - -external get_image_type : image_handle -> image_type = "imper_getimagetype" - - -let string_of_image_type image_type = - match image_type with - | Undefined_image_type -> "Undefined" - | Bilevel -> "Bilevel" - | Grayscale -> "Grayscale" - | GrayscaleMatte -> "GrayscaleMatte" - | Palette -> "Palette" - | PaletteMatte -> "PaletteMatte" - | TrueColor -> "TrueColor" - | TrueColorMatte -> "TrueColorMatte" - | ColorSeparation -> "ColorSeparation" - | ColorSeparationMatte -> "ColorSeparationMatte" - | Optimize -> "Optimize" - - -(* }}} *) -(* {{{ types *) - - -type magick_boolean = - | MagickFalse - | MagickTrue - -let magick_boolean_of_string str = - match String.lowercase_ascii str with - | "false" | "magick-false" | "magickfalse" -> MagickFalse - | "true" | "magick-true" | "magicktrue" -> MagickTrue - | _ -> raise Not_found - - -type noise_type = - | UndefinedNoise - | UniformNoise - | GaussianNoise - | MultiplicativeGaussianNoise - | ImpulseNoise - | LaplacianNoise - | PoissonNoise - - - -type resize_filter = - | Undefined_resize_filter - | Point - | Box - | Triangle - | Hermite - | Hanning - | Hamming - | Blackman - | Gaussian - | Quadratic - | Cubic - | Catrom - | Mitchell - | Lanczos - | Bessel - | Sinc - - -let resize_filter_of_string str = - match String.lowercase_ascii str with - | "undefined" -> Undefined_resize_filter - | "point" -> Point - | "box" -> Box - | "triangle" -> Triangle - | "hermite" -> Hermite - | "hanning" -> Hanning - | "hamming" -> Hamming - | "blackman" -> Blackman - | "gaussian" -> Gaussian - | "quadratic" -> Quadratic - | "cubic" -> Cubic - | "catrom" -> Catrom - | "mitchell" -> Mitchell - | "lanczos" -> Lanczos - | "bessel" -> Bessel - | "sinc" -> Sinc - | _ -> Undefined_resize_filter - -let resize_filter_of_string' str = - match String.lowercase_ascii str with - | "undefined" -> Undefined_resize_filter - | "point" -> Point - | "box" -> Box - | "triangle" -> Triangle - | "hermite" -> Hermite - | "hanning" -> Hanning - | "hamming" -> Hamming - | "blackman" -> Blackman - | "gaussian" -> Gaussian - | "quadratic" -> Quadratic - | "cubic" -> Cubic - | "catrom" -> Catrom - | "mitchell" -> Mitchell - | "lanczos" -> Lanczos - | "bessel" -> Bessel - | "sinc" -> Sinc - | _ -> raise Not_found - -let string_of_resize_filter = function - | Undefined_resize_filter -> "undefined" - | Point -> "point" - | Box -> "box" - | Triangle -> "triangle" - | Hermite -> "hermite" - | Hanning -> "hanning" - | Hamming -> "hamming" - | Blackman -> "blackman" - | Gaussian -> "gaussian" - | Quadratic -> "quadratic" - | Cubic -> "cubic" - | Catrom -> "catrom" - | Mitchell -> "mitchell" - | Lanczos -> "lanczos" - | Bessel -> "bessel" - | Sinc -> "sinc" - - - -type channel_type = - | Undefined_Channel - | Red - | Gray - | Cyan - | Green - | Magenta - | Blue - | Yellow - | Alpha - | Opacity - | Black - | Index - | All_Channels - | Default_Channels - - -let channel_type_of_string str = - match String.lowercase_ascii str with - | "default_channels" - | "default" -> Default_Channels - | "red" -> Red - | "gray" -> Gray - | "cyan" -> Cyan - | "green" -> Green - | "magenta" -> Magenta - | "blue" -> Blue - | "yellow" -> Yellow - | "alpha" -> Alpha - | "opacity" -> Opacity - | "black" -> Black - | "index" -> Index - | "all_channels" - | "all" -> All_Channels - | "undefined_channel" - | "undefined" -> Undefined_Channel - | _ -> Default_Channels - -let channel_type_of_string' str = - match String.lowercase_ascii str with - | "default_channels" - | "default" -> Default_Channels - | "red" -> Red - | "gray" -> Gray - | "cyan" -> Cyan - | "green" -> Green - | "magenta" -> Magenta - | "blue" -> Blue - | "yellow" -> Yellow - | "alpha" -> Alpha - | "opacity" -> Opacity - | "black" -> Black - | "index" -> Index - | "all_channels" - | "all" -> All_Channels - | "undefined_channel" - | "undefined" -> Undefined_Channel - | _ -> raise Not_found - - -let string_of_channel_type = function - | Undefined_Channel -> "undefined" - | Red -> "red" - | Gray -> "gray" - | Cyan -> "cyan" - | Green -> "green" - | Magenta -> "magenta" - | Blue -> "blue" - | Yellow -> "yellow" - | Alpha -> "alpha" - | Opacity -> "opacity" - | Black -> "black" - | Index -> "index" - | All_Channels -> "all" - | Default_Channels -> "default" - - - -type composite_operator = - | Undefined_composite_operator - | No_composite_operator - | Add - | Atop - | Blend - | Bumpmap - | Clear - | ColorBurn - | ColorDodge - | Colorize - | CopyBlack - | CopyBlue - | Copy - | CopyCyan - | CopyGreen - | CopyMagenta - | CopyOpacity - | CopyRed - | CopyYellow - | Darken - | DstAtop - | Dst - | DstIn - | DstOut - | DstOver - | Difference - | Displace - | Dissolve - | Exclusion - | HardLight - | Hue - | In - | Lighten - | Luminize - | Minus - | Modulate - | Multiply - | Out - | Over - | Overlay - | Plus - | Replace - | Saturate - | Screen - | SoftLight - | SrcAtop - | Src - | SrcIn - | SrcOut - | SrcOver - | Subtract - | Threshold - | Xor - - -let composite_operator_of_string str_op = - match String.lowercase_ascii str_op with - | "undefined" -> Undefined_composite_operator - | "no" -> No_composite_operator - | "add" -> Add - | "atop" -> Atop - | "blend" -> Blend - | "bumpmap" -> Bumpmap - | "clear" -> Clear - | "color-burn" - | "colorburn" -> ColorBurn - | "color-dodge" - | "colordodge" -> ColorDodge - | "colorize" -> Colorize - | "copyblack" -> CopyBlack - | "copyblue" -> CopyBlue - | "copy" -> Copy - | "copycyan" -> CopyCyan - | "copygreen" -> CopyGreen - | "copymagenta" -> CopyMagenta - | "copyopacity" -> CopyOpacity - | "copyred" -> CopyRed - | "copyyellow" -> CopyYellow - | "darken" -> Darken - | "dst-atop" - | "dstatop" -> DstAtop - | "dst" -> Dst - | "dst-in" - | "dstin" -> DstIn - | "dst-out" - | "dstout" -> DstOut - | "dst-over" - | "dstover" -> DstOver - | "difference" -> Difference - | "displace" -> Displace - | "dissolve" -> Dissolve - | "exclusion" -> Exclusion - | "hard-light" - | "hardlight" -> HardLight - | "hue" -> Hue - | "in" -> In - | "lighten" -> Lighten - | "luminize" -> Luminize - | "minus" -> Minus - | "modulate" -> Modulate - | "multiply" -> Multiply - | "out" -> Out - | "over" -> Over - | "overlay" -> Overlay - | "plus" -> Plus - | "replace" -> Replace - | "saturate" -> Saturate - | "screen" -> Screen - | "soft-light" - | "softlight" -> SoftLight - | "src-atop" - | "srcatop" -> SrcAtop - | "src" -> Src - | "src-in" - | "srcin" -> SrcIn - | "src-out" - | "srcout" -> SrcOut - | "src-over" - | "srcover" -> SrcOver - | "subtract" -> Subtract - | "threshold" -> Threshold - | "xor" -> Xor - | _ -> Undefined_composite_operator - -let composite_operator_of_string' str_op = - match String.lowercase_ascii str_op with - | "undefined" -> Undefined_composite_operator - | "no" -> No_composite_operator - | "add" -> Add - | "atop" -> Atop - | "blend" -> Blend - | "bumpmap" -> Bumpmap - | "clear" -> Clear - | "color-burn" - | "colorburn" -> ColorBurn - | "color-dodge" - | "colordodge" -> ColorDodge - | "colorize" -> Colorize - | "copyblack" -> CopyBlack - | "copyblue" -> CopyBlue - | "copy" -> Copy - | "copycyan" -> CopyCyan - | "copygreen" -> CopyGreen - | "copymagenta" -> CopyMagenta - | "copyopacity" -> CopyOpacity - | "copyred" -> CopyRed - | "copyyellow" -> CopyYellow - | "darken" -> Darken - | "dst-atop" - | "dstatop" -> DstAtop - | "dst" -> Dst - | "dst-in" - | "dstin" -> DstIn - | "dst-out" - | "dstout" -> DstOut - | "dst-over" - | "dstover" -> DstOver - | "difference" -> Difference - | "displace" -> Displace - | "dissolve" -> Dissolve - | "exclusion" -> Exclusion - | "hard-light" - | "hardlight" -> HardLight - | "hue" -> Hue - | "in" -> In - | "lighten" -> Lighten - | "luminize" -> Luminize - | "minus" -> Minus - | "modulate" -> Modulate - | "multiply" -> Multiply - | "out" -> Out - | "over" -> Over - | "overlay" -> Overlay - | "plus" -> Plus - | "replace" -> Replace - | "saturate" -> Saturate - | "screen" -> Screen - | "soft-light" - | "softlight" -> SoftLight - | "src-atop" - | "srcatop" -> SrcAtop - | "src" -> Src - | "src-in" - | "srcin" -> SrcIn - | "src-out" - | "srcout" -> SrcOut - | "src-over" - | "srcover" -> SrcOver - | "subtract" -> Subtract - | "threshold" -> Threshold - | "xor" -> Xor - | _ -> raise Not_found - - - -let string_of_composite_operator comp_op = - match comp_op with - | Undefined_composite_operator -> "Undefined" - | No_composite_operator -> "No" - | Add -> "Add" - | Atop -> "Atop" - | Blend -> "Blend" - | Bumpmap -> "Bumpmap" - | Clear -> "Clear" - | ColorBurn -> "ColorBurn" - | ColorDodge -> "ColorDodge" - | Colorize -> "Colorize" - | CopyBlack -> "CopyBlack" - | CopyBlue -> "CopyBlue" - | Copy -> "Copy" - | CopyCyan -> "CopyCyan" - | CopyGreen -> "CopyGreen" - | CopyMagenta -> "CopyMagenta" - | CopyOpacity -> "CopyOpacity" - | CopyRed -> "CopyRed" - | CopyYellow -> "CopyYellow" - | Darken -> "Darken" - | DstAtop -> "DstAtop" - | Dst -> "Dst" - | DstIn -> "DstIn" - | DstOut -> "DstOut" - | DstOver -> "DstOver" - | Difference -> "Difference" - | Displace -> "Displace" - | Dissolve -> "Dissolve" - | Exclusion -> "Exclusion" - | HardLight -> "HardLight" - | Hue -> "Hue" - | In -> "In" - | Lighten -> "Lighten" - | Luminize -> "Luminize" - | Minus -> "Minus" - | Modulate -> "Modulate" - | Multiply -> "Multiply" - | Out -> "Out" - | Over -> "Over" - | Overlay -> "Overlay" - | Plus -> "Plus" - | Replace -> "Replace" - | Saturate -> "Saturate" - | Screen -> "Screen" - | SoftLight -> "SoftLight" - | SrcAtop -> "SrcAtop" - | Src -> "Src" - | SrcIn -> "SrcIn" - | SrcOut -> "SrcOut" - | SrcOver -> "SrcOver" - | Subtract -> "Subtract" - | Threshold -> "Threshold" - | Xor -> "Xor" - - - -(* }}} *) - - -(* {{{ Imperative module *) - -module Imper = struct - - -external plasma_image : image_handle -> x1:int -> y1:int -> x2:int -> y2:int -> - attenuate:int -> depth:int -> unit - = "imper_plasmaimage_bytecode" - "imper_plasmaimage_native" - - -external flip: image_handle -> unit = "imper_flipimage" -external flop: image_handle -> unit = "imper_flopimage" -external magnify: image_handle -> unit = "imper_magnifyimage" -external minify: image_handle -> unit = "imper_minifyimage" -external enhance: image_handle -> unit = "imper_enhanceimage" -external trim: image_handle -> unit = "imper_trimimage" -external despeckle: image_handle -> unit = "imper_despeckle" - - -external negate : image_handle -> grayscale:magick_boolean -> unit = "imper_negateimage" -let negate t_img ?(grayscale=MagickFalse) () = negate t_img ~grayscale - - -external contrast: image_handle -> sharpen:magick_boolean -> unit = "imper_contrastimage" -external equalize: image_handle -> unit = "imper_equalizeimage" -external normalize: image_handle -> unit = "imper_normalizeimage" -external white_threshold: image_handle -> threshold:string -> unit = "imper_whitethresholdimage" -external black_threshold: image_handle -> threshold:string -> unit = "imper_blackthresholdimage" -external cyclecolormap: image_handle -> displace:int -> unit = "imper_cyclecolormapimage" -external solarize: image_handle -> threshold:float -> unit = "imper_solarizeimage" - -external modulate' : image_handle -> factors:string -> unit = "imper_modulateimage" - -let modulate t_img ?(brightness=100) ?(saturation=100) ?(hue=100) () = - let br = string_of_int brightness - and sa = string_of_int saturation - and hu = string_of_int hue - in - modulate' t_img ~factors:(br ^","^ sa ^","^ hu) - - - -external blur : image_handle -> radius:float -> sigma:float -> unit = "imper_blurimage" -let blur t_img ?(radius=0.0) ~sigma () = blur t_img ~radius ~sigma - -external gaussian_blur : image_handle -> radius:float -> sigma:float -> unit = "imper_gaussianblurimage" -let gaussian_blur t_img ?(radius=0.0) ~sigma () = gaussian_blur t_img ~radius ~sigma - -external motion_blur : image_handle -> radius:float -> sigma:float -> angle:float -> unit = "imper_motionblurimage" -let motion_blur t_img ?(radius=0.0) ~sigma ~angle () = motion_blur t_img ~radius ~sigma ~angle - -external charcoal : image_handle -> radius:float -> sigma:float -> unit = "imper_charcoalimage" -let charcoal t_img ?(radius=0.0) ~sigma () = charcoal t_img ~radius ~sigma - -external edge : image_handle -> radius:float -> unit = "imper_edgeimage" - -external emboss : image_handle -> radius:float -> sigma:float -> unit = "imper_embossimage" -let emboss t_img ?(radius=0.0) ~sigma () = emboss t_img ~radius ~sigma - -external implode: image_handle -> amount:float -> unit = "imper_implodeimage" -external medianfilter: image_handle -> radius:float -> unit = "imper_medianfilterimage" -external oilpaint: image_handle -> radius:float -> unit = "imper_oilpaintimage" -external reduce_noise: image_handle -> radius:float -> unit = "imper_reducenoiseimage" -external roll: image_handle -> x:int -> y:int -> unit = "imper_rollimage" - -external shade: image_handle -> gray:magick_boolean -> azimuth:float -> elevation:float -> unit = "imper_shadeimage" -let shade t_img ?(gray=MagickTrue) ~azimuth ~elevation () = shade t_img ~gray ~azimuth ~elevation - -external spread : image_handle -> radius:float -> unit = "imper_spreadimage" -external swirl : image_handle -> degrees:float -> unit = "imper_swirlimage" - -external sharpen: image_handle -> float -> float -> unit = "imper_sharpenimage" -let sharpen t_img ?(radius=0.0) ~sigma () = sharpen t_img radius sigma - -external unsharpmask : image_handle -> radius:float -> sigma:float -> amount:float -> threshold:float -> unit - = "imper_unsharpmaskimage" - -external wave : image_handle -> amplitude:float -> wave_length:float -> unit = "imper_waveimage" - -external rotate : image_handle -> degrees:float -> unit = "imper_rotateimage" -external shear : image_handle -> x:float -> y:float -> unit = "imper_shearimage" - -external affine_transform : image_handle -> - sx:float -> - rx:float -> - ry:float -> - sy:float -> - tx:float -> - ty:float -> - unit = "imper_affinetransformimage_bytecode" - "imper_affinetransformimage_native" - -let affine_transform t_img - ?(tx=0.0) ?(ty=0.0) - ?(sx=1.0) ?(sy=1.0) - ?(rx=0.0) ?(ry=0.0) - () = - if sx = 0.0 then invalid_arg "affine_transform: sx = 0.0 would produce a 0 width image"; - if sy = 0.0 then invalid_arg "affine_transform: sy = 0.0 would produce a 0 height image"; - affine_transform t_img - ~sx ~rx ~ry ~sy ~tx ~ty - - - -external adaptive_threshold: image_handle -> width:int -> height:int -> offset:int -> unit = "imper_adaptivethresholdimage" - -external crop : image_handle -> x:int -> y:int -> width:int -> height:int -> unit = "imper_cropimage" -external chop : image_handle -> x:int -> y:int -> width:int -> height:int -> unit = "imper_chopimage" -external splice : image_handle -> x:int -> y:int -> width:int -> height:int -> unit = "imper_spliceimage" - - -external colorize: image_handle -> string -> int -> int -> int -> int -> unit - = "imper_colorizeimage_bytecode" - "imper_colorizeimage_native" - -external acquire_pixel : image_handle -> int -> int -> int * int * int * int = "imper_acquireonepixel" - - - -external composite_image: image_handle -> image_handle -> x:int -> y:int -> compose:composite_operator -> unit - = "imper_compositeimage" -let composite_image t_img u_img ~compose ?(x=0) ?(y=0) () = composite_image t_img u_img ~x ~y ~compose - - - - -external texture_image: image_handle -> image_handle -> unit = "imper_textureimage" - - - -external bilevel_channel : image_handle -> channel:channel_type -> float -> unit = "imper_bilevelimagechannel" - -external blur_channel : image_handle -> channel:channel_type -> radius:float -> sigma:float -> unit = "imper_blurimagechannel" -let blur_channel t_img ~channel ?(radius=0.0) ~sigma () = blur_channel t_img ~channel ~radius ~sigma - - -external gaussian_blur_channel : image_handle -> channel:channel_type -> - radius:float -> sigma:float -> unit = "imper_gaussianblurimagechannel" -let gaussian_blur_channel t_img ~channel ?(radius=0.0) ~sigma () = - gaussian_blur_channel t_img ~channel ~radius ~sigma - - -external radial_blur : image_handle -> angle:float -> unit = "imper_radialblurimage" -external radial_blur_channel : image_handle -> channel:channel_type -> angle:float -> unit - = "imper_radialblurimagechannel" - -external sharpen_image_channel : image_handle -> channel:channel_type -> - radius:float -> sigma:float -> unit = "imper_sharpenimagechannel" - -let sharpen_image_channel t_img ~channel ?(radius=0.0) ~sigma () = - sharpen_image_channel t_img ~channel ~radius ~sigma - - - - -external add_noise : image_handle -> noise_type -> unit = "imper_addnoiseimage" - - -external resize: image_handle -> width:int -> height:int -> filter:resize_filter -> blur:float -> unit - = "imper_resizeimage" - -external sample : image_handle -> width:int -> height:int -> unit = "imper_sampleimage" -external scale : image_handle -> width:int -> height:int -> unit = "imper_scaleimage" -external thumbnail : image_handle -> width:int -> height:int -> unit = "imper_thumbnailimage" - - - -external set_image_colors: image_handle -> int -> unit = "imper_setimagecolors" -external set_compression_quality: image_handle -> int -> unit = "imper_setcompressionquality" - - -external set_image_type : image_handle -> image_type:image_type -> unit = "imper_setimagetype" -external set_type : image_handle -> unit = "imper_setimagetype__" - - - -external strip_image : image_handle -> unit = "imper_stripimage" - - - -external level : image_handle -> string -> unit = "imper_levelimage" -external level_channel : image_handle -> channel:channel_type -> float -> float -> float -> unit = "imper_levelimagechannel" -external gamma_channel : image_handle -> channel:channel_type -> gamma:float -> unit = "imper_gammaimagechannel" -external negate_channel : image_handle -> channel:channel_type -> magick_boolean -> unit = "imper_negateimagechannel" - - -external ordered_dither : image_handle -> unit = "imper_orderedditherimage" - -external compress_colormap : image_handle -> unit = "imper_compressimagecolormap" - -external posterize : image_handle -> levels:int -> dither:magick_boolean -> unit = "imper_posterizeimage" - -external map_image : image_handle -> map_image:image_handle -> dither:magick_boolean -> unit = "imper_mapimage" - - -external is_gray : image_handle -> bool = "imper_isgrayimage" -external is_monochrome : image_handle -> bool = "imper_ismonochromeimage" -external is_opaque : image_handle -> bool = "imper_isopaqueimage" -external is_palette : image_handle -> bool = "imper_ispaletteimage" -external is_taint : image_handle -> bool = "imper_istaintimage" -external is_equal : image_handle -> image_handle -> bool * float * float * float = "imper_isimagesequal" - - - - -(* DRAW *) - - -type line_cap = - | UndefinedCap - | ButtCap - | RoundCap - | SquareCap - -type line_join = - | UndefinedJoin - | MiterJoin - | RoundJoin - | BevelJoin - - -type color = int * int * int * int - - -let channels_of_color (red, green, blue, opacity : color) = - (red, green, blue, opacity) - - - -external acquire_pixel_opacity : image_handle -> int -> int -> int * int * int * int - = "imper_acquireonepixel_opacity" - - - -external set_image_opacity : image_handle -> opacity:int -> unit = "imper_setimageopacity" - - - -external color_of_string : string -> color = "imper_querycolordatabase" - - -let color_of_rgbo_tuple (r,g,b,o) = - (r,g,b,o : color) - -let rgbo_tuple_of_color (r,g,b,o : color) = - (r,g,b,o) - -(* {{{ op *) - -let max_color_map = get_max_colormap() ;; - -let add_colors - (r1, g1, b1, a1 : color) - (r2, g2, b2, a2 : color) = - let r = min (r1 + r2) max_color_map - and g = min (g1 + g2) max_color_map - and b = min (b1 + b2) max_color_map - and a = min (a1 + a2) max_color_map in - (r, g, b, a : color) - -let sub_colors - (r1, g1, b1, a1 : color) - (r2, g2, b2, a2 : color) = - let r = max (r1 - r2) 0 - and g = max (g1 - g2) 0 - and b = max (b1 - b2) 0 - and a = max (a1 - a2) 0 in - (r, g, b, a : color) - -let mul_colors - (r1,g1,b1,a1 : color) - (r2,g2,b2,a2 : color) = - let r = min (r1 * r2) max_color_map - and g = min (g1 * g2) max_color_map - and b = min (b1 * b2) max_color_map - and a = min (a1 * a2) max_color_map in - (r, g, b, a : color) - -let dump_color (r,g,b,a : color) = - let (r,g,b,a) = - if max_color_map = 65535 - then (r/257,g/257,b/257,a/257) - else (r,g,b,a) - in - Printf.printf "rgba(%d,%d,%d,%d)\n" r g b a - -let div_colors - (r1,g1,b1,a1 : color) - (r2,g2,b2,a2 : color) = - let r = r1 / r2 - and g = g1 / g2 - and b = b1 / b2 - and a = a1 / a2 in - (r, g, b, a : color) - -(* }}} *) -(* {{{ string_of_color *) - -let rgb_string_of_color (r,g,b,o : color) = - let (r,g,b) = - if max_color_map = 65535 - then (r/257, g/257, b/257) - else - if max_color_map = 255 - then (r,g,b) - else - failwith ("unimplemented colormap: " ^ string_of_int max_color_map) - in - Printf.sprintf "rgba(%d,%d,%d)" r g b - - -let rgba_string_of_color (r,g,b,o : color) = - let (r,g,b,o) = - if max_color_map = 65535 - then (r/257, g/257, b/257, o/257) - else - if max_color_map = 255 - then (r,g,b,o) - else - failwith ("unimplemented colormap: " ^ string_of_int max_color_map) - in - let a = 255 - o in - Printf.sprintf "rgba(%d,%d,%d,%d)" r g b a - - -let hexa_string_of_color (r,g,b,o : color) = - let (r,g,b,o) = - if max_color_map = 65535 - then (r/257, g/257, b/257, o/257) - else - if max_color_map = 255 - then (r,g,b,o) - else - failwith ("unimplemented colormap: " ^ string_of_int max_color_map) - in - let a = 255 - o in - Printf.sprintf "#%02X%02X%02X%02X" r g b a - -(* }}} *) - -(* {{{ color_of_hex *) - -let color_of_hex str_color = - - (* check if the string is empty *) - let str_len = String.length str_color in - if str_len = 0 then - invalid_arg "empty string"; - - (* remove the starting char '#' *) - let str_color = - if str_color.[0] = '#' - then String.sub str_color 1 (str_len - 1) - else str_color - in - let str_len = String.length str_color in - if str_len = 0 then - invalid_arg "no data given for the color"; - - (* check what is the maximum value for the color of a pixel *) - let cast_for = - let max_color_map = get_max_colormap() in - match max_color_map with - | 255 - | 65535 -> max_color_map - | _ -> - invalid_arg - (Printf.sprintf - "« %d »: unimplemented color_map \ - (implemented ones are 255 and 65535) \ - recompile ImageMagick and ./configure --with-quantum-depth 16 \ - (for exemple)" - max_color_map) - in - - (* convert a char to a string *) - let string_of_char my_char = - String.make 1 my_char - in - - (* cast and check the values of the color for IM *) - let mk_channel_value ~value ~cast_from = - let value = - match cast_from, cast_for with - | 255, 255 -> value - | 255, 65535 -> value * 257 - | 65535, 255 -> value / 257 - | 65535, 65535 -> value - (* {{{ for exhaustive pattern-matching *) - | 255, _ - | 655535, _ -> - invalid_arg - "the cast_from argument should be either 255 or 655535" - | _, 255 - | _, 655535 -> - invalid_arg - "the get_max_colormap() function should return either 255 or 65535" - | _, _ -> - invalid_arg - "the cast_from argument should be either 255 or 655535 \ - and the get_max_colormap() function should return either 255 or 65535" - (* }}} *) - in - if value > cast_for then - invalid_arg - ("beyond the maximum value for a color channel: " ^ (string_of_int cast_for)); - if value < 0 then - invalid_arg "the minimum value for a color channel is 0"; - value - in - - (* convert an hexadecimal value in a string to an int *) - let int_of_hexa_string elem = - let value = - try int_of_string ("0x" ^ elem) - with _ -> - invalid_arg ("give characters from [0-9a-fA-F] in " ^ str_color); - in - value - in - - (* the value of a channel can be given with 1, 2 or 4 hexa characters *) - let chan_of_1char elem = - let value = int_of_hexa_string (elem ^ elem) in - mk_channel_value ~value ~cast_from:255 - in - let chan_of_2char elem = - let value = int_of_hexa_string elem in - mk_channel_value ~value ~cast_from:255 - in - let chan_of_4char elem = - let value = int_of_hexa_string elem in - mk_channel_value ~value ~cast_from:65535 - in - - (* separate the values of each channel of the given color, - which depends of the number of characters given *) - match str_len with - | 1 -> - (chan_of_1char (string_of_char str_color.[0])), - (chan_of_1char (string_of_char str_color.[0])), - (chan_of_1char (string_of_char str_color.[0])), - 0 - | 2 -> - (chan_of_1char (string_of_char str_color.[0])), - (chan_of_1char (string_of_char str_color.[0])), - (chan_of_1char (string_of_char str_color.[0])), - cast_for - - (chan_of_1char (string_of_char str_color.[1])) - | 3 -> - (chan_of_1char (string_of_char str_color.[0])), - (chan_of_1char (string_of_char str_color.[1])), - (chan_of_1char (string_of_char str_color.[2])), - 0 - | 4 -> - (chan_of_1char (string_of_char str_color.[0])), - (chan_of_1char (string_of_char str_color.[1])), - (chan_of_1char (string_of_char str_color.[2])), - cast_for - - (chan_of_1char (string_of_char str_color.[3])) - | 6 -> - (chan_of_2char (String.sub str_color 0 2)), - (chan_of_2char (String.sub str_color 2 2)), - (chan_of_2char (String.sub str_color 4 2)), - 0 - | 8 -> - (chan_of_2char (String.sub str_color 0 2)), - (chan_of_2char (String.sub str_color 2 2)), - (chan_of_2char (String.sub str_color 4 2)), - cast_for - - (chan_of_2char (String.sub str_color 6 2)) - | 12 -> - (chan_of_4char (String.sub str_color 0 4)), - (chan_of_4char (String.sub str_color 4 4)), - (chan_of_4char (String.sub str_color 8 4)), - 0 - | 16 -> - (chan_of_4char (String.sub str_color 0 4)), - (chan_of_4char (String.sub str_color 4 4)), - (chan_of_4char (String.sub str_color 8 4)), - cast_for - - (chan_of_4char (String.sub str_color 12 4)) - | _ -> - invalid_arg "wrong number of characters (allowed are: 1|2|3|4|6|8|12|16)" - -(* }}} *) - -let black = (0, 0, 0, 0 : color) -let transparent = (0, 0, 0, max_color_map : color) - -(* TODO: test the affine_matrix parameter *) -(* {{{ affine_matrix *) - -type affine_matrix = { - sx : float; - rx : float; - ry : float; - sy : float; - tx : float; - ty : float; -} - -let identity_matrix = { - sx = 1.0; - rx = 0.0; - ry = 0.0; - sy = 1.0; - tx = 0.0; - ty = 0.0; -} - -let tuple_of_matrix ~affine_matrix = - ( affine_matrix.sx, - affine_matrix.rx, - affine_matrix.ry, - affine_matrix.sy, - affine_matrix.tx, - affine_matrix.ty ) -;; - -(* }}} *) - -(* {{{ draw_point *) - -external set_pixel : image_handle -> - x:int -> y:int -> - red:int -> green:int -> blue:int -> opacity:int -> unit - = "imper_draw_point_bytecode" - "imper_draw_point_native" - - -external draw_point : image_handle -> - x:int -> y:int -> - red:int -> green:int -> blue:int -> opacity:int -> unit - = "imper_draw_point_bytecode" - "imper_draw_point_native" - -let draw_point t_img ~x ~y ~color = - let (red, green, blue, opacity) = channels_of_color color in - draw_point t_img ~x ~y - ~red ~green ~blue ~opacity - -(* }}} *) -(* {{{ draw_line *) - -external draw_line : image_handle -> - x0:int -> y0:int -> x1:int -> y1:int -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_antialias:magick_boolean -> - stroke_width:float -> line_cap:line_cap -> unit - = "imper_draw_line_bytecode" - "imper_draw_line_native" - -let draw_line t_img - ~x0 ~y0 ~x1 ~y1 - ?(fill_color=transparent) - ?(stroke_color=black) - ?(stroke_antialias=MagickTrue) - ?(stroke_width=1.0) ?(line_cap=ButtCap) () = - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color in - draw_line t_img - ~x0 ~y0 ~x1 ~y1 - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_antialias ~stroke_width ~line_cap - -(* }}} *) -(* {{{ draw_circle *) - -external draw_circle : image_handle -> - x0:int -> y0:int -> x1:int -> y1:int -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_antialias:magick_boolean -> stroke_width:float -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> unit - = "imper_draw_circle_bytecode" - "imper_draw_circle_native" - -let draw_circle t_img - ~x0 ~y0 ~x1 ~y1 - ?(fill_color=black) - ?(stroke_color=transparent) - ?(stroke_width=1.0) - ?(stroke_antialias=MagickTrue) - ?(affine_matrix=identity_matrix) - () = - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color - and (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix - in - draw_circle t_img - ~x0 ~y0 ~x1 ~y1 - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_antialias ~stroke_width - ~sx ~rx ~ry ~sy ~tx ~ty - -(* }}} *) -(* {{{ draw_rectangle *) - -external draw_rectangle : image_handle -> - x0:int -> y0:int -> x1:int -> y1:int -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_antialias:magick_boolean -> - stroke_width:float -> line_join:line_join -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> unit - = "imper_draw_rectangle_bytecode" - "imper_draw_rectangle_native" - -let draw_rectangle - t_img ~x0 ~y0 ~x1 ~y1 - ?(fill_color=black) - ?(stroke_color=transparent) - ?(stroke_width=1.0) - ?(stroke_antialias=MagickTrue) - ?(line_join=MiterJoin) - ?(affine_matrix=identity_matrix) - () = - (* TODO: check if the affine_matrix is the identity and if so the - default for antialias should be False, otherwise True. *) - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color - and (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix - in - draw_rectangle t_img - ~x0 ~y0 ~x1 ~y1 - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_antialias - ~stroke_width ~line_join - ~sx ~rx ~ry ~sy ~tx ~ty - -(* }}} *) -(* {{{ draw_round_rectangle *) - -external draw_round_rectangle : image_handle -> - x0:int -> y0:int -> x1:int -> y1:int -> wc:int -> hc:int -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_antialias:magick_boolean -> - stroke_width:float -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> unit - = "imper_draw_roundrectangle_bytecode" - "imper_draw_roundrectangle_native" - -let draw_round_rectangle - t_img ~x0 ~y0 ~x1 ~y1 ~wc ~hc - ?(fill_color=black) - ?(stroke_color=transparent) - ?(stroke_antialias=MagickTrue) - ?(stroke_width=1.0) - ?(affine_matrix=identity_matrix) - () = - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color - and (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix - in - draw_round_rectangle t_img - ~x0 ~y0 ~x1 ~y1 ~wc ~hc - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_antialias ~stroke_width - ~sx ~rx ~ry ~sy ~tx ~ty - -(* }}} *) -(* {{{ draw_arc *) - -external draw_arc : image_handle -> - x0:int -> y0:int -> x1:int -> y1:int -> a0:int -> a1:int -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_antialias:magick_boolean -> - stroke_width:float -> line_cap:line_cap -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> unit - = "imper_draw_arc_bytecode" - "imper_draw_arc_native" - -let draw_arc t_img - ~x0 ~y0 ~x1 ~y1 ~a0 ~a1 - ?(fill_color=transparent) - ?(stroke_color=black) - ?(stroke_antialias=MagickTrue) - ?(stroke_width=1.0) - ?(line_cap=ButtCap) - ?(affine_matrix=identity_matrix) - () = - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color - and (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix - in - draw_arc t_img - ~x0 ~y0 ~x1 ~y1 ~a0 ~a1 - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_antialias ~stroke_width ~line_cap - ~sx ~rx ~ry ~sy ~tx ~ty - -(* }}} *) -(* {{{ draw_ellipse *) - -external draw_ellipse : image_handle -> - cx:int -> cy:int -> rx:int -> ry:int -> a0:int -> a1:int -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_antialias:magick_boolean -> stroke_width:float -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> unit - = "imper_draw_ellipse_bytecode" - "imper_draw_ellipse_native" - -let draw_ellipse t_img - ~cx ~cy ~rx ~ry - ?(a0=0) ?(a1=360) - ?(fill_color=black) - ?(stroke_color=transparent) - ?(stroke_antialias=MagickTrue) - ?(stroke_width=1.0) - ?(affine_matrix=identity_matrix) - () = - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color - and (sx, rx_, ry_, sy, tx, ty) = tuple_of_matrix ~affine_matrix - in - draw_ellipse t_img - ~cx ~cy ~rx ~ry ~a0 ~a1 - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_antialias ~stroke_width - ~sx ~rx:rx_ ~ry:ry_ ~sy ~tx ~ty - -(* }}} *) - -(* {{{ draw_polyline *) - -external draw_polyline : image_handle -> - coords:(int * int) array -> array_length:int -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_antialias:magick_boolean -> - stroke_width:float -> line_join:line_join -> line_cap:line_cap -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> unit - = "imper_draw_polyline_bytecode" - "imper_draw_polyline_native" - -let draw_polyline t_img - ~coords - ?(fill_color=transparent) - ?(stroke_color=black) - ?(stroke_antialias=MagickTrue) - ?(stroke_width=1.0) - ?(line_join=MiterJoin) - ?(line_cap=ButtCap) - ?(affine_matrix=identity_matrix) - () = - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color - and (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix - and array_length = Array.length coords - in - draw_polyline t_img - ~coords ~array_length - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_antialias ~stroke_width ~line_join ~line_cap - ~sx ~rx ~ry ~sy ~tx ~ty - -(* }}} *) -(* {{{ draw_polygon *) - -external draw_polygon : image_handle -> - coords:(int * int) array -> array_length:int -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_antialias:magick_boolean -> - stroke_width:float -> line_join:line_join -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> unit - = "imper_draw_polygon_bytecode" - "imper_draw_polygon_native" - -let draw_polygon t_img - ~coords - ?(fill_color=black) - ?(stroke_color=transparent) - ?(stroke_antialias=MagickTrue) - ?(stroke_width=1.0) - ?(line_join=MiterJoin) - ?(affine_matrix=identity_matrix) - () = - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color - and (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix - and array_length = Array.length coords - in - draw_polygon t_img - ~coords ~array_length - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_antialias ~stroke_width ~line_join - ~sx ~rx ~ry ~sy ~tx ~ty - -(* }}} *) -(* {{{ draw_bezier *) - -external draw_bezier : image_handle -> - coords:(int * int) array -> array_length:int -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_antialias:magick_boolean -> - stroke_width:float -> line_cap:line_cap -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> unit - = "imper_draw_bezier_bytecode" - "imper_draw_bezier_native" - -let draw_bezier t_img - ~coords - ?(fill_color=transparent) - ?(stroke_color=black) - ?(stroke_antialias=MagickTrue) - ?(stroke_width=1.0) - ?(line_cap=ButtCap) - ?(affine_matrix=identity_matrix) - () = - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color - and (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix - and array_length = Array.length coords - in - draw_bezier t_img - ~coords ~array_length - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_antialias ~stroke_width ~line_cap - ~sx ~rx ~ry ~sy ~tx ~ty - -(* }}} *) - -(* {{{ draw_path *) - -external draw_path : image_handle -> - path:string -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_antialias:magick_boolean -> - stroke_width:float -> line_join:line_join -> line_cap:line_cap -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> unit - = "imper_draw_path_bytecode" - "imper_draw_path_native" - - -let draw_path t_img - ~path - ?(fill_color=transparent) - ?(stroke_color=black) - ?(stroke_antialias=MagickTrue) - ?(stroke_width=1.0) - ?(line_join=MiterJoin) - ?(line_cap=ButtCap) - ?(affine_matrix=identity_matrix) - () = - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color - and (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix - in - draw_path t_img - ~path - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_antialias ~stroke_width ~line_join ~line_cap - ~sx ~rx ~ry ~sy ~tx ~ty - -(* }}} *) - -(* {{{ types for draw_text *) - -type style_type = - | Undefined_Style - | Normal_Style - | Italic - | Oblique - | Any_Style - -type decoration_type = - | Undefined_Decoration - | No_Decoration - | Underline - | Overline - | LineThrough - -type stretch_type = - | Undefined_Stretch - | Normal_Stretch - | UltraCondensed - | ExtraCondensed - | Condensed - | SemiCondensed - | SemiExpanded - | Expanded - | ExtraExpanded - | UltraExpanded - | Any_Stretch - -(* }}} *) - -(* {{{ draw_text *) - -external draw_text : image_handle -> - text:string -> font:string -> x:int -> y:int -> point_size:float -> - density_x:int -> density_y:int -> - style:style_type -> weight:int -> decoration:decoration_type -> stretch:stretch_type -> - fill_red:int -> fill_green:int -> fill_blue:int -> fill_alpha:int -> - stroke_red:int -> stroke_green:int -> stroke_blue:int -> stroke_alpha:int -> - stroke_width:float -> - stroke_antialias:magick_boolean -> - text_antialias:magick_boolean -> - encoding:string -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> unit - = "imper_draw_text_bytecode" - "imper_draw_text_native" - -let draw_text t_img - ~text ?(font="") - ~x ~y ~point_size - ?(density_x=72) - ?(density_y=72) - ?(style=Normal_Style) ?(weight=1) - ?(fill_color=black) - ?(stroke_color=transparent) - ?(decoration=No_Decoration) - ?(stretch=Normal_Stretch) - ?(stroke_width=1.0) - ?(stroke_antialias=MagickTrue) (* TODO: no stroke antialias if stroke is transparent *) - ?(text_antialias=MagickTrue) - ?(encoding="") - ?(affine_matrix=identity_matrix) - () = - let (fill_red, fill_green, fill_blue, fill_alpha) = channels_of_color fill_color - and (stroke_red, stroke_green, stroke_blue, stroke_alpha) = channels_of_color stroke_color - and (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix - in - draw_text t_img - ~text ~font ~x ~y ~point_size - ~density_x ~density_y - ~style ~weight ~decoration ~stretch - ~fill_red ~fill_green ~fill_blue ~fill_alpha - ~stroke_red ~stroke_green ~stroke_blue ~stroke_alpha - ~stroke_width - ~stroke_antialias - ~text_antialias - ~encoding - ~sx ~rx ~ry ~sy ~tx ~ty - -(* }}} *) -(* {{{ get_metrics *) - -type metrics_infos = { - ascent : float; - descent : float; - text_width : float; - text_height : float; - max_advance : float; - underline_position : float; - underline_thickness : float; - pixels_per_em_x : float; - pixels_per_em_y : float; - bounds_x1 : float; - bounds_y1 : float; - bounds_x2 : float; - bounds_y2 : float; -} - -external get_metrics : image_handle -> - text:string -> font:string -> x:int -> y:int -> point_size:float -> - density_x:int -> density_y:int -> - style:style_type -> weight:int -> decoration:decoration_type -> stretch:stretch_type -> - stroke_width:float -> - sx:float -> rx:float -> ry:float -> sy:float -> tx:float -> ty:float -> - float * float * float * float * float * float * float * - float * float * float * float * float * float - = "imper_get_metrics_bytecode" - "imper_get_metrics_native" - -let get_metrics t_img - ~text ?(font="") ~x ~y ~point_size - ?(density_x=72) - ?(density_y=72) - ?(style=Normal_Style) ?(weight=1) - ?(decoration=No_Decoration) - ?(stretch=Normal_Stretch) - ?(stroke_width=1.0) - (* - ?(affine_matrix=identity_matrix) - *) - () = - (* The transformation matrix doesn't affect the results, - but perhaps this will change in the futur ? *) - let (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix:identity_matrix in - (* - let (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix in - *) - let ( ascent, descent, - width, height, - max_advance, - underline_position, - underline_thickness, - pixels_per_em_x, - pixels_per_em_y, - bounds_x1, bounds_y1, - bounds_x2, bounds_y2 ) - = get_metrics t_img - ~text ~font ~x ~y ~point_size - ~density_x ~density_y - ~style ~weight ~decoration ~stretch - ~stroke_width - ~sx ~rx ~ry ~sy ~tx ~ty - in - { - ascent = ascent; - descent = descent; - text_width = width; - text_height = height; - max_advance = max_advance; - underline_position = underline_position; - underline_thickness = underline_thickness; - pixels_per_em_x = pixels_per_em_x; - pixels_per_em_y = pixels_per_em_y; - bounds_x1 = bounds_x1; - bounds_y1 = bounds_y1; - bounds_x2 = bounds_x2; - bounds_y2 = bounds_y2; - } - - - -let transform_metrics ~metrics ~affine_matrix = - let m = metrics - and (sx, rx, ry, sy, tx, ty) = tuple_of_matrix ~affine_matrix - in - let width = m.text_width *. sx - and height = m.text_height *. sy - and pixels_per_em_x = m.pixels_per_em_x *. sx - and pixels_per_em_y = m.pixels_per_em_y *. sy - and bounds_x1 = m.bounds_x1 *. sx - and bounds_x2 = m.bounds_x2 *. sx - and bounds_y1 = m.bounds_y1 *. sy - and bounds_y2 = m.bounds_y2 *. sy - and underline_position = m.underline_position *. sy - and underline_thickness = m.underline_thickness *. sy - and ascent = m.ascent *. sy - and descent = m.descent *. sy - and max_advance = m.max_advance *. sx - in - { - ascent = ascent; - descent = descent; - text_width = width; - text_height = height; - max_advance = max_advance; - underline_position = underline_position; - underline_thickness = underline_thickness; - pixels_per_em_x = pixels_per_em_x; - pixels_per_em_y = pixels_per_em_y; - bounds_x1 = bounds_x1; - bounds_y1 = bounds_y1; - bounds_x2 = bounds_x2; - bounds_y2 = bounds_y2; - } - - -(* }}} *) - - -external draw_text_devel : image_handle -> text:string -> unit = "imper_draw_text_new1" - -(* {{{ draw_mvg *) - -external draw_mvg: image_handle -> mvg:string -> unit = "imper_draw_mvg" - -(* }}} *) - - -(* @TODO: Make these functions work -external set_image_pixel : image_handle -> int -> int -> unit = "imper_setimagepixel" -external load_image : x:int -> y:int -> color:int -> image_handle = "imper_loadimage" -*) - - -external get_raw : image_handle -> (int * int * int * int) array array = "imper_get_raw" -external get_raw' : image_handle -> (int * int * int * int) array array = "imper_get_raw2" - -external get_raw_opacity : image_handle -> (int * int * int * int) array array = "imper_get_raw_opacity" - -external get_raw_without_alpha : image_handle -> (int * int * int) array array = "imper_get_raw_without_alpha" - - -external get_raw_gl_indexed : image_handle -> (int * int * int * int) array = "imper_get_raw_gl_indexed" -external get_raw_gl_indexed_without_alpha : image_handle -> (int * int * int) array - = "imper_get_raw_gl_indexed_without_alpha" - - -(* @TODO: send the array to C rather than unefficient loops on set_pixel calls *) -(* -let set_raw ~raw = - let width = Array.length raw - and height = Array.length raw.(0) - in - let t_img = get_canvas ~width ~height ~color:"#000000" - in - for x = 0 to width - 1 do - let raw_x = raw.(x) in - for y = 0 to height - 1 do - let (red, green, blue, alpha) = raw_x.(y) in - set_pixel t_img ~x ~y ~red ~green ~blue ~opacity; - done - done; - t_img -;; -*) -let set_raw ~raw = - let width = Array.length raw - and height = Array.length raw.(0) - in - let t_img = get_canvas ~width ~height ~color:"#000000" - in - for x = 0 to width - 1 do - for y = 0 to height - 1 do - let (red, green, blue, opacity) = raw.(x).(y) in - set_pixel t_img ~x ~y ~red ~green ~blue ~opacity; - done - done; - t_img -;; - - -external set_raw_c : raw:(int * int * int * int) array array -> width:int -> height:int -> image_handle - = "imper_set_raw_c" - -let set_raw_c ~raw = - let width = Array.length raw - and height = Array.length raw.(0) - in - set_raw_c ~raw ~width ~height; -;; - - - - - - - -(* images lists *) - -type image_list_handle - - -external new_image_list : unit -> image_list_handle = "imper_new_image_list" - -external no_op : image_handle -> unit = "imper_no_op" (* TEMP *) - - -external display_images : image_list_handle -> unit = "im_displayimages" - -external append_image_to_list : image_list_handle -> image_handle -> delay:int -> unit = "imper_appendimagetolist" -let append_image_to_list t_img_list t_img ?(delay=50) () = - append_image_to_list t_img_list t_img ~delay - -external image_list_length : image_list_handle -> int = "imper_getimagelistlength" - - -external deconstruct_images : image_list_handle -> unit = "imper_deconstructimages" -external coalesce_images : image_list_handle -> unit = "imper_coalesceimages" -external flatten_images : image_list_handle -> unit = "imper_flattenimages" - - -external average_images : image_list_handle -> image_handle -> unit = "imper_averageimages" -let average_images img_list = - let _img = get_canvas 2 2 "#0000" in - average_images img_list _img; - _img -;; - - -external animate_images : image_list_handle -> unit = "imper_animateimages" - - -external write_images : image_list_handle -> string -> unit = "im_writeimage" - -external get_last_image_in_list : image_list_handle -> image_handle = "imper_getlastimageinlist" -external get_first_image_in_list : image_list_handle -> image_handle = "imper_getfirstimageinlist" - - -external has_link : image_handle -> bool = "imper_has_link" - - -type stack = - | Left_to_right - | Top_to_bottom - -let stack_dir_of_string ~stack = - match String.lowercase_ascii stack with - | "left to right" - | "left-to-right" - | "left_to_right" -> Left_to_right - | "top to bottom" - | "top-to-bottom" - | "top_to_bottom" -> Top_to_bottom - | _ -> failwith "unrecognized stack direction" - -(* -external append_images : image_list_handle -> stack:stack -> image_handle = "imper_appendimages" -*) -external append_images : image_list_handle -> stack:stack -> image_handle -> unit = "imper_appendimages" -let append_images img_list ~stack = - let _img = get_canvas 2 2 "#0000" in - append_images img_list ~stack _img; - _img -;; - -end;; (* of module Imper }}} *) - - -(* {{{ Functional module *) - -module Fun = struct - - -let create_image ~width ~height ~pseudo_format () = create_image ~width ~height ~pseudo_format -let get_canvas ~width ~height ~color () = get_canvas ~width ~height ~color -let read_image ~filename () = read_image ~filename - - -(* {{{ functions with a functionnal forme in the MagickCore *) - -external blur : image_handle -> radius:float -> sigma:float -> image_handle = "fun_blurimage" -let blur ?(radius=0.0) ~sigma () img = blur img ~radius ~sigma - -external radial_blur : image_handle -> angle:float -> image_handle = "fun_radialblurimage" -let radial_blur ~angle () img = radial_blur img ~angle - -external radial_blur_channel : image_handle -> channel:channel_type -> angle:float -> image_handle - = "fun_radialblurimagechannel" -let radial_blur_channel ~channel ~angle () img = radial_blur_channel img ~channel ~angle - -external charcoal : image_handle -> radius:float -> sigma:float -> image_handle = "fun_charcoalimage" -let charcoal ?(radius=0.0) ~sigma () img = charcoal img ~radius ~sigma - -external edge : image_handle -> radius:float -> image_handle = "fun_edgeimage" -let edge ~radius () img = edge img ~radius - -external emboss : image_handle -> radius:float -> sigma:float -> image_handle = "fun_embossimage" -let emboss ?(radius=0.0) ~sigma () img = emboss img ~radius ~sigma - -external gaussian_blur : image_handle -> radius:float -> sigma:float -> image_handle = "fun_gaussianblurimage" -let gaussian_blur ?(radius=0.0) ~sigma () img = gaussian_blur img ~radius ~sigma - -external implode : image_handle -> amount:float -> image_handle = "fun_implodeimage" -let implode ~amount () img = implode img ~amount - -external medianfilter : image_handle -> radius:float -> image_handle = "fun_medianfilterimage" -let medianfilter ~radius () img = medianfilter img ~radius - -external motion_blur : image_handle -> radius:float -> sigma:float -> angle:float -> image_handle = "fun_motionblurimage" -let motion_blur ?(radius=0.0) ~sigma ~angle () img = motion_blur img ~radius ~sigma ~angle - -external oilpaint : image_handle -> radius:float -> image_handle = "fun_oilpaintimage" -let oilpaint ~radius () img = oilpaint img ~radius - -external reduce_noise : image_handle -> radius:float -> image_handle = "fun_reducenoiseimage" -let reduce_noise ~radius () img = reduce_noise img ~radius - -external roll : image_handle -> x:int -> y:int -> image_handle = "fun_rollimage" -let roll ~x ~y () img = roll img ~x ~y - -external shade : image_handle -> gray:magick_boolean -> azimuth:float -> elevation:float -> image_handle = "fun_shadeimage" -let shade ?(gray=MagickTrue) ~azimuth ~elevation () img = shade img ~gray ~azimuth ~elevation - -external sharpen : image_handle -> radius:float -> sigma:float -> image_handle = "fun_sharpenimage" -let sharpen ?(radius=0.0) ~sigma () img = sharpen img ~radius ~sigma - -external spread : image_handle -> radius:float -> image_handle = "fun_spreadimage" -let spread ~radius () img = spread img ~radius - -external swirl : image_handle -> degrees:float -> image_handle = "fun_swirlimage" -let swirl ~degrees () img = swirl img ~degrees - -external unsharpmask : image_handle -> radius:float -> sigma:float -> amount:float -> threshold:float -> image_handle - = "fun_unsharpmaskimage" -let unsharpmask ~radius ~sigma ~amount ~threshold () img = unsharpmask img ~radius ~sigma ~amount ~threshold - -external wave : image_handle -> amplitude:float -> wave_length:float -> image_handle = "fun_waveimage" -let wave ~amplitude ~wave_length () img = wave img ~amplitude ~wave_length - -external rotate : image_handle -> degrees:float -> image_handle = "fun_rotateimage" -let rotate ~degrees () img = rotate img ~degrees - -external shear : image_handle -> x:float -> y:float -> image_handle = "fun_shearimage" -let shear ~x ~y () img = shear img ~x ~y - -external sample : image_handle -> width:int -> height:int -> image_handle = "fun_sampleimage" -let sample ~width ~height () img = sample img ~width ~height - -external scale : image_handle -> width:int -> height:int -> image_handle = "fun_scaleimage" -let scale ~width ~height () img = scale img ~width ~height - -external thumbnail : image_handle -> width:int -> height:int -> image_handle = "fun_thumbnailimage" -let thumbnail ~width ~height () img = thumbnail img ~width ~height - -external adaptive_threshold : image_handle -> width:int -> height:int -> offset:int -> image_handle - = "fun_adaptivethresholdimage" -let adaptive_threshold ~width ~height ~offset () img = adaptive_threshold img ~width ~height ~offset - -external blur_channel : image_handle -> channel:channel_type -> radius:float -> sigma:float -> image_handle - = "fun_blurimagechannel" -let blur_channel ~channel ?(radius=0.0) ~sigma () img = blur_channel img ~channel ~radius ~sigma - -external gaussian_blur_channel : image_handle -> channel:channel_type -> radius:float -> sigma:float -> image_handle - = "fun_gaussianblurimagechannel" -let gaussian_blur_channel ~channel ?(radius=0.0) ~sigma () img = gaussian_blur_channel img ~channel ~radius ~sigma - -external add_noise : image_handle -> noise_type:noise_type -> image_handle = "fun_addnoiseimage" -let add_noise ~noise_type () img = add_noise img ~noise_type - -external resize : image_handle -> width:int -> height:int -> filter:resize_filter -> blur:float -> image_handle - = "fun_resizeimage" -let resize ~width ~height ~filter ~blur () img = resize img ~width ~height ~filter ~blur - -external enhance : image_handle -> image_handle = "fun_enhanceimage" -let enhance () img = enhance img - -external despeckle : image_handle -> image_handle = "fun_despeckleimage" -let despeckle () img = despeckle img - -external minify : image_handle -> image_handle ="fun_minifyimage" -let minify () img = minify img - -external magnify : image_handle -> image_handle = "fun_magnifyimage" -let magnify () img = magnify img - -external flip : image_handle -> image_handle = "fun_flipimage" -let flip () img = flip img - -external flop : image_handle -> image_handle = "fun_flopimage" -let flop () img = flop img - -external splice : image_handle -> x:int -> y:int -> width:int -> height:int -> image_handle = "fun_spliceimage" -let splice ~x ~y ~width ~height () img = splice img ~x ~y ~width ~height - - -external crop : image_handle -> x:int -> y:int -> width:int -> height:int -> image_handle = "fun_cropimage" -let crop ~x ~y ~width ~height () img = crop img ~x ~y ~width ~height - - - -external affine_transform : image_handle -> - sx:float -> - rx:float -> - ry:float -> - sy:float -> - tx:float -> - ty:float -> - image_handle = "fun_affinetransformimage_bytecode" - "fun_affinetransformimage_native" - -let affine_transform - ?(tx=0.0) ?(ty=0.0) - ?(sx=1.0) ?(sy=1.0) - ?(rx=0.0) ?(ry=0.0) - () img = - if sx = 0.0 then invalid_arg "affine_transform: sx = 0.0 would produce a 0 width image"; - if sy = 0.0 then invalid_arg "affine_transform: sy = 0.0 would produce a 0 height image"; - affine_transform img - ~sx ~rx ~ry ~sy ~tx ~ty - -(* }}} *) - -(* {{{ functions with an imperative forme in the MagickCore *) - -external negate : image_handle -> grayscale:magick_boolean -> image_handle = "fun_negateimage" -let negate ?(grayscale=MagickFalse) () img = negate img ~grayscale - - -external contrast : image_handle -> sharpen:magick_boolean -> image_handle = "fun_contrastimage" -let contrast ~sharpen () img = contrast img ~sharpen - -external equalize : image_handle -> image_handle = "fun_equalizeimage" -let equalize () img = equalize img - -external normalize : image_handle -> image_handle = "fun_normalizeimage" -let normalize () img = normalize img - -external black_threshold : image_handle -> threshold:string -> image_handle = "fun_blackthresholdimage" -let black_threshold ~threshold () img = black_threshold img ~threshold - -external white_threshold : image_handle -> threshold:string -> image_handle = "fun_whitethresholdimage" -let white_threshold ~threshold () img = white_threshold img ~threshold - -external cyclecolormap : image_handle -> displace:int -> image_handle = "fun_cyclecolormapimage" -let cyclecolormap ~displace () img = cyclecolormap img ~displace - -external solarize : image_handle -> threshold:float -> image_handle = "fun_solarizeimage" -let solarize ~threshold () img = solarize img ~threshold - -external strip : image_handle -> image_handle = "fun_stripimage" -let strip () img = strip img - -external gamma_channel : image_handle -> channel:channel_type -> gamma:float -> image_handle = "fun_gammaimagechannel" -let gamma_channel ~channel ~gamma () img = gamma_channel img ~channel ~gamma - -external level : image_handle -> levels:string -> image_handle = "fun_levelimage" -let level ~levels () img = level img ~levels - -external level_channel : image_handle -> channel:channel_type -> black_point:float -> white_point:float -> - gamma:float -> image_handle = "fun_levelimagechannel" -let level_channel ~channel ~black_point ~white_point ~gamma () img = - level_channel img ~channel ~black_point ~white_point ~gamma - -external negate_channel : image_handle -> channel:channel_type -> grayscale:magick_boolean -> image_handle - = "fun_negateimagechannel" -let negate_channel ~channel ~grayscale () img = negate_channel img ~channel ~grayscale - -external ordered_dither : image_handle -> image_handle = "fun_orderedditherimage" -let ordered_dither () = ordered_dither ;; - - - -(* TODO: ask which is the good traduction - * - * below, behind, underneath, beneath - * above, on_top - *) -let composite_image ~compose ?(x=0) ?(y=0) () ~img_below ~img_above = - let img_under = clone_image img_below in - Imper.composite_image img_under img_above ~compose ~x ~y (); - img_under -;; - - -let texture_image ~img ~tex_img = - let new_img = clone_image img in - Imper.texture_image new_img tex_img; - new_img -;; - - - - -external modulate' : image_handle -> factors:string -> image_handle = "fun_modulateimage" - -let modulate ?(brightness=100) ?(saturation=100) ?(hue=100) () img = - let br = string_of_int brightness - and sa = string_of_int saturation - and hu = string_of_int hue - in - modulate' img ~factors:(br ^","^ sa ^","^ hu) - -let modulate' ~factors () img = modulate' img ~factors - - - -let view () img = display img; img - - -(* }}} *) - - -end;; (* of module Functional }}} *) - - -(* {{{ get_magick_* *) - -external get_magick_copyright : unit -> string = "imper_getmagickcopyright" -external get_magick_home_url : unit -> string = "imper_getmagickhomeurl" -external get_magick_release_date : unit -> string = "imper_getmagickreleasedate" -external get_magick_version : unit -> int * string = "imper_getmagickversion" -external get_magick_quantum_depth : unit -> int * string = "imper_getmagickquantumdepth" -external get_magick_quantum_range : unit -> int * string = "imper_getmagickquantumrange" -(* external get_magick_name : unit -> string = "imper_getmagickname" *) - -external get_binding_version : unit -> string = "imper_getbindingversion" - -(* }}} *) - - -(* {{{ BigArray *) - -type shared_data = - | UI8 of (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array3.t - | UI16 of (int, Bigarray.int16_unsigned_elt, Bigarray.c_layout) Bigarray.Array3.t - | UI32 of (int, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array3.t - | UI64 of (int, Bigarray.int64_elt, Bigarray.c_layout) Bigarray.Array3.t - - -external inspect_big_array: ('a, 'b, 'c) Bigarray.Array2.t -> unit = "ml_big_array_test" - -let select () = - let qb = sizeof_quantum_bit() in - qb -;; - -let big_array2_dump arr = - for i = 0 to pred(Bigarray.Array2.dim1 arr) do - for j = 0 to pred(Bigarray.Array2.dim2 arr) do - Printf.printf " %d,%d:%3d" i j arr.{i,j}; - done; - Printf.printf "\n"; - done; - flush stdout; -;; - - -external image_of_bigarray: ('a, 'b, 'c) Bigarray.Array3.t -> image_handle = "constituteimage_from_big_array_char" - - -(* }}} *) - - -(* {{{ Linear Gradient *) - -type coords_2d = { - x : int; - y : int; -} - -type dimentions = { - width : int; - height : int; -} - -type bounding_box = { - pos : coords_2d; - dims : dimentions; -} - -type gradient_spreadMethod = - | Pad_spread - | Repeat_spread - | Reflect_spread - - -external _linear_gradient: width:int -> height:int -> - a_x:int -> a_y:int -> - b_x:int -> b_y:int -> - spread_method:gradient_spreadMethod -> - bounding_box_x : int -> - bounding_box_y : int -> - bounding_box_width : int -> - bounding_box_height : int -> - image_handle - = "linear_gradient_bytecode" - "linear_gradient_native" - -let _linear_gradient ~width ~height ~a ~b ?(spread_method=Pad_spread) ?bounding_box () = - let a_x = a.x and a_y = a.y - and b_x = b.x and b_y = b.y - in - let bounding_box = - match bounding_box with - | None -> { pos={x=0; y=0}; dims={width=width; height=height} } - | Some v -> v - in - let bounding_box_x = bounding_box.pos.x - and bounding_box_y = bounding_box.pos.y - and bounding_box_width = bounding_box.dims.width - and bounding_box_height = bounding_box.dims.height - in - _linear_gradient ~width ~height - ~a_x ~a_y - ~b_x ~b_y - ~spread_method - ~bounding_box_x - ~bounding_box_y - ~bounding_box_width - ~bounding_box_height -;; - - - -external linear_gradient: - image_handle -> - width:int -> height:int -> - a_x:int -> a_y:int -> - b_x:int -> b_y:int -> - spread_method:gradient_spreadMethod -> - stop:(float * string) list -> stop_nb:int -> - a:float -> b:float -> c:float -> - d:float -> e:float -> f:float -> - g:float -> h:float -> i:float -> - bounding_box_x : int -> - bounding_box_y : int -> - bounding_box_width : int -> - bounding_box_height : int -> - unit - = "linear_gradient_bytecode" - "linear_gradient_native" - - -let linear_gradient img ~a:(pa) ~b:(pb) - ~stop - ?(matrix=( (1.0, 0.0, 0.0), - (0.0, 1.0, 0.0), - (0.0, 0.0, 1.0) )) - ?(spread_method=Pad_spread) - ?bounding_box () = - let width = get_image_width img - and height = get_image_height img - in - let bounding_box = - match bounding_box with - | None -> { pos={x=0; y=0}; dims={width=width; height=height} } - | Some v -> v - in - let ((a, b, c), (d, e, f), (g, h, i)) = matrix in - linear_gradient - img - ~width ~height - ~a_x:pa.x ~a_y:pa.y - ~b_x:pb.x ~b_y:pb.y - ~spread_method - ~stop ~stop_nb:(List.length stop) - ~a ~b ~c - ~d ~e ~f - ~g ~h ~i - ~bounding_box_x:bounding_box.pos.x - ~bounding_box_y:bounding_box.pos.y - ~bounding_box_width:bounding_box.dims.width - ~bounding_box_height:bounding_box.dims.height -;; - -(* }}} *) - - -(* vim: sw=2 ts=2 sts=2 et fdm=marker - *) diff --git a/magick.mli b/magick.mli deleted file mode 100644 index 9fd04b7..0000000 --- a/magick.mli +++ /dev/null @@ -1,757 +0,0 @@ -external sizeof_quantum : unit -> int = "im_sizeof_quantum" -external sizeof_quantum_bit : unit -> int = "im_sizeof_quantum_bit" -type image_handle -external read_image : filename:string -> image_handle = "im_readimage" -external get_canvas : width:int -> height:int -> color:string -> image_handle - = "im_getimagecanvas" -external create_image : - width:int -> height:int -> pseudo_format:string -> image_handle - = "im_create_image" -external clone_image : image_handle -> image_handle = "im_cloneimage" -external write_image : image_handle -> filename:string -> unit - = "im_writeimage" -external display : image_handle -> unit = "im_displayimages" -external image_to_stdout : image_handle -> unit = "imper_imagetoblob_stdout" -external blob_of_image : image_handle -> int list = "imper_imagetoblob_bytes" -val dump_to_stdout : image_handle -> unit -external get_image_width : image_handle -> int = "imper_getimagewidth" -external get_image_height : image_handle -> int = "imper_getimageheight" -external get_image_depth : image_handle -> int = "imper_getimagedepth" -external get_image_quality : image_handle -> int = "imper_getimagequality" -external get_image_mimetype : image_handle -> string - = "imper_getimagemimetype" -external get_image_size : image_handle -> string = "imper_getimagesize" -external get_image_colors : image_handle -> int = "imper_getimagecolors" -external get_image_colorspace : image_handle -> int - = "imper_getimagecolorspace" -external ping_image_infos : string -> int * int * int * int * int * string - = "imper_ping_image_infos" -external ping_image : string -> bool = "imper_ping_image" -external get_number_colors : image_handle -> int = "imper_getimagehistogram" -external get_image_histogram : image_handle -> histogram_file:string -> int - = "imper_getnumbercolors" -external get_max_colormap : unit -> int = "imper_getmaxcolormap" -type image_type = - Undefined_image_type - | Bilevel - | Grayscale - | GrayscaleMatte - | Palette - | PaletteMatte - | TrueColor - | TrueColorMatte - | ColorSeparation - | ColorSeparationMatte - | Optimize -external get_image_type : image_handle -> image_type = "imper_getimagetype" -val string_of_image_type : image_type -> string -type magick_boolean = MagickFalse | MagickTrue -val magick_boolean_of_string : string -> magick_boolean -type noise_type = - UndefinedNoise - | UniformNoise - | GaussianNoise - | MultiplicativeGaussianNoise - | ImpulseNoise - | LaplacianNoise - | PoissonNoise -type resize_filter = - Undefined_resize_filter - | Point - | Box - | Triangle - | Hermite - | Hanning - | Hamming - | Blackman - | Gaussian - | Quadratic - | Cubic - | Catrom - | Mitchell - | Lanczos - | Bessel - | Sinc -val resize_filter_of_string : string -> resize_filter -val resize_filter_of_string' : string -> resize_filter -val string_of_resize_filter : resize_filter -> string -type channel_type = - Undefined_Channel - | Red - | Gray - | Cyan - | Green - | Magenta - | Blue - | Yellow - | Alpha - | Opacity - | Black - | Index - | All_Channels - | Default_Channels -val channel_type_of_string : string -> channel_type -val channel_type_of_string' : string -> channel_type -val string_of_channel_type : channel_type -> string -type composite_operator = - Undefined_composite_operator - | No_composite_operator - | Add - | Atop - | Blend - | Bumpmap - | Clear - | ColorBurn - | ColorDodge - | Colorize - | CopyBlack - | CopyBlue - | Copy - | CopyCyan - | CopyGreen - | CopyMagenta - | CopyOpacity - | CopyRed - | CopyYellow - | Darken - | DstAtop - | Dst - | DstIn - | DstOut - | DstOver - | Difference - | Displace - | Dissolve - | Exclusion - | HardLight - | Hue - | In - | Lighten - | Luminize - | Minus - | Modulate - | Multiply - | Out - | Over - | Overlay - | Plus - | Replace - | Saturate - | Screen - | SoftLight - | SrcAtop - | Src - | SrcIn - | SrcOut - | SrcOver - | Subtract - | Threshold - | Xor -val composite_operator_of_string : string -> composite_operator -val composite_operator_of_string' : string -> composite_operator -val string_of_composite_operator : composite_operator -> string -module Imper : - sig - external plasma_image : - image_handle -> - x1:int -> - y1:int -> x2:int -> y2:int -> attenuate:int -> depth:int -> unit - = "imper_plasmaimage_bytecode" "imper_plasmaimage_native" - external flip : image_handle -> unit = "imper_flipimage" - external flop : image_handle -> unit = "imper_flopimage" - external magnify : image_handle -> unit = "imper_magnifyimage" - external minify : image_handle -> unit = "imper_minifyimage" - external enhance : image_handle -> unit = "imper_enhanceimage" - external trim : image_handle -> unit = "imper_trimimage" - external despeckle : image_handle -> unit = "imper_despeckle" - val negate : image_handle -> ?grayscale:magick_boolean -> unit -> unit - external contrast : image_handle -> sharpen:magick_boolean -> unit - = "imper_contrastimage" - external equalize : image_handle -> unit = "imper_equalizeimage" - external normalize : image_handle -> unit = "imper_normalizeimage" - external white_threshold : image_handle -> threshold:string -> unit - = "imper_whitethresholdimage" - external black_threshold : image_handle -> threshold:string -> unit - = "imper_blackthresholdimage" - external cyclecolormap : image_handle -> displace:int -> unit - = "imper_cyclecolormapimage" - external solarize : image_handle -> threshold:float -> unit - = "imper_solarizeimage" - external modulate' : image_handle -> factors:string -> unit - = "imper_modulateimage" - val modulate : - image_handle -> - ?brightness:int -> ?saturation:int -> ?hue:int -> unit -> unit - val blur : image_handle -> ?radius:float -> sigma:float -> unit -> unit - val gaussian_blur : - image_handle -> ?radius:float -> sigma:float -> unit -> unit - val motion_blur : - image_handle -> - ?radius:float -> sigma:float -> angle:float -> unit -> unit - val charcoal : - image_handle -> ?radius:float -> sigma:float -> unit -> unit - external edge : image_handle -> radius:float -> unit = "imper_edgeimage" - val emboss : image_handle -> ?radius:float -> sigma:float -> unit -> unit - external implode : image_handle -> amount:float -> unit - = "imper_implodeimage" - external medianfilter : image_handle -> radius:float -> unit - = "imper_medianfilterimage" - external oilpaint : image_handle -> radius:float -> unit - = "imper_oilpaintimage" - external reduce_noise : image_handle -> radius:float -> unit - = "imper_reducenoiseimage" - external roll : image_handle -> x:int -> y:int -> unit - = "imper_rollimage" - val shade : - image_handle -> - ?gray:magick_boolean -> - azimuth:float -> elevation:float -> unit -> unit - external spread : image_handle -> radius:float -> unit - = "imper_spreadimage" - external swirl : image_handle -> degrees:float -> unit - = "imper_swirlimage" - val sharpen : - image_handle -> ?radius:float -> sigma:float -> unit -> unit - external unsharpmask : - image_handle -> - radius:float -> sigma:float -> amount:float -> threshold:float -> unit - = "imper_unsharpmaskimage" - external wave : - image_handle -> amplitude:float -> wave_length:float -> unit - = "imper_waveimage" - external rotate : image_handle -> degrees:float -> unit - = "imper_rotateimage" - external shear : image_handle -> x:float -> y:float -> unit - = "imper_shearimage" - val affine_transform : - image_handle -> - ?tx:float -> - ?ty:float -> - ?sx:float -> ?sy:float -> ?rx:float -> ?ry:float -> unit -> unit - external adaptive_threshold : - image_handle -> width:int -> height:int -> offset:int -> unit - = "imper_adaptivethresholdimage" - external crop : - image_handle -> x:int -> y:int -> width:int -> height:int -> unit - = "imper_cropimage" - external chop : - image_handle -> x:int -> y:int -> width:int -> height:int -> unit - = "imper_chopimage" - external splice : - image_handle -> x:int -> y:int -> width:int -> height:int -> unit - = "imper_spliceimage" - external colorize : - image_handle -> string -> int -> int -> int -> int -> unit - = "imper_colorizeimage_bytecode" "imper_colorizeimage_native" - external acquire_pixel : - image_handle -> int -> int -> int * int * int * int - = "imper_acquireonepixel" - val composite_image : - image_handle -> - image_handle -> - compose:composite_operator -> ?x:int -> ?y:int -> unit -> unit - external texture_image : image_handle -> image_handle -> unit - = "imper_textureimage" - external bilevel_channel : - image_handle -> channel:channel_type -> float -> unit - = "imper_bilevelimagechannel" - val blur_channel : - image_handle -> - channel:channel_type -> ?radius:float -> sigma:float -> unit -> unit - val gaussian_blur_channel : - image_handle -> - channel:channel_type -> ?radius:float -> sigma:float -> unit -> unit - external radial_blur : image_handle -> angle:float -> unit - = "imper_radialblurimage" - external radial_blur_channel : - image_handle -> channel:channel_type -> angle:float -> unit - = "imper_radialblurimagechannel" - val sharpen_image_channel : - image_handle -> - channel:channel_type -> ?radius:float -> sigma:float -> unit -> unit - external add_noise : image_handle -> noise_type -> unit - = "imper_addnoiseimage" - external resize : - image_handle -> - width:int -> height:int -> filter:resize_filter -> blur:float -> unit - = "imper_resizeimage" - external sample : image_handle -> width:int -> height:int -> unit - = "imper_sampleimage" - external scale : image_handle -> width:int -> height:int -> unit - = "imper_scaleimage" - external thumbnail : image_handle -> width:int -> height:int -> unit - = "imper_thumbnailimage" - external set_image_colors : image_handle -> int -> unit - = "imper_setimagecolors" - external set_compression_quality : image_handle -> int -> unit - = "imper_setcompressionquality" - external set_image_type : image_handle -> image_type:image_type -> unit - = "imper_setimagetype" - external set_type : image_handle -> unit = "imper_setimagetype__" - external strip_image : image_handle -> unit = "imper_stripimage" - external level : image_handle -> string -> unit = "imper_levelimage" - external level_channel : - image_handle -> channel:channel_type -> float -> float -> float -> unit - = "imper_levelimagechannel" - external gamma_channel : - image_handle -> channel:channel_type -> gamma:float -> unit - = "imper_gammaimagechannel" - external negate_channel : - image_handle -> channel:channel_type -> magick_boolean -> unit - = "imper_negateimagechannel" - external ordered_dither : image_handle -> unit - = "imper_orderedditherimage" - external compress_colormap : image_handle -> unit - = "imper_compressimagecolormap" - external posterize : - image_handle -> levels:int -> dither:magick_boolean -> unit - = "imper_posterizeimage" - external map_image : - image_handle -> map_image:image_handle -> dither:magick_boolean -> unit - = "imper_mapimage" - external is_gray : image_handle -> bool = "imper_isgrayimage" - external is_monochrome : image_handle -> bool = "imper_ismonochromeimage" - external is_opaque : image_handle -> bool = "imper_isopaqueimage" - external is_palette : image_handle -> bool = "imper_ispaletteimage" - external is_taint : image_handle -> bool = "imper_istaintimage" - external is_equal : - image_handle -> image_handle -> bool * float * float * float - = "imper_isimagesequal" - type line_cap = UndefinedCap | ButtCap | RoundCap | SquareCap - type line_join = UndefinedJoin | MiterJoin | RoundJoin | BevelJoin - type color = int * int * int * int - val channels_of_color : color -> int * int * int * int - external acquire_pixel_opacity : - image_handle -> int -> int -> int * int * int * int - = "imper_acquireonepixel_opacity" - external set_image_opacity : image_handle -> opacity:int -> unit - = "imper_setimageopacity" - external color_of_string : string -> color = "imper_querycolordatabase" - val color_of_rgbo_tuple : int * int * int * int -> color - val rgbo_tuple_of_color : color -> int * int * int * int - val max_color_map : int - val add_colors : color -> color -> color - val sub_colors : color -> color -> color - val mul_colors : color -> color -> color - val dump_color : color -> unit - val div_colors : color -> color -> color - val rgb_string_of_color : color -> string - val rgba_string_of_color : color -> string - val hexa_string_of_color : color -> string - val color_of_hex : string -> int * int * int * int - val black : color - val transparent : color - type affine_matrix = { - sx : float; - rx : float; - ry : float; - sy : float; - tx : float; - ty : float; - } - val identity_matrix : affine_matrix - val tuple_of_matrix : - affine_matrix:affine_matrix -> - float * float * float * float * float * float - external set_pixel : - image_handle -> - x:int -> - y:int -> red:int -> green:int -> blue:int -> opacity:int -> unit - = "imper_draw_point_bytecode" "imper_draw_point_native" - val draw_point : image_handle -> x:int -> y:int -> color:color -> unit - val draw_line : - image_handle -> - x0:int -> - y0:int -> - x1:int -> - y1:int -> - ?fill_color:color -> - ?stroke_color:color -> - ?stroke_antialias:magick_boolean -> - ?stroke_width:float -> ?line_cap:line_cap -> unit -> unit - val draw_circle : - image_handle -> - x0:int -> - y0:int -> - x1:int -> - y1:int -> - ?fill_color:color -> - ?stroke_color:color -> - ?stroke_width:float -> - ?stroke_antialias:magick_boolean -> - ?affine_matrix:affine_matrix -> unit -> unit - val draw_rectangle : - image_handle -> - x0:int -> - y0:int -> - x1:int -> - y1:int -> - ?fill_color:color -> - ?stroke_color:color -> - ?stroke_width:float -> - ?stroke_antialias:magick_boolean -> - ?line_join:line_join -> ?affine_matrix:affine_matrix -> unit -> unit - val draw_round_rectangle : - image_handle -> - x0:int -> - y0:int -> - x1:int -> - y1:int -> - wc:int -> - hc:int -> - ?fill_color:color -> - ?stroke_color:color -> - ?stroke_antialias:magick_boolean -> - ?stroke_width:float -> ?affine_matrix:affine_matrix -> unit -> unit - val draw_arc : - image_handle -> - x0:int -> - y0:int -> - x1:int -> - y1:int -> - a0:int -> - a1:int -> - ?fill_color:color -> - ?stroke_color:color -> - ?stroke_antialias:magick_boolean -> - ?stroke_width:float -> - ?line_cap:line_cap -> ?affine_matrix:affine_matrix -> unit -> unit - val draw_ellipse : - image_handle -> - cx:int -> - cy:int -> - rx:int -> - ry:int -> - ?a0:int -> - ?a1:int -> - ?fill_color:color -> - ?stroke_color:color -> - ?stroke_antialias:magick_boolean -> - ?stroke_width:float -> ?affine_matrix:affine_matrix -> unit -> unit - val draw_polyline : - image_handle -> - coords:(int * int) array -> - ?fill_color:color -> - ?stroke_color:color -> - ?stroke_antialias:magick_boolean -> - ?stroke_width:float -> - ?line_join:line_join -> - ?line_cap:line_cap -> ?affine_matrix:affine_matrix -> unit -> unit - val draw_polygon : - image_handle -> - coords:(int * int) array -> - ?fill_color:color -> - ?stroke_color:color -> - ?stroke_antialias:magick_boolean -> - ?stroke_width:float -> - ?line_join:line_join -> ?affine_matrix:affine_matrix -> unit -> unit - val draw_bezier : - image_handle -> - coords:(int * int) array -> - ?fill_color:color -> - ?stroke_color:color -> - ?stroke_antialias:magick_boolean -> - ?stroke_width:float -> - ?line_cap:line_cap -> ?affine_matrix:affine_matrix -> unit -> unit - val draw_path : - image_handle -> - path:string -> - ?fill_color:color -> - ?stroke_color:color -> - ?stroke_antialias:magick_boolean -> - ?stroke_width:float -> - ?line_join:line_join -> - ?line_cap:line_cap -> ?affine_matrix:affine_matrix -> unit -> unit - type style_type = - Undefined_Style - | Normal_Style - | Italic - | Oblique - | Any_Style - type decoration_type = - Undefined_Decoration - | No_Decoration - | Underline - | Overline - | LineThrough - type stretch_type = - Undefined_Stretch - | Normal_Stretch - | UltraCondensed - | ExtraCondensed - | Condensed - | SemiCondensed - | SemiExpanded - | Expanded - | ExtraExpanded - | UltraExpanded - | Any_Stretch - val draw_text : - image_handle -> - text:string -> - ?font:string -> - x:int -> - y:int -> - point_size:float -> - ?density_x:int -> - ?density_y:int -> - ?style:style_type -> - ?weight:int -> - ?fill_color:color -> - ?stroke_color:color -> - ?decoration:decoration_type -> - ?stretch:stretch_type -> - ?stroke_width:float -> - ?stroke_antialias:magick_boolean -> - ?text_antialias:magick_boolean -> - ?encoding:string -> ?affine_matrix:affine_matrix -> unit -> unit - type metrics_infos = { - ascent : float; - descent : float; - text_width : float; - text_height : float; - max_advance : float; - underline_position : float; - underline_thickness : float; - pixels_per_em_x : float; - pixels_per_em_y : float; - bounds_x1 : float; - bounds_y1 : float; - bounds_x2 : float; - bounds_y2 : float; - } - val get_metrics : - image_handle -> - text:string -> - ?font:string -> - x:int -> - y:int -> - point_size:float -> - ?density_x:int -> - ?density_y:int -> - ?style:style_type -> - ?weight:int -> - ?decoration:decoration_type -> - ?stretch:stretch_type -> ?stroke_width:float -> unit -> metrics_infos - val transform_metrics : - metrics:metrics_infos -> affine_matrix:affine_matrix -> metrics_infos - external draw_text_devel : image_handle -> text:string -> unit - = "imper_draw_text_new1" - external draw_mvg : image_handle -> mvg:string -> unit = "imper_draw_mvg" - external get_raw : image_handle -> (int * int * int * int) array array - = "imper_get_raw" - external get_raw' : image_handle -> (int * int * int * int) array array - = "imper_get_raw2" - external get_raw_opacity : - image_handle -> (int * int * int * int) array array - = "imper_get_raw_opacity" - external get_raw_without_alpha : - image_handle -> (int * int * int) array array - = "imper_get_raw_without_alpha" - external get_raw_gl_indexed : - image_handle -> (int * int * int * int) array - = "imper_get_raw_gl_indexed" - external get_raw_gl_indexed_without_alpha : - image_handle -> (int * int * int) array - = "imper_get_raw_gl_indexed_without_alpha" - val set_raw : raw:(int * int * int * int) array array -> image_handle - val set_raw_c : raw:(int * int * int * int) array array -> image_handle - type image_list_handle - external new_image_list : unit -> image_list_handle - = "imper_new_image_list" - external no_op : image_handle -> unit = "imper_no_op" - external display_images : image_list_handle -> unit = "im_displayimages" - val append_image_to_list : - image_list_handle -> image_handle -> ?delay:int -> unit -> unit - external image_list_length : image_list_handle -> int - = "imper_getimagelistlength" - external deconstruct_images : image_list_handle -> unit - = "imper_deconstructimages" - external coalesce_images : image_list_handle -> unit - = "imper_coalesceimages" - external flatten_images : image_list_handle -> unit - = "imper_flattenimages" - val average_images : image_list_handle -> image_handle - external animate_images : image_list_handle -> unit - = "imper_animateimages" - external write_images : image_list_handle -> string -> unit - = "im_writeimage" - external get_last_image_in_list : image_list_handle -> image_handle - = "imper_getlastimageinlist" - external get_first_image_in_list : image_list_handle -> image_handle - = "imper_getfirstimageinlist" - external has_link : image_handle -> bool = "imper_has_link" - type stack = Left_to_right | Top_to_bottom - val stack_dir_of_string : stack:string -> stack - val append_images : image_list_handle -> stack:stack -> image_handle - end -module Fun : - sig - val create_image : - width:int -> height:int -> pseudo_format:string -> unit -> image_handle - val get_canvas : - width:int -> height:int -> color:string -> unit -> image_handle - val read_image : filename:string -> unit -> image_handle - val blur : - ?radius:float -> sigma:float -> unit -> image_handle -> image_handle - val radial_blur : angle:float -> unit -> image_handle -> image_handle - val radial_blur_channel : - channel:channel_type -> - angle:float -> unit -> image_handle -> image_handle - val charcoal : - ?radius:float -> sigma:float -> unit -> image_handle -> image_handle - val edge : radius:float -> unit -> image_handle -> image_handle - val emboss : - ?radius:float -> sigma:float -> unit -> image_handle -> image_handle - val gaussian_blur : - ?radius:float -> sigma:float -> unit -> image_handle -> image_handle - val implode : amount:float -> unit -> image_handle -> image_handle - val medianfilter : radius:float -> unit -> image_handle -> image_handle - val motion_blur : - ?radius:float -> - sigma:float -> angle:float -> unit -> image_handle -> image_handle - val oilpaint : radius:float -> unit -> image_handle -> image_handle - val reduce_noise : radius:float -> unit -> image_handle -> image_handle - val roll : x:int -> y:int -> unit -> image_handle -> image_handle - val shade : - ?gray:magick_boolean -> - azimuth:float -> - elevation:float -> unit -> image_handle -> image_handle - val sharpen : - ?radius:float -> sigma:float -> unit -> image_handle -> image_handle - val spread : radius:float -> unit -> image_handle -> image_handle - val swirl : degrees:float -> unit -> image_handle -> image_handle - val unsharpmask : - radius:float -> - sigma:float -> - amount:float -> threshold:float -> unit -> image_handle -> image_handle - val wave : - amplitude:float -> - wave_length:float -> unit -> image_handle -> image_handle - val rotate : degrees:float -> unit -> image_handle -> image_handle - val shear : x:float -> y:float -> unit -> image_handle -> image_handle - val sample : - width:int -> height:int -> unit -> image_handle -> image_handle - val scale : - width:int -> height:int -> unit -> image_handle -> image_handle - val thumbnail : - width:int -> height:int -> unit -> image_handle -> image_handle - val adaptive_threshold : - width:int -> - height:int -> offset:int -> unit -> image_handle -> image_handle - val blur_channel : - channel:channel_type -> - ?radius:float -> sigma:float -> unit -> image_handle -> image_handle - val gaussian_blur_channel : - channel:channel_type -> - ?radius:float -> sigma:float -> unit -> image_handle -> image_handle - val add_noise : - noise_type:noise_type -> unit -> image_handle -> image_handle - val resize : - width:int -> - height:int -> - filter:resize_filter -> - blur:float -> unit -> image_handle -> image_handle - val enhance : unit -> image_handle -> image_handle - val despeckle : unit -> image_handle -> image_handle - val minify : unit -> image_handle -> image_handle - val magnify : unit -> image_handle -> image_handle - val flip : unit -> image_handle -> image_handle - val flop : unit -> image_handle -> image_handle - val splice : - x:int -> - y:int -> - width:int -> height:int -> unit -> image_handle -> image_handle - val crop : - x:int -> - y:int -> - width:int -> height:int -> unit -> image_handle -> image_handle - val affine_transform : - ?tx:float -> - ?ty:float -> - ?sx:float -> - ?sy:float -> - ?rx:float -> ?ry:float -> unit -> image_handle -> image_handle - val negate : - ?grayscale:magick_boolean -> unit -> image_handle -> image_handle - val contrast : - sharpen:magick_boolean -> unit -> image_handle -> image_handle - val equalize : unit -> image_handle -> image_handle - val normalize : unit -> image_handle -> image_handle - val black_threshold : - threshold:string -> unit -> image_handle -> image_handle - val white_threshold : - threshold:string -> unit -> image_handle -> image_handle - val cyclecolormap : displace:int -> unit -> image_handle -> image_handle - val solarize : threshold:float -> unit -> image_handle -> image_handle - val strip : unit -> image_handle -> image_handle - val gamma_channel : - channel:channel_type -> - gamma:float -> unit -> image_handle -> image_handle - val level : levels:string -> unit -> image_handle -> image_handle - val level_channel : - channel:channel_type -> - black_point:float -> - white_point:float -> - gamma:float -> unit -> image_handle -> image_handle - val negate_channel : - channel:channel_type -> - grayscale:magick_boolean -> unit -> image_handle -> image_handle - val ordered_dither : unit -> image_handle -> image_handle - val composite_image : - compose:composite_operator -> - ?x:int -> - ?y:int -> - unit -> - img_below:image_handle -> img_above:image_handle -> image_handle - val texture_image : - img:image_handle -> tex_img:image_handle -> image_handle - val modulate : - ?brightness:int -> - ?saturation:int -> ?hue:int -> unit -> image_handle -> image_handle - val modulate' : factors:string -> unit -> image_handle -> image_handle - val view : unit -> image_handle -> image_handle - end -external get_magick_copyright : unit -> string = "imper_getmagickcopyright" -external get_magick_home_url : unit -> string = "imper_getmagickhomeurl" -external get_magick_release_date : unit -> string - = "imper_getmagickreleasedate" -external get_magick_version : unit -> int * string = "imper_getmagickversion" -external get_magick_quantum_depth : unit -> int * string - = "imper_getmagickquantumdepth" -external get_magick_quantum_range : unit -> int * string - = "imper_getmagickquantumrange" -external get_binding_version : unit -> string = "imper_getbindingversion" -type shared_data = - UI8 of - (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array3.t - | UI16 of - (int, Bigarray.int16_unsigned_elt, Bigarray.c_layout) Bigarray.Array3.t - | UI32 of (int, Bigarray.int32_elt, Bigarray.c_layout) Bigarray.Array3.t - | UI64 of (int, Bigarray.int64_elt, Bigarray.c_layout) Bigarray.Array3.t -external inspect_big_array : ('a, 'b, 'c) Bigarray.Array2.t -> unit - = "ml_big_array_test" -val select : unit -> int -val big_array2_dump : (int, 'a, 'b) Bigarray.Array2.t -> unit -external image_of_bigarray : ('a, 'b, 'c) Bigarray.Array3.t -> image_handle - = "constituteimage_from_big_array_char" -type coords_2d = { x : int; y : int; } -type dimentions = { width : int; height : int; } -type bounding_box = { pos : coords_2d; dims : dimentions; } -type gradient_spreadMethod = Pad_spread | Repeat_spread | Reflect_spread -val _linear_gradient : - width:int -> - height:int -> - a:coords_2d -> - b:coords_2d -> - ?spread_method:gradient_spreadMethod -> - ?bounding_box:bounding_box -> unit -> image_handle -val linear_gradient : - image_handle -> - a:coords_2d -> - b:coords_2d -> - stop:(float * string) list -> - ?matrix:(float * float * float) * (float * float * float) * - (float * float * float) -> - ?spread_method:gradient_spreadMethod -> - ?bounding_box:bounding_box -> unit -> unit diff --git a/mlarg.ml b/mlarg.ml deleted file mode 100644 index 133b615..0000000 --- a/mlarg.ml +++ /dev/null @@ -1,12 +0,0 @@ - -let () = - for i = 1 to pred (Array.length Sys.argv) do - if Sys.argv.(i) = "-pthread" then () - else begin - let arg = Sys.argv.(i) in - match arg.[0], arg.[1] with - | '-', 'l' -> Printf.printf " -cclib %s" arg - | '-', 'L' -> Printf.printf " -ccopt %s" arg - | _ -> () - end - done diff --git a/opam b/opam new file mode 100644 index 0000000..b1dd1b3 --- /dev/null +++ b/opam @@ -0,0 +1,23 @@ +opam-version: "2.0" +authors: ["Florent Monnier"] +maintainer: "https://github.com/fccm/" +license: "Zlib" +homepage: "http://decapode314.free.fr/ocaml/GraphicsMagick/" +doc: "http://decapode314.free.fr/ocaml/GraphicsMagick/doc/" +dev-repo: "git+https://github.com/fccm/ocaml-graphicsmagick.git" +bug-reports: "https://github.com/fccm/ocaml-graphicsmagick/issues" +tags: ["graphics" "2D" "image"] +synopsis: "Bindings for GraphicsMagick" +description: """ +GraphicsMagick Bindings for OCaml. +""" +depends: [ + "ocaml" + "ocamlfind" {build} +] +depexts: [ + ["libgraphicsmagick-dev"] {os-family = "debian"} + ["libgraphicsmagick-devel"] {os-distribution = "mageia"} +] +build: [[make "all" "opt"]] +install: [[make "install"]] diff --git a/src/META b/src/META new file mode 100644 index 0000000..33d4204 --- /dev/null +++ b/src/META @@ -0,0 +1,7 @@ +name = "magick" +description = "OCaml interface for GraphicsMagick" +version = "0.42" +license = "Zlib" +requires = "bigarray" +archive(byte) = "magick.cma" +archive(native) = "magick.cmxa" diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 0000000..e888c6f --- /dev/null +++ b/src/Makefile @@ -0,0 +1,79 @@ +# Copyright (C) 2022 Florent Monnier +# +# Permission is granted to anyone to use this software for any purpose, +# including commercial applications, and to modify it and redistribute it +# freely. +# +# This software is provided "AS-IS", without any express or implied warranty. +# In no event will the authors be held liable for any damages arising from +# the use of this software. + + +# Check the result of the following command to adapt this Makefile +# GraphicsMagick-config --cppflags --ldflags --libs + +# $ GraphicsMagick-config --cppflags +# -I/usr/include/GraphicsMagick + +# $ GraphicsMagick-config --ldflags +# -L/usr/lib -Wl,--as-needed -Wl,--no-undefined -Wl,-z,relro -Wl,-O1 -Wl,--build-id -Wl,--enable-new-dtags -L/usr/lib + +# $ GraphicsMagick-config --libs +# -lGraphicsMagick -llcms2 -lfreetype -lX11 -llzma -lbz2 -lz -lltdl -lm -lpthread + +.PHONY: opt + +all: magick.cma +opt: magick.cmxa + + +magick.cmi: magick.mli + ocamlc -c $< + +magick.cmo: magick.ml magick.cmi + ocamlc -c $< + +magick.cmx: magick.ml magick.cmi + ocamlopt -c $< + +magick.cma: magick.cmo dllmagick_stubs.so + ocamlc -a -o $@ $< \ + -dllib -lmagick_stubs \ + -ccopt -L/usr/lib \ + -cclib -lGraphicsMagick + +magick.cmxa: magick.cmx dllmagick_stubs.so + ocamlopt -a -o $@ $< \ + -cclib -lmagick_stubs \ + -ccopt -L/usr/lib \ + -cclib -lGraphicsMagick + +magick_stubs.o: magick_stubs.c + ocamlc -c -I /usr/include/GraphicsMagick $< + +dllmagick_stubs.so: magick_stubs.o + ocamlmklib -o magick_stubs $< \ + -L/usr/lib \ + -lGraphicsMagick + +.PHONY: install +install: META magick.cma magick.cmxa + ocamlfind install magick META \ + *.cm[ioxa] *.cmx[as] magick.{a,mli} *magick_stubs.{a,so} + +.PHONY: uninstall +uninstall: + ocamlfind remove magick + +.PHONY: doc +doc: magick.mli + mkdir -p doc + ocamldoc -d doc -html magick.mli + +.PHONY: edit +edit: + vim magick.ml magick.mli magick_stubs.c + +clean: + $(RM) *.[oa] *.so *.cm[ixoat] *.cmx[as] + diff --git a/src/magick.ml b/src/magick.ml new file mode 100644 index 0000000..cfc1dfc --- /dev/null +++ b/src/magick.ml @@ -0,0 +1,409 @@ +(* GraphicsMagick bindings for OCaml + * Copyright (C) 2022 Florent Monnier + * + * Permission is granted to anyone to use this software for any + * purpose, including commercial applications, and to modify it + * and redistribute it freely. + *) + +(* GraphicsMagick API documentation: + * http://www.graphicsmagick.org/api/api.html + *) + +external initialize: unit -> unit = "caml_InitializeMagick" +external destroy: unit -> unit = "caml_DestroyMagick" + +type image +type images + +external read_image: filename:string -> image = "caml_ReadImage" +external write_image: image -> filename:string -> unit = "caml_WriteImage" + +external blob_to_image: blob:string -> image = "caml_BlobToImage" + +external get_canvas: width:int -> height:int -> color:string -> image = "caml_CanvasImage" + +external clone: image -> image = "caml_CloneImage" + +external image_width: image -> int = "caml_ImageWidth" +external image_height: image -> int = "caml_ImageHeight" + +external display: image -> unit = "caml_DisplayImages" + +external destroy_image: image -> unit = "caml_DestroyImage" + + +(* effects *) + +external blur: image -> radius:float -> sigma:float -> image = "caml_BlurImage" +external motion_blur: image -> radius:float -> sigma:float -> angle:float -> image = "caml_MotionBlurImage" +external emboss: image -> radius:float -> sigma:float -> image = "caml_EmbossImage" +external sharpen: image -> radius:float -> sigma:float -> image = "caml_SharpenImage" +external edge: image -> radius:float -> image = "caml_EdgeImage" +external enhance: image -> image = "caml_EnhanceImage" +external shade: image -> gray:int -> azimuth:float -> elevation:float -> image = "caml_ShadeImage" + +let blur image ?(radius = 0.0) ~sigma () = + blur image ~radius ~sigma; +;; + + +(* fx *) + +external charcoal: image -> radius:float -> sigma:float -> image = "caml_CharcoalImage" +external implode: image -> amount:float -> image = "caml_ImplodeImage" + +external morph: images -> frames:int -> images = "caml_MorphImages" + +external oil_paint: image -> radius:float -> image = "caml_OilPaintImage" +external swirl: image -> degrees :float -> image = "caml_SwirlImage" + +external wave: image -> amplitude:float -> length:float -> image = "caml_WaveImage" + + +(* enhance *) + +external contrast: image -> sharpen:int -> unit = "caml_ContrastImage" +external equalize: image -> unit = "caml_EqualizeImage" +external gamma: image -> level:string -> unit = "caml_GammaImage" +external level: image -> level:string -> unit = "caml_LevelImage" + +module Channel = struct +type channel_type = + | Undefined + | Red + | Cyan + | Green + | Magenta + | Blue + | Yellow + | Opacity + | Black + | Matte + | All + | Gray +end + +external level_channel: image -> + channel:Channel.channel_type -> + black_point:float -> mid_point:float -> white_point:float -> unit + = "caml_LevelImageChannel" + +external modulate: image -> string -> unit = "caml_ModulateImage" +external negate: image -> int -> unit = "caml_NegateImage" +external normalize: image -> unit = "caml_NormalizeImage" + + +(* transform *) + +external flip: image -> image = "caml_FlipImage" +external flop: image -> image = "caml_FlopImage" + +type rectangle_info = { + x: int; + y: int; + width: int; + height: int; +} + +external crop: image -> rectangle_info -> image = "caml_CropImage" +external shave: image -> rectangle_info -> image = "caml_ShaveImage" + +let shave img (width, height) = + (* x and y are not used *) + shave img { x=0; y=0; width; height }; +;; + +external roll: image -> x_offset:int -> y_offset:int -> image + = "caml_RollImage" + + +(* resize *) + +external sample: image -> width:int -> height:int -> image = "caml_SampleImage" +external scale: image -> width:int -> height:int -> image = "caml_ScaleImage" +external thumbnail: image -> width:int -> height:int -> image = "caml_ThumbnailImage" + +external magnify: image -> image = "caml_MagnifyImage" +external minify: image -> image = "caml_MinifyImage" + + +module Filter = struct +type filter_type = + | Undefined + | DefaultResize + | Point + | Box + | Triangle + | Hermite + | Hanning + | Hamming + | Blackman + | Gaussian + | Quadratic + | Cubic + | Catrom + | Mitchell + | Lanczos + | Bessel + | Sinc +end + +external resize: image -> width:int -> height:int -> filter:Filter.filter_type -> blur:float -> image = "caml_ResizeImage" + +let resize image ~width ~height ?(filter = Filter.DefaultResize) ?(blur=1.0) () = + resize image ~width ~height ~filter ~blur; +;; + + +(* composite *) + +module CompositeOp = struct +type composite_operator = + | Undefined + | Over + | In + | Out + | Atop + | Xor + | Plus + | Minus + | Add + | Subtract + | Difference + | Multiply + | Bumpmap + | Copy + | CopyRed + | CopyGreen + | CopyBlue + | CopyOpacity + | Clear + | Dissolve + | Displace + | Modulate + | Threshold + | No + | Darken + | Lighten + | Hue + | Saturate + | Colorize + | Luminize + | Screen + | Overlay + | CopyCyan + | CopyMagenta + | CopyYellow + | CopyBlack + | Divide + | HardLight + | Exclusion + | ColorDodge + | ColorBurn + | SoftLight + | LinearBurn + | LinearDodge + | LinearLight + | VividLight + | PinLight + | HardMix + +let to_string = function + | Undefined -> "Undefined" + | Over -> "Over" + | In -> "In" + | Out -> "Out" + | Atop -> "Atop" + | Xor -> "Xor" + | Plus -> "Plus" + | Minus -> "Minus" + | Add -> "Add" + | Subtract -> "Subtract" + | Difference -> "Difference" + | Multiply -> "Multiply" + | Bumpmap -> "Bumpmap" + | Copy -> "Copy" + | CopyRed -> "CopyRed" + | CopyGreen -> "CopyGreen" + | CopyBlue -> "CopyBlue" + | CopyOpacity -> "CopyOpacity" + | Clear -> "Clear" + | Dissolve -> "Dissolve" + | Displace -> "Displace" + | Modulate -> "Modulate" + | Threshold -> "Threshold" + | No -> "No" + | Darken -> "Darken" + | Lighten -> "Lighten" + | Hue -> "Hue" + | Saturate -> "Saturate" + | Colorize -> "Colorize" + | Luminize -> "Luminize" + | Screen -> "Screen" + | Overlay -> "Overlay" + | CopyCyan -> "CopyCyan" + | CopyMagenta -> "CopyMagenta" + | CopyYellow -> "CopyYellow" + | CopyBlack -> "CopyBlack" + | Divide -> "Divide" + | HardLight -> "HardLight" + | Exclusion -> "Exclusion" + | ColorDodge -> "ColorDodge" + | ColorBurn -> "ColorBurn" + | SoftLight -> "SoftLight" + | LinearBurn -> "LinearBurn" + | LinearDodge -> "LinearDodge" + | LinearLight -> "LinearLight" + | VividLight -> "VividLight" + | PinLight -> "PinLight" + | HardMix -> "HardMix" + +let of_string = function + | "Undefined" -> Undefined + | "Over" -> Over + | "In" -> In + | "Out" -> Out + | "Atop" -> Atop + | "Xor" -> Xor + | "Plus" -> Plus + | "Minus" -> Minus + | "Add" -> Add + | "Subtract" -> Subtract + | "Difference" -> Difference + | "Multiply" -> Multiply + | "Bumpmap" -> Bumpmap + | "Copy" -> Copy + | "CopyRed" -> CopyRed + | "CopyGreen" -> CopyGreen + | "CopyBlue" -> CopyBlue + | "CopyOpacity" -> CopyOpacity + | "Clear" -> Clear + | "Dissolve" -> Dissolve + | "Displace" -> Displace + | "Modulate" -> Modulate + | "Threshold" -> Threshold + | "No" -> No + | "Darken" -> Darken + | "Lighten" -> Lighten + | "Hue" -> Hue + | "Saturate" -> Saturate + | "Colorize" -> Colorize + | "Luminize" -> Luminize + | "Screen" -> Screen + | "Overlay" -> Overlay + | "CopyCyan" -> CopyCyan + | "CopyMagenta" -> CopyMagenta + | "CopyYellow" -> CopyYellow + | "CopyBlack" -> CopyBlack + | "Divide" -> Divide + | "HardLight" -> HardLight + | "Exclusion" -> Exclusion + | "ColorDodge" -> ColorDodge + | "ColorBurn" -> ColorBurn + | "SoftLight" -> SoftLight + | "LinearBurn" -> LinearBurn + | "LinearDodge" -> LinearDodge + | "LinearLight" -> LinearLight + | "VividLight" -> VividLight + | "PinLight" -> PinLight + | "HardMix" -> HardMix + | _ -> invalid_arg "Magick.CompositeOp.of_string" + +end + +external composite: image -> CompositeOp.composite_operator -> image -> x_offset:int -> y_offset:int -> unit = "caml_CompositeImage" + +let composite image1 ~compose image2 ?(x_offset=0) ?(y_offset=0) () = + composite image1 compose image2 ~x_offset ~y_offset; +;; + + +(* image list *) + +module ImgList = struct + +type img_list = images + +external new_image_list: unit -> img_list = "caml_NewImageList" + +external destroy_image_list: img_list -> unit = "caml_DestroyImageList" + +external append_image: img_list -> image -> img_list = "caml_AppendImageToList" + +external prepend_image: img_list -> image -> img_list = "caml_PrependImageToList" + +external get_first_image: img_list -> image = "caml_GetFirstImageInList" + +external get_image: img_list -> offset:int -> image = "caml_GetImageFromList" + +external length: img_list -> int = "caml_GetImageListLength" + +external get_index: img_list -> int = "caml_GetImageIndexInList" + +end + + +(* draw *) + +module Draw = struct + +type context + +external allocate_context: image -> context + = "caml_DrawAllocateContext" + +external destroy_context: context -> unit + = "caml_DrawDestroyContext" + +external stroke_color_string: context -> string -> unit + = "caml_DrawSetStrokeColorString" + +external fill_color_string: context -> string -> unit + = "caml_DrawSetFillColorString" + +external stroke_width: context -> float -> unit + = "caml_DrawSetStrokeWidth" + +external circle: context -> ox:float -> oy:float -> px:float -> py:float -> unit + = "caml_DrawCircle" + +external rectangle: context -> x1:float -> y1:float -> x2:float -> y2:float -> unit + = "caml_DrawRectangle" + +external round_rectangle: context -> p1:float * float -> p2:float * float -> r:float * float -> unit + = "caml_DrawRoundRectangle" + +external line: context -> x1:float -> y1:float -> x2:float -> y2:float -> unit + = "caml_DrawLine" + +external arc: context -> p1:float * float -> p2:float * float -> rot:float * float -> unit + = "caml_DrawArc" + +external ellipse: context -> o:float * float -> r:float * float -> rot:float * float -> unit + = "caml_DrawEllipse" + +external bezier: context -> coords:(float * float) array -> unit + = "caml_DrawBezier" + +external render: context -> unit + = "caml_DrawRender" + +end + + +(* describe *) + +external describe: image -> unit = "caml_DescribeImage" + + +(* attribute *) + +external set_image_attribute: image -> key:string -> value:string -> unit + = "caml_SetImageAttribute" + +external get_image_attribute: image -> key:string -> string + = "caml_GetImageAttribute" + +(* vim: sw=2 ts=2 sts=2 et + *) diff --git a/src/magick.mli b/src/magick.mli new file mode 100644 index 0000000..aa2123a --- /dev/null +++ b/src/magick.mli @@ -0,0 +1,326 @@ +(** GraphicsMagick bindings for OCaml *) +(* Copyright (C) 2022 Florent Monnier + * + * Permission is granted to anyone to use this software for any + * purpose, including commercial applications, and to modify it + * and redistribute it freely. + *) + +(** {{:http://www.graphicsmagick.org/api/api.html} + GraphicsMagick API documentation} *) + +external initialize: unit -> unit = "caml_InitializeMagick" +external destroy: unit -> unit = "caml_DestroyMagick" + +type image +type images + +external read_image: filename:string -> image = "caml_ReadImage" +external write_image: image -> filename:string -> unit = "caml_WriteImage" + +external blob_to_image: blob:string -> image = "caml_BlobToImage" + +external get_canvas: width:int -> height:int -> color:string -> image = "caml_CanvasImage" + +external clone: image -> image = "caml_CloneImage" + +external image_width: image -> int = "caml_ImageWidth" +external image_height: image -> int = "caml_ImageHeight" + +external display: image -> unit = "caml_DisplayImages" + +external destroy_image: image -> unit = "caml_DestroyImage" + + +(** {3 Effects} *) + +(** {{:http://www.graphicsmagick.org/api/effect.html}api doc} *) + +val blur: image -> ?radius:float -> sigma:float -> unit -> image + +external motion_blur: image -> radius:float -> sigma:float -> angle:float -> image + = "caml_MotionBlurImage" + +external emboss: image -> radius:float -> sigma:float -> image + = "caml_EmbossImage" + +external sharpen: image -> radius:float -> sigma:float -> image + = "caml_SharpenImage" + +external edge: image -> radius:float -> image = "caml_EdgeImage" + +external enhance: image -> image = "caml_EnhanceImage" + +external shade: image -> gray:int -> azimuth:float -> elevation:float -> image + = "caml_ShadeImage" + + +(** {3 FX} *) + +(** {{:http://www.graphicsmagick.org/api/fx.html}api doc} *) + +external charcoal: image -> radius:float -> sigma:float -> image = "caml_CharcoalImage" +external implode: image -> amount:float -> image = "caml_ImplodeImage" + +external morph: images -> frames:int -> images = "caml_MorphImages" + +external oil_paint: image -> radius:float -> image = "caml_OilPaintImage" +external swirl: image -> degrees:float -> image = "caml_SwirlImage" + +external wave: image -> amplitude:float -> length:float -> image = "caml_WaveImage" + + +(** {3 Enhance} *) + +(** {{:http://www.graphicsmagick.org/api/enhance.html}api doc} *) + +external contrast: image -> sharpen:int -> unit = "caml_ContrastImage" +external equalize: image -> unit = "caml_EqualizeImage" +external gamma: image -> level:string -> unit = "caml_GammaImage" +external level: image -> level:string -> unit = "caml_LevelImage" + +module Channel: sig + type channel_type = + | Undefined + | Red + | Cyan + | Green + | Magenta + | Blue + | Yellow + | Opacity + | Black + | Matte + | All + | Gray +end + +external level_channel: image -> channel:Channel.channel_type -> + black_point:float -> mid_point:float -> white_point:float -> unit + = "caml_LevelImageChannel" + +external modulate: image -> string -> unit = "caml_ModulateImage" + +external negate: image -> int -> unit = "caml_NegateImage" + +external normalize: image -> unit = "caml_NormalizeImage" + + +(** {3 Transform} *) + +(** {{:http://www.graphicsmagick.org/api/transform.html}api doc} *) + +external flip: image -> image = "caml_FlipImage" +external flop: image -> image = "caml_FlopImage" + +type rectangle_info = { x: int; y: int; width: int; height: int; } + +external crop: image -> rectangle_info -> image = "caml_CropImage" + +val shave: image -> int * int -> image + +external roll: image -> x_offset:int -> y_offset:int -> image + = "caml_RollImage" + + +(** {3 Resize} *) + +(** {{:http://www.graphicsmagick.org/api/resize.html}api doc} *) + +external sample: image -> width:int -> height:int -> image + = "caml_SampleImage" + +external scale: image -> width:int -> height:int -> image + = "caml_ScaleImage" + +external thumbnail: image -> width:int -> height:int -> image + = "caml_ThumbnailImage" + +external magnify: image -> image = "caml_MagnifyImage" +external minify: image -> image = "caml_MinifyImage" + + +module Filter: sig + type filter_type = + | Undefined + | DefaultResize + | Point + | Box + | Triangle + | Hermite + | Hanning + | Hamming + | Blackman + | Gaussian + | Quadratic + | Cubic + | Catrom + | Mitchell + | Lanczos + | Bessel + | Sinc +end + +val resize: image -> width:int -> height:int -> + ?filter:Filter.filter_type -> ?blur:float -> unit -> image + + +(** {3 Composite} *) + +module CompositeOp: sig + (** {4 Composite Operator} *) + + (** {{:http://www.graphicsmagick.org/api/types.html#compositeoperator} + composite-operator api doc} *) + type composite_operator = + | Undefined + | Over + | In + | Out + | Atop + | Xor + | Plus + | Minus + | Add + | Subtract + | Difference + | Multiply + | Bumpmap + | Copy + | CopyRed + | CopyGreen + | CopyBlue + | CopyOpacity + | Clear + | Dissolve + | Displace + | Modulate + | Threshold + | No + | Darken + | Lighten + | Hue + | Saturate + | Colorize + | Luminize + | Screen + | Overlay + | CopyCyan + | CopyMagenta + | CopyYellow + | CopyBlack + | Divide + | HardLight + | Exclusion + | ColorDodge + | ColorBurn + | SoftLight + | LinearBurn + | LinearDodge + | LinearLight + | VividLight + | PinLight + | HardMix + + val to_string: composite_operator -> string + val of_string: string -> composite_operator +end + +val composite: image -> compose:CompositeOp.composite_operator -> + image -> ?x_offset:int -> ?y_offset:int -> unit -> unit +(** {{:http://www.graphicsmagick.org/api/composite.html}api doc} *) + + +(** {3 Image Lists} *) + +module ImgList: sig + (** {3 Image Lists} *) + + (** {{:http://www.graphicsmagick.org/api/list.html}api doc} *) + + type img_list = images + + external new_image_list: unit -> img_list = "caml_NewImageList" + external destroy_image_list: img_list -> unit = "caml_DestroyImageList" + + external append_image: img_list -> image -> img_list + = "caml_AppendImageToList" + + external prepend_image: img_list -> image -> img_list + = "caml_PrependImageToList" + + external get_first_image: img_list -> image = "caml_GetFirstImageInList" + + external get_image: img_list -> offset:int -> image + = "caml_GetImageFromList" + + external length: img_list -> int = "caml_GetImageListLength" + + external get_index: img_list -> int = "caml_GetImageIndexInList" +end + + +(** {3 Draw} *) + +module Draw: sig + (** {3 Draw} *) + + (** {{:http://www.graphicsmagick.org/api/draw.html}api doc} *) + + type context + + external allocate_context: image -> context = "caml_DrawAllocateContext" + + external destroy_context: context -> unit = "caml_DrawDestroyContext" + + external stroke_color_string: context -> string -> unit + = "caml_DrawSetStrokeColorString" + + external fill_color_string: context -> string -> unit + = "caml_DrawSetFillColorString" + + external stroke_width: context -> float -> unit + = "caml_DrawSetStrokeWidth" + + external circle: context -> ox:float -> oy:float -> px:float -> py:float -> unit + = "caml_DrawCircle" + + external line: context -> x1:float -> y1:float -> x2:float -> y2:float -> unit + = "caml_DrawLine" + + external rectangle: context -> x1:float -> y1:float -> x2:float -> y2:float -> unit + = "caml_DrawRectangle" + + external round_rectangle: context -> p1:float * float -> p2:float * float -> r:float * float -> unit + = "caml_DrawRoundRectangle" + + external arc: context -> p1:float * float -> p2:float * float -> rot:float * float -> unit + = "caml_DrawArc" + + external ellipse: context -> o:float * float -> r:float * float -> rot:float * float -> unit + = "caml_DrawEllipse" + + external bezier: context -> coords:(float * float) array -> unit + = "caml_DrawBezier" + + external render: context -> unit + = "caml_DrawRender" +end + + +(** {3 Describe} *) + +external describe: image -> unit = "caml_DescribeImage" +(** {{:http://www.graphicsmagick.org/api/describe.html}api doc} *) + + +(** {3 Attributes} *) + +(** {{:http://www.graphicsmagick.org/api/attribute.html}api doc} *) + +external set_image_attribute: image -> key:string -> value:string -> unit + = "caml_SetImageAttribute" + +external get_image_attribute: image -> key:string -> string + = "caml_GetImageAttribute" + diff --git a/src/magick_stubs.c b/src/magick_stubs.c new file mode 100644 index 0000000..8c09598 --- /dev/null +++ b/src/magick_stubs.c @@ -0,0 +1,1159 @@ +/* Copyright (C) 2022 Florent Monnier + * + * Permission is granted to anyone to use this software for any purpose, + * including commercial applications, and to modify it and redistribute it + * freely. + * + * This software is provided "AS-IS", without any express or implied warranty. + * In no event will the authors be held liable for any damages arising from + * the use of this software. + */ + +#include +#include +#include +#include +#include + +#include + +#include +#include +#include +#include +#include + + +CAMLprim value +caml_InitializeMagick(value unit) +{ + InitializeMagick(NULL); + return Val_unit; +} + +CAMLprim value +caml_DestroyMagick(value unit) +{ + DestroyMagick(); + return Val_unit; +} + +#if 1 + +static value Val_Image(Image *img) +{ + value v = caml_alloc(1, Abstract_tag); + *((Image **) Data_abstract_val(v)) = img; + return v; +} + +static Image * Image_val(value v) +{ + return *((Image **) Data_abstract_val(v)); +} + +#else + +static value Val_Image(Image *img) +{ + return caml_copy_nativeint((intnat) img); +} + +static Image * Image_val(value v) +{ + return (Image *) Nativeint_val(v); +} +#endif + + +CAMLprim value +caml_ReadImage(value img_filename) +{ + CAMLparam1(img_filename); + + Image *image = (Image *) NULL; + char infile[MaxTextExtent]; + ImageInfo *imageInfo; + ExceptionInfo exception; + + imageInfo = CloneImageInfo((ImageInfo *) NULL); + GetExceptionInfo(&exception); + + (void) strncpy(infile, String_val(img_filename), MaxTextExtent-1); + (void) strcpy(imageInfo->filename, infile); + + image = ReadImage(imageInfo, &exception); + + if (imageInfo != (ImageInfo *) NULL) + DestroyImageInfo(imageInfo); + + if (image == (Image *) NULL) + { + CatchException(&exception); + DestroyExceptionInfo(&exception); + caml_failwith("Magick.read_image"); + } + + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_CanvasImage(value width, value height, value color) +{ + CAMLparam3(width, height, color); + + Image *image = (Image *) NULL; + char sbuf[MaxTextExtent]; + unsigned int str_len; + ImageInfo *imageInfo; + ExceptionInfo exception; + + imageInfo = CloneImageInfo((ImageInfo *) NULL); + GetExceptionInfo(&exception); + + /* give image size */ + str_len = snprintf(sbuf, MaxTextExtent, "%ldx%ld", Long_val(width), Long_val(height)); + (void) CloneString(&imageInfo->size, sbuf); + + /* give image color */ + str_len = snprintf(sbuf, MaxTextExtent, "xc:%s", String_val(color)); + strncpy(imageInfo->filename, sbuf, str_len); + + image = ReadImage(imageInfo, &exception); + + if (imageInfo != (ImageInfo *) NULL) + DestroyImageInfo(imageInfo); + + if (image == (Image *) NULL) + { + CatchException(&exception); + DestroyExceptionInfo(&exception); + caml_failwith("Magick.canvas_image"); + } + + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_WriteImage(value _image, value out_filename) +{ + CAMLparam2(_image, out_filename); + + Image *image = (Image *) NULL; + char outfile[MaxTextExtent]; + ImageInfo *imageInfo; + ExceptionInfo exception; + + imageInfo = CloneImageInfo((ImageInfo *) NULL); + GetExceptionInfo(&exception); + + image = Image_val(_image); + + (void) strncpy(outfile, String_val(out_filename), MaxTextExtent-1); + + (void) strcpy(image->filename, outfile); + + if (!WriteImage(imageInfo, image)) + { + CatchException(&image->exception); + if (image != (Image *) NULL) DestroyImage(image); + if (imageInfo != (ImageInfo *) NULL) DestroyImageInfo(imageInfo); + caml_failwith("Magick.write_image"); + } + + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_BlobToImage(value blob) +{ + CAMLparam1(blob); + + Image *image = (Image *) NULL; + ImageInfo *imageInfo; + ExceptionInfo exception; + + imageInfo = CloneImageInfo((ImageInfo *) NULL); + GetExceptionInfo(&exception); + + image = BlobToImage(imageInfo, String_val(blob), caml_string_length(blob), &exception); + + if (imageInfo != (ImageInfo *) NULL) + DestroyImageInfo(imageInfo); + + if (image == (Image *) NULL) + { + CatchException(&exception); + DestroyExceptionInfo(&exception); + caml_failwith("Magick.blob_to_image"); + } + + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_ImageWidth(value _image) +{ + CAMLparam1(_image); + Image *image = Image_val(_image); + CAMLreturn(Val_int(image->columns)); +} + +CAMLprim value +caml_ImageHeight(value _image) +{ + CAMLparam1(_image); + Image *image = Image_val(_image); + CAMLreturn(Val_int(image->rows)); +} + +CAMLprim value +caml_DisplayImages(value _image) +{ + CAMLparam1(_image); + + Image *image = (Image *) NULL; + image = Image_val(_image); + + ImageInfo *imageInfo = CloneImageInfo((ImageInfo *) NULL); + + if (!DisplayImages(imageInfo, image)) + { + CatchException(&image->exception); + DestroyImageInfo(imageInfo); + caml_failwith("Magick.display"); + } + DestroyImageInfo(imageInfo); + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_DestroyImage(value _image) +{ + CAMLparam1(_image); + + DestroyImage(Image_val(_image)); + + CAMLreturn(Val_unit); +} + +CAMLprim value +caml_CloneImage(value _image) +{ + CAMLparam1(_image); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = CloneImage(Image_val(_image), 0, 0, 1, &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.clone"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_BlurImage(value _image, value radius, value sigma) +{ + CAMLparam3(_image, radius, sigma); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = BlurImage(Image_val(_image), Double_val(radius), Double_val(sigma), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.blur"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_MotionBlurImage(value _image, value radius, value sigma, value angle) +{ + CAMLparam4(_image, radius, sigma, angle); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = MotionBlurImage(Image_val(_image), + Double_val(radius), Double_val(sigma), Double_val(angle), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.motion_blur"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_EmbossImage(value _image, value radius, value sigma) +{ + CAMLparam3(_image, radius, sigma); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = EmbossImage(Image_val(_image), Double_val(radius), Double_val(sigma), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.emboss"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_SharpenImage(value _image, value radius, value sigma) +{ + CAMLparam3(_image, radius, sigma); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = SharpenImage(Image_val(_image), Double_val(radius), Double_val(sigma), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.sharpen"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_ShadeImage(value _image, value gray, value azimuth, value elevation) +{ + CAMLparam4(_image, gray, azimuth, elevation); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = ShadeImage(Image_val(_image), Int_val(gray), Double_val(azimuth), Double_val(elevation), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.shade"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_EdgeImage(value _image, value radius) +{ + CAMLparam2(_image, radius); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = EdgeImage(Image_val(_image), Double_val(radius), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.edge"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_CharcoalImage(value _image, value radius, value sigma) +{ + CAMLparam3(_image, radius, sigma); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = CharcoalImage(Image_val(_image), Double_val(radius), Double_val(sigma), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.charcoal"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_ImplodeImage(value _image, value amount) +{ + CAMLparam2(_image, amount); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = ImplodeImage(Image_val(_image), Double_val(amount), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.implode"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_MorphImages(value _image, value number_frames) +{ + CAMLparam2(_image, number_frames); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = MorphImages(Image_val(_image), Long_val(number_frames), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.morph"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_OilPaintImage(value _image, value radius) +{ + CAMLparam2(_image, radius); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = OilPaintImage(Image_val(_image), Double_val(radius), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.oil_paint"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_SwirlImage(value _image, value degrees) +{ + CAMLparam2(_image, degrees); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = SwirlImage(Image_val(_image), Double_val(degrees), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.swirl"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_WaveImage(value _image, value amplitude, value length) +{ + CAMLparam3(_image, amplitude, length); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = WaveImage(Image_val(_image), Double_val(amplitude), Double_val(length), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.wave"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_EnhanceImage(value _image) +{ + CAMLparam1(_image); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = EnhanceImage(Image_val(_image), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.enhance"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_ContrastImage(value image, value sharpen) +{ + ContrastImage(Image_val(image), Int_val(sharpen)); + return Val_unit; +} + +CAMLprim value +caml_EqualizeImage(value image) +{ + EqualizeImage(Image_val(image)); + return Val_unit; +} + +CAMLprim value +caml_GammaImage(value image, value level) +{ + GammaImage(Image_val(image), String_val(level)); + return Val_unit; +} + +CAMLprim value +caml_LevelImage(value image, value level) +{ + LevelImage(Image_val(image), String_val(level)); + return Val_unit; +} + +static const ChannelType channeltype_table[] = { + UndefinedChannel, + RedChannel, + CyanChannel, + GreenChannel, + MagentaChannel, + BlueChannel, + YellowChannel, + OpacityChannel, + BlackChannel, + MatteChannel, + AllChannels, + GrayChannel +}; + +#define ChannelType_val(i) (channeltype_table[Int_val(i)]) + +CAMLprim value +caml_LevelImageChannel(value image, value channel, + value black_point, value mid_point, value white_point) +{ + LevelImageChannel( + Image_val(image), + ChannelType_val(channel), + Double_val(black_point), + Double_val(mid_point), + Double_val(white_point) ); + + return Val_unit; +} + +CAMLprim value +caml_ModulateImage(value image, value modulate) +{ + ModulateImage(Image_val(image), String_val(modulate)); + return Val_unit; +} + +CAMLprim value +caml_NegateImage(value image, value grayscale) +{ + NegateImage(Image_val(image), Int_val(grayscale)); + return Val_unit; +} + +CAMLprim value +caml_NormalizeImage(value image) +{ + NormalizeImage(Image_val(image)); + return Val_unit; +} + +CAMLprim value +caml_FlipImage(value _image) +{ + CAMLparam1(_image); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = FlipImage(Image_val(_image), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.flip"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_FlopImage(value _image) +{ + CAMLparam1(_image); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = FlopImage(Image_val(_image), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.flop"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_CropImage(value _image, value _geometry) +{ + CAMLparam2(_image, _geometry); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + RectangleInfo geometry; + geometry.x = Int_val(Field(_geometry, 0)); + geometry.y = Int_val(Field(_geometry, 1)); + geometry.width = Int_val(Field(_geometry, 2)); + geometry.height = Int_val(Field(_geometry, 3)); + + Image *image = (Image *) NULL; + image = CropImage(Image_val(_image), &geometry, &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.crop"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_ShaveImage(value _image, value _shave_info) +{ + CAMLparam2(_image, _shave_info); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + RectangleInfo shave_info; + shave_info.x = Int_val(Field(_shave_info, 0)); + shave_info.y = Int_val(Field(_shave_info, 1)); + shave_info.width = Int_val(Field(_shave_info, 2)); + shave_info.height = Int_val(Field(_shave_info, 3)); + + Image *image = (Image *) NULL; + image = ShaveImage(Image_val(_image), &shave_info, &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.shave"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_RollImage(value _image, value x_offset, value y_offset) +{ + CAMLparam3(_image, x_offset, y_offset); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = RollImage(Image_val(_image), Long_val(x_offset), Long_val(y_offset), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.roll"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_MagnifyImage(value _image) +{ + CAMLparam1(_image); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = MagnifyImage(Image_val(_image), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.magnify"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_MinifyImage(value _image) +{ + CAMLparam1(_image); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = MinifyImage(Image_val(_image), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.minify"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_SampleImage(value _image, value width, value height) +{ + CAMLparam3(_image, width, height); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = SampleImage(Image_val(_image), Int_val(width), Int_val(height), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.sample"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_ScaleImage(value _image, value width, value height) +{ + CAMLparam3(_image, width, height); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = ScaleImage(Image_val(_image), Int_val(width), Int_val(height), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.scale"); + } + CAMLreturn(Val_Image(image)); +} + +CAMLprim value +caml_ThumbnailImage(value _image, value width, value height) +{ + CAMLparam3(_image, width, height); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + Image *image = (Image *) NULL; + image = ThumbnailImage(Image_val(_image), Int_val(width), Int_val(height), &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.thumbnail"); + } + CAMLreturn(Val_Image(image)); +} + +static const FilterTypes filtertypes_table[] = { + UndefinedFilter, + DefaultResizeFilter, + PointFilter, + BoxFilter, + TriangleFilter, + HermiteFilter, + HanningFilter, + HammingFilter, + BlackmanFilter, + GaussianFilter, + QuadraticFilter, + CubicFilter, + CatromFilter, + MitchellFilter, + LanczosFilter, + BesselFilter, + SincFilter +}; + +CAMLprim value +caml_ResizeImage(value _image, value width, value height, value _filter, value _blur) +{ + CAMLparam5(_image, width, height, _filter, _blur); + + ExceptionInfo exception; + GetExceptionInfo(&exception); + + FilterTypes filter = filtertypes_table[Int_val(_filter)]; + double blur = Double_val(_blur); + + Image *image = (Image *) NULL; + image = ResizeImage(Image_val(_image), Int_val(width), Int_val(height), + filter, blur, &exception); + + if (image == (Image *) NULL) + { + CatchException(&exception); + caml_failwith("Magick.resize"); + } + CAMLreturn(Val_Image(image)); +} + +static const CompositeOperator compositeoperator_table[] = { + UndefinedCompositeOp, + OverCompositeOp, + InCompositeOp, + OutCompositeOp, + AtopCompositeOp, + XorCompositeOp, + PlusCompositeOp, + MinusCompositeOp, + AddCompositeOp, + SubtractCompositeOp, + DifferenceCompositeOp, + MultiplyCompositeOp, + BumpmapCompositeOp, + CopyCompositeOp, + CopyRedCompositeOp, + CopyGreenCompositeOp, + CopyBlueCompositeOp, + CopyOpacityCompositeOp, + ClearCompositeOp, + DissolveCompositeOp, + DisplaceCompositeOp, + ModulateCompositeOp, + ThresholdCompositeOp, + NoCompositeOp, + DarkenCompositeOp, + LightenCompositeOp, + HueCompositeOp, + SaturateCompositeOp, + ColorizeCompositeOp, + LuminizeCompositeOp, + ScreenCompositeOp, + OverlayCompositeOp, + CopyCyanCompositeOp, + CopyMagentaCompositeOp, + CopyYellowCompositeOp, + CopyBlackCompositeOp, + DivideCompositeOp, + HardLightCompositeOp, + ExclusionCompositeOp, + ColorDodgeCompositeOp, + ColorBurnCompositeOp, + SoftLightCompositeOp, + LinearBurnCompositeOp, + LinearDodgeCompositeOp, + LinearLightCompositeOp, + VividLightCompositeOp, + PinLightCompositeOp, + HardMixCompositeOp +}; + +CAMLprim value +caml_CompositeImage(value _image1, value compOp, value _image2, value x_offset, value y_offset) +{ + CAMLparam5(_image1, compOp, _image2, x_offset, y_offset); + + CompositeOperator compose = compositeoperator_table[Int_val(compOp)]; + + if (!CompositeImage(Image_val(_image1), compose, Image_val(_image2), + Int_val(x_offset), Int_val(y_offset))) + { + caml_failwith("Magick.composite"); + } + CAMLreturn(Val_unit); +} + +/* Image List */ + +CAMLprim value +caml_NewImageList(value unit) +{ + Image *image = NewImageList(); + return Val_Image(image); +} + +CAMLprim value +caml_DestroyImageList(value image) +{ + DestroyImageList(Image_val(image)); + return Val_unit; +} + +CAMLprim value +caml_AppendImageToList(value _images, value image) +{ + Image * images = Image_val(_images); + AppendImageToList(&images, Image_val(image)); + return Val_Image(images); +} + +CAMLprim value +caml_PrependImageToList(value _images, value image) +{ + Image * images = Image_val(_images); + PrependImageToList(&images, Image_val(image)); + return Val_Image(images); +} + +CAMLprim value +caml_GetFirstImageInList(value imageList) +{ + Image *image = GetFirstImageInList(Image_val(imageList)); + return Val_Image(image); +} + +CAMLprim value +caml_GetImageFromList(value imageList, value offset) +{ + Image *image = GetImageFromList(Image_val(imageList), Long_val(offset)); + return Val_Image(image); +} + +CAMLprim value +caml_GetImageListLength(value images) +{ + unsigned long length = GetImageListLength(Image_val(images)); + return Val_long(length); +} + +CAMLprim value +caml_GetImageIndexInList(value images) +{ + long index = GetImageIndexInList(Image_val(images)); + return Val_long(index); +} + +/* */ + +static value Val_DrawContext(DrawContext ctx) +{ + value v = caml_alloc(1, Abstract_tag); + *((DrawContext *) Data_abstract_val(v)) = ctx; + return v; +} + +static DrawContext DrawContext_val(value v) +{ + return *((DrawContext *) Data_abstract_val(v)); +} + +CAMLprim value +caml_DrawAllocateContext(value image) +{ + DrawInfo *draw_info = NULL; + + DrawContext ctx = + DrawAllocateContext(draw_info, Image_val(image)); + + return Val_DrawContext(ctx); +} + +CAMLprim value +caml_DrawDestroyContext(value context) +{ + DrawDestroyContext(DrawContext_val(context)); + return Val_unit; +} + +CAMLprim value +caml_DrawSetStrokeColorString(value context, value stroke_color) +{ + DrawSetStrokeColorString(DrawContext_val(context), String_val(stroke_color)); + return Val_unit; +} + +CAMLprim value +caml_DrawSetFillColorString(value context, value fill_color) +{ + DrawSetFillColorString(DrawContext_val(context), String_val(fill_color)); + return Val_unit; +} + +CAMLprim value +caml_DrawSetStrokeWidth(value context, value width) +{ + DrawSetStrokeWidth(DrawContext_val(context), Double_val(width)); + return Val_unit; +} + +CAMLprim value +caml_DrawCircle(value context, value ox, value oy, value px, value py) +{ + DrawCircle( + DrawContext_val(context), + Double_val(ox), Double_val(oy), + Double_val(px), Double_val(py)); + + return Val_unit; +} + +CAMLprim value +caml_DrawLine(value context, value x1, value y1, value x2, value y2) +{ + DrawLine( + DrawContext_val(context), + Double_val(x1), Double_val(y1), + Double_val(x2), Double_val(y2)); + + return Val_unit; +} + +CAMLprim value +caml_DrawRectangle(value context, value x1, value y1, value x2, value y2) +{ + DrawRectangle( + DrawContext_val(context), + Double_val(x1), Double_val(y1), + Double_val(x2), Double_val(y2)); + + return Val_unit; +} + +CAMLprim value +caml_DrawRoundRectangle(value context, value p1, value p2, value r) +{ + DrawRoundRectangle( + DrawContext_val(context), + Double_val(Field(p1,0)), Double_val(Field(p1,1)), + Double_val(Field(p2,0)), Double_val(Field(p2,1)), + Double_val(Field(r,0)), Double_val(Field(r,1))); + + return Val_unit; +} + +CAMLprim value +caml_DrawArc(value context, value p1, value p2, value rot) +{ + double sx = Double_val(Field(p1, 0)); + double sy = Double_val(Field(p1, 1)); + double ex = Double_val(Field(p2, 0)); + double ey = Double_val(Field(p2, 1)); + double sd = Double_val(Field(rot, 0)); + double ed = Double_val(Field(rot, 1)); + + DrawArc( + DrawContext_val(context), + sx, sy, ex, ey, sd, ed); + + return Val_unit; +} + +CAMLprim value +caml_DrawEllipse(value context, value o, value r, value rot) +{ + double ox = Double_val(Field(o, 0)); + double oy = Double_val(Field(o, 1)); + double rx = Double_val(Field(r, 0)); + double ry = Double_val(Field(r, 1)); + double st = Double_val(Field(rot, 0)); + double en = Double_val(Field(rot, 1)); + + DrawEllipse( + DrawContext_val(context), + ox, oy, rx, ry, st, en); + + return Val_unit; +} + +CAMLprim value +caml_DrawBezier(value context, value coords) +{ + unsigned long num_coords, i; + PointInfo * coordinates; + + num_coords = Wosize_val(coords); + coordinates = malloc(sizeof(PointInfo) * num_coords); + + for (i = 0; i < num_coords; i++) + { + value pnt = Field(coords, i); + + coordinates[i].x = Double_val(Field(pnt, 0)); + coordinates[i].y = Double_val(Field(pnt, 1)); + } + + DrawBezier(DrawContext_val(context), num_coords, coordinates); + + free(coordinates); + + return Val_unit; +} + +CAMLprim value +caml_DrawRender(value context) +{ + DrawRender(DrawContext_val(context)); + return Val_unit; +} + +CAMLprim value +caml_DescribeImage(value image) +{ + DescribeImage(Image_val(image), stdout, MagickTrue); + return Val_unit; +} + +CAMLprim value +caml_SetImageAttribute(value image, value key, value value) +{ + MagickPassFail r; + r = SetImageAttribute(Image_val(image), String_val(key), String_val(value)); + if (r == MagickFail) + { + caml_failwith("Magick.set_image_attribute"); + } + return Val_unit; +} + +CAMLprim value +caml_GetImageAttribute(value image, value key) +{ + CAMLparam2(image, key); + CAMLlocal1(attr); + + const ImageAttribute *imgAttr; + + imgAttr = GetImageAttribute(Image_val(image), String_val(key)); + + if (imgAttr == NULL) { + caml_failwith("Magick.get_image_attribute"); + } else { + attr = caml_alloc_initialized_string(imgAttr->length, imgAttr->value); + } + + CAMLreturn(attr); +} + +/* vim: sw=4 ts=4 sts=4 et + */ diff --git a/test/Makefile b/test/Makefile new file mode 100644 index 0000000..ce2c2f7 --- /dev/null +++ b/test/Makefile @@ -0,0 +1,6 @@ +all: + sh test.sh + +clean: + $(RM) _out.* + $(RM) _lst.gif diff --git a/test/image.png b/test/image.png new file mode 100644 index 0000000..17b92eb Binary files /dev/null and b/test/image.png differ diff --git a/test/image.svg b/test/image.svg new file mode 100644 index 0000000..197f339 --- /dev/null +++ b/test/image.svg @@ -0,0 +1,14 @@ + + + +OCaml +GraphicsMagick + + diff --git a/test/test.sh b/test/test.sh new file mode 100644 index 0000000..6bb1cbd --- /dev/null +++ b/test/test.sh @@ -0,0 +1,41 @@ +ocaml -I ../src magick.cma test00.ml && echo "test 00: OK!" || echo "test 00: Arg" +ocaml -I ../src magick.cma test01.ml && echo "test 01: OK!" || echo "test 01: Arg" +ocaml -I ../src magick.cma test02.ml && echo "test 02: OK!" || echo "test 02: Arg" +ocaml -I ../src magick.cma test03.ml && echo "test 03: Arg" || echo "test 03: OK!" +ocaml -I ../src magick.cma test04.ml && echo "test 04: Arg" || echo "test 04: OK!" +ocaml -I ../src magick.cma test05.ml && echo "test 05: OK!" || echo "test 05: Arg" +ocaml -I ../src magick.cma test06.ml && echo "test 06: OK!" || echo "test 06: Arg" +ocaml -I ../src magick.cma test07.ml && echo "test 07: OK!" || echo "test 07: Arg" +ocaml -I ../src magick.cma test08.ml && echo "test 08: OK!" || echo "test 08: Arg" +ocaml -I ../src magick.cma test09.ml && echo "test 09: OK!" || echo "test 09: Arg" +ocaml -I ../src magick.cma test10.ml && echo "test 10: OK!" || echo "test 10: Arg" +ocaml -I ../src magick.cma test11.ml && echo "test 11: OK!" || echo "test 11: Arg" +ocaml -I ../src magick.cma test12.ml && echo "test 12: OK!" || echo "test 12: Arg" +ocaml -I ../src magick.cma test13.ml && echo "test 13: OK!" || echo "test 13: Arg" +ocaml -I ../src magick.cma test14.ml && echo "test 14: OK!" || echo "test 14: Arg" +ocaml -I ../src magick.cma test15.ml && echo "test 15: OK!" || echo "test 15: Arg" +ocaml -I ../src magick.cma test16.ml && echo "test 16: OK!" || echo "test 16: Arg" +ocaml -I ../src magick.cma test17.ml && echo "test 17: OK!" || echo "test 17: Arg" +ocaml -I ../src magick.cma test18.ml && echo "test 18: OK!" || echo "test 18: Arg" +ocaml -I ../src magick.cma test19.ml && echo "test 19: OK!" || echo "test 19: Arg" +ocaml -I ../src magick.cma test20.ml && echo "test 20: OK!" || echo "test 20: Arg" +ocaml -I ../src magick.cma test21.ml && echo "test 21: OK!" || echo "test 21: Arg" +ocaml -I ../src magick.cma test22.ml && echo "test 22: OK!" || echo "test 22: Arg" +ocaml -I ../src magick.cma test23.ml && echo "test 23: OK!" || echo "test 23: Arg" +ocaml -I ../src magick.cma test24.ml && echo "test 24: OK!" || echo "test 24: Arg" +ocaml -I ../src magick.cma test25.ml && echo "test 25: OK!" || echo "test 25: Arg" +ocaml -I ../src magick.cma test26.ml && echo "test 26: OK!" || echo "test 26: Arg" +ocaml -I ../src magick.cma test27.ml && echo "test 27: OK!" || echo "test 27: Arg" +ocaml -I ../src magick.cma test28.ml && echo "test 28: OK!" || echo "test 28: Arg" +ocaml -I ../src magick.cma test29.ml && echo "test 29: OK!" || echo "test 29: Arg" +ocaml -I ../src magick.cma test30.ml && echo "test 30: OK!" || echo "test 30: Arg" +ocaml -I ../src magick.cma test31.ml && echo "test 31: OK!" || echo "test 31: Arg" +ocaml -I ../src magick.cma test32.ml && echo "test 32: OK!" || echo "test 32: Arg" +ocaml -I ../src magick.cma test33.ml && echo "test 33: OK!" || echo "test 33: Arg" +ocaml -I ../src magick.cma test34.ml && echo "test 34: OK!" || echo "test 34: Arg" +ocaml -I ../src magick.cma test35.ml && echo "test 35: OK!" || echo "test 35: Arg" +ocaml -I ../src magick.cma test36.ml && echo "test 36: OK!" || echo "test 36: Arg" +ocaml -I ../src magick.cma test37.ml && echo "test 37: OK!" || echo "test 37: Arg" +ocaml -I ../src magick.cma test38.ml && echo "test 38: OK!" || echo "test 38: Arg" +ocaml -I ../src magick.cma test39.ml && echo "test 39: OK!" || echo "test 39: Arg" +ocaml -I ../src magick.cma test40.ml && echo "test 40: OK!" || echo "test 40: Arg" diff --git a/test/test00.ml b/test/test00.ml new file mode 100644 index 0000000..be8cd78 --- /dev/null +++ b/test/test00.ml @@ -0,0 +1,8 @@ + +let () = + Magick.initialize (); + let img = Magick.get_canvas ~color:"#ED6352" ~width:380 ~height:220 in + Magick.display img; + Magick.destroy (); +;; + diff --git a/test/test01.ml b/test/test01.ml new file mode 100644 index 0000000..9a4d020 --- /dev/null +++ b/test/test01.ml @@ -0,0 +1,8 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.write_image img ~filename:"_out.jpg"; + Magick.destroy (); +;; + diff --git a/test/test02.ml b/test/test02.ml new file mode 100644 index 0000000..db4b43e --- /dev/null +++ b/test/test02.ml @@ -0,0 +1,8 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.svg" in + Magick.write_image img ~filename:"_out.png"; + Magick.destroy (); +;; + diff --git a/test/test03.ml b/test/test03.ml new file mode 100644 index 0000000..d4af9d0 --- /dev/null +++ b/test/test03.ml @@ -0,0 +1,8 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.write_image img ~filename:"/tmp/dont_exist/out.jpg"; (* test failure *) + Magick.destroy (); +;; + diff --git a/test/test04.ml b/test/test04.ml new file mode 100644 index 0000000..d211068 --- /dev/null +++ b/test/test04.ml @@ -0,0 +1,8 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"dont_exist.png" in (* test failure *) + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test05.ml b/test/test05.ml new file mode 100644 index 0000000..61a39f6 --- /dev/null +++ b/test/test05.ml @@ -0,0 +1,11 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let w = Magick.image_width img in + let h = Magick.image_height img in + Printf.printf "image size: %d x %d\n%!" w h; + assert ( (w, h) = (350, 110) ); + Magick.destroy (); +;; + diff --git a/test/test06.ml b/test/test06.ml new file mode 100644 index 0000000..b06c614 --- /dev/null +++ b/test/test06.ml @@ -0,0 +1,8 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.display img; + Magick.destroy (); +;; + diff --git a/test/test07.ml b/test/test07.ml new file mode 100644 index 0000000..3f32dff --- /dev/null +++ b/test/test07.ml @@ -0,0 +1,8 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test08.ml b/test/test08.ml new file mode 100644 index 0000000..f980ce6 --- /dev/null +++ b/test/test08.ml @@ -0,0 +1,10 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.clone img in + Magick.destroy_image img; + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test09.ml b/test/test09.ml new file mode 100644 index 0000000..ccddf99 --- /dev/null +++ b/test/test09.ml @@ -0,0 +1,9 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.emboss img ~radius:4.0 ~sigma:2.8 in + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test10.ml b/test/test10.ml new file mode 100644 index 0000000..c1b0e04 --- /dev/null +++ b/test/test10.ml @@ -0,0 +1,9 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.blur img ~radius:4.0 ~sigma:2.8 () in + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test11.ml b/test/test11.ml new file mode 100644 index 0000000..b3e4f03 --- /dev/null +++ b/test/test11.ml @@ -0,0 +1,10 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.edge img ~radius:4.0 in + Magick.destroy_image img; + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test12.ml b/test/test12.ml new file mode 100644 index 0000000..449d6d0 --- /dev/null +++ b/test/test12.ml @@ -0,0 +1,10 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.enhance img in + Magick.destroy_image img; + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test13.ml b/test/test13.ml new file mode 100644 index 0000000..1917350 --- /dev/null +++ b/test/test13.ml @@ -0,0 +1,10 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.motion_blur img ~radius:0.0 ~sigma:12.0 ~angle:16.0 in + Magick.destroy_image img; + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test14.ml b/test/test14.ml new file mode 100644 index 0000000..3498807 --- /dev/null +++ b/test/test14.ml @@ -0,0 +1,10 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.sample img ~width:120 ~height:120 in + Magick.destroy_image img; + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test15.ml b/test/test15.ml new file mode 100644 index 0000000..63d516b --- /dev/null +++ b/test/test15.ml @@ -0,0 +1,10 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.resize img ~width:140 ~height:140 ~filter:Magick.Filter.Lanczos ~blur:1.0 () in + Magick.destroy_image img; + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test16.ml b/test/test16.ml new file mode 100644 index 0000000..eaaa916 --- /dev/null +++ b/test/test16.ml @@ -0,0 +1,69 @@ +open Magick + +let composite_operators = [| + CompositeOp.Undefined; + CompositeOp.Over; + CompositeOp.In; + CompositeOp.Out; + CompositeOp.Atop; + CompositeOp.Xor; + CompositeOp.Plus; + CompositeOp.Minus; + CompositeOp.Add; + CompositeOp.Subtract; + CompositeOp.Difference; + CompositeOp.Multiply; + CompositeOp.Bumpmap; + CompositeOp.Copy; + CompositeOp.CopyRed; + CompositeOp.CopyGreen; + CompositeOp.CopyBlue; + CompositeOp.CopyOpacity; + CompositeOp.Clear; + CompositeOp.Dissolve; + CompositeOp.Displace; + CompositeOp.Modulate; + CompositeOp.Threshold; + CompositeOp.No; + CompositeOp.Darken; + CompositeOp.Lighten; + CompositeOp.Hue; + CompositeOp.Saturate; + CompositeOp.Colorize; + CompositeOp.Luminize; + CompositeOp.Screen; + CompositeOp.Overlay; + CompositeOp.CopyCyan; + CompositeOp.CopyMagenta; + CompositeOp.CopyYellow; + CompositeOp.CopyBlack; + CompositeOp.Divide; + CompositeOp.HardLight; + CompositeOp.Exclusion; + CompositeOp.ColorDodge; + CompositeOp.ColorBurn; + CompositeOp.SoftLight; + CompositeOp.LinearBurn; + CompositeOp.LinearDodge; + CompositeOp.LinearLight; + CompositeOp.VividLight; + CompositeOp.PinLight; + CompositeOp.HardMix +|] + +let compose = + Random.self_init (); + let n = Array.length composite_operators in + composite_operators.(Random.int n) + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.blur img ~radius:0.0 ~sigma:6.0 () in + Printf.printf "composite_operator: %s\n%!" + (Magick.CompositeOp.to_string compose); + Magick.composite img ~compose img2 ~x_offset:0 ~y_offset:0 (); + Magick.display img; + Magick.destroy (); +;; + diff --git a/test/test17.ml b/test/test17.ml new file mode 100644 index 0000000..846d63a --- /dev/null +++ b/test/test17.ml @@ -0,0 +1,10 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.shade img ~gray:2 ~azimuth:60.0 ~elevation:12.0 in + Magick.destroy_image img; + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test18.ml b/test/test18.ml new file mode 100644 index 0000000..eed8091 --- /dev/null +++ b/test/test18.ml @@ -0,0 +1,10 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.sharpen img ~radius:4.0 ~sigma:2.8 in + Magick.destroy_image img; + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test19.ml b/test/test19.ml new file mode 100644 index 0000000..26a35cf --- /dev/null +++ b/test/test19.ml @@ -0,0 +1,19 @@ + +let load_file f = + let ic = open_in f in + let n = in_channel_length ic in + let s = Bytes.create n in + really_input ic s 0 n; + close_in ic; + (Bytes.unsafe_to_string s) + + +let () = + Magick.initialize (); + let blob = load_file "image.png" in + let img = Magick.blob_to_image ~blob in + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test20.ml b/test/test20.ml new file mode 100644 index 0000000..2a15336 --- /dev/null +++ b/test/test20.ml @@ -0,0 +1,14 @@ + +let () = + Magick.initialize (); + let img1 = Magick.read_image ~filename:"image.png" in + let img2 = Magick.minify img1 in + let img3 = Magick.magnify img1 in + Magick.destroy_image img1; + Magick.display img2; + Magick.display img3; + Magick.destroy_image img2; + Magick.destroy_image img3; + Magick.destroy (); +;; + diff --git a/test/test21.ml b/test/test21.ml new file mode 100644 index 0000000..7e7d4b3 --- /dev/null +++ b/test/test21.ml @@ -0,0 +1,10 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.scale img ~width:120 ~height:120 in + Magick.destroy_image img; + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test22.ml b/test/test22.ml new file mode 100644 index 0000000..3fd490d --- /dev/null +++ b/test/test22.ml @@ -0,0 +1,10 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.thumbnail img ~width:120 ~height:120 in + Magick.destroy_image img; + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test23.ml b/test/test23.ml new file mode 100644 index 0000000..9b5cf15 --- /dev/null +++ b/test/test23.ml @@ -0,0 +1,14 @@ + +let () = + Magick.initialize (); + let img1 = Magick.read_image ~filename:"image.png" in + let img2 = Magick.flip img1 in + let img3 = Magick.flop img1 in + Magick.display img2; + Magick.display img3; + Magick.destroy_image img1; + Magick.destroy_image img2; + Magick.destroy_image img3; + Magick.destroy (); +;; + diff --git a/test/test24.ml b/test/test24.ml new file mode 100644 index 0000000..59cca0f --- /dev/null +++ b/test/test24.ml @@ -0,0 +1,12 @@ +open Magick + +let () = + Magick.initialize (); + let img1 = Magick.read_image ~filename:"image.png" in + let img2 = Magick.crop img1 { x = 80; y = 30; width = 160; height = 60 } in + Magick.display img2; + Magick.destroy_image img1; + Magick.destroy_image img2; + Magick.destroy (); +;; + diff --git a/test/test25.ml b/test/test25.ml new file mode 100644 index 0000000..dbde0e5 --- /dev/null +++ b/test/test25.ml @@ -0,0 +1,13 @@ +open Magick + +let () = + Magick.initialize (); + let img1 = Magick.read_image ~filename:"image.png" in + let width, height = (40, 20) in + let img2 = Magick.shave img1 (width, height) in + Magick.display img2; + Magick.destroy_image img1; + Magick.destroy_image img2; + Magick.destroy (); +;; + diff --git a/test/test26.ml b/test/test26.ml new file mode 100644 index 0000000..b3b6b79 --- /dev/null +++ b/test/test26.ml @@ -0,0 +1,11 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.contrast img ~sharpen:40; + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test27.ml b/test/test27.ml new file mode 100644 index 0000000..66564ec --- /dev/null +++ b/test/test27.ml @@ -0,0 +1,11 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.equalize img; + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test28.ml b/test/test28.ml new file mode 100644 index 0000000..ebe440c --- /dev/null +++ b/test/test28.ml @@ -0,0 +1,11 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.gamma img ~level:"1.0,2.2,0.45"; + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test29.ml b/test/test29.ml new file mode 100644 index 0000000..aab797e --- /dev/null +++ b/test/test29.ml @@ -0,0 +1,11 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.level img ~level:"10,1.0,65000"; + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test30.ml b/test/test30.ml new file mode 100644 index 0000000..d1dac95 --- /dev/null +++ b/test/test30.ml @@ -0,0 +1,11 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.modulate img "90,150,100"; + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test31.ml b/test/test31.ml new file mode 100644 index 0000000..275f2b9 --- /dev/null +++ b/test/test31.ml @@ -0,0 +1,11 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.negate img 3; + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test32.ml b/test/test32.ml new file mode 100644 index 0000000..c9db951 --- /dev/null +++ b/test/test32.ml @@ -0,0 +1,11 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.normalize img; + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test33.ml b/test/test33.ml new file mode 100644 index 0000000..cd80608 --- /dev/null +++ b/test/test33.ml @@ -0,0 +1,15 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.level_channel img + ~channel:Channel.Blue + ~black_point:1.0 + ~mid_point:1.0 + ~white_point:1.0; + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test34.ml b/test/test34.ml new file mode 100644 index 0000000..0879b7a --- /dev/null +++ b/test/test34.ml @@ -0,0 +1,19 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let ctx = Magick.Draw.allocate_context img in + + Magick.Draw.stroke_color_string ctx "black"; + Magick.Draw.fill_color_string ctx "#FF00FF"; + Magick.Draw.stroke_width ctx 3.0; + Magick.Draw.rectangle ctx ~x1:20.0 ~y1:20.0 ~x2:200.0 ~y2:80.0; + Magick.Draw.circle ctx ~ox:100.0 ~oy:60.0 ~px:100.0 ~py:100.0; + Magick.Draw.arc ctx ~p1:(80.0, 40.0) ~p2:(260.0, 100.0) ~rot:(30.0, 240.0); + Magick.Draw.render ctx; + + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test35.ml b/test/test35.ml new file mode 100644 index 0000000..559a7bc --- /dev/null +++ b/test/test35.ml @@ -0,0 +1,8 @@ + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + Magick.describe img; + Magick.destroy (); +;; + diff --git a/test/test36.ml b/test/test36.ml new file mode 100644 index 0000000..260e565 --- /dev/null +++ b/test/test36.ml @@ -0,0 +1,10 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.charcoal img ~radius:3.0 ~sigma:6.0 in + Magick.display img2; + Magick.destroy (); +;; + diff --git a/test/test37.ml b/test/test37.ml new file mode 100644 index 0000000..478b88c --- /dev/null +++ b/test/test37.ml @@ -0,0 +1,15 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.charcoal img ~radius:2.0 ~sigma:5.0 in + let imglst = Magick.ImgList.new_image_list () in + let imglst2 = Magick.ImgList.append_image imglst img in + let imglst3 = Magick.ImgList.append_image imglst2 img2 in + let imglst4 = Magick.morph imglst3 ~frames:6 in + Magick.display (Obj.magic imglst4); + Magick.write_image (Obj.magic imglst4) ~filename:"_lst.gif"; + Magick.destroy (); +;; + diff --git a/test/test38.ml b/test/test38.ml new file mode 100644 index 0000000..25a0096 --- /dev/null +++ b/test/test38.ml @@ -0,0 +1,18 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + let img2 = Magick.charcoal img ~radius:3.0 ~sigma:6.0 in + let img3 = Magick.implode img ~amount:2.0 in + let img4 = Magick.oil_paint img ~radius:6.0 in + let img5 = Magick.swirl img ~degrees:80.0 in + let img6 = Magick.wave img ~amplitude:3.0 ~length:4.0 in + Magick.display img2; + Magick.display img3; + Magick.display img4; + Magick.display img5; + Magick.display img6; + Magick.destroy (); +;; + diff --git a/test/test39.ml b/test/test39.ml new file mode 100644 index 0000000..a608c66 --- /dev/null +++ b/test/test39.ml @@ -0,0 +1,26 @@ + +let () = + Magick.initialize (); + let img = Magick.get_canvas ~color:"#63ED52" ~width:380 ~height:220 in + + let ctx = Magick.Draw.allocate_context img in + + Magick.Draw.stroke_color_string ctx "black"; + Magick.Draw.fill_color_string ctx "#B54082"; + Magick.Draw.stroke_width ctx 3.0; + Magick.Draw.round_rectangle ctx ~p1:(100.0, 20.0) ~p2:(260.0, 100.0) ~r:(16.0, 16.0); + Magick.Draw.bezier ctx ~coords:[| + (20.0, 20.0); + (80.0, 20.0); + (80.0, 80.0); + (20.0, 140.0); + |]; + Magick.Draw.line ctx ~x1:20.0 ~y1:20.0 ~x2:20.0 ~y2:140.0; + Magick.Draw.render ctx; + Magick.Draw.destroy_context ctx; + + Magick.display img; + Magick.destroy_image img; + Magick.destroy (); +;; + diff --git a/test/test40.ml b/test/test40.ml new file mode 100644 index 0000000..afa2cd2 --- /dev/null +++ b/test/test40.ml @@ -0,0 +1,18 @@ +open Magick + +let () = + Magick.initialize (); + let img = Magick.read_image ~filename:"image.png" in + + Magick.set_image_attribute img ~key:"author" ~value:"Jane Smith"; + Magick.set_image_attribute img ~key:"commiter" ~value:"John Doe"; + Magick.set_image_attribute img ~key:"uploader" ~value:"Mister T"; + + let key = "commiter" in + let value = Magick.get_image_attribute img ~key in + Printf.printf " (%s, %s)\n" key value; + + Magick.destroy_image img; + Magick.destroy (); +;; +