Part of Slepp's ProjectsPastebinTURLImagebinFilebin
Feedback -- English French German Japanese
Create Upload Newest Tools Donate
Sign In | Create Account

DivideScannedImages.scm
Sunday, July 22nd, 2012 at 3:02:26pm UTC 

  1. ; DivideScannedImages.scm
  2. ; by Rob Antonishen
  3. ; http://ffaat.pointclark.net
  4. ; hacked by JordanN http://registry.gimp.org/node/22177
  5.  
  6. ; Version 1.9 (20101007)
  7.  
  8. ; Description
  9. ;
  10. ; Locates each separate element and creates a new image from each.
  11. ; will call the deskew plugin http://www.cubewano.org/gimp-deskew-plugin/
  12. ; if it is installed on each image
  13. ;
  14. ; Changes:
  15. ; v1.1 - Added a size threshold slider, and it will call the deskew plugin if installed
  16. ; v1.2 - takes a rectangular selection bounding the path rather than a selection from the path itself, added an abort threshold incase the parameters are wonky
  17. ; v1.3 - simplifies the selection via feather/sharpen first to speed up the image analysis.
  18. ;        - fixed exporting the whole image as one.
  19. ;        - added sliders to pick a background offset.  This is useful if your scanner has a "shadow" around the edge of full scans,
  20. ; v1.4 - added the ability to save out dividede images to a directory with an incremental filename and number
  21. ; v1.5 - added corner selection to background pick
  22. ; v1.6 - changed global buffer use to named buffers
  23. ; v1.7 - added batch mode for whole directories, plus bug fix for no deskew plugin and saving files, also a fix to get both cases of file
  24. ; v1.8 - should now work on both windows and linux using the pathchar def.
  25. ; v1.9 - added sort code to the batch script
  26.  
  27. ; License:
  28. ;
  29. ; This program is free software; you can redistribute it and/or modify
  30. ; it under the terms of the GNU General Public License as published by
  31. ; the Free Software Foundation; either version 2 of the License, or
  32. ; (at your option) any later version.
  33. ;
  34. ; This program is distributed in the hope that it will be useful,
  35. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  36. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  37. ; GNU General Public License for more details.
  38. ;
  39. ; The GNU Public License is available at
  40. ; http://www.gnu.org/copyleft/gpl.html
  41.  
  42. (define (script_fu_DivideScannedImages img inLayer inThreshold inSize inLimit inCorner inX inY inSaveFiles inDir inSaveType inFileName inFileNumber)
  43.   (let*
  44.     (
  45.       (width (car (gimp-image-width img)))
  46.       (height (car (gimp-image-height img)))
  47.       (newpath 0)
  48.       (strokes 0)
  49.       (tempVector 0)
  50.       (tempImage 0)
  51.       (tempLayer 0)
  52.       (bounds 0)
  53.       (count 0)
  54.       (numextracted 0)
  55.       (saveString "")
  56.       (newFileName "")
  57.       (tempdisplay 0)
  58.       (buffname "dsibuff")
  59.       (pathchar (if (equal? (substring gimp-dir 0 1) "/") "/" "\\"))
  60.     )
  61.     ;  it begins here
  62.     (gimp-context-push)
  63.     (gimp-image-undo-disable img)
  64.  
  65.     ;logging
  66.     ;(gimp-message-set-handler ERROR-CONSOLE)
  67.     ;(gimp-message-set-handler CONSOLE)
  68.     ;(gimp-message-set-handler MESSAGE-BOX)
  69.     ;or start GIMP wwith "gimp --console-messages" to spawn a console box
  70.     ;then use this:
  71.     ;(gimp-message "foobar")
  72.  
  73.     ;testing for functions defined
  74.     ;(if (defined? 'plug-in-shift) (gimp-message "It Exists") (gimp-message "Doesnt Exist"))
  75.  
  76.     ;set up saving
  77.     (if (= inSaveFiles TRUE)
  78.       (set! saveString
  79.       (cond
  80.         (( equal? inSaveType 0 ) ".jpg" )
  81.         (( equal? inSaveType 1 ) ".bmp" )
  82.         (( equal? inSaveType 2 ) ".png" )
  83.       )
  84.     ))
  85.  
  86.     ; Expand the image a bit to fix problem with images near the right edge. Probably could get away just expanding
  87.     ; width but go ahead and expand height in case same issue is there...
  88.     (set! width (+ width 30))
  89.     (set! height (+ height 30))
  90.     (gimp-image-resize img width height 0 0)
  91.     (gimp-layer-resize-to-image-size inLayer)
  92.  
  93.     ; convert in inverted copy of the background selection to a path using the selected corner
  94.     (cond
  95.       ( (equal? inCorner 0)
  96.         (gimp-fuzzy-select inLayer inX inY inThreshold CHANNEL-OP-REPLACE TRUE FALSE 0 TRUE)
  97.         (gimp-context-set-background (car (gimp-image-pick-color img inLayer inX inY FALSE FALSE 0)))
  98.       )
  99.       ( (equal? inCorner 1)
  100.         (gimp-fuzzy-select inLayer (- width inX) inY inThreshold CHANNEL-OP-REPLACE TRUE FALSE 0 TRUE)
  101.         (gimp-context-set-background (car (gimp-image-pick-color img inLayer (- width inX) inY FALSE FALSE 0)))
  102.       )
  103.       ( (equal? inCorner 2)
  104.         (gimp-fuzzy-select inLayer inX (- height inY) inThreshold CHANNEL-OP-REPLACE TRUE FALSE 0 TRUE)
  105.         (gimp-context-set-background (car (gimp-image-pick-color img inLayer inX (- height inY) FALSE FALSE 0)))
  106.       )
  107.       ( (equal? inCorner 3)
  108.         (gimp-fuzzy-select inLayer (- width inX) (- height inY) inThreshold CHANNEL-OP-REPLACE TRUE FALSE 0 TRUE)
  109.         (gimp-context-set-background (car (gimp-image-pick-color img inLayer (- width inX) (- height inY) FALSE FALSE 0)))
  110.       )
  111.     )
  112.     (gimp-selection-feather img (/ (min width height) 100))
  113.     (gimp-selection-sharpen img)
  114.     (gimp-selection-invert img)
  115.     (plug-in-sel2path RUN-NONINTERACTIVE img inLayer)
  116.  
  117.     ;break up the vectors
  118.     (set! newpath (vector-ref (cadr (gimp-image-get-vectors img)) 0))
  119.  
  120.     (set! strokes (gimp-vectors-get-strokes newpath))
  121.     (while (and (< count (car strokes)) (< numextracted inLimit))
  122.  
  123.       (set! tempVector (gimp-vectors-new img "Temp"))
  124.       (gimp-image-add-vectors img (car tempVector) -1)
  125.       (gimp-vectors-stroke-new-from-points (car tempVector)
  126.         (list-ref (gimp-vectors-stroke-get-points newpath (vector-ref (cadr strokes) count)) 0)
  127.         (list-ref (gimp-vectors-stroke-get-points newpath (vector-ref (cadr strokes) count)) 1)
  128.         (list-ref (gimp-vectors-stroke-get-points newpath (vector-ref (cadr strokes) count)) 2)
  129.         (list-ref (gimp-vectors-stroke-get-points newpath (vector-ref (cadr strokes) count)) 3)
  130.       )
  131.       (gimp-vectors-to-selection (car tempVector) CHANNEL-OP-REPLACE TRUE FALSE 0 0)
  132.  
  133.       ;check for minimum size
  134.       (set! bounds (gimp-selection-bounds img))
  135.       (if (and (> (- (list-ref bounds 3) (list-ref bounds 1)) inSize) (> (- (list-ref bounds 4) (list-ref bounds 2)) inSize) ;min size slider
  136.                (< (- (list-ref bounds 3) (list-ref bounds 1)) width) (< (- (list-ref bounds 4) (list-ref bounds 2)) height)) ;max size image
  137.         (begin
  138.           (gimp-rect-select img (list-ref bounds 1) (list-ref bounds 2)
  139.                                 (- (list-ref bounds 3) (list-ref bounds 1)) (- (list-ref bounds 4) (list-ref bounds 2))
  140.                                 CHANNEL-OP-REPLACE FALSE 0 )
  141.           (set! buffname (car (gimp-edit-named-copy inLayer buffname)))
  142.           (set! tempImage (car (gimp-edit-named-paste-as-new buffname)))
  143.           (set! tempLayer (car (gimp-image-get-active-layer tempImage)))
  144.           (gimp-image-undo-disable tempImage)
  145.           (set! tempdisplay (car (gimp-display-new tempImage)))
  146.  
  147.           ;run deskew if it is installed
  148.           (if (defined? 'gimp-deskew-plugin)
  149.             (begin
  150.               (gimp-progress-set-text "Deskewing...")
  151.               (gimp-layer-flatten tempLayer)
  152.               (gimp-deskew-plugin 0 tempImage tempLayer 0 0 0 0 0)
  153.               (gimp-image-resize-to-layers tempImage)
  154.               (gimp-layer-flatten tempLayer)
  155.               (gimp-fuzzy-select tempLayer 0 0 inThreshold CHANNEL-OP-REPLACE TRUE FALSE 0 TRUE)
  156.               (gimp-selection-invert tempImage)
  157.               (set! bounds (gimp-selection-bounds tempImage))
  158.               (gimp-selection-none tempImage)
  159.               (gimp-image-crop tempImage (- (list-ref bounds 3) (list-ref bounds 1)) (- (list-ref bounds 4) (list-ref bounds 2))
  160.                                (list-ref bounds 1) (list-ref bounds 2))
  161.             )
  162.           )
  163.           (gimp-image-undo-enable tempImage)
  164.  
  165.           ;save file
  166.           (if (= inSaveFiles TRUE)
  167.           (begin
  168.             (set! newFileName (string-append inDir pathchar inFileName
  169.                                        (substring "00000" (string-length (number->string (+ inFileNumber numextracted))))
  170.                                        (number->string (+ inFileNumber numextracted)) saveString))
  171.             (gimp-file-save RUN-NONINTERACTIVE tempImage tempLayer newFileName newFileName)
  172.             (gimp-display-delete tempdisplay)
  173.           )
  174.           )
  175.  
  176.           (set! numextracted (+ numextracted 1))
  177.         )
  178.       )
  179.       (gimp-image-remove-vectors img (car tempVector))
  180.       (set! count (+ count 1))
  181.     )
  182.  
  183.     ;input drawable name should be set to 1919191919 if in batch
  184.     (if (and (> numextracted 0) (equal? (car (gimp-drawable-get-name inLayer)) "1919191919"))
  185.       (gimp-drawable-set-name inLayer (number->string (+ 1919191919 numextracted))))
  186.  
  187.     ;delete temp path
  188.     (gimp-image-remove-vectors img newpath)
  189.     (gimp-selection-none img)
  190.  
  191.     ;done
  192.     (gimp-image-undo-enable img)
  193.     (gimp-progress-end)
  194.     (gimp-displays-flush)
  195.     (gimp-context-pop)
  196.   )
  197. )
  198.  
  199. (script-fu-register "script_fu_DivideScannedImages"
  200.                     "<Image>/Filters/Divide Scanned Images..."
  201.                     "Attempts to isolate each part of the image from the background and creates a new image from it"
  202.                     "Rob Antonishen"
  203.                     "Rob Antonishen"
  204.                     "Dec 2008"
  205.                     "RGB* GRAY*"
  206.                     SF-IMAGE      "image"      0
  207.                     SF-DRAWABLE   "drawable"   0
  208.                     SF-ADJUSTMENT "Selection Threshold"                 (list 10 0 255 1 10 1 SF-SLIDER)
  209.                     SF-ADJUSTMENT "Size Threshold"                      (list 100 0 2000 10 100 1 SF-SLIDER)
  210.                     SF-ADJUSTMENT "Abort Limit"                         (list 5 1 100 1 10 1 SF-SLIDER)
  211.                     SF-OPTION     "Background Sample Corner"            (list "Top Left" "Top Right" "Bottom Left" "Bottom Right")
  212.                     SF-ADJUSTMENT "Background Sample X Offset"          (list 5 1 100 1 10 1 SF-SLIDER)
  213.                     SF-ADJUSTMENT "Background Sample Y Offset"          (list 5 1 100 1 10 1 SF-SLIDER)
  214.                     SF-TOGGLE     "Save and Close Extracted Images"     FALSE
  215.                     SF-DIRNAME    "Save Directory"                      ""
  216.                     SF-OPTION     "Save File Type"                      (list "jpg" "bmp" "png")
  217.                     SF-STRING     "Save File Base Name"                 "IMAGE"
  218.                     SF-ADJUSTMENT "Save File Start Number"              (list 0 0 9000 1 100 0 SF-SPINNER)
  219. )
  220.  
  221. ;line added by Jordan Nash in February 2012 (tested in Windows 7 Pro 64bit with Gimp 2.6.12)
  222. (script-fu-menu-register "script_fu_DivideScannedImages"
  223. "<Toolbox>/_Filters/_Script-Fu")
  224.  
  225. (define (script_fu_BatchDivideScannedImages inSourceDir inLoadType inThreshold inSize inLimit inCorner inX inY inDestDir inSaveType inFileName inFileNumber)
  226. (let*
  227.     (
  228.       (varLoadStr "")
  229.       (varFileList 0)
  230.       (varCounter inFileNumber)
  231.       (pathchar (if (equal? (substring gimp-dir 0 1) "/") "/" "\\"))
  232.     )
  233.  
  234.     (define split
  235.       (lambda (ls)
  236.         (letrec ((split-h (lambda (ls ls1 ls2)
  237.                             (cond
  238.                               ((or (null? ls) (null? (cdr ls)))
  239.                                (cons (reverse ls2) ls1))
  240.                               (else (split-h (cddr ls)
  241.                                       (cdr ls1) (cons (car ls1) ls2)))))))
  242.           (split-h ls ls '()))))
  243.  
  244.     (define merge
  245.       (lambda (pred ls1 ls2)
  246.         (cond
  247.           ((null? ls1) ls2)
  248.           ((null? ls2) ls1)
  249.           ((pred (car ls1) (car ls2))
  250.            (cons (car ls1) (merge pred (cdr ls1) ls2)))
  251.           (else (cons (car ls2) (merge pred ls1 (cdr ls2)))))))
  252.  
  253.     ;pred is the comparison, i.e. <= for an ascending numeric list, or
  254.     ;string<=? for a case sensitive alphabetical sort,
  255.     ;string-ci<=? for a case insensitive alphabetical sort,
  256.     (define merge-sort
  257.       (lambda (pred ls)
  258.         (cond
  259.           ((null? ls) ls)
  260.           ((null? (cdr ls)) ls)
  261.           (else (let ((splits (split ls)))
  262.                   (merge pred
  263.                     (merge-sort pred (car splits))
  264.                     (merge-sort pred (cdr splits))))))))
  265.  
  266.     ;begin here
  267.     (set! varLoadStr
  268.     (cond
  269.     (( equal? inLoadType 0 ) ".[jJ][pP][gG]" )
  270.     (( equal? inLoadType 1 ) ".[bB][mM][pP]" )
  271.     (( equal? inLoadType 2 ) ".[pP][nN][gG]" )
  272.     ))
  273.  
  274.     (set! varFileList (merge-sort string<=? (cadr (file-glob (string-append inSourceDir pathchar "*" varLoadStr)  1))))
  275.     (while (not (null? varFileList))
  276.       (let* ((filename (car varFileList))
  277.              (image (car (gimp-file-load RUN-NONINTERACTIVE filename filename)))
  278.              (drawable (car (gimp-image-get-active-layer image))))
  279.  
  280.         ;flag for batch mode
  281.         (gimp-drawable-set-name drawable "1919191919")
  282.         (gimp-progress-set-text (string-append "Working on ->" filename))
  283.  
  284.         (script_fu_DivideScannedImages image drawable inThreshold inSize inLimit inCorner inX inY TRUE inDestDir inSaveType inFileName varCounter)
  285.  
  286.         ;increment by number extracted.
  287.         (set! varCounter (+ varCounter (- (string->number (car (gimp-drawable-get-name drawable))) 1919191919)))
  288.         (gimp-image-delete image)
  289.       )
  290.       (set! varFileList (cdr varFileList))
  291.     )
  292.   )
  293. )
  294.  
  295. (script-fu-register "script_fu_BatchDivideScannedImages"
  296.                     "<Toolbox>/Xtns/Batch Tools/Batch Divide Scanned Images..."
  297.                     "Batch devide a folder of full page scans images."
  298.                     "Rob Antonishen"
  299.                     "Rob Antonishen"
  300.                     "May 2009"
  301.                     ""
  302.                     SF-DIRNAME    "Load from" ""
  303.                     SF-OPTION     "Load File Type" (list "jpg" "bmp" "png")
  304.                     SF-ADJUSTMENT "Selection Threshold"                 (list 10 0 255 1 10 1 SF-SLIDER)
  305.                     SF-ADJUSTMENT "Size Threshold"                      (list 100 0 2000 10 100 1 SF-SLIDER)
  306.                     SF-ADJUSTMENT "Abort Limit"                         (list 5 1 100 1 10 1 SF-SLIDER)
  307.                     SF-OPTION     "Background Sample Corner"            (list "Top Left" "Top Right" "Bottom Left" "Bottom Right")
  308.                     SF-ADJUSTMENT "Background Sample X Offset"          (list 5 1 100 1 10 1 SF-SLIDER)
  309.                     SF-ADJUSTMENT "Background Sample Y Offset"          (list 5 1 100 1 10 1 SF-SLIDER)
  310.                     SF-DIRNAME    "Save Directory"                      ""
  311.                     SF-OPTION     "Save File Type"                      (list "jpg" "bmp" "png")
  312.                     SF-STRING     "Save File Base Name"                 "IMAGE"
  313.                     SF-ADJUSTMENT "Save File Start Number"              (list 0 0 9000 1 100 0 SF-SPINNER)
  314. )
  315.  
  316. ;line added by Jordan Nash in February 2012 (tested in Windows 7 Pro 64bit with Gimp 2.6.12)
  317. (script-fu-menu-register "script_fu_BatchDivideScannedImages"
  318. "<Toolbox>/_Filters/_Script-Fu")

Update the Post

Either update this post and resubmit it with changes, or make a new post.

You may also comment on this post.

update paste below
details of the post (optional)

Note: Only the paste content is required, though the following information can be useful to others.

Save name / title?

(space separated, optional)



Please note that information posted here will expire by default in one month. If you do not want it to expire, please set the expiry time above. If it is set to expire, web search engines will not be allowed to index it prior to it expiring. Items that are not marked to expire will be indexable by search engines. Be careful with your passwords. All illegal activities will be reported and any information will be handed over to the authorities, so be good.

comments powered by Disqus
worth-right
worth-right
worth-right