;;; Leptonica library wrapped for Chicken Scheme.
;;; Copyright (c) Peter Lane, 2010.
;;; 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 3 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.
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see .
;;; -------------------------------------------------------------------------------
(module
leptonica
(export
L-BRING-IN-WHITE L-BRING-IN-BLACK
L-ROTATE-AREA-MAP L-ROTATE-SHEAR L-ROTATE-SAMPLING
IFF-UNKNOWN IFF-BMP IFF-JFIF-JPEG IFF-PNG IFF-TIFF IFF-TIFF-PACKBITS
IFF-TIFF-RLE IFF-TIFF-G3 IFF-TIFF-G4 IFF-TIFF-LZW IFF-TIFF-ZIP
IFF-PNM IFF-PS IFF-GIF IFF-JP2 IFF-DEFAULT IFF-SPIX
L-LINEAR-SCALE L-LOG-SCALE
L-CHOOSE-MIN L-CHOOSE-MAX L-CHOOSE-MAX-MIN-DIFF
L-COPY L-CLONE
box-get-geometry
box-set-geometry
boxa-get-box
boxa-get-count
pix-create pix-copy pix-destroy
pix-get-width pix-set-width pix-get-height pix-set-height
pix-get-depth pix-set-depth pix-set-dimensions
pix-get-x-res pix-set-x-res pix-get-y-res pix-set-y-res
pix-set-resolution pix-scale-resolution pix-get-input-format pix-set-input-format
pix-abs-difference
pix-add-gray
pix-close-gray
pix-combine-masked
pix-conn-comp-bb
pix-conn-comp-pixa
pix-count-conn-comp
pix-dilate-gray
pix-dither-to-binary
pix-dither-to-binary-spec
pix-erode-gray
pix-find-skew
pix-invert
pix-max-dynamic-range
pix-min-or-max
pix-mult-constant-gray
pix-open-gray
pix-read
pix-rotate
pix-rotate-am-gray
pix-scale
pix-subtract-gray
pix-threshold-to-binary
pix-threshold-to-value
pix-var-threshold-to-binary
pix-write
pixa-get-count
pixa-get-pix
)
(import chicken extras foreign scheme)
#>
#include
<#
;; define constants
(define L-BRING-IN-WHITE 1)
(define L-BRING-IN-BLACK 2)
(define L-ROTATE-AREA-MAP 1)
(define L-ROTATE-SHEAR 2)
(define L-ROTATE-SAMPLING 3)
;; -- from imageio.h
;; define constants
(define IFF-UNKNOWN 0)
(define IFF-BMP 1)
(define IFF-JFIF-JPEG 2)
(define IFF-PNG 3)
(define IFF-TIFF 4)
(define IFF-TIFF-PACKBITS 5)
(define IFF-TIFF-RLE 6)
(define IFF-TIFF-G3 7)
(define IFF-TIFF-G4 8)
(define IFF-TIFF-LZW 9)
(define IFF-TIFF-ZIP 10)
(define IFF-PNM 11)
(define IFF-PS 12)
(define IFF-GIF 13)
(define IFF-JP2 14)
(define IFF-DEFAULT 15)
(define IFF-SPIX 16)
(define L-LINEAR-SCALE 1)
(define L-LOG-SCALE 2)
(define L-CHOOSE-MIN 1)
(define L-CHOOSE-MAX 2)
(define L-CHOOSE-MAX-MIN-DIFF 3)
(define L-COPY 1)
(define L-CLONE 2)
;; -- from boxbasic.c
(define call-box-geometry
(foreign-lambda integer "boxGetGeometry" c-pointer
(c-pointer integer) (c-pointer integer)
(c-pointer integer) (c-pointer integer)))
(define (box-get-geometry box)
(let-location ((x-coord integer)
(y-coord integer)
(width integer)
(height integer))
(let ((value (call-box-geometry box (location x-coord) (location y-coord)
(location width) (location height))))
(if (zero? value)
(values x-coord y-coord width height)
#f))))
(define box-set-geometry
(foreign-lambda integer "boxSetGeometry" c-pointer integer integer integer integer))
(define boxa-get-box
(foreign-lambda c-pointer "boxaGetBox" c-pointer integer integer))
(define boxa-get-count
(foreign-lambda int "boxaGetCount" c-pointer))
;; -- from conncomp.c
(define pix-conn-comp-bb
(foreign-lambda c-pointer "pixConnCompBB" c-pointer integer))
(define call-pix-conn-comp-pixa
(foreign-lambda c-pointer "pixConnCompPixa" c-pointer c-pointer integer))
(define (pix-conn-comp-pixa pix connectivity)
(let-location ((pixa c-pointer))
(let ((boxa (call-pix-conn-comp-pixa pix (location pixa) connectivity)))
(values boxa pixa))))
(define call-count-conn-comp
(foreign-lambda integer "pixCountConnComp" c-pointer integer (c-pointer integer)))
(define (pix-count-conn-comp pix connectivity)
(let-location ((count integer))
(let ((value (call-count-conn-comp pix connectivity (location count))))
(if (zero? value)
count
#f))))
;; -- from graymorph.c (complete)
(define pix-close-gray
(foreign-lambda c-pointer "pixCloseGray" c-pointer integer integer))
(define pix-dilate-gray
(foreign-lambda c-pointer "pixDilateGray" c-pointer integer integer))
(define pix-erode-gray
(foreign-lambda c-pointer "pixErodeGray" c-pointer integer integer))
(define pix-open-gray
(foreign-lambda c-pointer "pixOpenGray" c-pointer integer integer))
;; -- from grayquant.c
;; ---- threshold from 8 bpp to 1 bpp
;; Uses Floyd-Steinberg error diffusion dithering algorithm to convert
;; given pix to a new pix. Returns #f on error
(define pix-dither-to-binary
(foreign-lambda c-pointer "pixDitherToBinary" c-pointer))
;; as above, but takes parameters for the lowerclip (distance from 0) and
;; upperclip (distance from 255), to adjust the values below and above which
;; the routine does not propagate excess.
(define pix-dither-to-binary-spec
(foreign-lambda c-pointer "pixDitherToBinarySpec" c-pointer integer integer))
;; Simple (pixelwise) binarisation with fixed threshold
;; converts an image pix with 4 or 8 bpp to an image pix with 1 bpp,
;; thresholding on given level
(define pix-threshold-to-binary
(foreign-lambda c-pointer "pixThresholdToBinary" c-pointer integer))
;; uses second argument as a source of variable thresholds for first argument.
(define pix-var-threshold-to-binary
(foreign-lambda c-pointer "pixVarThresholdToBinary" c-pointer c-pointer))
;; -- from pixarith.c
(define pix-abs-difference
(foreign-lambda c-pointer "pixAbsDifference" c-pointer c-pointer))
(define pix-add-gray
(foreign-lambda c-pointer "pixAddGray" c-pointer c-pointer c-pointer))
(define pix-add-constant-gray
(foreign-lambda integer "pixAddConstantGray" c-pointer integer))
(define pix-max-dynamic-range
(foreign-lambda c-pointer "pixMaxDynamicRange" c-pointer integer))
(define pix-min-or-max
(foreign-lambda c-pointer "pixMinOrMax" c-pointer c-pointer c-pointer integer))
(define pix-mult-constant-gray
(foreign-lambda integer "pixMultConstantGray" c-pointer float))
(define pix-subtract-gray
(foreign-lambda c-pointer "pixSubtractGray" c-pointer c-pointer c-pointer))
(define pix-threshold-to-value
(foreign-lambda c-pointer "pixThresholdToValue" c-pointer c-pointer integer integer))
;; -- from pixbasic.
(define pixa-get-count
(foreign-lambda integer "pixaGetCount" c-pointer))
(define pixa-get-pix
(foreign-lambda c-pointer "pixaGetPix" c-pointer integer integer))
;; -- from pix1.c
(define pix-create
(foreign-lambda c-pointer "pixCreate" integer integer integer))
(define pix-clone
(foreign-lambda c-pointer "pixClone" c-pointer))
(define pix-copy
(foreign-lambda c-pointer "pixCopy" c-pointer c-pointer))
(define pix-destroy
(foreign-lambda void "pixDestroy" c-pointer))
(define pix-get-width
(foreign-lambda integer "pixGetWidth" c-pointer))
(define pix-set-width
(foreign-lambda integer "pixSetWidth" c-pointer integer))
(define pix-get-height
(foreign-lambda integer "pixGetHeight" c-pointer))
(define pix-set-height
(foreign-lambda integer "pixSetHeight" c-pointer integer))
(define pix-get-depth
(foreign-lambda integer "pixGetDepth" c-pointer))
(define pix-set-depth
(foreign-lambda integer "pixSetDepth" c-pointer integer))
(define pix-set-dimensions
(foreign-lambda integer "pixSetDimensions" c-pointer integer integer integer))
(define pix-get-x-res
(foreign-lambda integer "pixGetXRes" c-pointer))
(define pix-set-x-res
(foreign-lambda integer "pixSetXRes" c-pointer integer))
(define pix-get-y-res
(foreign-lambda integer "pixGetYRes" c-pointer))
(define pix-set-y-res
(foreign-lambda integer "pixSetYRes" c-pointer integer))
(define pix-set-resolution
(foreign-lambda integer "pixSetResolution" c-pointer integer integer))
(define pix-scale-resolution
(foreign-lambda integer "pixScaleResolution" c-pointer float float))
(define pix-get-input-format
(foreign-lambda integer "pixGetInputFormat" c-pointer))
(define pix-set-input-format
(foreign-lambda integer "pixSetInputFormat" c-pointer integer))
;; -- from pix3.c
(define pix-combine-masked
(foreign-lambda integer "pixCombineMasked" c-pointer c-pointer c-pointer))
(define pix-invert
(foreign-lambda c-pointer "pixInvert" c-pointer c-pointer))
;; -- from readfile.c
;; Reads an image reference from given filename
(define pix-read
(foreign-lambda c-pointer "pixRead" c-string))
;; -- from rotate.c
;; input:
;; * c-pointer: to image
;; * float: angle (radians, clockwise is positive)
;; * integer: type (L-ROTATE-*)
;; * integer: incolour (L-BRING-IN-*)
;; * width: original width, use 0 to avoid embedding
;; * height: original height, use 0 to avoid embedding
;; output:
;; * c-pointer to new image, or #f on error
(define pix-rotate
(foreign-lambda c-pointer "pixRotate" c-pointer float integer integer integer integer))
(define pix-rotate-am-gray
(foreign-lambda c-pointer "pixRotateAMGray" c-pointer float integer))
;; -- from scale.c
;; input:
;; * c-pointer: to image
;; * float: scale_x
;; * float: scale_y
;; output:
;; * c-pointer to new image, or #f on error
(define pix-scale
(foreign-lambda c-pointer "pixScale" c-pointer float float))
;; -- from skew.c
(define call-find-skew
(foreign-lambda integer "pixFindSkew" c-pointer (c-pointer float) (c-pointer float)))
(define (pix-find-skew pix)
(let-location ((angle float)
(confidence float))
(let ((value (call-find-skew pix (location angle) (location confidence))))
(values (/ (* 3.141927 angle) 180) confidence))))
;; -- from writefile.c
;; Writes image reference by c-pointer to filename c-string, using type of integer
(define pix-write
(foreign-lambda void "pixWrite" c-string c-pointer integer))
) ; end of module