'From etoys2.1 of 26 July 2007 [latest update: #1586] on 4 September 2007 at 9:41:47 am'! "Change Set: flexibleEtoysFont-tak Date: 4 September 2007 Author: Takashi Yamamiya Makes tile and viewer layout to fit with various font sizes. "! !CategoryViewer methodsFor: 'categories' stamp: 'tak 8/30/2007 16:51'! adjustColorsAndBordersWithin "Adjust the colors and borders of submorphs to suit current fashion" self allMorphsDo: [:aMorph | (aMorph isKindOf: TilePadMorph) ifTrue: [aMorph beTransparent]. (aMorph isKindOf: PhraseTileMorph) ifTrue: [aMorph beTransparent. aMorph borderWidth: 0]. (aMorph isKindOf: TileMorph) ifTrue: [aMorph borderWidth: 1]]. ! ! !CategoryViewer methodsFor: 'entries' stamp: 'tak 9/1/2007 17:24'! addPlayerArgumentTo: aRow "Add, delimited by spacer morphs, a player-valued TileMorph to the row provided." aRow addMorphBack: (Morph new extent: 0@0). "spacer (Is this spacer really needed??? - takashi)" aRow addMorphBack: self presenter standardPlayer tileToRefer. aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" ! ! !CategoryViewer methodsFor: 'entries' stamp: 'tak 8/30/2007 17:14'! 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 | 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: [aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary. aPhrase setOperator: cmd type: resultType rcvrType: #Player] 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. aPhrase _ PhraseTileMorph new vocabulary: self currentVocabulary. (self isSpecialPatchReceiver: scriptedPlayer and: cmd) ifTrue: [ aPhrase setOperator: cmd type: resultType rcvrType: #Patch argType: argType. ] ifFalse: [ aPhrase setOperator: cmd type: resultType rcvrType: #Player argType: argType. ]. (self isSpecialPatchCase: scriptedPlayer and: cmd) ifTrue: [ argTile _ (Vocabulary vocabularyForType: argType) defaultArgumentTileFor: scriptedPlayer. ] ifFalse: [ argTile _ ScriptingSystem tileForArgType: argType forCommand: cmd. ]. (#(bounce: wrap:) includes: cmd) ifTrue: ["help for the embattled bj" argTile setLiteral: 'silence'; updateLiteralLabel]. argTile position: aPhrase lastSubmorph position. aPhrase lastSubmorph addMorph: argTile]]. (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 _ nil]. tileBearingHelp balloonTextSelector: balloonTextSelector]. 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]. universal ifFalse: [selfTile _ self tileForSelf. selfTile position: aPhrase firstSubmorph position. aPhrase firstSubmorph addMorph: selfTile]. aRow _ ViewerLine newRow. aRow elementSymbol: cmd asSymbol. aRow addMorphBack: ( (balloonTextSelector = #userSlot) ifTrue: [(self infoButtonFor: cmd)] ifFalse: [cmd = #emptyScript ifTrue: [ScriptingSystem buttonSpacer] ifFalse: [ScriptingSystem tryButtonFor: aPhrase]]). aRow addMorphBack: self spacerAfterButton. aRow addMorphBack: 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! ! !CategoryViewer methodsFor: 'entries' stamp: 'tak 8/31/2007 17:31'! phraseForTest "Answer a phrase for the non-slot-like command represented by aMethodInterface - classic tiles" | aPhrase aRow | aPhrase _ PhraseTileForTest new. aRow _ ViewerLine newRow. aRow addMorphBack: ScriptingSystem buttonSpacer. aRow addMorphBack: self spacerAfterButton. aRow addMorphBack: aPhrase. aRow balloonTextSelector: #addYesNoToHand. ^ aRow. ! ! !CategoryViewer methodsFor: 'entries' stamp: 'tak 8/31/2007 17:18'! phraseForTimesRepeat "Answer a phrase representing times/repeat" | aPhrase aRow | aPhrase _ PhraseTileForTimesRepeat new. aRow _ ViewerLine newRow. aRow addMorphBack: ScriptingSystem buttonSpacer. aRow addMorphBack: self spacerAfterButton. aRow addMorphBack: aPhrase. aRow setBalloonText: 'Drag here to tear off a Repeat/Times unit which you can drop into your script' translated. ^ aRow. ! ! !CategoryViewer methodsFor: 'entries' stamp: 'tak 8/30/2007 17:18'! 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 | aRow _ ViewerLine newRow elementSymbol: (slotName _ aMethodInterface selector); wrapCentering: #center; cellPositioning: #leftCenter. universal _ scriptedPlayer isUniversalTiles. (self wantsInfoButtonFor: slotName) ifFalse: [aRow addMorphBack: ScriptingSystem buttonSpacer] ifTrue: [aRow addMorphBack: (self infoButtonFor: slotName)]. aRow addMorphBack: self spacerAfterButton. 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: [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: 0@0). 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. 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]. universal ifFalse: [(slotName == #seesColor:) ifTrue: [self addIsOverColorDetailTo: aRow. ^ aRow]. (slotName == #color:sees:) ifTrue: [self addColorSeesDetailTo: aRow. ^ aRow]. (#(touchesA: overlaps: overlapsAny:) includes: slotName) ifTrue: [self addPlayerArgumentTo: aRow. ^ aRow]]. aRow addMorphBack: (AlignmentMorph new beTransparent). "flexible spacer" (setter _ aMethodInterface companionSetterSelector) ifNotNil: [aRow addMorphBack: (Morph new color: self color; extent: 2@10). " spacer" 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! ! !CategoryViewer methodsFor: 'entries' stamp: 'tak 8/30/2007 17:09'! spacerAfterButton ^ Morph new extent: 2 @ 0; beTransparent! ! !CategoryViewer methodsFor: 'header pane' stamp: 'tak 8/30/2007 17:25'! addHeaderMorph "Add the header at the top of the viewer, with a control for choosing the category, etc." | header aButton | header _ AlignmentMorph newRow color: self color; wrapCentering: #center; cellPositioning: #leftCenter. header beSticky. header layoutInset: 0. header cellInset: 0. aButton _ self tanOButton. header addMorph: aButton. aButton setBalloonText: 'remove this pane from the screen don''t worry -- nothing will be lost!!.' translated. header addMorphBack: self spacerAfterButton. self addMorph: header. self addNamePaneTo: header. chosenCategorySymbol _ #basic! ! !CategoryViewer methodsFor: 'header pane' stamp: 'tak 8/30/2007 18:07'! addNamePaneTo: header "Add the namePane, which is a pop-up" | triangle aLabel | namePane := BorderedMorph new. namePane layoutPolicy: TableLayout new. namePane hResizing: #spaceFill. namePane listDirection: #leftToRight. namePane wrapCentering: #center. namePane cellInset: 2. namePane layoutInset: 6 @ 0. namePane color: ScriptingSystem baseColor. namePane borderColor: Preferences menuTitleBorderColor. namePane borderWidth: 0. namePane height: TileMorph defaultH. namePane useRoundedCornersInEtoys. triangle _ ImageMorph new image: (ScriptingSystem formAtKey: #MenuTriangle). namePane addMorph: triangle. aLabel := StringMorph contents: '---------' font: ScriptingSystem fontForViewerCategoryPopups. namePane addMorphBack: aLabel. namePane on: #mouseDown send: #chooseCategory to: self. header addMorphBack: namePane! ! !CategoryViewer methodsFor: 'initialization' stamp: 'tak 8/30/2007 17:28'! initialize super initialize. self listDirection: #topToBottom. self hResizing: #spaceFill. self vResizing: #spaceFill. self beSticky. self color: ScriptingSystem paneColor. self cellInset: 1! ! !CategoryViewer methodsFor: 'initialization' stamp: 'tak 8/30/2007 17:28'! initializeFor: aPlayer categoryChoice: aChoice "Initialize the receiver to be associated with the player and category specified" scriptedPlayer _ aPlayer. self addHeaderMorph. self chooseCategoryWhoseTranslatedWordingIs: aChoice ! ! !NumberType methodsFor: 'tiles' stamp: 'yo 12/20/2006 18:00'! argumentTileForValue: aNumber "Answer a tile to represent the type" ^ aNumber newTileMorphRepresentative typeColor: self typeColor! ! !PhraseTileMorph methodsFor: 'initialization' stamp: 'tak 8/31/2007 17:24'! initialize "Initialize a nascent instance" super initialize. resultType _ #unknown. self wrapCentering: #center; cellPositioning: #leftCenter. self hResizing: #shrinkWrap. self vResizing: #spaceFill. self borderWidth: 0. self layoutInset: 0. self extent: 5@5. "will grow to fit" self minCellSize: 0 @ TileMorph defaultH. self minHeight: TileMorph defaultH. justGrabbedFromViewer _ true. "All new PhraseTileMorphs that go through the initialize process (rather than being copied) are placed in viewers; the clones dragged out from them will thus have this set the right way; the drop code resets this to false" ! ! !PhraseTileForTest methodsFor: 'as yet unclassified' stamp: 'tak 8/31/2007 17:25'! initialize super initialize. self color: Color orange muchLighter. self hResizing: #shrinkWrap; vResizing: #shrinkWrap; borderWidth: 1; borderColor: ScriptingSystem standardTileBorderColor. self setupCostume. ! ! !PhraseTileForTimesRepeat methodsFor: 'initialization' stamp: 'tak 8/31/2007 17:25'! initialize "Initialize the receiver." super initialize. self color: Color orange muchLighter. self hResizing: #shrinkWrap; vResizing: #shrinkWrap; borderWidth: 1; borderColor: ScriptingSystem standardTileBorderColor. self setupCostume ! ! !ReleaseBuilderSqueakland methodsFor: 'utilities' stamp: 'tak 8/28/2007 15:47'! installReleaseSpecificsForOLPC "ReleaseBuilderSqueakland new installReleaseSpecificsForOLPC" World color: (Color r: 0.9 g: 0.9 b: 1.0). Preferences restoreDefaultFonts. Preferences setDefaultFonts: #( (setCodeFontTo: BitstreamVeraSans 12) ). ! ! !StandardScriptingSystem methodsFor: 'font & color choices' stamp: 'tak 8/28/2007 16:40'! fontForEToyButtons "Answer the font to be used for the status buttons affiliated with a ScriptInstantiation in a Viewer or Scriptor, and with other buttons that are part of the basic etoy UI." " ^ StrikeFont familyName: 'KomikaText' size: 28" ^ Preferences standardButtonFont! ! !StandardScriptingSystem methodsFor: 'olpc' stamp: 'tak 8/28/2007 16:48'! fontForViewerCategoryPopups "Answer the font to be used for the category-name at the top of each category-viewer pane." ^ Preferences standardButtonFont! ! !StandardScriptingSystem methodsFor: 'buttons' stamp: 'tak 8/30/2007 11:41'! buttonExtent "ScriptingSystem buttonExtent" ^ (ScriptingSystem formAtKey: #TryIt) extent! ! !StandardScriptingSystem methodsFor: 'buttons' stamp: 'tak 8/30/2007 11:34'! buttonSpacer "ScriptingSystem buttonSpacer openInHand" | m | m := Morph new. m color: Color transparent. m extent: self buttonExtent. ^ m! ! !StandardScriptingSystem methodsFor: 'utilities' stamp: 'yo 12/20/2006 18:01'! tileForArgType: aType forCommand: cmd "Anwer a default tile to represent a datum of the given argument type, which may be either a symbol (e.g. #Color) or a class" (aType isKindOf: Class) "Allowed in Ted's work" ifTrue: [^ aType name asString newTileMorphRepresentative typeColor: Color gray]. cmd = #playSound: ifTrue: [ ^ (Vocabulary vocabularyForType: aType) argumentTileForValue: 880. ]. ^ (Vocabulary vocabularyForType: aType) defaultArgumentTile. ! ! !TextMorph class methodsFor: '*connectorstext-parts bin' stamp: 'tak 8/28/2007 15:44'! boldAuthoringPrototype "TextMorph boldAuthoringPrototype openInHand" | text style index baseFont textMorph | text := Text fromString: 'Text' translated. baseFont _ Preferences standardEToysFont. style _ baseFont textStyle. index _ style fontIndexOfPointSize: 24. text addAttribute: (TextFontChange fontNumber: index). textMorph := self new contentsWrapped: text; setTextStyle: style; margins: 0@0; yourself. "Too ugly dirty hack" textMorph wrapFlag: false. textMorph fit. textMorph wrapFlag: true. ^ textMorph ! ! !TileMorph class methodsFor: 'constants' stamp: 'tak 8/30/2007 15:53'! defaultH "Answer minimal size of tile height. This number is decided from font size, icon size, and readout caret size." ^ ScriptingSystem buttonExtent y max: Preferences standardEToysFont height rounded! ! !TTCFont methodsFor: 'accessing' stamp: 'tak 8/28/2007 15:26'! textStyle ^ TextStyle actualTextStyles at: self familyName asSymbol ifAbsent: []! ! !ViewerLine class methodsFor: 'instance creation' stamp: 'tak 8/30/2007 17:19'! newRow | instance | instance := super newRow. instance vResizing: #shrinkWrap. instance layoutInset: 0. instance color: Color transparent. "instance beSticky". ^ instance! ! !StandardScriptingSystem reorganize! ('benchmarks' benchmarkCategory benchmarkPainter benchmarkScriptor benchmarkViewer benchmark:label:on: macroBenchmark memory) ('font & color choices' colorBehindTiles fontForEToyButtons fontForNameEditingInScriptor fontForTiles installDevelopmentFontsAndPreferences installOLPCFontsAndPreferences smallBoldFont statusColorSymbolFor: uniformTileInteriorColor) ('form dictionary' deletePrivateGraphics deletePrivateGraphics:afterStoringToFileNamed: formAtKey: formAtKey:extent:depth: formDictionary formPressedAtKey: inspectFormDictionary installSolidMenuForm mergeGraphicsFrom: patchInNewStandardPlayerForm privateGraphics readFormsFromFileNamed: readFormsFromFileNamed:andStoreIntoGlobal: restorePrivateGraphics saveFormsToFileNamed: saveForm:atKey: squeakyMouseForm standardForms) ('gold box' randomNumberTile seminalFunctionTile systemQueryPhraseWithActionString:labelled: timesRepeatComplexOfTiles yesNoComplexOfTiles) ('help dictionary' helpStringOrNilFor: initializeHelpStrings) ('help in a flap' assureFlapOfLabel:withContents: cleanUpFlapTabsOnLeft openInfoFlapWithLabel:helpContents:edge:) ('olpc' fontForViewerCategoryPopups sizeForThumbnailsInProjectSorter sorterGridSize) ('parts bin' anyButtonPressedTiles noButtonPressedTiles prototypicalHolder resetStandardPartsBin tilesForQuery:label:) ('script-control' goButton goUp:with: scriptControlButtons stepButton stepDown:with: stepStillDown:with: stepUp:with: stopButton stopUp:with:) ('tile colors' baseColor borderColor colorForType: colorFudge paneColor standardTileBorderColor) ('universal slots & scripts' acceptableSlotNameFrom:forSlotCurrentlyNamed:asSlotNameIn:world: doesOperatorWantArrows: systemSlotNamesOfType:) ('buttons' buttonExtent buttonSpacer tryButtonFor:) ('utilities' allClassVarNamesInSystem allKnownClassVariableNames arithmeticalOperatorsAndHelpStrings biggerHandlesPreferenceChanged buildPanelTitled: buttonDownTile buttonUpTile cleanupsForRelease customizeForEToyUsers: helpStringForOperator: helpStringOrNilForOperator: holderWithAlphabet informScriptingUser: initializeLargeHaloIcons initializeSmallHaloIcons nameForInstanceVariablesCategory nameForScriptsCategory newScriptingSpace newScriptingSpace2 numericComparitorsAndHelpStrings numericFunctionsAndHelpStrings prepareForExternalReleaseNamed: putUpInfoPanelFor:title:extent: reclaimSpace reinvigorateThumbnailsInViewerFlapTabs reportToUser: resetAllScriptingReferences resetStaleScriptingReferences restoreClassicEToyLook searchForSlotProtocolConflicts setterSelectorForGetter: soundNamesToSuppress spaceReclaimed stripGraphicsForExternalRelease tableOfNumericFunctions tileForArgType: tileForArgType:forCommand:) ('*customevents-custom events' addCustomEventFor:named:help:targetMorphClass: addUserCustomEventNamed:help: customEventNamesAndHelpStringsFor: customEventStati customEventsRegistry globalCustomEventNames globalCustomEventNamesFor: removeCustomEventNamed:for: removeUserCustomEventNamed: standardEventStati userCustomEventNames) ('*customevents-help dictionary' statusHelpStringFor:) ('*WS-Sound-Override' wordingForOperator:) ! IconicButton class removeSelector: #spacer!