Showing posts with label image. Show all posts
Showing posts with label image. Show all posts

Tuesday, 17 September 2013

Image resizer

The following script is a simple image resizer,it will reduce proportionally images. You can set max X or Y or both sizes.


Here is the source code:
Rebol [
Title: "Resizer"
File: %resizer.r
Author: "Massimiliano Vessi"
Date: 2011-07-22
Version: 1.1.2
email: maxint@tiscali.it
Purpose: {Simple image resizer}
]
max_L: 70
max_H: 70
suff: "_small"
ridimensiona:   does [
    immagini: request-file  
    foreach immagine_f   immagini [
        immagine_i: load-image immagine_f
        temp_imm: load-image immagine_f ;we'll use this for height check        
        if x/data [
            dimensioni: immagine_i/size
            if dimensioni/1 > max_L [
                fattore:   dimensioni/1 / max_L  
                temp_L:   layout/tight [ image (dimensioni / fattore) immagine_i ]
                temp_imm: to-image temp_L ;this will be used for heigh check
                if png/data [save/png (to-file rejoin [   immagine_f   suff_f/text ".png" ]) temp_imm]
                if bmp/data [save/bmp (to-file rejoin [   immagine_f   suff_f/text ".bmp" ]) temp_imm]
               
                ]
            ]
        if y/data [
            dimensioni: temp_imm/size ;this way, we'll use the X resized image or the original image
            if dimensioni/2 > max_H [
                fattore:   dimensioni/2 / max_H  
                temp_L:   layout/tight [ image (dimensioni / fattore) immagine_i ]
                temp_imm: to-image temp_L              
                if png/data [save/png (to-file rejoin [   immagine_f   suff_f/text ".png" ]) temp_imm]
                if bmp/data [save/bmp (to-file rejoin [   immagine_f   suff_f/text ".bmp" ]) temp_imm]
                ]
            ]
        ]
    alert "DONE!"  
    ]  
help_L: layout [
    title "Help"
    text 250 {This is software aims to create small copy of the original images, resize the to smaller size.
        You can choose what dimensions use, if software should check just length or height or both.
        You can select multiple files at one time.
        You can choose the suffix to append at the new images.
        If you need further help, you can contact me:}

    text (rejoin [ "maxint" "@" "tiscali.it" ])
    ]
view layout [
    title "THUMBNAIL GENERATOR"
    across
    x: check true
    h4 "Max Leight:"
    maxL: field (to-string max_L)
    return
    y: check
    h4 "Max Height:"
    maxL: field (to-string max_H)
    return
    h4 "Suffix:"
    suff_f: field suff ;ths suffix to append at the file names of thumbnail immages
    return
    h4 "Output image format:"
    bmp: radio
    text ".bmp"
    png: radio true
    text ".png"
    return
    button "Select image(s)" [ ridimensiona ]
    btn-help [view/new help_L ]
    ]

Tuesday, 3 September 2013

Picture reorder renamer

Sometimes you have to rename pictures in a folder to display them correctly. The following script make this job: open a directory, select image order then press RENUMBER. You can change order and renumber how many times you wish, the file name will remain always of the same length. It contains also image previewer.



Here is the source:

