REBOL [
    Title: "Image Sorter"
    Date: 30-May-2001
    Version: 1.1.0
    File: %image-sort.r
    Author: "Carl Sassenrath"
    Purpose: {A handy tool for sorting images into separate directories
or deleting images.  Includes scrolling list of image
files with highlight and scrolling list of target directories.
Also uses cursor keys, space, and backspace for navigation.
}
    Email: carl@rebol.com
    library: [
        level: 'intermediate 
        platform: none 
        type: 'tool 
        domain: [GUI file-handling] 
        tested-under: none 
        support: none 
        license: none 
        see-also: none
    ]
]

howto: {
    Click on a file in the upper list to view the image.
    You can use the arrow, space, or backspace keys to change images.

    Click the Scale button to scale all images to fit the window.
    
    To move an image, select a directory name from the lower list.
    The file will be moved to that directory.
    
    Click on the delete button or key to immediately delete an image.
}

files: []
dirs: []
a-file: none
dirn: num: 0 ; scroll offsets
date-of?: func [f] [all [f: modified? f  f/date]]

show-img: does [
    if a-file [
        img/text: none
        img/image: load root/:a-file
        name/text: reform [
            a-file "-" img/image/size "-" size? root/:a-file "bytes -" date-of? root/:a-file]
        show [name img]
    ]
    show l1
]

move-file: func [/move dir] [
    if a-file [
        if move [write/binary root/:dir/:a-file read/binary root/:a-file]
        remove dir: find files a-file
        delete root/:a-file
        if tail? dir [dir: back dir]
        a-file: pick dir 1 ; could be none
    ]
    show-img
]

next-file: func [/reverse /local file] [
    either none? a-file [
        a-file: files/1
        show l1
    ][
        if a-file: all [
            file: find files a-file
            file: either reverse [back file] [
                either tail? next file [file] [file: next file]
            ]
            pick file 1  ; could be none
        ][
            if (index? file) <= num [num: max 0 num - 1]
            if (index? file) > (num + max-files) [num: num + 1]
            show l1
        ]
    ]
    show-img
]

until [
    root: request-file/title "Pick a directory by picking any file in it." "View"
    if not root [quit]
    if empty? root [alert "You must select a file in the directory."]
    not empty? root
]

root: first split-path first root

files: read root
while [not tail? files] [  ; find dirs and images
    file: files/1
    any [
        all [dir? root/:file  append dirs file  remove files]
        all [find [%.bmp %.jpg %.gif %.png] find/last file "."
            files: next files
        ]
        remove files
    ]
]
files: head files

out: center-face layout [
    style bx text white 40.40.40 bold center middle 120x20
    backcolor pewter

    across at 20x20
    h2 "Image Sorter" center 120
    pad 10
    name: info 450x24 ivory center
    sensor 1x1 keycode [right down #" "] [next-file]
    sensor 1x1 keycode [left up #"^(back)"] [next-file/reverse]
    button "Delete File" 160.0.0 #"^(del)" [move-file]
    tog: toggle "Scale" [
        img/effect: either tog/state [[aspect]][none] show img
    ]
    button "Close" #"^(ESC)" [quit]

    return  space 0  pad 0x10
    t0: bx "Image Files" return
    l1: list 120x400 [
        t1: text 116x14 font [size: 10 color: black shadow: none] [
            a-file: t1/text  t1/font/color: black  show-img
        ]
    ] supply [
        count: count + num
        t1/color: either all [t1/text: files/:count  t1/text = a-file][
            yellow] [l1/color]
    ]
    do [max-files: to-integer 400 / 14]
    s1: slider l1/size * 0x1 + 16x0 length? files [num: s1/data * length? files show l1]

    return pad 0x10
    bx "Move Image To" return
    l2: list 120x150 [
        t2: txt 116x14 font-size 10 [move-file/move t2/text]
    ] supply [count: count + dirn t2/text: dirs/:count] 
    s2: slider l2/size * 0x1 + 16x0 length? dirs [dirn: s2/data * length? dirs show l2]

    return
    at t0/offset + 140x0
    img: box howto 800x600 40.40.40 effect none frame 100.100.100
    ;do [a-file: files/1 show-img]
]

if empty? files [name/text: "No image files found."]
view out