Squeak5.0で日本語表示をするシリーズ: (寄り道編)ワークスペース内容をHTMLで保存する機能追加

Squeak5.0の日本語フォント表示周りをぼちぼち直していこうかと件のTTなんたらクラスの動きをちまちま調べている途中、ワークスペースにメソッド内容などをコピペしてメモを作ったりしているうちに、シンタックスハイライトできれいに色づけされた文字属性も保持しつつ保存したくなってきたので、思い切ってそういう機能を追加することにしました。そこで、トリビアルなテクニックなどをご紹介しつつ、作業内容を記したいと思います。


もともとワークスペースの内容は、ウインドウメニュー(以前はマウスの第三ボタンでしたが、今はウインドウタイトルバー右手に設置された青いメニューボタンでプルダウン)から save contents to file... を選択したり、黄ボタン(通常は右クリック)メニューからも more... 経由でポップアップできるシフト黄ボタン(同、右クリック)メニューから同名メニュー項目を選択する(ワークスペースを含む TextMorphForEditView なら可能)ことで保存自体はできるようになっています。

http://squab.no-ip.com/collab/uploads/saveContentsInFile01.png


ちなみにワークスペースでは、内容の保存のつもりで accept (alt/cmd + s) しても、これはビューなど UI コンポーネントでの編集内容がモデル(a Workspace)に反映されるだけで、ファイルへの保存がされているわけではないという点に注意を要します。やっかいなことに、こうしてモデルにビューの内容が反映されて一致した状態になってしまうと、両者に不一致がある状態のままインドウを閉じようとした場合に出る警告(Changes have not been saved. Is it OK to cancel those changes?)が出なくなり、当該ウインドウを容易に閉じてしまうことができるというワナももれなくついてくるのでこれまた要注意です。(もっとも、うっかり閉じてしまったとしても、ガベコレされる前なら、Workspace allInstances を inspect it (alt/cmd + i) して、閉じてしまったと思われるワークスペースのモデルをその内容(contents)からなんとか探し、それに openLabel: 'Workspace' などのメッセージを送ってやれば復活は可能です。念のため。)


さて、ワークスペースの内容の保存に話を元に戻すと、たしかに save contents to file... でファイルとして保存することは可能なのですが、保存されるのは文字列のみで、カラー情報などは抜け落ちてしまいます。そこで、保存時の拡張子を .html にしたときにカラー情報などを保持したまま HTML ファイルとしてはき出す細工をします。


まず、メニューから save contents to file... を選んだときにコールされるメソッド(当該機能の実体)を探します。本来であれば StringHolder(ワークスペースの実体)のソースを読むべきなのですが、操作のトリガーとなるメニュー項目をとっ捕まえて訊ねるのが一番手っ取り早いので、ここではそうします。

適当なワークスペースのウインドウメニューかシフト黄ボタンメニューをポップアップさせて、alt/cmd + シフトキーを押しながら当該メニュー項目をクリックしてモーフ(オブジェクト)として選択します。

http://squab.no-ip.com/collab/uploads/saveContentsInFile02.png


他のモーフ同様、メニュー項目オブジェクト(a MenuItemMorph)も選択すると、ハロー(小さな丸いボタン)に囲まれるので、右手にある灰色のデバッグハローをシフトボタンを押しながらクリック(あるいはただクリックしてポップアップするメニューから inspect morph )して選択されたメニュー項目のインスペクターを呼び出します。

http://squab.no-ip.com/collab/uploads/saveContentsInFile03.png


左側のペインからインスタンス変数である selector をクリックして内容を確認すると、#saveContentsInFile であることがわかります。“#”を含めずに save〜以下を選択して implementors of it (alt/cmd + m) すると、同名メソッドの一覧を呼び出せるので、その中から関連がありそうな TextEditor>>#saveContentsInFile をクリックして選択してそのコードを呼び出します。

http://squab.no-ip.com/collab/uploads/saveContentsInFile04.png


最後のところを下に示す青字の部分を赤字のようにちょっと手直しして置き換え、accept (alt/cmd + s) します。いつもどおり、初回の accept でイニシャルを求められたら教えてあげてください。

