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 ]
]
replace-jpgshere 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]
]
No comments:
Post a Comment