画像収集スクリプト
(2006.12.02)
最近の付録はCD-ROMだけではなくDVD-ROMの場合では容量制限がなくなったようなものですからJPEGの解像度がモニタ用ではなくて印刷用に4000x3000ドットとかインフレぎみです。AmigaのブラウザAWebIIでは付録のHTMLで閲覧できないので(DOSルールでファイルやパスを指定してエラー)これまでもJPEGを集めるスクリプトを使って閲覧していましたけれどサムネイルが欲しくなったり(付録のサムネイルまで一般画像扱いだから)印刷用の画像をモニタのサイズに縮小したり色々と自動化してみました。スクリプトを実際に使う方々は(いないと思いますけれど)先頭部分に保存先のパスやImageFXのパスを設定しますのでよく見てください。ブラウザ表示ではスクリプトが文字化けしているハズですからHTMLのソースからコピーしてください。タグ<PRE>を使っているので面倒なしで使えます。
動作の概要は次の通りです。
設定のドライブをルートからツリーウオークします。
拡張子jpgのファイルをImageFXで開きます。
サイズが300x300未満であればサムネイルと見なして無視します。
1024x768より大きいかチェックして大きければ収まるように縮小します。
ファイル名を単純な通番にして拡張子jpegで保存します。
画像表示用のHTMLを生成します。(AWebIIは画像を指定しても表示しないのでHTMLが必要です)
100x100に収まるように縮小してサムネイルを保存します。
サムネイル一覧表示用のHTMLを1個生成します。
収集後にドロワにあるindex.htmlを開くとサムネイルが全部表示されて見たい画像をクリックすると表示される訳です。
/*
$VER: Grab JPEG files. Ver 1.2 2006/12/02
This fllowing lines are config.
EXTENTION=.jpg
TOEXTENTION=.jpeg
GRABPATH=CD0:
TOPATH=hugevol:grabfiles
IMAGEFX=toolsvol:ImageFX4/ImageFX
DRAWER=hugevol:
*/
OPTIONS RESULTS
IF ~ SHOW('L', "rexxsupport.library") THEN DO
IF ADDLIB('rexxsupport.library', 0, -30, 0) THEN DO
SAY "Added rexxsupport.library."
END
ELSE DO
SAY 'ARexx support library not available, exiting'
EXIT 10
END
END
extention = getlinetype('EXTENTION', '.mpg')
toextention = getlinetype('TOEXTENTION', '.mpeg')
grabpath = getlinetype('GRABPATH', 'CD0:')
topath = getlinetype('TOPATH', 'WORK:')
imagefx = getlinetype('IMAGEFX', 'ImageFX')
drawer = getlinetype('DRAWER', 'RAM:')
SAY 'Check ImageFX running.'
ADDRESS COMMAND 'WaitForPort IMAGEFX.1'
IF 5 = RC THEN DO
ADDRESS COMMAND run '"'imagefx'"'
ADDRESS COMMAND 'WaitForPort IMAGEFX.1'
END
ADDRESS "IMAGEFX.1"
resfile = 'RAM:thumbnail.temp'
respath = ''
ADDRESS COMMAND 'requestfile >'resfile' "'drawer'" drawersonly'
IF 1 = OPEN(res_handle, resfile, READ) THEN DO
respath = READLN(res_handle)
CALL CLOSE(res_handle)
IF '"' == LEFT(respath, 1) THEN DO
respath = SUBSTR(respath, 2)
END
IF '"' == RIGHT(respath, 1) THEN DO
respath = LEFT(respath, LENGTH(respath) - 1)
END
IF '/' == RIGHT(respath, 1) THEN DO
respath = LEFT(respath, LENGTH(respath) - 1)
END
END
ADDRESS COMMAND 'delete 'resfile' quiet'
IF '' == respath THEN DO
topath = getuniqdir(topath)
END
ELSE DO
topath = respath
END
SAY 'grab to '''topath'''.'
htmlfile = catpathfile(topath, 'index.html')
SAY 'create html '''htmlfile''''
IF 1 = OPEN(html_handle, htmlfile, WRITE) THEN DO
CALL WRITELN(html_handle, '')
CALL WRITELN(html_handle, '')
filecount = treewalk(grabpath, topath, 0, UPPER(extention), toextention)
CALL WRITELN(html_handle, '')
CALL WRITELN(html_handle, '')
CALL CLOSE(html_handle)
END
SAY 'Quit ImageFX.'
Quit Force
SAY 'summary - grab 'filecount' file(s).'
EXIT
getuniqdir: PROCEDURE
PARSE ARG uniqdir
n = ''
DO WHILE EXISTS(uniqdir''n)
IF '' == n THEN DO
n = 1
END
ELSE DO
n = n + 1
END
END
ADDRESS COMMAND makedir '"'uniqdir''n'"'
RETURN uniqdir''n
getlinetype: PROCEDURE
PARSE ARG typename, def
v = def
linenum = SOURCELINE()
i = 1
DO WHILE '*/' ~== SOURCELINE(i) & i <= linenum
sl = SOURCELINE(i)
IF 1 = INDEX(sl, typename'=') THEN DO
v = SUBSTR(sl, INDEX(sl, '=') + 1)
LEAVE
END
i = i + 1
END
RETURN v
treewalk: PROCEDURE
PARSE ARG grabpath, topath, filecount, extention, toextention
SAY 'check '''grabpath''''
el = LENGTH(extention)
sd = SHOWDIR(grabpath, 'FILE', '"')
slen = LENGTH(sd)
p1 = 1
DO WHILE p1 < slen
p2 = INDEX(sd, '"', p1)
IF 0 = p2 THEN DO
p2 = slen + 1
END
item = SUBSTR(sd, p1, p2 - p1)
item = catpathfile(grabpath, item)
IF extention == UPPER(RIGHT(item, el)) THEN DO
filecount = filefilter(filecount, toextention, topath, item)
END
p1 = p2 + 1
END
sd = SHOWDIR(grabpath, 'DIR', '"')
slen = LENGTH(sd)
p1 = 1
DO WHILE p1 < slen
p2 = INDEX(sd, '"', p1)
IF 0 = p2 THEN DO
p2 = slen + 1
END
item = SUBSTR(sd, p1, p2 - p1)
item = catpathfile(grabpath, item)
filecount = treewalk(item, topath, filecount, extention, toextention)
p1 = p2 + 1
END
RETURN filecount
catpathfile: PROCEDURE
PARSE ARG pathname, filename
IF '' = pathname THEN DO
RETURN filename
END
IF '' = filename THEN DO
return pathname
END
IF ':' = RIGHT(pathname, 1) THEN DO
return pathname''filename
END
IF '/' = RIGHT(pathname, 1) THEN DO
return pathname''filename
END
IF '/' = LEFT(filename, 1) THEN DO
return pathname''filename
END
RETURN pathname'/'filename
filefilter: PROCEDURE
PARSE ARG filecount, toextention, topath, item
newcount = filecount + 1
toitem = RIGHT('0000'newcount, 4)
fileonly = 'file'toitem''toextention
toitem = catpathfile(topath, fileonly)
/*
ADDRESS COMMAND 'copy "'item'" "'toitem'" clone buffer=0'
*/
/* ADDRESS "IMAGEFX.1" */
LoadBuffer item Force New NoSmooth Worst
GetMain
minfo = result
orgwidth = WORD(minfo, 2)
orgheight = WORD(minfo, 3)
IF 300 <= orgwidth & 300 <= orgheight THEN DO
viewwidth = orgwidth
viewheight = orgheight
IF 1024 < viewwidth THEN DO
r = viewwidth / 1024
viewwidth = 1024
viewheight = viewheight % r
END
IF 768 < viewheight THEN DO
r = viewheight / 768
viewwidth = viewwidth % r
viewheight = 768
END
IF viewwidth ~== orgwidth | viewheight ~== orgheight THEN DO
SAY 'Scale to 'viewwidth' x 'viewheight' and save.'
Scale viewwidth viewheight Smooth
SaveBufferAs JPEG toitem Force 100 Progressive Best
END
viewhtml = fileonly'.html'
viewpath = catpathfile(topath, viewhtml)
IF 1 = OPEN(view_handle, viewpath, WRITE) THEN DO
CALL WRITELN(view_handle, '')
CALL WRITELN(view_handle, '')
CALL WRITELN(view_handle, '
')
CALL WRITELN(view_handle, '')
CALL WRITELN(view_handle, '')
CALL CLOSE(view_handle)
END
thumbwidth = orgwidth
thumbheight = orgheight
IF 100 < thumbwidth THEN DO
r = thumbwidth / 100
thumbwidth = 100
thumbheight = thumbheight % r
END
IF 100 < thumbheight THEN DO
r = thumbheight / 100
thumbwidth = thumbwidth % r
thumbheight = 100
END
Scale thumbwidth thumbheight Smooth
thumbitem = 'thumb.'fileonly
thumbpath = catpathfile(topath, thumbitem)
SaveBufferAs JPEG thumbpath Force 100 Progressive Best
CALL WRITELN(html_handle, '
')
filecount = newcount
END
KillBuffer Force
RETURN filecount