Rebol [
    Title: "Rename & Renumber Pictures"
    file: %rename-pics.r
    purpose: "Renumber & Rename pictures in a folder"
    date: 11/05/2008
    version: 1.0.2
    License: {Copyright (c) <2007>, <Phil Bevan>
All rights reserved.
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.}
]
gv-folder: %./
gv-files: []
gv-ofiles: []
gv-start: 10
gv-inc: 10
gv-pic-max: 200x150
fn-aspect: func [ip-size [pair!] /local x1 y1][
    ; Check x/y size
    x1: gv-pic-max/x
    y1: x1 * ip-size/y / ip-size/x
    either y1 <= gv-pic-max/y [
        return to pair! reduce [x1 y1]
    ][
        y1: gv-pic-max/y
        x1: ip-size/x * y1 / ip-size/y
        return to pair! reduce [x1 y1]
    ]
]
fn-save-flr: func [][write %rename-pics.ini to string! gv-folder]
fn-init-flr: func [][
    either exists? %rename-pics.ini
    [gv-folder: to file! read %rename-pics.ini]
    [gv-folder: %./]
    if not exists? gv-folder [gv-folder: %./]
]
fn-fetch-files: func [/new-fldr /local lv-fldr][
        if new-fldr [
            lv-fldr: request-dir/dir gv-folder
            if lv-fldr <> none [gv-folder: lv-fldr]
        ]
        if gv-folder = none [return]
        either gv-folder = %./ [f-folder/text: to string! gv-folder]
        [f-folder/text: to string! second split-path gv-folder]
        fn-read-files
        fix-slider f-list
        clear f-list/picked
        f-data/text: ""
        fn-high-first
        show [f-list f-data f-folder]
        fn-save-flr
]
fn-read-files: func [/local lv-files sfx lv-file name sh-name][
    clear gv-files
    clear gv-ofiles
    lv-files: sort read gv-folder
    foreach lv-file lv-files [
        sfx: suffix? lv-file
        if any[sfx = %.jpg sfx = %.gif sfx = %.bmp sfx = %.png sfx = %.jpeg] [
            name: copy to-string lv-file
            append gv-files name
            append gv-ofiles lv-file
        ]
    ]
]
; fix slider when text list is updated
fix-slider: func [faces [object! block!] /noreset]
[
    foreach lv-list to-block faces
    [
        if not noreset
        [
            lv-list/sld/data: 0
            lv-list/sn: 0
            lv-list/sld/redrag lv-list/lc / max 1 length? head lv-list/lines
        ]
        show lv-list
    ]
]
fn-up: func [/local curr lv-file][
    if (length? f-list/picked) > 0 [
        curr: find gv-files f-list/picked
        if (index? curr) = 1 [return]
        idx: index? curr
        remove curr
        curr: back curr
        insert curr first f-list/picked
        curr: skip gv-ofiles (idx - 1)
        lv-file: copy first curr
        remove curr
        curr: back curr
        insert curr lv-file
        show f-list
    ]
]
fn-down: func [][
    if (length? f-list/picked) > 0 [
        curr: find gv-files f-list/picked
        if (index? curr) = length? gv-files [return]
        idx: index? curr
        remove curr
        curr: next curr
        insert curr first f-list/picked
        curr: skip gv-ofiles (idx - 1)
        lv-file: copy first curr
        remove curr
        curr: next curr
        insert curr lv-file
        show f-list
    ]
]
fn-refocus: func [][
    focus f-data
    system/view/caret: f-data/text
    system/view/highlight-start: tail f-data/text
    system/view/highlight-end: tail f-data/text
]
fn-update: func [/local ind sfx osfx][
    ind: index? find gv-files first f-list/picked
    sfx: skip f-data/text ((length? f-data/text) - 4)
    osfx: to string! suffix? pick gv-ofiles ind
    if sfx <> osfx [f-data/text: rejoin[f-data/text osfx]]
    poke gv-files ind f-data/text
    clear f-list/picked
    append f-list/picked f-data/text
    fn-refocus
    show [f-list f-data]
]
fn-rename: func [/ok /prt /local count from-file new-file dups new-file-p][
    dups: copy []
    count: gv-start
;rename with qzwx-
    for i 1 length? gv-files 1 [
        to-file: fn-strip to string! gv-files/:i
        from-file: rejoin[gv-folder gv-ofiles/:i]
        new-file: to file! rejoin [fn-pad count " " to-file] ; new file name
        new-file-p: to file! rejoin ["qzwx-" new-file]
        append/only dups reducerejoin[gv-folder new-file-p] new-file]
        if prt [print [from-file " ---> " new-file exists? new-file]]
        if ok [rename from-file new-file-p]
        count: count + gv-inc
    ]
    ; rename without qzwx-
    if any[ok][
        foreach dup dups [
            if ok [rename dup/1 dup/2]
        ]
    ]
    ; refresh list
    fn-fetch-files
]
fn-pad: func [ip-int [integer!]][
    outstr: to-string ip-int
    while [4 > length? outstr] [
        outstr: rejoin ["0" outstr]
    ]
    return outstr
]
fn-strip: func [ip-str [string!] /local i][
    i: 0
    for j 1 length? ip-str 1 [
        if ip-str/:j = #" " [i: j + 1 break]
        if none = find "1234567890" ip-str/:j [i: j break]
    ]
    ip-str: skip ip-str (i - 1)
]
fn-high-up: func [/local lv-file][
    if 0 = length? f-list/picked [return]
    lv-file: first f-list/picked
    curr: find f-list/data lv-file
    if 1 = index? curr [return]
    fn-update
    clear f-list/picked
    append f-list/picked first back curr
    f-data/text: first f-list/picked
    fn-refocus
    show [f-list f-data]
    fn-fit-image
]
fn-high-down: func [/local lv-file][
    if 0 = length? f-list/picked [return]
    lv-file: first f-list/picked
    curr: find f-list/data lv-file
    if (length? gv-files) = index? curr [return]
    fn-update
    clear f-list/picked
    append f-list/picked first next curr
    f-data/text: first f-list/picked
    fn-refocus
    show [f-list f-data]
    fn-fit-image
]
fn-high-first: func [][
    if 0 < length? gv-files [
        append f-list/picked first gv-files
        f-data/text: first gv-files
        focus f-data
    ]
    fn-fit-image
]
fn-fit-image: func [/local lv-file idx][
    if 0 = length? f-list/picked [return]
    idx: index? find gv-files first f-list/picked
    lv-file: gv-ofiles/:idx
    lv-file: rejoin [gv-folder lv-file]
    lv-image: load/all lv-file
    f-image/size: fn-aspect lv-image/size
    f-image/image: lv-image
    show f-image
]
; initial folder
fn-init-flr
; Read the initial files
fn-read-files
;create the layout
lv-lay: layout [
    style btnf btn 200
    backdrop 0.200.0
    origin 4x4
    space 4x0
;     sensor keycode [page-down page-up home end #"^D" #"^A"]
    sensor keycode [up down F1 F2 F5]
    [
        switch value
        [
            F1 [fn-up]
            F2 [fn-down]
            F5 [fn-rename/ok]
            up [fn-high-up]
            down [fn-high-down]
        ]
    ] 0x0
    across
    f-folder: info white to string! gv-folder 604
    return
    panel [
        across
        space 0x0
        f-list: text-list 400x400 data gv-files [f-data/text: value focus f-data show f-data fn-fit-image]
        return
        f-data: field [fn-update] 350
        arrow down 25x25 [fn-down]
        arrow up 25x25 [fn-up]
    ] 400x430
    panel [
        btnf "Renumber (F5)" [fn-rename/ok] 200x40
        f-image: image help.gif gv-pic-max
        space 0x0
        btnf "Change Folder" [fn-fetch-files/new-fldr]
        space 0x20
        btnf "Print" [fn-rename/prt]
        space 0x0
        vtext "F1=Up"
        vtext "F2=Down"
    ] 200x430
]
either gv-folder = %./
[f-folder/text: to string! gv-folder]
[f-folder/text: to string! second split-path gv-folder]
fn-high-first
; display the layout
view/title lv-lay "Rename pictures in a folder"

Friday, 28 June 2013

Auto scroll image

Do you know panoramic images? They are very long images of landscape surrounding the camera.
The following script create the panorama-ss style to use in your program, you can use it this way:
view layout [
styles panorama-ss
panorama http://www.maxvessi.net/rebsite/images/newupperporch360.jpg 500x500
]


Here a demo video:



Here is the source:

REBOL [
    Title: "'Panoramatic image' style"
    Date: 22-May-2002/22:28:36+2:00
    Version: 1.0.0
    File: %panorama-ss.r
    Author: "Oldes"
    Purpose: "Style for scrolling (panoramatic) images"
    Email: oliva.david@seznam.cz
]
panorama-ss: stylize [
    panorama: box 320x120 with [
        rate: 30 m-pos: 0 mov: 1
        p-img: w: w2: ofs1: ofs2: old-rate: none
        effect: [draw [image ofs1 p-img image ofs2 p-img]]
        init: [
            p-img: first facets
            switch type?/word p-img [
                file! [p-img: load p-img]
                url!   [p-img: load read-thru p-img]
            ]
            w: p-img/size/x w2: 2 * w
            ofs1: 0x0 ofs2: to-pair reduce [w 0]
        ]
        feel/engage: func [face action event][
            switch action [
                down [face/m-pos: event/offset/x face/mov: 0
                    if face/rate [face/old-rate: face/rate]
                    face/rate: none
                ]
                over [
                    face/mov: event/offset/x - face/m-pos face/rate: face/old-rate
                    show face
                ]
                time [face/my-draw face]
            ]
        ]
        my-draw: func[face][
            ofs1/x: ofs1/x + mov
            ofs2/x: ofs2/x + mov
            either mov > 0 [
                if ofs1/x >= w [ofs1/x: ofs1/x - w2]
                if ofs2/x >= w [ofs2/x: ofs2/x - w2]
            ][
                if (0 - ofs1/x) >= w [ ofs1/x: ofs1/x + w2]
                if (0 - ofs2/x) >= w [ofs2/x: ofs2/x + w2]
            ]
            show face
        ]
    ]
]
                                                             

Friday, 7 December 2012

Removing superfluos data from JPG images

I found a script that remove unnecessary data form JPG images, so I added a GUI:
Here the source of the script:

Rebol [title: "JPG purger"]
jpg-analyse: func[
    "Analyses the JPG file and tries to remove some unnecessary infos from file"
    file [file! url! binary!]   "JPG file to analyse"
    /remove tags-to-remove [block!] {If not specified these tags are removed:
            ["Photoshop 3.0" "ICC_PROFILE" "Adobe" "Ducky"] if presents}

    /quiet "Will not print informations"
    /local
        to-int buf   jfif version units Xdensity Ydensity
        Xthumbnail Ythumbnail rgb length lng identifier data APP0
][
    if not remove [
        tags-to-remove: [
            "Photoshop 3.0"
            "ICC_PROFILE"
            "Adobe"
            "Ducky"
        ]
    ]
    img: either binary? file [file][read/binary file]
    newimg: make binary! length? img
   
    to-int: func[i][to-integer to-binary i]
    msg: func[m][if not quiet [print m]]
    JFIF: [
        ["JFIF^@"
            copy version 2 skip (
                version: (to-int version/1) + ((to-int version/2) / 100)
            )
            copy units 1 skip (units: to-int units)
            copy Xdensity 2 skip
            copy Ydensity 2 skip
            copy Xthumbnail 1 skip
            copy Ythumbnail 1 skip
            copy rgb to end
        ] (
           
            print "JFIF HEADER:"
            print ["^-   version:" version]
            print ["^-     units:" pick [
                "no units, X and Y specify the pixel aspect ratio"
                "X and Y are dots per inch"
                "X and Y are dots per cm"
                ] 1 + units
            ]
            print ["^-   density:" to-pair reduce [to-int Xdensity to-int Ydensity]]
            print ["^-thumbnail:" to-pair reduce [
                to-int Xthumbnail
                to-int Ythumbnail]
            ]
        )
    ]
    parse/all img [
        copy buf thru "ÿØ" (insert tail newimg buf)
        some [
            "ÿ"
            copy APP0 1 skip
            copy length 2 skip (lng: (to-int length) - 2)
            copy data lng skip (
                identifier: none
                either APP0 = "à" [
                    if not quiet [parse/all data JFIF]
                ][
                    if not none? data [
                    parse/all data [
                        copy identifier to "^@" 1 skip
                        to end
                    ]
                    ]
                ]
                either any [
                    found? find tags-to-remove identifier
                    APP0 = "þ"   ;info about the creator's program
                ][
                    msg either none? identifier [
                        ["Removed data:" data]
                    ][
                        ["Removed tag" mold identifier "lenght:" lng + 4]
                    ]
                ][
                    insert tail newimg rejoin ["ÿ" APP0 length data]
                ]
            )
        ]
        copy buf to end (insert tail newimg buf)
    ]
    msg ["Original   image:" length? img "B"]
    msg ["Optimised image:" length? newimg "B"]
    newimg
]
temp: temp2: none
view layout [
    h1 "JPG purger"
    btn "Select file..." [temp: request-file/only/filter   "*.jpg"  
        if temp [
            a/image: load temp
            temp2: jpg-analyse/quiet read/binary temp
            b/image: load temp2
            aa/text: reform ["Original image " (round/to ((length? img) / 1000) 0.01)   "kb size" ]          
            bb/text: reform ["Removed superfluos data image " (round/to ((length? newimg) / 1000) 0.01) "kb size" ]
            show [a aa b bb]
            ]
        ]
    panel [
    a: image 100x100 effect [aspect ]
    aa: text 100x100
    return
    box 2x200 black
    return
    b: image 100x100 effect [aspect ]
    bb: text 100x100
    ]
    btn "Save..." [write/binary (to-file join (request-text/title/default   "Choose new image name:"   "my-image")   %.jpg )   temp2 ]
    ]
If you need to edit more than one file, for a example all images in a folder, you can use the original script (see below) and launch:
replace-jpgs
here the original source code:
REBOL [
    Title: "JPG analyse"
    Date: 4-Jan-2002/18:22:48+1:00
    Version: 1.0.0
    File: %jpg-analyse.r
    Author: "Oldes"
    Usage: "NEWjpg: jpg-analyse %/e/testjpg.jpg"
    Purpose: {To remove some data from the JPG files to make them smaller.
^-For example files from Adobe contains so many other informations that the file is twice bigger than may be.}
    Email: oliva.david@seznam.cz
]
jpg-analyse: func[
    "Analyses the JPG file and tries to remove some unnecessary infos from file"
    file [file! url! binary!]   "JPG file to analyse"
    /remove tags-to-remove [block!] {If not specified these tags are removed:
            ["Photoshop 3.0" "ICC_PROFILE" "Adobe" "Ducky"] if presents}

    /quiet "Will not print informations"
    /local
        img to-int buf newimg jfif version units Xdensity Ydensity
        Xthumbnail Ythumbnail rgb length lng identifier data APP0
][
    if not remove [
        tags-to-remove: [
            "Photoshop 3.0"
            "ICC_PROFILE"
            "Adobe"
            "Ducky"
        ]
    ]
    img: either binary? file [file][read/binary file]
    newimg: make binary! length? img
   
    to-int: func[i][to-integer to-binary i]
    msg: func[m][if not quiet [print m]]
    JFIF: [
        ["JFIF^@"
            copy version 2 skip (
                version: (to-int version/1) + ((to-int version/2) / 100)
            )
            copy units 1 skip (units: to-int units)
            copy Xdensity 2 skip
            copy Ydensity 2 skip
            copy Xthumbnail 1 skip
            copy Ythumbnail 1 skip
            copy rgb to end
        ] (
           
            print "JFIF HEADER:"
            print ["^-   version:" version]
            print ["^-     units:" pick [
                "no units, X and Y specify the pixel aspect ratio"
                "X and Y are dots per inch"
                "X and Y are dots per cm"
                ] 1 + units
            ]
            print ["^-   density:" to-pair reduce [to-int Xdensity to-int Ydensity]]
            print ["^-thumbnail:" to-pair reduce [
                to-int Xthumbnail
                to-int Ythumbnail]
            ]
        )
    ]
    parse/all img [
        copy buf thru "ÿØ" (insert tail newimg buf)
        some [
            "ÿ"
            copy APP0 1 skip
            copy length 2 skip (lng: (to-int length) - 2)
            copy data lng skip (
                identifier: none
                either APP0 = "à" [
                    if not quiet [parse/all data JFIF]
                ][
                    if not none? data [
                    parse/all data [
                        copy identifier to "^@" 1 skip
                        to end
                    ]
                    ]
                ]
                either any [
                    found? find tags-to-remove identifier
                    APP0 = "þ"   ;info about the creator's program
                ][
                    msg either none? identifier [
                        ["Removed data:" data]
                    ][
                        ["Removed tag" mold identifier "lenght:" lng + 4]
                    ]
                ][
                    insert tail newimg rejoin ["ÿ" APP0 length data]
                ]
            )
        ]
        copy buf to end (insert tail newimg buf)
    ]
    msg ["Original   image:" length? img "B"]
    msg ["Optimised image:" length? newimg "B"]
    newimg
]
replace-jpgs: func[
    "Replaces all JPG files"
    /local path tsz1 tsz2 sz1 sz2 ext img newimg modes
][
    path: to-file ask {Directory? }
    if empty? path [path: %./]
    if (last path) <> #"/" [append path #"/"]
    if not exists? path [print [path "does not exist"] halt]
    tsz1: 0
    tsz2: 0
    foreach file files: read path [
        either dir? path/:file [
            foreach newfile read path/:file [append files file/:newfile]
        ][
            ext: last (parse mold path/:file ".")
            if ext = "jpg" [
                if error? try [
                img: read/binary path/:file
                modes: get-modes path/:file [modification-date owner-write]
                if not last modes [
                    ;change back tail modes true
                    ;set-modes path/:file modes
                    ;uncomment if you want to replace locked files
                ]
                sz1: length? img
                newimg: jpg-analyse/quiet img
                sz2: length? newimg
                tsz1: tsz1 + sz1
                tsz2: tsz2 + sz2
                if sz1 > sz2 [
                    write/binary path/:file newimg
                    set-modes path/:file modes
                    print [path/:file sz1 sz2]
                ]
                ][print ["ERROR: " path/:file]]
            ]
        ]
    ]
    print ["Before: " tsz1]
    print ["Now:     " tsz2]
    print ["Removed:" tsz1 - tsz2]
]                                                                                                                                                



Tuesday, 4 December 2012

Image effector

This is a simple demo of effect on images, made by Nick Antonaccio:
Here the source:
Rebol [
    title: "Image Effector"
    date: 29-june-2008
    file: %image-effector.r
    purpose: {
        A simple GUI demo application.  
        Taken from the tutorial at http://musiclessonz.com/rebol_tutorial.html
    }
]
filename: none
effect-types: ["Invert" "Grayscale" "Emboss" "Blur" "Sharpen" "Flip 1x1" "Rotate 90" "Tint 83" "Contrast 66" "Luma 150" "None"]
image-url: to-url request-text/title/default {Enter the url of an image to use:}   {http://rebol.com/view/demos/palms.jpg}
gui: [
    across
    space -1
    at 20x2 choice 160 tan
    "Save Image"
    "View Saved Image"
    "Download New Image"
    "-------------"
    "Exit" [   switch value [
        "Save Image" [
            filename: to-file request-file/title/file/save {Save file as:} "Save" %/c/effectedimage.png
            save/png filename to-image picture
            ]        
        "View Saved Image" [
            view-filename: to-file request-file/title/file   {View file:} "Save" filename
            view/new center-face layout [image load view-filename]
            ]
        "Download New Image" [
            new-image: load to-url request-text/title/default   {Enter a new image url}   {http://www.rebol.com/view/bay.jpg}
            picture/image: new-image
            show picture ; update the GUI display
            ]
        "-------------" [face/text: "Save Image" show face] ; don't do anything
        "Exit" [quit]      
        ]
    ]
    choice tan "Info" "About" [alert "Image Effector - Copyright 2005, Nick Antonaccio"]
    below
    space 5
    pad 2
    box 550x1 white
    pad 10
    vh1 "Click each effect in the list on the right:"    
    return
    across
    picture: image load image-url
    text-list data effect-types [
        current-effect: to-string value
        picture/effect: to-block form current-effect
        show picture
    ]
]
view/options center-face layout gui [no-title]

Monday, 3 December 2012

Image browser

The following script is an image browser:
You can mix easily this script with other script about image manipulation and drawing, like.
Here the source:

REBOL [
    Title: "Iconic Image Browser"
    Date: 3-Dec-2012
    Version: 2.1.1
    File: %icon-browse2.r
    Author: ["Massimiliano Vessi" "Carl Sassenrath"]
    Purpose: {Browse a directory of images using a scrolling list of icons. }    
]

;-- Read directory, find image files:
newset: func [] [
    flash "Creating thumbnail..."
    files: copy []
    foreach item (read %.) [
        if   find [ %.bmp %.jpg %.gif %.png ]   (suffix? item)   [append files item   ]
        ]
    temp:   copy []
    foreach item files [
        append temp compose [icon (load item) (to-string item) [
            imageb/image: copy face/pane/image  
            image-name/text: face/text
            show [imageb image-name] ]
            ]
        ]
    temp:   layout/tight temp
    unview
    ]
;-- Create icons from images:
newset
;global resize function:

insert-event-func [
    either event/type = 'resize [
    ;resize all widgets wih one line:
    ;print imageb/parent-face/size/y
    icon-list/size/y:   sc/size/y: imageb/size/y:   imageb/parent-face/size/y - 120
    imageb/size/x:   imageb/parent-face/size/x - 140
    show [icon-list sc imageb]
        none   ; return this value when you don't want to do anything else with the event.
    ][event   ; return this value if the specified event is not found ]
]
;-- Main display:
view/options layout [
    title reform ["REBOL" system/script/header/title   system/script/header/version]
    across
    button "Change dir..." [
            change-dir request-dir  
            newset
            icon-list/pane: temp
            sc/data: 0
            show [icon-list   sc]
            ]  
    toggle "fit"     "aspect" [either face/state [ imageb/effect:   'aspect] [imageb/effect: 'fit]    
            show imageb]  
    image-name:   text 280  
    return
    icon-list:   box   70x400 edge [size: 1x1]with [pane:   temp]
    sc: slider 15x400 [
        delta: abs ( icon-list/size/y - temp/size/y)
        icon-list/pane/offset: as-pair 0 (-1 * face/data * delta)
        show icon-list
        ]
    imageb: box 400x400 main-color          
    ] [resize]