TextEditor >> saveContentsInFile
    "Save the receiver's contents string to a file, prompting the user for a
    file-name. Suggest a reasonable file-name."
    | fileName stringToSave parentWindow labelToUse suggestedName |
    stringToSave := paragraph text string.
    stringToSave size = 0
        ifTrue: [^ self inform: 'nothing to save.'].
    parentWindow := model dependents
                detect: [:dep | dep isKindOf: SystemWindow]
                ifNone: [].
    labelToUse := parentWindow
                ifNil: ['Untitled']
                ifNotNil: [parentWindow label].
    suggestedName := nil.
    #(#('Decompressed contents of: ' '.gz' ) )
        do: [:leaderTrailer | | lastIndex | "can add more here..."
            (labelToUse beginsWith: leaderTrailer first)
                ifTrue: [suggestedName := labelToUse copyFrom: leaderTrailer first size + 1 to: labelToUse size.
                    (labelToUse endsWith: leaderTrailer last)
                        ifTrue: [suggestedName := suggestedName copyFrom: 1 to: suggestedName size - leaderTrailer last size]
                        ifFalse: [lastIndex := suggestedName
                                        lastIndexOf: $.
                                        ifAbsent: [0].
                            (lastIndex = 0
                                    or: [lastIndex = 1])
                                ifFalse: [suggestedName := suggestedName copyFrom: 1 to: lastIndex - 1]]]].
    suggestedName
        ifNil: [suggestedName := labelToUse , '.text'].
    fileName := UIManager default request: 'File name?' initialAnswer: suggestedName.
    fileName isEmptyOrNil
        ifFalse: [(fileName endsWith: '.html')
                ifTrue: [FileStream
                        newFileNamed: fileName
                        do: [:file | paragraph text printHtmlOn: file]]
                ifFalse: [FileStream
                        newFileNamed: fileName
                        do: [:file | file nextPutAll: stringToSave]]]
        ifFalse: [(FileStream newFileNamed: fileName) nextPutAll: stringToSave;
                 close]


これで #saveContentsInFile で色情報などを保ったまま HTML での保存が可能になります。上のは実は TextEditor>>>#saveContentsInFile の versions の diff(下のペインの内容)を当該メソッドを用いて HTML保存し、それをコピペしたものです。と、書いていて気がついたのですが打ち消し線とか抜け落ちてしまうのですね。残念。


さて、スタイルを保ったまま保存はできましたが、これを読み込んでワークスペースとして表示できないとうれしさは半減です。そこで、ファイルリストをちょっといじって読み込みもできるようにしましょう。

Squeak 組み込みのファイラであるファイルリスト(Tools メニュー → File List などで呼び出し可能)には、ファイル名のリストにあるファイル(たとえば .html ファイル)を右クリックして選択すると同時に黄ボタンメニューを呼び出すとそこに「workspace with contents」という項目が見つかります。

http://squab.no-ip.com/collab/uploads/saveContentsInFile05.png


これを選ぶと選択したテキストファイルの内容を新しいワークスペースとして開けます。ただ、この機能で注意しないといけないのは、ワークスペースとして表示されたのはあくまでファイルの中身のコピーであり、これを編集して accept したからといって、元ファイルに変更が保存されるわけではない、ということです。なお、ファイルの中身を編集して更新したければ、ファイルリストの下のペインか、spawn (alt/cmd + o) して1ペインのエディタスタイルのウインドウを開いて編集し、accept → overwrite that file する必要があります。


話を戻して、workspace with contents ですが、先の方法でこのメニュー項目のインスペクターを開いて selector を見ても #performServiceFor: とあるだけで、今回は残念ながら機能の実体のメソッド名らしき情報を得ることができません。こういう場合は arguments とか target も順に見ていくとよいです。すると target に SimpleServiceEntry: (a FileList --- viewContentsInWorkspace) とあり、セレクター(メソッド名の実体のシンボル)ではありませんが、それっぽい viewContentsInWorkspace というメソッド名らしき情報を得ることができます。

http://squab.no-ip.com/collab/uploads/saveContentsInFile06.png


試しに、選択して implementors of it すると、はたして興味の対象であるファイルの内容をワークスペースとして表示する機能の実体である FileList>>#viewContentsInWorkspace のコードを呼び出すことができます。

http://squab.no-ip.com/collab/uploads/saveContentsInFile07.png


これを次のように編集して accept してコンパイルします。

FileList >> viewContentsInWorkspace
    
"View the contents of my selected file in a new workspace"
    
    
| aStringOrText aName |
    
directory readOnlyFileNamed: self fullName do: [:file |
        
file setConverterForCode.
        
aStringOrText := (file localName endsWith: '.html') ifFalse: [
            
file contentsOfEntireFile
        
] ifTrue: [
            
(HtmlReadWriter on: file) nextText
        
].
        
aName := file localName.
    
].
    
