'From Squeakland.396-Nihongo7.29 of 14 March 2005 [latest update: #42] on 15 March 2005 at 2:25:51 pm'! "Change Set: AddTranslationMar15 Date: 15 March 2005 Author: Yoshiki Ohshima #translated more places."! !Debugger methodsFor: 'initialize' stamp: 'yo 3/15/2005 13:18'! preDebugButtonQuads ^Preferences eToyFriendly ifTrue: [ { {'Store log' translated. #storeLog. #blue. 'write a log of the encountered problem' translated}. {'Abandon' translated. #abandon. #black. 'abandon this execution by closing this window' translated}. {'Debug' translated. #debug. #red. 'bring up a debugger' translated}}] ifFalse: [ { {'Proceed' translated. #proceed. #blue. 'continue execution' translated}. {'Abandon' translated. #abandon. #black. 'abandon this execution by closing this window' translated}. {'Debug' translated. #debug. #red. 'bring up a debugger' translated}}] ! ! !FileList2 methodsFor: 'user interface' stamp: 'yo 3/15/2005 12:38'! blueButtonForService: aService textColor: textColor inWindow: window | block | block _ [ aService performServiceFor: self ] copy fixTemps. ^(window fancyText: aService buttonLabel capitalized translated ofSize: 15 color: textColor) setProperty: #buttonText toValue: aService buttonLabel capitalized; hResizing: #rigid; extent: 100@20; layoutInset: 4; borderWidth: 0; useRoundedCorners; setBalloonText: aService label translated; on: #mouseUp send: #value to: block ! ! !FileList2 class methodsFor: 'blue ui' stamp: 'yo 3/15/2005 12:24'! endingSpecs "Answer a collection of specs to build the selective 'find anything' tool called by the Navigator. This version uses the services registry to do so." "FileList2 morphicViewGeneralLoaderInWorld: World" | categories services specs rejects | rejects _ #(addFileToNewZip: compressFile: openInZipViewer: extractAllFrom: openOn:). categories _ #( ('Art' ('bmp' 'gif' 'jpg' 'jpeg' 'form' 'png' 'pcx' 'xbm' 'xpm' 'ppm' 'pbm')) ('Morphs' ('morph' 'morphs' 'sp')) ('Projects' ('extseg' 'project' 'pr')) ('Books' ('bo')) ('Music' ('mid')) ('Movies' ('movie' 'mpg' 'mpeg' 'qt' 'mov')) "('Code' ('st' 'cs'))" ('Flash' ('swf')) ('TrueType' ('ttf')) ('3ds' ('3ds')) ('Tape' ('tape')) ('Wonderland' ('wrl')) ('HTML' ('htm' 'html')) ). categories first at: 2 put: ImageReadWriter allTypicalFileExtensions. specs _ OrderedCollection new. categories do: [ :cat | | catSpecs catServices okExtensions | services _ Dictionary new. catSpecs _ Array new: 3. catServices _ OrderedCollection new. okExtensions _ Set new. cat second do: [ :ext | (FileList itemsForFile: 'fred.',ext) do: [ :i | (rejects includes: i selector) ifFalse: [ okExtensions add: ext. services at: i label put: i ]]]. services do: [ :svc | catServices add: svc ]. services isEmpty ifFalse: [ catSpecs at: 1 put: cat first translated; at: 2 put: okExtensions; at: 3 put: catServices. specs add: catSpecs ] ]. ^specs ! ! !FileList2 class methodsFor: 'morphic ui' stamp: 'yo 3/15/2005 12:36'! update: actionRow in: window fileTypeRow: fileTypeRow morphUp: morph | fileTypeInfo info2 buttons textColor1 fileSuffixes fileActions aFileList fileTypeString | (morph valueOfProperty: #enabled) ifFalse: [^self]. fileTypeRow submorphsDo: [ :sub | sub color: ( sub == morph ifTrue: [Color white] ifFalse: [(sub valueOfProperty: #enabled) ifTrue: [Color transparent] ifFalse: [Color gray]] ). ]. fileTypeString _ morph valueOfProperty: #buttonText. aFileList _ window valueOfProperty: #FileList. textColor1 _ Color r: 0.742 g: 0.839 b: 1.0. actionRow removeAllMorphs. fileTypeInfo _ self endingSpecs. info2 _ fileTypeInfo detect: [ :each | each first = fileTypeString] ifNone: [self error: 'bad fileTypeString' ]. fileSuffixes _ info2 second. fileActions _ info2 third. buttons _ fileActions collect: [ :each | aFileList blueButtonForService: each textColor: textColor1 inWindow: window ]. buttons addLast: (self blueButtonText: 'Cancel' textColor: textColor1 inWindow: window balloonText: 'Cancel this search' translated selector: #cancelHit recipient: aFileList). buttons do: [ :each | actionRow addMorphBack: each]. window fullBounds. buttons do: [ :each | each fillWithRamp: self blueRamp2 oriented: (0.75 @ 0). ]. aFileList fileSelectionBlock: ( self selectionBlockForSuffixes: (fileSuffixes collect: [ :each | '*.',each]) ). aFileList updateFileList. ! ! !Morph class methodsFor: 'scripting' stamp: 'yo 3/15/2005 14:10'! helpContributions "Answer a list of pairs of the form ( ) to contribute to the system help dictionary" "NB: Many of the items here are not needed any more since they're specified as part of command definitions now. Someone needs to take the time to go through the list and remove items no longer needed. But who's got that kind of time?" ^ #( (acceptScript:for: 'submit the contents of the given script editor as the code defining the given selector') (actorState 'return the ActorState object for the receiver, creating it if necessary') (addInstanceVariable 'start the interaction for adding a new variable to the object') (addPlayerMenuItemsTo:hand: 'add player-specific menu items to the given menu, on behalf of the given hand. At present, these are only commands relating to the turtle') (addYesNoToHand 'Press here to tear off a TEST/YES/NO unit which you can drop into your script') (allScriptEditors 'answer a list off the extant ScriptEditors for the receiver') (amount 'The amount of displacement') (angle 'The angular displacement') (anonymousScriptEditorFor: 'answer a new ScriptEditor object to serve as the place for scripting an anonymous (unnamed, unsaved) script for the receiver') (append: 'add an object to this container') (prepend: 'add an object to this container') (assignDecrGetter:setter:amt: 'evaluate the decrement variant of assignment') (assignGetter:setter:amt: 'evaluate the vanilla variant of assignment') (assignIncrGetter:setter:amt: 'evalute the increment version of assignment') (assignMultGetter:setter:amt: 'evaluate the multiplicative version of assignment') (assureEventHandlerRepresentsStatus 'make certain that the event handler associated with my current costume is set up to conform to my current script-status') (assureExternalName 'If I do not currently have an external name assigned, get one now') (assureUniClass 'make certain that I am a member a uniclass (i.e. a unique subclass); if I am not, create one now and become me into an instance of it') (availableCostumeNames 'answer a list of strings representing the names of all costumes currently available for me') (availableCostumesForArrows 'answer a list of actual, instantiated costumes for me, which can be cycled through as the user hits a next-costume or previous-costume button in a viewer') (beep: 'make the specified sound') (borderColor 'The color of the object''s border') (borderWidth 'The width of the object''s border') (bottom 'My bottom edge, measured downward from the top edge of the world') (bounce: 'If object strayed beyond the boundaries of its container, make it reflect back into it, making the specified noise while doing so.') (bounce 'If object strayed beyond the boundaries of its container, make it reflect back into it') (chooseTrigger 'When this script should run. "normal" means "only when called"') (clearTurtleTrails 'Clear all the pen trails in the interior.') (clearOwnersPenTrails 'Clear all the pen trails in my container.') (color 'The object''s interior color') (colorSees 'Whether a given color in the object is over another given color') (colorUnder 'The color under the center of the object') (copy 'Return a new object that is very much like this one') (cursor 'The index of the chosen element') (deleteCard 'Delete the current card.') (dismiss 'Click here to dismiss me') (doMenuItem: 'Do a menu item, the same way as if it were chosen manually') (doScript: 'Perform the given script once, on the next tick.') (elementNumber 'My element number as seen by my owner') (fire 'Run any and all button-firing scripts of this object') (firstPage 'Go to first page of book') (followPath 'Retrace the path the object has memorized, if any.') (forward: 'Moves the object forward in the direction it is heading') (goto: 'Go to the specfied book page') (goToNextCardInStack 'Go to the next card') (goToPreviousCardInStack 'Go to the previous card.') (goToRightOf: 'Align the object just to the right of any specified object.') (heading 'Which direction the object is facing. 0 is straight up') (height 'The distance between the top and bottom edges of the object') (hide 'Make the object so that it does not display and cannot handle input') (initiatePainting 'Initiate painting of a new object in the standard playfield.') (initiatePaintingIn: 'Initiate painting of a new object in the given place.') (isOverColor 'Whether any part of this object is directly over the specified color') (isUnderMouse 'Whether any part of this object is beneath the current mouse-cursor position') (lastPage 'Go to the last page of the book.') (left 'My left edge, measured from the left edge of the World') (leftRight 'The horizontal displacement') (liftAllPens 'Lift the pens on all the objects in my interior.') (lowerAllPens 'Lower the pens on all the objects in my interior.') (mouseX 'The x coordinate of the mouse pointer') (mouseY 'The y coordinate of the mouse pointer') (moveToward: 'Move in the direction of another object.') (insertCard 'Create a new card.') (nextPage 'Go to next page.') (numberAtCursor 'The number held by the object at the chosen element') (objectNameInHalo 'Object''s name -- To change: click here, edit, hit ENTER') (obtrudes 'Whether any part of the object sticks out beyond its container''s borders') (offerScriptorMenu 'The Scriptee. Press here to get a menu') (pauseScript: 'Make a running script become paused.') (penDown 'Whether the object''s pen is down (true) or up (false)') (penColor 'The color of the object''s pen') (penSize 'The size of the object''s pen') (clearPenTrails 'Clear all pen trails in the current playfield') (playerSeeingColorPhrase 'The player who "sees" a given color') (previousPage 'Go to previous page') (show 'If object was hidden, make it show itself again.') (startScript: 'Make a script start running.') (stopScript: 'Make a script stop running.') (top 'My top edge, measured downward from the top edge of the world') (right 'My right edge, measured from the left edge of the world') (roundUpStrays 'Bring all out-of-container subparts back into view.') (scaleFactor 'The amount by which the object is scaled') (stopScript: 'make the specified script stop running') (tellAllSiblings: 'send a message to all of my sibling instances') (try 'Run this command once.') (tryMe 'Click here to run this script once; hold button down to run repeatedly') (turn: 'Change the heading of the object by the specified amount') (unhideHiddenObjects 'Unhide all hidden objects.') (upDown 'The vertical displacement') (userScript 'This is a script defined by you.') (userSlot 'This is a variable defined by you. Click here to change its type') (valueAtCursor 'The chosen element') (wearCostumeOf: 'Wear the same kind of costume as the other object') (width 'The distance between the left and right edges of the object') (wrap 'If object has strayed beond the boundaries of its container, make it reappear from the opposite edge.') (x 'The x coordinate, measured from the left of the container') (y 'The y-coordinate, measured upward from the bottom of the container') ) ! ! !PasteUpMorph methodsFor: 'world menu' stamp: 'yo 3/15/2005 13:36'! attemptCleanupReporting: whetherToReport "Try to fix up some bad things that are known to occur in some etoy projects we've seen. If the whetherToReport parameter is true, an informer is presented after the cleanups" | fixes | fixes _ 0. ActiveWorld ifNotNil: [(ActiveWorld submorphs select: [:m | (m isKindOf: ScriptEditorMorph) and: [m submorphs isEmpty]]) do: [:m | m delete. fixes _ fixes + 1]]. TransformationMorph allSubInstancesDo: [:m | (m player notNil and: [m renderedMorph ~~ m]) ifTrue: [m renderedMorph visible ifFalse: [m renderedMorph visible: true. fixes _ fixes + 1]]]. (Player class allSubInstances select: [:cl | cl isUniClass]) do: [:aUniclass | fixes _ fixes + aUniclass cleanseScripts]. self presenter flushPlayerListCache; allExtantPlayers. whetherToReport ifTrue: [self inform: ('{1} [or more] repair(s) made' translated format: {fixes printString})] " ActiveWorld attemptCleanupReporting: true. ActiveWorld attemptCleanupReporting: false. "! ! !PopUpMenu methodsFor: 'basic control sequence' stamp: 'yo 3/15/2005 12:55'! startUpSegmented: segmentHeight withCaption: captionOrNil at: location "This menu is too big to fit comfortably on the screen. Break it up into smaller chunks, and manage the relative indices. Inspired by a special-case solution by Reinier van Loon." " (PopUpMenu labels: (String streamContents: [:s | 1 to: 100 do: [:i | s print: i; cr]. s skip: -1]) lines: (5 to: 100 by: 5)) startUpWithCaption: 'Give it a whirl...'. " | nLines nLinesPer allLabels from to subset subLines index | frame ifNil: [self computeForm]. allLabels := labelString findTokens: Character cr asString. nLines _ allLabels size. lineArray ifNil: [lineArray _ Array new]. nLinesPer _ segmentHeight // marker height - 3. from := 1. [ true ] whileTrue: [to := (from + nLinesPer) min: nLines. subset := allLabels copyFrom: from to: to. subset add: (to = nLines ifTrue: ['start over...' translated] ifFalse: ['more...' translated]) before: subset first. subLines _ lineArray select: [:n | n >= from] thenCollect: [:n | n - (from-1) + 1]. subLines _ (Array with: 1) , subLines. index := (PopUpMenu labels: subset asStringWithCr lines: subLines) startUpWithCaption: captionOrNil at: location. index = 1 ifTrue: [from := to + 1. from > nLines ifTrue: [ from := 1 ]] ifFalse: [index = 0 ifTrue: [^ 0]. ^ from + index - 2]]! ! !PopUpMenu methodsFor: 'basic control sequence' stamp: 'yo 3/15/2005 12:55'! startUpSegmented: segmentHeight withCaption: captionOrNil at: location allowKeyboard: aBoolean "This menu is too big to fit comfortably on the screen. Break it up into smaller chunks, and manage the relative indices. Inspired by a special-case solution by Reinier van Loon. The boolean parameter indicates whether the menu should be given keyboard focus (if in morphic)" " (PopUpMenu labels: (String streamContents: [:s | 1 to: 100 do: [:i | s print: i; cr]. s skip: -1]) lines: (5 to: 100 by: 5)) startUpWithCaption: 'Give it a whirl...'. " | nLines nLinesPer allLabels from to subset subLines index | frame ifNil: [self computeForm]. allLabels := labelString findTokens: Character cr asString. nLines _ allLabels size. lineArray ifNil: [lineArray _ Array new]. nLinesPer _ segmentHeight // marker height - 3. from := 1. [ true ] whileTrue: [to := (from + nLinesPer) min: nLines. subset := allLabels copyFrom: from to: to. subset add: (to = nLines ifTrue: ['start over...' translated] ifFalse: ['more...' translated]) before: subset first. subLines _ lineArray select: [:n | n >= from] thenCollect: [:n | n - (from-1) + 1]. subLines _ (Array with: 1) , subLines. index := (PopUpMenu labels: subset asStringWithCr lines: subLines) startUpWithCaption: captionOrNil at: location allowKeyboard: aBoolean. index = 1 ifTrue: [from := to + 1. from > nLines ifTrue: [ from := 1 ]] ifFalse: [index = 0 ifTrue: [^ 0]. ^ from + index - 2]]! ! !PreDebugWindow methodsFor: 'as yet unclassified' stamp: 'yo 3/15/2005 13:07'! setBalloonTextForCloseBox closeBox ifNotNil: [closeBox setBalloonText: 'abandon this execution by closing this window' translated]. ! ! !ScriptEditorMorph methodsFor: 'other' stamp: 'yo 3/15/2005 12:11'! handUserButtonUpTile "Hand the user a button-up tile, presumably to drop in the script" self currentHand attachMorph: (self presenter systemQueryPhraseWithActionString: '(Sensor noButtonPressed)' labelled: 'button up?' translated) ! ! !ScriptInstantiation methodsFor: 'status control' stamp: 'yo 3/15/2005 13:51'! typeInTickingRate | reply aNumber | reply _ FillInTheBlank request: 'Number of ticks per second: ' translated initialAnswer: self tickingRate printString. reply ifNotNil: [aNumber _ reply asNumber. aNumber > 0 ifTrue: [self tickingRate: aNumber]]! ! !SketchMorph methodsFor: 'menu' stamp: 'yo 3/15/2005 12:04'! callThisBaseGraphic "Set my baseGraphic to be the current form" | aGraphic | self isInWorld ifFalse: [^ self inform: 'oops, this menu is a for a morph that has been replaced, probably because a "look like" script was run. Please dismiss the menu and get a new one!!. Sorry!!' translated]. ((aGraphic _ self valueOfProperty: #baseGraphic) notNil and: [aGraphic ~= originalForm]) ifTrue: [self setProperty: #baseGraphic toValue: originalForm] ifFalse: [self inform: 'this already *was* your baseGraphic' translated]! ! !SketchMorph methodsFor: 'menu' stamp: 'yo 3/15/2005 13:57'! restoreBaseGraphicFromMenu "Restore the base graphic -- invoked from a menu, so give interactive feedback if appropriate" self isInWorld ifFalse: [^ self inform: 'oops, this menu is a for a morph that has been replaced, probably because a "look like" script was run. Please dismiss the menu and get a new one!!. Sorry!!' translated]. self baseGraphic = originalForm ifTrue: [^ self inform: 'This object is *already* showing its baseGraphic' translated]. self restoreBaseGraphic! !