source: project/release/4/leptonica/tags/0.2/leptonica.scm @ 20747

Last change on this file since 20747 was 20747, checked in by petercrlane, 11 years ago

version 0.2

File size: 10.8 KB
Line 
1;;; Leptonica library wrapped for Chicken Scheme.
2;;; Copyright (c) Peter Lane, 2010.
3
4;;; This program is free software: you can redistribute it and/or modify
5;;; it under the terms of the GNU General Public License as published by
6;;; the Free Software Foundation, either version 3 of the License, or
7;;; (at your option) any later version.
8
9;;; This program is distributed in the hope that it will be useful,
10;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12;;; GNU General Public License for more details.
13
14;;; You should have received a copy of the GNU General Public License
15;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
16
17;;; -------------------------------------------------------------------------------
18
19(module
20  leptonica
21  (export 
22    L-BRING-IN-WHITE L-BRING-IN-BLACK
23    L-ROTATE-AREA-MAP L-ROTATE-SHEAR L-ROTATE-SAMPLING
24    IFF-UNKNOWN IFF-BMP IFF-JFIF-JPEG IFF-PNG IFF-TIFF IFF-TIFF-PACKBITS
25    IFF-TIFF-RLE IFF-TIFF-G3 IFF-TIFF-G4 IFF-TIFF-LZW IFF-TIFF-ZIP
26    IFF-PNM IFF-PS IFF-GIF IFF-JP2 IFF-DEFAULT IFF-SPIX
27    L-LINEAR-SCALE L-LOG-SCALE
28    L-CHOOSE-MIN L-CHOOSE-MAX L-CHOOSE-MAX-MIN-DIFF
29    L-COPY L-CLONE
30    box-get-geometry
31    box-set-geometry
32    boxa-get-box
33    boxa-get-count
34    pix-create pix-copy pix-destroy
35    pix-get-width pix-set-width pix-get-height pix-set-height
36    pix-get-depth pix-set-depth pix-set-dimensions
37    pix-get-x-res pix-set-x-res pix-get-y-res pix-set-y-res
38    pix-set-resolution pix-scale-resolution pix-get-input-format pix-set-input-format
39    pix-abs-difference
40    pix-add-gray
41    pix-close-gray
42    pix-combine-masked
43    pix-conn-comp-bb
44    pix-conn-comp-pixa
45    pix-count-conn-comp
46    pix-dilate-gray
47    pix-dither-to-binary
48    pix-dither-to-binary-spec
49    pix-erode-gray
50    pix-find-skew
51    pix-invert
52    pix-max-dynamic-range
53    pix-min-or-max
54    pix-mult-constant-gray
55    pix-open-gray
56    pix-read
57    pix-rotate
58    pix-rotate-am-gray
59    pix-scale
60    pix-subtract-gray
61    pix-threshold-to-binary
62    pix-threshold-to-value
63    pix-var-threshold-to-binary
64    pix-write
65    pixa-get-count
66    pixa-get-pix
67    )
68  (import chicken extras foreign scheme)
69
70  #>
71  #include <liblept/allheaders.h>
72  <#
73
74  ;; define constants
75  (define L-BRING-IN-WHITE 1)
76  (define L-BRING-IN-BLACK 2)
77
78  (define L-ROTATE-AREA-MAP 1)
79  (define L-ROTATE-SHEAR 2)
80  (define L-ROTATE-SAMPLING 3)
81
82  ;; -- from imageio.h
83
84  ;; define constants
85  (define IFF-UNKNOWN 0)
86  (define IFF-BMP 1)
87  (define IFF-JFIF-JPEG 2)
88  (define IFF-PNG 3)
89  (define IFF-TIFF 4)
90  (define IFF-TIFF-PACKBITS 5)
91  (define IFF-TIFF-RLE 6)
92  (define IFF-TIFF-G3 7)
93  (define IFF-TIFF-G4 8)
94  (define IFF-TIFF-LZW 9)
95  (define IFF-TIFF-ZIP 10)
96  (define IFF-PNM 11)
97  (define IFF-PS 12)
98  (define IFF-GIF 13)
99  (define IFF-JP2 14)
100  (define IFF-DEFAULT 15)
101  (define IFF-SPIX 16)
102
103  (define L-LINEAR-SCALE 1)
104  (define L-LOG-SCALE 2)
105
106  (define L-CHOOSE-MIN 1)
107  (define L-CHOOSE-MAX 2)
108  (define L-CHOOSE-MAX-MIN-DIFF 3)
109
110  (define L-COPY 1)
111  (define L-CLONE 2)
112
113  ;; -- from boxbasic.c
114
115  (define call-box-geometry
116    (foreign-lambda integer "boxGetGeometry" c-pointer 
117                    (c-pointer integer) (c-pointer integer)
118                    (c-pointer integer) (c-pointer integer)))
119
120  (define (box-get-geometry box)
121    (let-location ((x-coord integer)
122                   (y-coord integer)
123                   (width integer)
124                   (height integer))
125                  (let ((value (call-box-geometry box (location x-coord) (location y-coord)
126                                                  (location width) (location height))))
127                    (if (zero? value)
128                      (values x-coord y-coord width height)
129                      #f))))
130
131  (define box-set-geometry
132    (foreign-lambda integer "boxSetGeometry" c-pointer integer integer integer integer))
133
134  (define boxa-get-box
135    (foreign-lambda c-pointer "boxaGetBox" c-pointer integer integer))
136
137  (define boxa-get-count
138    (foreign-lambda int "boxaGetCount" c-pointer))
139
140  ;; -- from conncomp.c
141
142  (define pix-conn-comp-bb
143    (foreign-lambda c-pointer "pixConnCompBB" c-pointer integer))
144
145  (define call-pix-conn-comp-pixa
146    (foreign-lambda c-pointer "pixConnCompPixa" c-pointer c-pointer integer))
147
148  (define (pix-conn-comp-pixa pix connectivity)
149    (let-location ((pixa c-pointer))
150                  (let ((boxa (call-pix-conn-comp-pixa pix (location pixa) connectivity)))
151                    (values boxa pixa))))
152
153  (define call-count-conn-comp
154    (foreign-lambda integer "pixCountConnComp" c-pointer integer (c-pointer integer)))
155
156  (define (pix-count-conn-comp pix connectivity)
157    (let-location ((count integer))
158                  (let ((value (call-count-conn-comp pix connectivity (location count))))
159                    (if (zero? value)
160                      count
161                      #f))))
162
163  ;; -- from graymorph.c (complete)
164
165  (define pix-close-gray
166    (foreign-lambda c-pointer "pixCloseGray" c-pointer integer integer))
167
168  (define pix-dilate-gray
169    (foreign-lambda c-pointer "pixDilateGray" c-pointer integer integer))
170
171  (define pix-erode-gray
172    (foreign-lambda c-pointer "pixErodeGray" c-pointer integer integer))
173
174  (define pix-open-gray
175    (foreign-lambda c-pointer "pixOpenGray" c-pointer integer integer))
176
177  ;; -- from grayquant.c
178
179  ;; ---- threshold from 8 bpp to 1 bpp
180
181  ;; Uses Floyd-Steinberg error diffusion dithering algorithm to convert
182  ;; given pix to a new pix.  Returns #f on error
183  (define pix-dither-to-binary
184    (foreign-lambda c-pointer "pixDitherToBinary" c-pointer))
185
186  ;; as above, but takes parameters for the lowerclip (distance from 0) and
187  ;; upperclip (distance from 255), to adjust the values below and above which
188  ;; the routine does not propagate excess.
189  (define pix-dither-to-binary-spec
190    (foreign-lambda c-pointer "pixDitherToBinarySpec" c-pointer integer integer))
191
192  ;; Simple (pixelwise) binarisation with fixed threshold
193  ;; converts an image pix with 4 or 8 bpp to an image pix with 1 bpp,
194  ;; thresholding on given level
195  (define pix-threshold-to-binary
196    (foreign-lambda c-pointer "pixThresholdToBinary" c-pointer integer))
197
198  ;; uses second argument as a source of variable thresholds for first argument.
199  (define pix-var-threshold-to-binary
200    (foreign-lambda c-pointer "pixVarThresholdToBinary" c-pointer c-pointer))
201
202  ;; -- from pixarith.c
203
204  (define pix-abs-difference
205    (foreign-lambda c-pointer "pixAbsDifference" c-pointer c-pointer))
206
207  (define pix-add-gray
208    (foreign-lambda c-pointer "pixAddGray" c-pointer c-pointer c-pointer))
209
210  (define pix-add-constant-gray
211    (foreign-lambda integer "pixAddConstantGray" c-pointer integer))
212
213  (define pix-max-dynamic-range
214    (foreign-lambda c-pointer "pixMaxDynamicRange" c-pointer integer))
215
216  (define pix-min-or-max
217    (foreign-lambda c-pointer "pixMinOrMax" c-pointer c-pointer c-pointer integer))
218
219  (define pix-mult-constant-gray
220    (foreign-lambda integer "pixMultConstantGray" c-pointer float))
221
222  (define pix-subtract-gray
223    (foreign-lambda c-pointer "pixSubtractGray" c-pointer c-pointer c-pointer))
224
225  (define pix-threshold-to-value
226    (foreign-lambda c-pointer "pixThresholdToValue" c-pointer c-pointer integer integer))
227
228  ;; -- from pixbasic.
229
230  (define pixa-get-count
231    (foreign-lambda integer "pixaGetCount" c-pointer))
232
233  (define pixa-get-pix
234    (foreign-lambda c-pointer "pixaGetPix" c-pointer integer integer))
235
236  ;; -- from pix1.c
237
238  (define pix-create
239    (foreign-lambda c-pointer "pixCreate" integer integer integer))
240
241  (define pix-clone
242    (foreign-lambda c-pointer "pixClone" c-pointer))
243
244  (define pix-copy
245    (foreign-lambda c-pointer "pixCopy" c-pointer c-pointer))
246
247  (define pix-destroy
248    (foreign-lambda void "pixDestroy" c-pointer))
249
250  (define pix-get-width
251    (foreign-lambda integer "pixGetWidth" c-pointer))
252
253  (define pix-set-width
254    (foreign-lambda integer "pixSetWidth" c-pointer integer))
255
256  (define pix-get-height
257    (foreign-lambda integer "pixGetHeight" c-pointer))
258
259  (define pix-set-height
260    (foreign-lambda integer "pixSetHeight" c-pointer integer))
261
262  (define pix-get-depth
263    (foreign-lambda integer "pixGetDepth" c-pointer))
264
265  (define pix-set-depth
266    (foreign-lambda integer "pixSetDepth" c-pointer integer))
267
268  (define pix-set-dimensions
269    (foreign-lambda integer "pixSetDimensions" c-pointer integer integer integer))
270
271  (define pix-get-x-res
272    (foreign-lambda integer "pixGetXRes" c-pointer))
273
274  (define pix-set-x-res
275    (foreign-lambda integer "pixSetXRes" c-pointer integer))
276
277  (define pix-get-y-res
278    (foreign-lambda integer "pixGetYRes" c-pointer))
279
280  (define pix-set-y-res
281    (foreign-lambda integer "pixSetYRes" c-pointer integer))
282
283  (define pix-set-resolution
284    (foreign-lambda integer "pixSetResolution" c-pointer integer integer))
285
286  (define pix-scale-resolution
287    (foreign-lambda integer "pixScaleResolution" c-pointer float float))
288
289  (define pix-get-input-format
290    (foreign-lambda integer "pixGetInputFormat" c-pointer))
291
292  (define pix-set-input-format
293    (foreign-lambda integer "pixSetInputFormat" c-pointer integer))
294
295  ;; -- from pix3.c
296
297  (define pix-combine-masked
298    (foreign-lambda integer "pixCombineMasked" c-pointer c-pointer c-pointer))
299
300  (define pix-invert
301    (foreign-lambda c-pointer "pixInvert" c-pointer c-pointer))
302
303  ;; -- from readfile.c
304
305  ;; Reads an image reference from given filename
306  (define pix-read
307    (foreign-lambda c-pointer "pixRead" c-string))
308
309  ;; -- from rotate.c
310
311  ;; input:
312  ;;   * c-pointer: to image
313  ;;   * float:     angle (radians, clockwise is positive)
314  ;;   * integer:   type (L-ROTATE-*)
315  ;;   * integer:   incolour (L-BRING-IN-*)
316  ;;   * width:     original width, use 0 to avoid embedding
317  ;;   * height:    original height, use 0 to avoid embedding
318  ;; output:
319  ;;   * c-pointer to new image, or #f on error
320  (define pix-rotate
321    (foreign-lambda c-pointer "pixRotate" c-pointer float integer integer integer integer))
322
323  (define pix-rotate-am-gray
324    (foreign-lambda c-pointer "pixRotateAMGray" c-pointer float integer))
325
326  ;; -- from scale.c
327
328  ;; input:
329  ;;   * c-pointer: to image
330  ;;   * float:     scale_x
331  ;;   * float:     scale_y
332  ;; output:
333  ;;   * c-pointer to new image, or #f on error
334  (define pix-scale
335    (foreign-lambda c-pointer "pixScale" c-pointer float float))
336
337  ;; -- from skew.c
338
339  (define call-find-skew
340    (foreign-lambda integer "pixFindSkew" c-pointer (c-pointer float) (c-pointer float)))
341
342  (define (pix-find-skew pix)
343    (let-location ((angle float)
344                   (confidence float))
345                  (let ((value (call-find-skew pix (location angle) (location confidence))))
346                    (values (/ (* 3.141927 angle) 180) confidence))))
347
348  ;; -- from writefile.c
349
350  ;; Writes image reference by c-pointer to filename c-string, using type of integer
351  (define pix-write
352    (foreign-lambda void "pixWrite" c-string c-pointer integer))
353
354  ) ; end of module
355
Note: See TracBrowser for help on using the repository browser.