UIManager default edit: aStringOrText withSqueakLineEndings label: 'Workspace from ', aName


この後、ファイルリストで .html を選択し workspace with contents すると、元のカラー属性などを保ったままワークスペースに内容を復元できるはずです。

Squeak5.0で日本語表示をするシリーズ: FontImporterTool を使う


ご多分に漏れず1バイト文字圏に自由気ままに振る舞われているのと、将来的には EncodingTag/leadingChar とかの仕組みが変わるような話も耳にして、5.0 までになった Squeak ではもはや日本語表示は無理なのかなぁ…4.3J とか 4.4J を使い続けるかなぁ…と、はなからあきらめて試してすらいなかったのですが、id:phaendal さんが http://phaendal.hatenablog.com/entry/2015/11/08/024055 の方法であっさり日本語表示できたの目の当たりにして、改心してちょっと調べてみました。


いろいろと眺めてみたところ、破壊されているのは確かですが、想像していたような壊滅的状況というわけではなく、根気強く直していけばなんとかなりそうな印象でした。しかし、それにつけても TrueType の表示に関わる TTなんちゃらクラス群は似たような名前のクラスが入り交じっていて、TrueType フォント周りはまったく無知な私が自力でなんとかするにしても、状況を把握する段階でかなり時間がかかりそうなので、とりあえず日本語を表示して遊びたいという向けの暫定的情報として FontImporterTool というのを見つけたのでこれだけ書いておきます。


このツールは Appsメニュー → Font Importer 等、あるいは、FontImporterTool open を do it (alt/cmd + d) することで起動できます。その名の通り、TrueType フォントをシステムにリンク、もしくはグリフデータごと読み込んでイメージ(環境)への組込みが可能な機構を持っているようです。

http://squab.no-ip.com/collab/uploads/FontImporterTool01.png


ただ相変わらずの Squeak クオリティで、デフォではいろいろと壊れているのでちょこちょこ直さないとうまく動きません。たとえば現状では、左側で選択したフォントが右側のプレビューで表示されないというなんだかなぁ…なバグがあります。

http://squab.no-ip.com/collab/uploads/FontImporterTool02.png


TrueType フォントファイル(.ttf、.ttc)によっては日本語フォントを提供していても、今の Squeak5.0 では日本語の表示ができないものもあるのでこれは不便です。そこで、とりあえず、FontImportTool>>#currentSelection: をさくっと一カ所修正(#contents を #previewText に変えて accept (alt/cmd + s)。イニシャルを求められたら適当に入れてあげてください)すれば、期待された動作をするようになるはずです。


http://squab.no-ip.com/collab/uploads/FontImporterTool03.png

http://squab.no-ip.com/collab/uploads/FontImporterTool04.png


これで選択したフォントの表示例が(なんとか)出るようになるので、この欄に 'あ' などと入力すれば選択したフォントで日本語表示が可能かどうか手軽に判断できるようになります。

http://squab.no-ip.com/collab/uploads/FontImporterTool05.png


フォントが決まったらインポートなのですが、ここで注意しないといけないのは、日本語表示用のフォントを下のボタンで Import しても表示できないということです。とんでもないワナですね。^^; Import ボタンを押したくなるのをぐっとこらえて、左側の枠の表示できるようにしたいフォント名のところで黄ボタン(通常は右ボタン)クリックし、 Link Font を選ぶ必要があります。

http://squab.no-ip.com/collab/uploads/FontImporterTool06.png


これで、ワークスペースなどの別ウインドウでもフォント選択ツール(FontChooserTool。alt/cmd + k)でフォントを選択すれば表示が可能になります。

http://squab.no-ip.com/collab/uploads/FontImporterTool07.png


システムフォントに設定するなどすれば日本語文字列の表示が可能になるはずです。手元の Windows では日本語入力も IME 経由で可能そうですが、他の OS ではいろいろといじる必要があるかもしれません。他にも、日本語フォントは MultiTTCFont でインポートされなければならないのに TTCFont になっているとか(したがって cache を再構築したりすると死にます)、もろもろの不都合があるので仕組みを勉強しつつ、暇をみて直していければと思っています。

“サイコロの展開図”問題を正規表現がデフォで使える Pharo Smalltalk で(正規表現を使わずに Squeak でも)


Pharo では正規表現が使えるとのことなので、ちょうどそれ向きのお題ということもあり、久しぶりに Pharo で、Squeak 向けのコードの動作確認の範疇をこえて、書き下ろしていろいろ遊んでみました。

