REBOL [
    Title: "Image Viewer"
    File: %viewer.r
    Date: 20-May-2000
    Author: "Carl Sassenrath"
    Purpose: {
        A useful image viewer that shows all the jpeg, gif, bmp, png
        images found in the current directory.
    }
    Category: [view VID 3]
]

;; [---------------------------------------------------------------------------]
;; [ Viewer program from Carl with a file pick list added by me.               ]
;; [ Renaming feature added in 2024.                                           ]
;; [                                                                           ]
;; [ This is a severe modification of a program by Carl that was used in a     ]
;; [ one-time project of renaming a bunch of pictures so that they did not     ]
;; [ have the generic names produced by the digital camera (IMGxxxx.jpg for    ]
;; [ example).  The program provides a viewing window and a field that         ]
;; [ allows one to type in a new name for the image (without the suffix),      ]
;; [ and then a button to make the change.                                     ]
;; [                                                                           ]
;; [ All of this renaming can be done with a file manager program.  It is      ]
;; [ just a little faster with a dedicated program.  This program is a good    ]
;; [ example of the value of REBOL; it allows an ordinary person to program    ]
;; [ his own computer to do things that are so specialized that it might be    ]
;; [ very hard to find that functionality in a pre-written program produced    ]
;; [ by others.                                                                ]
;; [---------------------------------------------------------------------------]

;page-size: 640x480
page-size: 800x600
;page-size: 1200x900

image-file?: func ["Returns true if file is an image" file] [
    find [%.bmp %.jpg %.jpeg %.gif %.png] find/last file "."
]

directory: request-dir
if not directory [
    alert "No collection requested"
    quit     
]
change-dir directory

LOAD-FILE-LIST: does [
    files: read directory/.  ;-- Read local file list, but want just image files...
    while [not tail? files] [
        either image-file? first files [files: next files][remove files]
    ]
    files: head files
]
LOAD-FILE-LIST
if empty? files [
    inform layout [backdrop 140.0.0 text bold "No images found"]
    do-events 
    quit  
]

quit-button: does [
    quit 
]

left-arrow: does [
files: back files
        name/text: first files  show name
        either exists? first files [
            img/image: load rejoin [directory first files]
            show img
        ] [
            alert "File has been renamed or deleted"
        ]
]

right-arrow: does [
    if tail? files: next files [files: back files]
    name/text: first files  show name
    either exists? first files [
        img/image: load rejoin [directory first files]  
        show img
    ] [
        alert "Files has been renamed or deleted"
    ]
]

show-picked: does [
    name/text: FILE-LIST/picked
    show name
    PICKNAME: rejoin [directory FILE-LIST/picked]
    either exists? PICKNAME [
        img/image: load PICKNAME
        show img 
    ] [
        alert "File has been renamed or deleted"     
    ] 
    files: head files
    files: find files FILE-LIST/picked
]

rename-button: does [
    WS-OLDNAME: copy ""
    WS-OLDNAME: get-face name
    WS-SUFFIX: suffix? to-string WS-OLDNAME
    WS-NEWNAME: copy ""
    WS-NEWNAME: join get-face NEWNAME WS-SUFFIX
;;  alert WS-NEWNAME
    if WS-NEWNAME = "" [
        alert "Specify new file name without suffix"
        exit
    ]
    OLDFILE: to-file WS-OLDNAME
    NEWFILE: to-file WS-NEWNAME
    rename OLDFILE NEWFILE
    alert to-string rejoin [
        WS-OLDNAME " renamed to " WS-NEWNAME
    ]
]

REFRESH-BUTTON: does [
    LOAD-FILE-LIST
    FILE-LIST/data: files
    show FILE-LIST
]

viewer-window: layout [
    across
;   size page-size
    origin 10x10
    FILE-LIST: text-list 240x540 data files [show-picked]
    img: image page-size - 20x50 rejoin [directory first files] effect 'aspect

    at page-size * 0x1 + 10x-30

    arrow left 24x24 keycode 'left [left-arrow]     
    arrow right 24x24 keycode 'right [right-arrow]
    button "Quit" #"^(ESC)" [quit-button]
    name: info 270x24 form first files
    button "Rename to:" [rename-button]
    NEWNAME: field 270x24
    button "Refresh" [REFRESH-BUTTON]
;;; button "Debug" [halt]
]

center-face viewer-window
view viewer-window