気象衛星の日本付近赤外映像を GIF アニメに

Smalltalk Squeak

FTP クライアント（an FTPClient）と GIF 読み書き（a GIFReadWriter）オブジェクトの使い方の練習をかねて。　指定された時間内に撮影された GOES-9 の赤外映像を過去にさかのぼって FTP サーバ（独ウルム大）より取得し、それぞれをフレームとしてつなぎ合わせ GIF アニメとして保存します。

なお、GIF アニメの生成じたいは当該サイトの cgi サービスを使用すれば可能なので Smalltalk に興味のないかたはそちらを利用したほうが早いでしょう。ほかにも、過去四日間のひまわり６号の QuickTime 動画（高知大）も小さいですがきれいなのでお薦めです。


このスクリプトは Nihongo7、Squeak 3.8 での動作を確認しています。ただ、最後の行は Nihongo7 ではうまく機能しないのでエラーを無視するか、do it する前に削ってください。この行は、作成した GIF アニメを確認のため Squeak システム内に読み込み、表示しているだけなので不要です。GIF アニメファイルは仮想イメージと同じフォルダに作られます。ダウンロードしたオリジナルの GIF 画像 は meteosat-cache フォルダに蓄積され、本スクリプトを再評価した際に利用されます。（追記：GMSN ディレクトリがなくなったので、スクリプトを D2 ディレクトリ用に書き換えました。）

| password past limit cacheDirName serverName path extractDateFromFilename 
  defaultDir cacheDir client cachedGifs gifs forms dates delays writer |

password := FillInTheBlank request: 'password for anonymous ftp\(your email address):' withCRs.
password ifEmpty: [^ self].

past := (FillInTheBlank request: 'how many hours back:' initialAnswer: '48') asInteger ifNil: [48].
limit := DateAndTime now - past hours.
cacheDirName := 'meteosat-cache'.
serverName := 'meteosat.e-technik.uni-ulm.de'.
path := '/pub/meteosat/mono/IR/D2/'.

extractDateFromFilename := [: filenameString |
   DateAndTime
      year: (filenameString first: 4) asInteger
      month: (filenameString copyFrom: 5 to: 6) asInteger
      day: (filenameString copyFrom: 7 to: 8) asInteger
      hour: (filenameString copyFrom: 10 to: 11) asInteger
      minute: (filenameString copyFrom: 12 to: 13) asInteger].

defaultDir := FileDirectory default.
(defaultDir directoryExists: cacheDirName) ifFalse: [defaultDir createDirectory: cacheDirName].
cacheDir := FileDirectory on: (defaultDir fullPathFor: cacheDirName).
cachedGifs := cacheDir entries 
   collect: [: entry | entry name] thenSelect: [: name | name endsWith: 'gif'].

client := client := FTPClient openOnHostNamed: serverName.
[  client loginUser: 'anonymous' password: password.
   client binary.
   client changeDirectoryTo: path.
   gifs := (client getFileList subStrings select: [: filename | 
      (filename endsWith: 'gif') and: [(extractDateFromFilename value: filename) >= limit]]).
   gifs := gifs copyWithoutAll: cachedGifs.
   gifs
      do: [: filename |
         | localFile |
         localFile := cacheDir forceNewFileNamed: filename.
         [  localFile binary.
            localFile nextPutAll: (client getFileNamed: filename) asByteArray
         ] ensure: [localFile close]] 
      displayingProgress: 'getting gif files...'] ensure: [client close].

gifs := cacheDir entries 
   collect: [: entry | entry name]
   thenSelect: [: filename | 
      (filename endsWith: 'gif') and: [(extractDateFromFilename value: filename) >= limit]].

forms := OrderedCollection new.
dates := OrderedCollection new.
gifs := gifs sort.
gifs
   do: [: filename |
      | file aForm |
      file := cacheDir fileNamed: filename.
      [  aForm := GIFReadWriter new setStream: file; nextImage.
         forms add: (aForm scaledToSize: aForm extent // 2) asGrayScale.
         dates add: (extractDateFromFilename value: filename)] ensure: [file close]]
   displayingProgress: 'importing gif images...'.

delays := OrderedCollection new.
(1 to: dates size - 1) do: [: idx |
   delays add: ((dates at: idx + 1) - (dates at: idx)) hours * 3].
delays add: 100.

file := FileStream forceNewFileNamed: gifs last.
[  writer := GIFReadWriter on: file.
   writer loopCount: 20.
   [(1 to: forms size) 
      do: [: idx |
         writer delay: (delays at: idx).
         writer nextPutImage: (forms at: idx)]
      displayingProgress: 'generating animated gif...'] ensure: [writer close]
] ensure: [file close].

(AnimatedImageMorph fromGIFFileNamed: gifs last) openInWorld


#collect:thenSelect: というのは、#collect: してから #select: するだけで、その見かけ(?)ほどたいしたことはしていません。括弧をひとつ省けるくらいでしょうか。似たようなものに #select:thenCollect: というのものあり、これも同様に #select: してから #collect: する作業をひとつのメソッドにまとめただけです。

($a to: $z) select: [: char | char isVowel] thenCollect: [: char | char asUppercase]
=> #($A $E $I $O $U)
(($a to: $z) select: [: char | char isVowel]) collect: [: char | char asUppercase]
=> #($A $E $I $O $U)


#do:displayingProgress: は、パラメータ（引数）として与えられたブロックを評価中に第二パラメータとして与えられた文字列をタイトルにしたプログレスバーを表示します。

(1 to: 1e5) do: [: ii | "処理" ] displayingProgress: '処理中...'

プログレスバーといえば、最近の Squeak システムではこれの表示が変わりました。上が Nihongo7 などの 3.7 まで、下が 3.8 で前のコードを do it したときの様子です。Morphic という新しい GUI フレームワークに切り替わったあともずっと MVC というレガシーな GUI フレームワークを使った描画をしているのはどうなのかなぁ…と引っかかっていたものの、いざなくなってみると、オリジナル Mac などに強い影響を与えた ALTO OS（としての Smalltalk システム）時代の古き良き白黒 GUI 文化(?)がまたひとつ失われてしまうようで、ちょっとさみしくもあります。