| patterns solveDiceDev |

patterns := #(
     '12S/453'
     '1T6/D45'
     '146/53D'
     '15S/3D4'
     '215/T64'
     '2S5/41T'
) inject: OrderedCollection new into: [:sum :pat |
     | alt |
     alt := (pat last: 3), '/', (pat first: 3).
     sum addAll: {pat. pat reversed. alt. alt reversed}; yourself
].

solveDiceDev := [:probStr |
   | boxes regex found |
   boxes := probStr allRegexMatches: '(w|x|y|z)'.
   regex := (probStr copyWithRegex: '(w|x|y|z)' matchesReplacedWith: '(.)') asRegex.
   found := OrderedCollection new.
   patterns do: [:pat |
      (regex matches: pat) ifTrue: [
         found add: (String streamContents: [:ss |
            (1 to: boxes size) do: [:idx |
               ss nextPutAll: (boxes at: idx), '=', (regex subexpression: idx+1)
            ] separatedBy: [ss nextPutAll: ',']
         ])
      ]
   ].
   found size caseOf: {
      [0] -> ['none'].
      [1] -> [found first].
   } otherwise: ['many']
].

#(
   '0' 'Tx4/5yz' 'x=1,y=S,z=2'
   '1' '14S/xyz' 'none'
   '2' '1w6/xyz' 'many'
   '3' '4w3/12S' 'w=5'
   '4' '4w3/S51' 'w=D'
   '5' '15S/wD4' 'w=3'
   '6' '54D/6Tw' 'w=1'
   '7' 'S21/35w' 'w=4'
   '8' 'w2x/354' 'w=S,x=1'
   '9' 'wx1/54D' 'w=6,x=T'
   '10' '45w/12x' 'w=3,x=S'
   '11' '5w2/x14' 'w=S,x=T'
   '12' 'Dw5/x41' 'w=3,x=6'
   '13' 'w4x/1y6' 'w=D,x=5,y=T'
   '14' '15w/xy4' 'w=S,x=3,y=D'
   '15' 'D35/wxy' 'w=6,x=4,y=1'
   '16' '4wx/51y' 'w=6,x=T,y=2'
   '17' 'wTx/D4y' 'w=1,x=6,y=5'
   '18' 'wxy/z3D' 'w=1,x=4,y=6,z=5'
   '19' 'wx5/1yz' 'w=D,x=4,y=T,z=6'
   '20' 'w53/xyz' 'w=4,x=1,y=2,z=S'
   '21' 'wx1/yzD' 'w=6,x=T,y=5,z=4'
   '22' 'wxS/3yz' 'w=1,x=5,y=D,z=4'
   '23' 'wx2/y1z' 'w=5,x=S,y=T,z=4'
   '24' '4wx/2yz' 'w=1,x=T,y=S,z=5'
   '25' 'T6w/xyz' 'w=4,x=2,y=1,z=5'
   '26' 'Swx/yDz' 'w=5,x=1,y=4,z=3'
   '27' 'wDx/yzS' 'w=3,x=4,y=1,z=5'
   '28' 'wxy/5Sz' 'w=T,x=1,y=4,z=2'
   '29' 'wSx/4yz' 'w=2,x=5,y=1,z=T'
   '30' 'wxS/y5z' 'w=1,x=2,y=4,z=3'
   '31' 'wxy/35z' 'w=S,x=2,y=1,z=4'
   '32' 'wxy/T6z' 'w=2,x=1,y=5,z=4'
   '33' 'wxD/yz1' 'w=5,x=4,y=6,z=T'
   '34' '1wx/yz5' 'w=T,x=6,y=D,z=4'
   '35' 'wx3/y5z' 'w=4,x=D,y=S,z=1'
   '36' '6wx/y3z' 'w=4,x=1,y=D,z=5'
   '37' '5wx/4yz' 'w=1,x=2,y=6,z=T'
   '38' 'wx4/Syz' 'w=3,x=5,y=2,z=1'
   '39' 'w3D/xyz' 'w=5,x=1,y=4,z=6'
   '40' 'w3x/6yz' 'w=D,x=5,y=4,z=1'
   '41' 'wxy/z12' 'w=4,x=6,y=T,z=5'
   '42' '1wS/xyz' 'many'
   '43' 'wxy/Dz5' 'many'
   '44' '3w4/xyz' 'many'
   '45' 'wxy/5zD' 'many'
   '46' 'wxy/Tz4' 'many'
   '47' '5wD/xyz' 'many'
   '48' 'wDx/y5z' 'many'
   '49' 'wxy/3z4' 'many'
   '50' 'wxy/5z2' 'many'
   '51' 'Dyz/S1x' 'none'
   '52' 'w1z/xyS' 'none'
   '53' '15x/T6y' 'none'
   '54' 'zy4/5x6' 'none'
   '55' '2xy/4Tz' 'none'
   '56' 'xzS/y1w' 'none'
   '57' 'Syx/4z5' 'none'
   '58' 'xwS/Tzy' 'none'
   '59' 'D5z/xwy' 'none'
   '60' 'yxD/z35' 'none'
) groupsOf: 3 atATimeDo: [:data | self assert: [(solveDiceDev value: data second) = data third]]


