'From Squeakland 3.8-05 of 1 September 2005 [latest update: #527] on 16 June 2006 at 11:12:46 am'! Object subclass: #CodeOfPhraseTile instanceVariableNames: 'subject verb object' classVariableNames: '' poolDictionaries: '' category: 'Kotodama-codeGenerator'! CodeOfPhraseTile subclass: #CodeOfMathTile instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Kotodama-codeGenerator'! PhraseTileMorph subclass: #DamaMathPhraseTile instanceVariableNames: 'leftTile rightTile opSymbol code ownerPhrase ' classVariableNames: '' poolDictionaries: '' category: 'Kotodama-Item'! PhraseTileMorph subclass: #DamaPhraseTileMorph instanceVariableNames: 'damaMethodInterface verbMorph objectMorph subject compareTile code ' classVariableNames: 'UpdatingOperators ' poolDictionaries: '' category: 'Kotodama-wrapper'! Morph subclass: #TilePadMorph instanceVariableNames: 'type receiverOfCodeChange ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Scripting Tiles'! TilePadMorph subclass: #ReceiverOfMathCodeChange instanceVariableNames: 'place mathPhraseTile' classVariableNames: '' poolDictionaries: '' category: 'Kotodama-codeGenerator'! TilePadMorph subclass: #ReceiverOfPhraseCodeChange instanceVariableNames: 'phraseTile' classVariableNames: '' poolDictionaries: '' category: 'Kotodama-codeGenerator'! TilePadMorph subclass: #ReceiverOfSubjectChange instanceVariableNames: 'subject' classVariableNames: '' poolDictionaries: '' category: 'Kotodama-codeGenerator'! !CategoryViewer methodsFor: 'entries' stamp: 'ko 5/14/2006 01:16'! phraseForCommandFrom: aMethodInterface "Answer a phrase for the non-slot-like command represented by aMethodInterface - classic tiles" | aRow resultType cmd names argType argTile selfTile aPhrase balloonTextSelector stat inst aDocString universal tileBearingHelp damaInterface | aDocString _ aMethodInterface documentation. aDocString = 'no help available' ifTrue: [aDocString _ nil]. names _ scriptedPlayer class namedTileScriptSelectors. resultType _ aMethodInterface resultType. cmd _ aMethodInterface selector. (universal _ scriptedPlayer isUniversalTiles) ifTrue: [aPhrase _ scriptedPlayer universalTilesForInterface: aMethodInterface] ifFalse: [cmd numArgs == 0 ifTrue: [ "主語を作成" universal ifFalse: [ selfTile _ self tileForSelf. ]. (damaInterface _ DamaVocabulary at: cmd) ifNotNil: [ "日本語フレーズタイルを作成する" selfTile _ (TilePadMorph new setType: #Player) addMorph: selfTile. damaInterface methodInterface: aMethodInterface. "フレーズタイル作成" aPhrase _ damaInterface makeTileForSubject: selfTile object: nil categoryViewer: self. aPhrase vocabulary: self currentVocabulary. ] ifNil: [ "既存のeToyフレーズタイルを作成する" aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary. aPhrase setOperator: cmd type: resultType rcvrType: #Player. aPhrase firstSubmorph addMorph: selfTile. ]. selfTile position: aPhrase firstSubmorph position. ] ifFalse: ["only one arg supported in classic tiles, so if this is fed with a selector with > 1 arg, results will be very strange" argType _ aMethodInterface typeForArgumentNumber: 1. "主語を作成" universal ifFalse: [ selfTile _ self tileForSelf. selfTile _ (TilePadMorph new setType: #Player) addMorph: selfTile. ]. "目的語Oを作成" (self isSpecialPatchCase: scriptedPlayer and: cmd) ifTrue: [ argTile _ (Vocabulary vocabularyForType: argType) defaultArgumentTileFor: scriptedPlayer. ] ifFalse: [ argTile _ ScriptingSystem tileForArgType: argType. ]. (#(bounce: wrap:) includes: cmd) ifTrue: ["help for the embattled bj" argTile setLiteral: #silence translated]. (argType == #Number) ifTrue: [argTile removeMorph: argTile submorphs third. "使用しない「→」モーフは削除する" ]. argType == #String ifTrue: [ argTile removeMorph: argTile submorphs second. "使用しない「→」モーフは削除する" ]. argTile _ (TilePadMorph new setType: (argType ifNil: [#Object])) addMorph: argTile. "日本語フレーズタイルを作成" (damaInterface _ DamaVocabulary at: cmd) ifNotNil: [ damaInterface methodInterface: aMethodInterface. aPhrase _ damaInterface makeTileForSubject: selfTile object: argTile categoryViewer: self. aPhrase vocabulary: self currentVocabulary. ] ifNil: [ "既存のeToyフレーズタイルを作成する" aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary. aPhrase setOperator: cmd type: resultType rcvrType: #Player argType: argType. aPhrase lastSubmorph addMorph: argTile. aPhrase firstSubmorph addMorph: selfTile. ]. selfTile position: aPhrase firstSubmorph position. argTile position: aPhrase lastSubmorph position. argTile receiverOfCodeChange: ( ReceiverOfPhraseCodeChange new phraseTile: aPhrase ). ] ]. (scriptedPlayer slotInfo includesKey: cmd) ifTrue: [balloonTextSelector _ #userSlot]. (scriptedPlayer belongsToUniClass and: [scriptedPlayer class includesSelector: cmd]) ifTrue: [aDocString ifNil: [aDocString _ (scriptedPlayer class userScriptForPlayer: scriptedPlayer selector: cmd) documentation]. aDocString ifNil: [balloonTextSelector _ #userScript]]. tileBearingHelp _ universal ifTrue: [aPhrase submorphs second] ifFalse: [aPhrase operatorTile]. aDocString ifNotNil: [tileBearingHelp setBalloonText: aDocString] ifNil: [balloonTextSelector ifNil: [tileBearingHelp setProperty: #inherentSelector toValue: cmd. balloonTextSelector _ #methodComment]. tileBearingHelp balloonTextSelector: balloonTextSelector]. "カテゴリビューワ内にあることを宣言する。これをやらないと、PhraseTileをクリックしたときに複製されない" aPhrase markAsPartsDonor. cmd == #emptyScript ifTrue: [aPhrase setProperty: #newPermanentScript toValue: true. aPhrase setProperty: #newPermanentPlayer toValue: scriptedPlayer. aPhrase submorphs second setBalloonText: 'drag and drop to add a new script' translated]. aRow _ DamaViewerLine newRow borderWidth: 0; color: self color. aRow elementSymbol: cmd asSymbol. aRow addMorphBack: (Morph new extent: 2@2; beTransparent). aRow addMorphBack: (self infoButtonFor: cmd). aRow addMorphBack: aPhrase. aRow addMorphBack: (AlignmentMorph new beTransparent). aRow addMorphBack: (ScriptingSystem tryButtonFor: aPhrase). aPhrase on: #mouseEnter send: #addCommandFeedback to: aRow. aPhrase on: #mouseLeave send: #removeHighlightFeedback to: aRow. aPhrase on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. (names includes: cmd) ifTrue: [aPhrase userScriptSelector: cmd. cmd numArgs == 0 ifTrue: ["aPhrase beTransparent. 透明化はしない" aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer. aRow addMorphBack: (stat _ (inst _ scriptedPlayer scriptInstantiationForSelector: cmd) statusControlMorph). inst updateStatusMorph: stat]]. aRow beSticky; disableDragNDrop. ^ aRow!]lang[(708 5 139 15 143 9 166 3 4 12 476 5 154 3 1 3 461 16 95 16 104 13 280 3 4 12 1249 29 10 16 959 7 258)0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0! ! !CategoryViewer methodsFor: 'entries' stamp: 'ko 5/14/2006 01:32'! phraseForVariableFrom: aMethodInterface "Return a structure consisting of tiles and controls and a readout representing a 'variable' belonging to the player, complete with an appropriate readout when indicated. Functions in both universalTiles mode and classic mode. Slightly misnamed in that this path is used for any methodInterface that indicates an interesting resultType." | anArrow slotName getterButton cover inner aRow doc setter tryer universal hotTileForSelf spacer buttonFont damaInterface aPhrase object aVariableSpace inherent wording | "ViewerLineの初期化" aRow _ DamaViewerLine newRow color: self color; beSticky; elementSymbol: (slotName _ aMethodInterface selector); wrapCentering: #center; cellPositioning: #leftCenter. "スペイサーと情報ボタンとスペイサーの追加" (universal _ scriptedPlayer isUniversalTiles) ifFalse: [buttonFont _ Preferences standardEToysFont. "aRow addMorphBack: (Morph new color: self color; extent: (((buttonFont widthOfString: '!!') + 8) @ (buttonFont height + 6)); yourself)" ]. "spacer" aRow addMorphBack: (self infoButtonFor: slotName). aRow addMorphBack: (Morph new color: self color; extent: 0@10). " vertical spacer" chosenCategorySymbol = 'variables' ifTrue: [ inherent _ Utilities inherentSelectorForGetter: slotName. wording _ (scriptedPlayer slotInfo includesKey: inherent) ifTrue: [inherent] ifFalse: [self currentVocabulary tileWordingForSelector: slotName ]. damaInterface _ DamaVariableInterface new. damaInterface initialize: slotName variableName: wording. damaInterface methodInterface: aMethodInterface. aVariableSpace _ self phraseForValue: damaInterface methodInterface: aMethodInterface row: aRow. aRow addMorphBack: aVariableSpace. ^aRow. ]. "日本語フレーズタイルを作成する" (damaInterface _ DamaVocabulary at: slotName) ifNotNil: [ damaInterface methodInterface: aMethodInterface. (setter _ aMethodInterface companionSetterSelector) ifNil: [ ( damaInterface isKindOf: DamaVariableInterface ) ifTrue: [ "主語タイルの生成(ex.四角形)" hotTileForSelf _ self tileForSelf. hotTileForSelf _ (TilePadMorph new setType: #Player) addMorph: hotTileForSelf. "フレーズタイル作成" slotName = #getNewClone ifTrue: [ aPhrase _ damaInterface makeVariableTileForMethodInterface: aMethodInterface categoryViewer: self haveCurrentValue: false. ] ifFalse: [ aPhrase _ damaInterface makeVariableTileForMethodInterface: aMethodInterface categoryViewer: self haveCurrentValue: true. ]. aPhrase vocabulary: self currentVocabulary. aPhrase resultType: aMethodInterface resultType. "マウスがタイルの上を通ると、ハイライト(丸で囲まれる)が為されるようにする" aPhrase on: #mouseEnter send: #addCommandFeedback to: aRow. aPhrase on: #mouseLeave send: #removeHighlightFeedback to: aRow. aPhrase on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. "カテゴリビューワ内にあることを宣言する。これをやらないと、PhraseTileをクリックしたときに複製されない" aPhrase markAsPartsDonor. aRow addMorphBack: aPhrase. ] ifFalse: [ (slotName = #overlaps:) ifTrue: [ object _ self tileForSelf. object _ (TilePadMorph new setType: #Player) addMorph: object. ]. (slotName = #overlapsAny:) ifTrue: [ object _ self tileForSelf. object _ (TilePadMorph new setType: #Player) addMorph: object. ]. (slotName = #touchesA: ) ifTrue: [ object _ self tileForSelf. object _ (TilePadMorph new setType: #Player) addMorph: object. ]. "主語タイルの生成(ex.四角形の) ☆☆☆コメントアウト☆☆☆" "hotTileForSelf _ self tileForSelf bePossessive. hotTileForSelf on: #mouseDown send: #makeGetter:event:from: to: self withValue: (Array with: aMethodInterface selector with: aMethodInterface resultType)." "主語タイルの生成(ex.四角形)" hotTileForSelf _ self tileForSelf. hotTileForSelf _ (TilePadMorph new setType: #Player) addMorph: hotTileForSelf. damaInterface methodInterface: aMethodInterface. "フレーズタイル作成" aPhrase _ damaInterface makeTileForSubject: hotTileForSelf object: object categoryViewer: self. aPhrase vocabulary: self currentVocabulary. aPhrase resultType: aMethodInterface resultType. "マウスがタイルの上を通ると、ハイライト(丸で囲まれる)が為されるようにする" aPhrase on: #mouseEnter send: #addCommandFeedback to: aRow. aPhrase on: #mouseLeave send: #removeHighlightFeedback to: aRow. aPhrase on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. "カテゴリビューワ内にあることを宣言する。これをやらないと、PhraseTileをクリックしたときに複製されない" aPhrase markAsPartsDonor. aRow addMorphBack: aPhrase. ]. ] ifNotNil: [ aVariableSpace _ self phraseForValue: damaInterface methodInterface: aMethodInterface row: aRow. aRow addMorphBack: aVariableSpace. ]. ^aRow ]. universal ifTrue: [ inner _ scriptedPlayer universalTilesForGetterOf: aMethodInterface. cover _ Morph new color: Color transparent. cover extent: inner fullBounds extent. (getterButton _ cover copy) addMorph: cover; addMorphBack: inner. cover on: #mouseDown send: #makeUniversalTilesGetter:event:from: to: self withValue: aMethodInterface. aRow addMorphFront: (tryer _ ScriptingSystem tryButtonFor: inner). tryer color: tryer color lighter lighter] ifFalse: [ "主語タイルの生成(ex.四角形の)" hotTileForSelf _ self tileForSelf bePossessive. hotTileForSelf on: #mouseDown send: #makeGetter:event:from: to: self withValue: (Array with: aMethodInterface selector with: aMethodInterface resultType). aRow addMorphBack: hotTileForSelf. "主語タイルと動詞タイルの間のスペイサー" aRow addMorphBack: (spacer _ Morph new color: self color; extent: 2@10). "スペイサーにイベント設定を施す" spacer on: #mouseEnter send: #addGetterFeedback to: aRow. spacer on: #mouseLeave send: #removeHighlightFeedback to: aRow. spacer on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. spacer on: #mouseDown send: #makeGetter:event:from: to: self withValue: (Array with: aMethodInterface selector with: aMethodInterface resultType). "主語タイルにイベント設定を施す" hotTileForSelf on: #mouseEnter send: #addGetterFeedback to: aRow. hotTileForSelf on: #mouseLeave send: #removeHighlightFeedback to: aRow. hotTileForSelf on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. "動詞タイル(ex.モーフはその色に触れているか)を生成する" getterButton _ self getterButtonFor: aMethodInterface selector type: aMethodInterface resultType. ]. "動詞タイルを追加する" aRow addMorphBack: getterButton. "動詞タイルにイベント設定を施す" getterButton on: #mouseEnter send: #addGetterFeedback to: aRow. getterButton on: #mouseLeave send: #removeHighlightFeedback to: aRow. getterButton on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow. (doc _ aMethodInterface documentation) ifNotNil: [getterButton setBalloonText: doc]. "????" (scriptedPlayer slotInfo includesKey: (Utilities inherentSelectorForGetter: slotName)) "user slot" ifTrue: ["aRow addTransparentSpacerOfSize: 3@0. aRow addMorphBack: (self slotTypeMenuButtonFor: varName)"]. "特殊なタイルの場合の処理" universal ifFalse: [(slotName == #seesColor:) ifTrue: [self addIsOverColorDetailTo: aRow. ^ aRow]. (slotName == #touchesA:) ifTrue: [self addTouchesADetailTo: aRow. ^ aRow]. (slotName == #overlaps: or: [ slotName == #overlapsAny:]) ifTrue: [self addOverlapsDetailTo: aRow. ^ aRow]]. "末尾に、フレキシブルに大きさが変わるスペイサーを入れる" aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" "変数の場合は、代入文用の矢印「_」マークを追加する" setter _ nil.anArrow _ nil. (setter _ aMethodInterface companionSetterSelector) ifNotNil: [ aRow addMorphBack: (Morph new color: self color; extent: 2@10). anArrow _ universal ifTrue: [self arrowSetterButton: #newMakeSetterFromInterface:evt:from: args: aMethodInterface] ifFalse: [self arrowSetterButton: #makeSetter:from:forPart: args: (Array with: slotName with: aMethodInterface resultType)]. anArrow beTransparent. universal ifFalse: [anArrow on: #mouseEnter send: #addSetterFeedback to: aRow. anArrow on: #mouseLeave send: #removeHighlightFeedback to: aRow. anArrow on: #mouseLeaveDragging send: #removeHighlightFeedback to: aRow]. aRow addMorphBack: anArrow. ]. "変数値タイルを追加する" (#(color:sees: playerSeeingColor copy touchesA: overlaps: getTurtleAt: getTurtleOf:) includes: slotName) ifFalse: [(universal and: [slotName == #seesColor:]) ifFalse: [aMethodInterface wantsReadoutInViewer ifTrue: [ aRow addMorphBack: (self readoutFor: slotName type: aMethodInterface resultType readOnly: setter isNil getSelector: aMethodInterface selector putSelector: setter). ]]]. anArrow ifNotNil: [anArrow step]. ^ aRow!]lang[(568 4 183 20 979 15 247 9 3 4 131 9 466 37 218 29 10 16 553 9 3 19 232 9 3 4 185 9 236 37 218 29 10 16 749 9 3 5 263 19 83 15 369 15 234 6 3 20 113 10 40 15 308 4 221 12 313 27 80 15 1 9 723 11 491)0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0! ! !CodeOfPhraseTile methodsFor: 'access' stamp: 'ko 5/13/2006 22:05'! objectMorph ^object! ! !CodeOfPhraseTile methodsFor: 'access' stamp: 'ko 5/13/2006 22:05'! objectMorph: o object_o! ! !CodeOfPhraseTile methodsFor: 'access' stamp: 'ko 5/13/2006 22:04'! subjectMorph ^subject! ! !CodeOfPhraseTile methodsFor: 'access' stamp: 'ko 5/13/2006 22:05'! subjectMorph: s subject_s! ! !CodeOfPhraseTile methodsFor: 'access' stamp: 'ko 5/13/2006 22:05'! verbMorph ^verb! ! !CodeOfPhraseTile methodsFor: 'access' stamp: 'ko 5/13/2006 22:05'! verbMorph: v verb_v! ! !CodeOfPhraseTile methodsFor: 'code' stamp: 'ko 5/13/2006 22:21'! catchDivideByZero: aStream indent: tabCount "See if I am have divide as my operator. If so, insert a test in the argument to divide." | exp | "secondMorph ではなく、verbMorphに変えた。Morph位置に拘束されないコードであるべき" self verbMorph type = #operator ifFalse: [^false]. "not me" exp _ self verbMorph operatorOrExpression. (#(/ // \\) includes: exp) ifFalse: [^false]. "not me" aStream space. aStream nextPutAll: '(self beNotZero: '. (self objectMorph) storeCodeOn: aStream indent: tabCount. aStream nextPut: $). ^true!]lang[(160 5 9 5 5 17 309)0,5,0,5,0,5,0! ! !CodeOfPhraseTile methodsFor: 'code' stamp: 'ko 5/13/2006 22:03'! storeCodeOn: aStream indent: tabCount aStream nextPut: $(. "主語タイルがPhraseTileかそうでないかが、主語のコード化で問題になる 例えば変数「四角形のx座標」が主語になっている場合(ex.四角形のx座標を100に変える)、 この主語はPhraseTileであり、コード化すると「self getX」になってしまう。そうすると 「四角形のx座標を100に変える」→ self getX setX: 100 という妙なコード化をしてしまう。これは困る。 そこでここではPhraseTileでなければ普通に主語にstoreCodeOnメッセージを送る、 PhraseTileだった場合は、そのPhraseTileのさらに主語に対してstoreCodeOnメッセージを送ることで解決する。 この場合は「四角形」に対してstoreCodeOnを送ることで、先ほどのコード化は self setX: 100 となる" self subjectMorph class name = 'TilePadMorph' ifTrue: [ self subjectMorph storeCodeOn: aStream indent: tabCount. ] ifFalse: [ self subjectMorph subjectMorph storeCodeOn: aStream indent: tabCount. ]. aStream space. "動詞モーフに対してstoreCodeOnメッセージを送って、メソッド名を出力させる" self verbMorph storeCodeOn: aStream indent: tabCount. "引数モーフに対してstoreCodeOnメッセージを送って、引数を出力させる" self objectMorph ifNotNil: [(self catchDivideByZero: aStream indent: tabCount) ifFalse: [aStream space. (self objectMorph) storeCodeOn: aStream indent: tabCount]]. aStream nextPut: $) !]lang[(65 6 10 22 3 26 3 17 3 5 10 12 9 14 4 18 24 22 4 7 10 11 11 9 13 9 10 10 11 16 3 14 11 16 21 3 234 9 11 21 62 9 11 18 218)0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0! ! !CodeOfMathTile methodsFor: 'code' stamp: 'ko 5/13/2006 22:57'! storeCodeOn: aStream indent: tabCount aStream nextPut: $( . self subjectMorph storeCodeOn: aStream indent: tabCount. aStream nextPutAll: ' ' , self verbMorph , ' '. self objectMorph storeCodeOn: aStream indent: tabCount. aStream nextPutAll: ')'.! ! !DamaCompoundTileMorph methodsFor: 'as yet unclassified' stamp: 'ko 5/14/2006 15:49'! addValueTile: valueTile valueTile damaMethodInterface methodInterface resultType = #Boolean ifTrue: [ valueTile changeToNounView. ]. valueTile isCompoundMode ifFalse: [ valueTile changeCompoundView. ]. testPart removeAllMorphs. testPart insertTileRow: ( Array with: valueTile ) after: 0. (valueTile damaMethodInterface isKindOf: DamaBooleanVariableInterface) ifTrue: [ self changeJoukenTileDroppedMode: valueTile damaMethodInterface. ]. valueTile compareMethodInterface ifNotNil: [ self changeJoukenTileDroppedMode: valueTile compareMethodInterface. ].! ! !DamaMathPhraseTile methodsFor: 'initialization' stamp: 'ko 5/14/2006 01:05'! initialize: op contents: opString | m1 | super initialize. code _ CodeOfMathTile new. resultType _ #Number. self vResizing: #shrinkWrap. borderWidth _ 1. self borderColor: (Color r: 0.806 g: 0.774 b: 0.581). color _ (Color r: 0.806 g: 1.0 b: 0.806). self layoutInset: 1. code verbMorph: op. m1 _ ScriptingSystem tileForArgType: #Number. m1 removeMorph: m1 submorphs third. code objectMorph: m1. m1 _ (TilePadMorph new setType: #Number ) addMorph: m1. m1 receiverOfCodeChange: ( ReceiverOfMathCodeChange new place: #right ; mathPhraseTile: self ). self addMorph: m1. self addMorph: ( StringMorph new contents: opString ). m1 _ ScriptingSystem tileForArgType: #Number. m1 removeMorph: m1 submorphs third. code subjectMorph: m1. m1 _ (TilePadMorph new setType: #Number ) addMorph: m1. m1 receiverOfCodeChange: ( ReceiverOfMathCodeChange new place: #left ; mathPhraseTile: self ). self addMorph: m1. ! ! !DamaMathPhraseTile methodsFor: 'code' stamp: 'ko 5/13/2006 23:32'! storeCodeOn: aStream indent: tabCount self code storeCodeOn: aStream indent: tabCount. ! ! !DamaMathPhraseTile methodsFor: 'event' stamp: 'ko 5/13/2006 23:32'! mouseDown: evt "Handle a mouse-down on the receiver" | argTile phraseTile editor tilepad | self isPartsDonor ifTrue: [^super mouseDown: evt]. submorphs isEmpty ifTrue: [^ super mouseDown: evt]. ( owner isKindOf: TilePadMorph ) ifTrue: [ tilepad _ owner. argTile _ DamaUtil makeDefaultTile: owner type. "ObjectMorph(引数タイル)に新しいタイルをセットする" ( phraseTile _ self ownerThatIsA: DamaMathPhraseTile) ifNotNil: [ phraseTile code subjectMorph = self ifTrue: [ phraseTile code subjectMorph: argTile. ] ifFalse: [ phraseTile code objectMorph: argTile. ]. ] ifNil: [ (self ownerThatIsA: DamaPhraseTileMorph) objectMorph: argTile. ]. owner addMorphBack: argTile. owner removeMorph: self. (editor := tilepad topEditor) ifNotNil: [editor install]. ^evt hand grabMorph: self. ]. ^super mouseDown: evt.!]lang[(332 20 491)0,5,0! ! !DamaMathPhraseTile methodsFor: 'access' stamp: 'ko 5/13/2006 23:06'! code ^code! ! !DamaModPhraseTile methodsFor: 'initialization' stamp: 'ko 6/16/2006 10:19'! initialize | m1 | super initialize. code _ CodeOfMathTile new. resultType _ #Number. self vResizing: #shrinkWrap. borderWidth _ 1. self borderColor: (Color r: 0.806 g: 0.774 b: 0.581). color _ (Color r: 0.806 g: 1.0 b: 0.806). self layoutInset: 1. self code verbMorph: '\\'. m1 _ ScriptingSystem tileForArgType: #Number. m1 removeMorph: m1 submorphs third. self code subjectMorph: m1. m1 _ (TilePadMorph new setType: #Number) addMorph: m1. m1 receiverOfCodeChange: ( ReceiverOfMathCodeChange new place: #left ; mathPhraseTile: self ). self addMorph: m1. self addMorphBack: ( StringMorph new contents: 'を' ). m1 _ ScriptingSystem tileForArgType: #Number. m1 removeMorph: m1 submorphs third. self code objectMorph: m1. m1 _ (TilePadMorph new setType: #Number) addMorph: m1. m1 receiverOfCodeChange: ( ReceiverOfMathCodeChange new place: #right ; mathPhraseTile: self ). self addMorphBack: m1. self addMorphBack: ( StringMorph new contents: 'で割った余り' ). !]lang[(636 1 354 6 6)0,5,0,5,0! ! !DamaPhraseTileMorph methodsFor: 'code generation' stamp: 'ko 5/13/2006 22:16'! code ^code! ! !DamaPhraseTileMorph methodsFor: 'code generation' stamp: 'ko 5/13/2006 22:16'! code: c code _ c! ! !DamaPhraseTileMorph methodsFor: 'code generation' stamp: 'ko 5/13/2006 22:19'! storeCodeOn: aStream indent: tabCount self code storeCodeOn: aStream indent: tabCount. ! ! !DamaPhraseTileMorph methodsFor: 'accessing' stamp: 'ko 5/13/2006 22:06'! objectMorph ^ code objectMorph! ! !DamaPhraseTileMorph methodsFor: 'accessing' stamp: 'ko 5/13/2006 22:07'! objectMorph: o code objectMorph:o! ! !DamaPhraseTileMorph methodsFor: 'accessing' stamp: 'ko 5/13/2006 22:10'! operatorTile ^ code verbMorph! ! !DamaPhraseTileMorph methodsFor: 'accessing' stamp: 'ko 5/13/2006 22:07'! subjectMorph "主語を取り出す" ^ code subjectMorph!]lang[(14 7 22)0,5,0! ! !DamaPhraseTileMorph methodsFor: 'accessing' stamp: 'ko 5/13/2006 22:07'! subjectMorph: s code subjectMorph: s! ! !DamaPhraseTileMorph methodsFor: 'accessing' stamp: 'ko 5/13/2006 22:07'! verbMorph ^ code verbMorph! ! !DamaPhraseTileMorph methodsFor: 'accessing' stamp: 'ko 5/13/2006 22:07'! verbMorph: v code verbMorph: v! ! !DamaPhraseTileMorph methodsFor: 'event handling' stamp: 'ko 5/13/2006 23:15'! mouseDown: evt "Handle a mouse-down on the receiver" | argTile booleanScriptEditor editor tilepad phraseTile | self isPartsDonor ifTrue: [^super mouseDown: evt]. submorphs isEmpty ifTrue: [^ super mouseDown: evt]. "どこかの引数タイルとして埋め込まれていたときにマウスで掴まれたら 命令タイル(DamaPhraseTile)の見た目を更新する" ( owner isKindOf: TilePadMorph ) ifTrue: [ tilepad _ owner. "代わりのタイルを作成する" argTile _ DamaUtil makeDefaultTile: owner type. "ObjectMorph(引数タイル)に新しいタイルをセットする" ( phraseTile _ self ownerThatIsA: DamaMathPhraseTile) ifNotNil: [ phraseTile code subjectMorph = self ifTrue: [ phraseTile code subjectMorph: argTile. ] ifFalse: [ phraseTile code objectMorph: argTile. ]. ] ifNil: [ (self ownerThatIsA: DamaPhraseTileMorph) objectMorph: argTile. ]. "代わりのタイルをaddする" owner addMorphBack: argTile. "自分をremoveする" owner removeMorph: self. (editor := tilepad topEditor) ifNotNil: [editor install]. ^evt hand grabMorph: self. ]. "テストタイルにて調べる対象になっていた時に掴まれたら テストタイルの見た目を更新する" ( owner owner isKindOf: DamaBooleanScriptEditor ) ifTrue: [ booleanScriptEditor _ owner owner. "自分をremoveする" owner removeMorph: self. "テストタイルの見た目を更新する" booleanScriptEditor initializeView. ^evt hand grabMorph: self. ]. ^super mouseDown: evt.!]lang[(224 32 3 6 14 10 70 12 67 20 316 8 3 2 37 3 6 2 127 26 3 15 104 3 6 2 33 15 98)0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0,5,0! ! !DamaPhraseTileMorph methodsFor: 'initialization' stamp: 'ko 5/13/2006 22:06'! initialize super initialize. borderWidth _ 1. self borderColor: (Color r: 0.806 g: 0.774 b: 0.581). color _ (Color r: 0.806 g: 1.0 b: 0.806). self layoutInset: 1. code _ CodeOfPhraseTile new.! ! !DamaPhraseTileMorph methodsFor: 'as yet unclassified' stamp: 'ko 6/16/2006 09:44'! duplicate "Make and return a duplicate of the receiver" | newMorph | newMorph _ super duplicate. "newMorph code: self code duplicate." ^ newMorph! ! !DamaRandomTile methodsFor: 'as yet unclassified' stamp: 'ko 6/16/2006 10:13'! mouseDown: evt "Handle a mouse-down on the receiver" | argTile phraseTile tilepad editor | ( owner isKindOf: TilePadMorph ) ifTrue: [ tilepad _ owner. argTile _ DamaUtil makeDefaultTile: owner type. ( phraseTile _ self ownerThatIsA: DamaMathPhraseTile orA: DamaModPhraseTile ) ifNotNil: [ phraseTile code subjectMorph = self ifTrue: [ phraseTile code subjectMorph: argTile. ] ifFalse: [ phraseTile code objectMorph: argTile. ]. ] ifNil: [ ( self ownerThatIsA: DamaPhraseTileMorph ) code objectMorph: argTile. ]. owner addMorphBack: argTile. owner removeMorph: self. ( editor _ tilepad topEditor ) ifNotNil: [ editor install ]. ^evt hand grabMorph: self. ]. ^super mouseDown: evt.! ! !DamaValueTileMorph methodsFor: 'as yet unclassified' stamp: 'ko 5/14/2006 15:39'! changeCompoundView: opSymbol subject: aSubject verb: aVerb | rel retrieverType outerPhrase methodInterface categoryViewer argTile aPhrase | self removeAllMorphs. "各種、必要な情報を準備する" categoryViewer _ CategoryViewer new invisiblySetPlayer: self associatedPlayer. methodInterface _ damaMethodInterface methodInterface. retrieverType _ methodInterface resultType. rel _ (Vocabulary vocabularyForType: retrieverType) comparatorForSampleBoolean. outerPhrase _ PhraseTileMorph new setOperator: rel type: #Boolean rcvrType: retrieverType argType: retrieverType. "主語モーフを作成する" aSubject ifNil: [ self subjectMorph: ( damaMethodInterface makeVariableTileForMethodInterface: methodInterface categoryViewer: categoryViewer haveCurrentValue: true ). ] ifNotNil: [ self subjectMorph: aSubject. ]. "動詞モーフを作成する" aVerb ifNil: [ self verbMorph: (DamaTileMorph new adoptVocabulary: categoryViewer currentVocabulary). self verbMorph resultType: self resultType. ( self verbMorph setOperator: rel asString ) typeColor: color. ] ifNotNil: [ self verbMorph: aVerb. ]. "引数モーフを作成する" self objectMorph ifNil: [ self objectMorph: outerPhrase submorphs third. argTile _ (ScriptingSystem tileForArgType: retrieverType). retrieverType == #Number ifTrue: [ argTile removeMorph: argTile submorphs third. ]. self objectMorph addMorph: argTile. ]. self verbMorph contents: opSymbol. compareMethodInterface _ ( DamaVocabulary at: opSymbol ). aPhrase _ compareMethodInterface makeTileForSubject: self subjectMorph object: self objectMorph verb: self verbMorph categoryViewer: categoryViewer. aPhrase submorphs do: [ :each | self addMorphBack: each ]. compoundMode _ true. !]lang[(170 13 383 10 244 10 265 10 609)0,5,0,5,0,5,0,5,0! ! !DamaValueTileMorph methodsFor: 'as yet unclassified' stamp: 'ko 6/16/2006 11:04'! mouseDown: evt | booleanScriptEditor | owner ifNotNil: [ owner owner ifNotNil: [ ( booleanScriptEditor _ self ownerThatIsA: DamaBooleanScriptEditor) ifNotNil: [ (booleanScriptEditor ownerThatIsA: DamaCompoundTileMorph) isEmpty ifTrue:[ (booleanScriptEditor ownerThatIsA: DamaCompoundTileMorph) removeMySelf. ] ifFalse: [ owner owner removeMorph: self owner. booleanScriptEditor initializeView. ]. self resultType = #Boolean ifTrue: [ self changeToSentenceView. ]. ^evt hand grabMorph: self. ] ]]. ^super mouseDown: evt. ! ! !DamaVariableInterface methodsFor: 'makeTile' stamp: 'ko 5/14/2006 01:39'! makeVariableTileForMethodInterface: aMethodInterface categoryViewer: categoryViewer haveCurrentValue: current | aPhrase aRow op aWatcher nowValueTile setter subject | "変数用のPhraseTileMorphを作成する" aPhrase _ DamaValueTileMorph new. aPhrase setSlotRefOperator: aMethodInterface selector asSymbol type: aMethodInterface resultType. aPhrase removeAllMorphs. aPhrase subjectMorph: categoryViewer tileForSelf. aPhrase verbMorph: ( categoryViewer getterButtonFor: aMethodInterface selector type: aMethodInterface resultType ). "主語タイル・「の」・属性タイルを連結する" aRow _ AlignmentMorph newRow color: categoryViewer color ; layoutInset: 0 ; borderWidth: 2. subject _ categoryViewer tileForSelf. subject _ (TilePadMorph new setType: #Player) addMorph: subject. aRow addMorphBack: subject. aPhrase subjectMorph: subject. self particle ifNil: [ aRow addMorphBack: ( StringMorph new contents: 'の' , variableName ). ] ifNotNil: [ aRow addMorphBack: ( StringMorph new contents: self particle , variableName ). ]. "「(現在値:100)」のタイルを連結する" current ifTrue: [ aRow addMorphBack: (StringMorph new contents:'(現在:' ). op _ aPhrase operatorTile operatorOrExpression. aWatcher _ WatcherWrapper new fancyForPlayer: aPhrase associatedPlayer getter: op. ( #(Number String) includes: aMethodInterface resultType) ifTrue: [ setter _ aMethodInterface companionSetterSelector. nowValueTile _ DamaUpdatingStringMorph new getSelector: op; target: aPhrase associatedPlayer; growable: true; minimumWidth: 1; putSelector: (setter ifNotNil: [(#(none #nil unused) includes: setter) ifTrue: [nil] ifFalse: [setter]]). nowValueTile contents: nowValueTile readFromTarget. aRow addMorphBack: nowValueTile. ] ifFalse: [ (#(Boolean BorderStyle TrailStyle) includes: aMethodInterface resultType) ifTrue:[ nowValueTile _ aWatcher submorphs third. nowValueTile removeMorph: nowValueTile submorphs first. aRow addMorphBack: nowValueTile. ] ifFalse: [ nowValueTile _ aWatcher submorphs third. aRow addMorphBack: nowValueTile. ]. ]. aRow addMorphBack: (StringMorph new contents: ')' ). ]. "タイルの色、境界線の太さ・色を決める" aRow borderWidth: 0. aRow borderColor: ( Color r: 0.806 g: 0.774 b: 0.581 ). aRow color: (Color r: 0.806 g: 1.0 b: 0.806). aPhrase addMorphBack: aRow. aPhrase enforceTileColorPolicy. "aPhrase markAsPartsDonor." aPhrase damaMethodInterface: self. subject receiverOfCodeChange: ( ReceiverOfSubjectChange new subject: nowValueTile ). ^ aPhrase !]lang[(172 4 15 5 334 20 337 1 123 20 70 2 1045 18 359)0,5,0,5,0,5,0,5,0,5,0,5,0,5,0! ! !TilePadMorph methodsFor: 'layout' stamp: 'ko 5/14/2006 01:27'! acceptDroppingMorph: aMorph event: evt "Accept the given morph within my bowels" | editor wasPossessive morphToUse ownerTilePad | wasPossessive := submorphs notEmpty and: [submorphs first isPossessive]. morphToUse _ self morphToDropFrom: aMorph. self prepareToUndoDropOf: morphToUse. self removeAllMorphs. morphToUse position: self position. self addMorph: morphToUse. wasPossessive ifTrue: [morphToUse bePossessive]. "morphToUse lastTile addRetractArrow." "if can" "ドロップに伴ってコードに影響する部分を、変更する" receiverOfCodeChange ifNotNil: [ receiverOfCodeChange changeCodeSetting: aMorph. ]. (editor := self topEditor) ifNotNil: [editor install]. "親TilePadを通常色に戻す" ( ownerTilePad _ self ownerThatIsA: TilePadMorph ) ifNotNil: [ ownerTilePad firstSubmorph useUniformTileColor. ].!]lang[(483 24 151 1 7 7 119)0,5,0,5,0,5,0! ! !TilePadMorph methodsFor: 'mouse' stamp: 'ko 6/16/2006 11:07'! canAccept: aMorph "Answer whether this pad can accept the given morph" | itsType myType | (self submorphs size = 0 ) ifTrue: [ ^false ]. (self submorphs first isKindOf: DamaMathPhraseTile ) ifTrue: [ ^false ]. ((aMorph isKindOf: PhraseTileMorph) or: [aMorph isKindOf: TileMorph orOf: WatcherWrapper]) ifTrue: [^ ((itsType _ aMorph resultType capitalized) = (myType _ self type capitalized)) or: [(myType = #Graphic) and: [itsType = #Player]]]. ^ false! ! !TilePadMorph methodsFor: 'access' stamp: 'ko 5/14/2006 01:03'! receiverOfCodeChange: receiver receiverOfCodeChange _ receiver.! ! !ReceiverOfMathCodeChange methodsFor: 'as yet unclassified' stamp: 'ko 5/14/2006 01:20'! changeCodeSetting: aMorph "ドロップされた位置が左項ならsubjectMorphを、右項ならobjectMorphを 書き換える" place = #left ifTrue: [ mathPhraseTile code subjectMorph: aMorph. ]. place = #right ifTrue: [ mathPhraseTile code objectMorph: aMorph. ].!]lang[(29 14 12 6 11 1 3 5 150)0,5,0,5,0,5,0,5,0! ! !ReceiverOfMathCodeChange methodsFor: 'as yet unclassified' stamp: 'ko 5/14/2006 00:39'! mathPhraseTile: m mathPhraseTile _ m.! ! !ReceiverOfMathCodeChange methodsFor: 'as yet unclassified' stamp: 'ko 5/14/2006 00:39'! place: p place _ p.! ! !ReceiverOfPhraseCodeChange methodsFor: 'as yet unclassified' stamp: 'ko 5/14/2006 01:20'! changeCodeSetting: aMorph phraseTile code objectMorph: aMorph. ! ! !ReceiverOfPhraseCodeChange methodsFor: 'as yet unclassified' stamp: 'ko 5/14/2006 00:43'! phraseTile: p phraseTile _ p.! ! !ReceiverOfSubjectChange methodsFor: 'as yet unclassified' stamp: 'ko 6/16/2006 10:29'! changeCodeSetting: aMorph subject ifNotNil: [ subject target: aMorph actualObject. ].! ! !ReceiverOfSubjectChange methodsFor: 'as yet unclassified' stamp: 'ko 6/16/2006 10:28'! subject: s subject _ s.! ! Morph subclass: #TilePadMorph instanceVariableNames: 'type receiverOfCodeChange' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Scripting Tiles'! PhraseTileMorph subclass: #DamaPhraseTileMorph instanceVariableNames: 'damaMethodInterface compareTile code' classVariableNames: 'UpdatingOperators' poolDictionaries: '' category: 'Kotodama-wrapper'! DamaMathPhraseTile removeSelector: #leftTile! DamaMathPhraseTile removeSelector: #rightTile! PhraseTileMorph subclass: #DamaMathPhraseTile instanceVariableNames: 'ownerPhrase code' classVariableNames: '' poolDictionaries: '' category: 'Kotodama-Item'!