;;; 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 <http://www.gnu.org/licenses/>.

;;; -------------------------------------------------------------------------------

(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 <allheaders.h>
  <#

  ;; 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