Pharo も 4 まで来てだいぶマシになったように思うのですが、4 になって改めて、ifTrue: ifFalse: のイッパツ挿入とか、advance argument(shift + alt + A)とか、これなくして Pharo 使いはいったいどうやってコードを書いているの?といったような、いにしえの Smalltalk-80 〜 Squeak 時代の(かろうじて Pharo 3 までは使えた)便利機能をぶっ壊したまま放置されているところが多々あり、相変わらずいろいろダメなやつですね。

もちろん、今回の正規表現とかコード補完とか、今日日の処理系や IDE にはあってあたりまえの機能があたりまえのようにデフォで用意されている点に関しては Squeak は完全に置いてきぼりにされた感があるので(だが、古き良き機能をぶっ壊すくらいならそれでいい…)、Squeak を知らない世代は Pharo でぜんぜんオッケー、あえて Squeak を使う意味がきっとわからないのでは?とも思いますが。^^;



そんなわけでやっぱりしばらくは Squeak 使いなので Squeak でも動く正規表現を使わない版も書きました。

| boxChars patterns solveDiceDev |

boxChars := 'wxyz'.

patterns := #(
   '12S/453'
   '1T6/D45'
   '146/53D'
   '15S/3D4'
   '215/T64'
   '2S5/41T'
) inject: OrderedCollection new into: [:sum :pat |
   | alt |
   alt := (pat last: 3), '/', (pat first: 3).
   sum addAll: {pat. pat reversed. alt. alt reversed}; yourself
].

solveDiceDev := [:probStr |
   | found |
   found := OrderedCollection new.
   patterns do: [:pat | [:exit |
      found add: (String streamContents: [:ss |
         pat with: probStr do: [:a :b |
            (a = b or: [(boxChars includes: b) and: [ss nextPutAll: {b. $=. a. $,}. true]]) ifFalse: [exit value]
         ].
         ss skip: -1
      ])
   ] valueWithExit].
   found ifEmpty: ['none'] ifNotEmpty: [found size = 1 ifTrue: [found first] ifFalse: ['many']]
].

#(
   '0' 'Tx4/5yz' 'x=1,y=S,z=2'
   '1' '14S/xyz' 'none'
   '2' '1w6/xyz' 'many'
   '3' '4w3/12S' 'w=5'
   '4' '4w3/S51' 'w=D'
   '5' '15S/wD4' 'w=3'
   '6' '54D/6Tw' 'w=1'
   '7' 'S21/35w' 'w=4'
   '8' 'w2x/354' 'w=S,x=1'
   '9' 'wx1/54D' 'w=6,x=T'
   '10' '45w/12x' 'w=3,x=S'
   '11' '5w2/x14' 'w=S,x=T'
   '12' 'Dw5/x41' 'w=3,x=6'
   '13' 'w4x/1y6' 'w=D,x=5,y=T'
   '14' '15w/xy4' 'w=S,x=3,y=D'
   '15' 'D35/wxy' 'w=6,x=4,y=1'
   '16' '4wx/51y' 'w=6,x=T,y=2'
   '17' 'wTx/D4y' 'w=1,x=6,y=5'
   '18' 'wxy/z3D' 'w=1,x=4,y=6,z=5'
   '19' 'wx5/1yz' 'w=D,x=4,y=T,z=6'
   '20' 'w53/xyz' 'w=4,x=1,y=2,z=S'
   '21' 'wx1/yzD' 'w=6,x=T,y=5,z=4'
   '22' 'wxS/3yz' 'w=1,x=5,y=D,z=4'
   '23' 'wx2/y1z' 'w=5,x=S,y=T,z=4'
   '24' '4wx/2yz' 'w=1,x=T,y=S,z=5'
   '25' 'T6w/xyz' 'w=4,x=2,y=1,z=5'
   '26' 'Swx/yDz' 'w=5,x=1,y=4,z=3'
   '27' 'wDx/yzS' 'w=3,x=4,y=1,z=5'
   '28' 'wxy/5Sz' 'w=T,x=1,y=4,z=2'
   '29' 'wSx/4yz' 'w=2,x=5,y=1,z=T'
   '30' 'wxS/y5z' 'w=1,x=2,y=4,z=3'
   '31' 'wxy/35z' 'w=S,x=2,y=1,z=4'
   '32' 'wxy/T6z' 'w=2,x=1,y=5,z=4'
   '33' 'wxD/yz1' 'w=5,x=4,y=6,z=T'
   '34' '1wx/yz5' 'w=T,x=6,y=D,z=4'
   '35' 'wx3/y5z' 'w=4,x=D,y=S,z=1'
   '36' '6wx/y3z' 'w=4,x=1,y=D,z=5'
   '37' '5wx/4yz' 'w=1,x=2,y=6,z=T'
   '38' 'wx4/Syz' 'w=3,x=5,y=2,z=1'
   '39' 'w3D/xyz' 'w=5,x=1,y=4,z=6'
   '40' 'w3x/6yz' 'w=D,x=5,y=4,z=1'
   '41' 'wxy/z12' 'w=4,x=6,y=T,z=5'
   '42' '1wS/xyz' 'many'
   '43' 'wxy/Dz5' 'many'
   '44' '3w4/xyz' 'many'
   '45' 'wxy/5zD' 'many'
   '46' 'wxy/Tz4' 'many'
   '47' '5wD/xyz' 'many'
   '48' 'wDx/y5z' 'many'
   '49' 'wxy/3z4' 'many'
   '50' 'wxy/5z2' 'many'
   '51' 'Dyz/S1x' 'none'
   '52' 'w1z/xyS' 'none'
   '53' '15x/T6y' 'none'
   '54' 'zy4/5x6' 'none'
   '55' '2xy/4Tz' 'none'
   '56' 'xzS/y1w' 'none'
   '57' 'Syx/4z5' 'none'
   '58' 'xwS/Tzy' 'none'
   '59' 'D5z/xwy' 'none'
   '60' 'yxD/z35' 'none'
) groupsOf: 3 atATimeDo: [:data | self assert: [(solveDiceDev value: data second) = data third]]

“とある世界のタクシー料金”問題を Squeak/Pharo Smalltalk で

| cityOfPlace distOfSection additFare initFare fareFor |
cityOfPlace := Dictionary new.
#(円來 'ABC' 炭州 'DEFG') pairsDo: [:ci :pls | pls do: [:pl | cityOfPlace at: pl put: ci]].

distOfSection := {
   'AC'->180.
   'AB'->1090.
   'DA'->540.
   'BC'->960.
   'BG'->1270.
   'DC'->400.
   'CF'->200.
   'DE'->720.
   'DF'->510.
   'EG'->1050.
   'FG'->230
} as: Dictionary.

initFare := {#円來->#(-995 400). #炭州->#(-845 350)} as: Dictionary.
additFare := {#円來->#(-200 60). #炭州->#(-200 50)} as: Dictionary.

fareFor := [:path |
   | path1 distAndFare |
   path1 := path. "for Pharo"
   distAndFare := (initFare at: (cityOfPlace at: path1 first)) copy.
   [path1 size < 2] whileFalse: [
      | section nextDist city |
      section := path1 first: 2.
      nextDist := distOfSection at: section
         ifAbsent: [distOfSection at: (section := section reversed)].
      distAndFare at: 1 incrementBy: nextDist.
      city := cityOfPlace at: section first.
      [distAndFare first positive]
         whileTrue: [distAndFare := distAndFare + (additFare at: city)].
      path1 := path1 allButFirst.
   ].
   distAndFare last
].


#(
   (0  ADFC  510)
   (1  CFDA  500)
   (2  AB  460)
   (3  BA  460)
   (4  CD  400)
   (5  DC  350)
   (6  BG  520)
   (7  GB  530)
   (8  FDA  450)
   (9  ADF  450)
   (10  FDACB  750)
   (11  BCADF  710)
   (12  EDACB  800)
   (13  BCADE  810)
   (14  EGFCADE  920)
   (15  EDACFGE  910)
   (16  ABCDA  960)
   (17  ADCBA  1000)
   (18  BADCFGB  1180)
   (19  BGFCDAB  1180)
   (20  CDFC  460)
   (21  CFDC  450)
   (22  ABGEDA  1420)
   (23  ADEGBA  1470)
   (24  CFGB  640)
   (25  BGFC  630)
   (26  ABGEDFC  1480)
   (27  CFDEGBA  1520)
   (28  CDFGEDABG  1770)
   (29  GBADEGFDC  1680)
) do: [:data | self assert: (fareFor value: data second) = data last]


以下、解説。


cityOfPlace は乗降場所(A〜G)がどちらの市にあるか、の辞書です。

distOfSection は各区間がどのくらいの距離かを調べるための辞書です。キーである区間は乗降場所二カ所を表わす二文字の組み合わせの文字列で、距離を引けるようになっています。両端の乗降場所がある市が異なる場合については、最初の文字の市がその区間が属する市と同一になるようにしました。

initFare、additFare は、それぞれの市(円來、炭州)での初乗り、もしくは、加算の距離と運賃のタプル(配列ですが)を引くための辞書です。

これくらいを用意しておけば、料金体系の違う市が追加されることがあっても対応可能と考えました(無いと思いますが^^;)。


fareFor が料金計算機です。お題にあるように乗降場所のルート(パス)を表わす文字列を与えることでかかった料金の計算をします。


冒頭に

path1 := path. "for Pharo"

とあるのは、Squeak と違い、Pharo ではブロック引数への代入が禁じられているため、書き換え専用の一時変数(path1)を用意したからです。


まず、path1 の一文字目(path1 first)で cityOfPlace 辞書を引いてどちらの市からの乗車かを判定し、さらにその市の初乗り距離と料金のタプルを distAndFare の初期値として得ます。あとで処理を単純な加算ですませられるように、初乗り距離は負にしてあります。

distAndFare := (initFare at: (cityOfPlace at: path1 first)) copy.

あとで破壊的な操作をしているので、得られた値はここでコピーしておかないとひどい目に遭います。^^;


path1 が二文字より少なくなければ、最初の二文字から区間 section を得ます

section := path1 first: 2.


得られた区間をキーにして distOfSection 辞書から距離 nextDist を得ますが、見つからなければ section を逆順にして辞書を引き直します。

nextDist := distOfSection at: section
   ifAbsent: [distOfSection at: (section := section reversed)].


区間を Set のインスタンスとして管理しておけば逆順にして〜のくだりの処理は必要ないので、どうするかすこし迷ったところですが、区間が属する市、ひいては加算距離と料金を得るのに簡単で、distOfSection 辞書を複雑にしない方向にしました。

ここで得られた nextDist をもって、distAndFare の第一要素である初乗り距離(負数)に破壊的に加算します。

distAndFare at: 1 incrementBy: nextDist.

こういうむき出しの処理が入ると、distAndFare は料金メーターかなにかに抽象化したオブジェクトであったほうがコードの可読性が増すのでよいかなとも一瞬思いましたが、たとえば GUI をつけるとか、ゲームやシミュレーションにするとかの方向にこのお題が拡張されることはないと判断し、そういう仕組みを作り込むことはしませんでした。


続いて、必要なら加算距離・料金の計算をするために、区間が属する市を得ます。すでに section は第一文字目が示す乗降場所がその区間が属する市と一致するように変更されているので、キーは section first で事足ります。

city := cityOfPlace at: section first.


負数の初乗り距離に対して、正の区間距離を足していますので、それがゼロ以上になるのを待って(distAndFare first positive)、その間、距離を減算しつつ料金を加算します。

distAndFare := distAndFare + (additFare at: city))

距離と料金のタプル(配列)同士の加算(加算距離の方は負数なので減算)になっているのがミソとなっています。


最後に、path1 から最初の文字を省いて次の区間の計算を同様に繰り返し、

path1 := path1 allButFirst.


パスを消費しつくしたら、タプルの料金の方だけを返し終了する、

   distAndFare last


とそんな感じです。

「進捗・どう・です・か」を Squeak Smalltalk で

タイトルにもあるように「進捗・どう・です・か」をランダムな順序で表示し、「進捗どうですか」が完成したところで適当にクエスチョンマークをつけて去っていくプログラムです。

特に意味もなく文字カウントします。おおよそ数十文字から1000文字程度で目的を成し遂げて去っていきます。

「進捗・どう・です・か」をランダムに表示し「進捗どうですか」が完成したら煽ってくるプログラム | ぞうさんの何でもノート
| elems count tail |
elems := #(進捗 どう です か).
count := 0.
World findATranscript: nil.
Transcript cr.
tail := OrderedCollection new: elems size withAll: ''.
[  Transcript show: (tail removeFirst; add: elems atRandom).
   count := count + tail last size.
   tail asArray = elems
] whileFalse.
Transcript show: '???\' withCRs, count, '文字で煽られました。'

共立出版刊「Common Lisp オブジェクトシステム」の共通例題 Grapher の Smalltalk-80 版を Squeak 1.3 で

Ruby の「特異メソッド」命名の元ネタとも言われる共立出版刊「Common Lisp オブジェクトシステム」にあった各種 OOPL での共通例題の Smalltalk-80 版を Squeak Smalltalk のごく初期のバージョン(1.31)で動かしてみました。


http://squab.no-ip.com/collab/uploads/CLOS-Grapher.png http://squab.no-ip.com/collab/uploads/CLOS-Grapher-ori.png


だいぶ改変しないといけないのかな…とおそるおそる試しててみたところ、GrapherView >> #display を #displayView に変更するなどちょこっと変えるだけで案外あっさり動きました。あと、GrapherController >> #isControlActive は必要ないようだったので削ったり、通常のクリックでもメニューが出るように GrapherController >> #redButtonActivity を追加したりしてあります。


Squeak1.3 は ftp.squeak.org のアーカイブから入手してものを使用しました(Windows 版)。展開して、Squeak1.31.image を Squeak.exe にドロップインすると起動できます。手元の環境では、あらかじめ Squeak.exe のプロパティ→ 互換性で XP 互換にして動かすと安定するように見えました。


CLOS-Grapher.st を Squeak1.31 フォルダに移動してから Squeak 環境内で デスクトップクリック → open... → open file list でファイラを起動し、CLOS-Grapher.st を右クリック → fileIn で環境に読み込めます。Grapher 自体の起動は、下のペイン(選択ファイルの内容)をスクロールするなどして GrapherView open を見つけて選択し(あるいはどこかにタイプして入力してから改めて選択し)、右クリック → do it (d) で起動します。

ウインドウ内をクリックするとメニューが現われるので、add node もしくは複数のノードがある状態で add arc し、十字のマウスポインタで設置したいウインドウ内の位置をクリックする(前者)とノードを、つなぎたい2つのノードを順次クリックして選択する(後者)とアークを追加できます。


ちなみに、ここで用いた Squeak1.31 を使うと、第30回Smalltalk勉強会「もういちどMVC」 で使われた副読本 青木淳さんの「使わないと損をするModel-View-Controller」 のコードを移植した Mickey1(コントローラーが頑張る MVC )、Mickey2(依存性を利用する MVC )、Mickey3(プラガブルを利用する MVC )を動かしてみることも可能です。ぜひ、おためしあれかし。


Common Lisp オブジェクトシステム

Common Lisp オブジェクトシステム

“SEND + MORE = MONEY”ソルバーを Squeak Smalltalk で その4

久しぶりに SEND + MORE = MONEY 。以前書いたもの(ブルートフォース版)の焼き直しなのですが、少しだけ趣を変えてみました。デュードニーの覆面算というのですね。

| int solveAlphametics |

int := [:array | array reversed polynomialEval: 10].

solveAlphametics := [:spec |
   | check ans |
   check := spec value: (ans := OrderedCollection new).
   (0 to: 9) combinations: check numArgs atATimeDo: [:digits |
      digits permutationsDo: [:param | check valueWithArguments: param]].
   ans asArray].

solveAlphametics value: [:ans | [:S :E :N :D :M :O :R :Y |
   | a b c |
   (({S. M} noneSatisfy: #isZero) and: [
      (a := int value: {S.E.N.D})
      + (b := int value: {M.O.R.E})
      = (c := int value: {M.O.N.E.Y})]) ifTrue: [ans add: {a. b. c}]]].
"=> #(#(9567 1085 10652)) "

solveAlphametics value: [:ans | [:W :D :O :T :G :L :E :C :M |
   | a b c |
   (({W. G. D} noneSatisfy: #isZero) and: [
      (a := int value: {W.W.W.D.O.T})
      - (b := int value: {G.O.O.G.L.E})
      = (c := int value: {D.O.T.C.O.M})]) ifTrue: [ans add: {a. b. c}]]].
"=> #(#(777589 188106 589483) #(777589 188103 589486)) "