Tim Felgentreff uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-tfel.878.mcz
==================== Summary ====================
Name: System-tfel.878
Author: tfel
Time: 10 August 2016, 9:51:41.662314 am
UUID: 70c58675-7950-f044-892b-4195c4eb4dd6
Ancestors: System-tfel.877
add Object>>translatedNoop as catch-all for localization
=============== Diff against System-cmm.876 ===============
Item was changed:
----- Method: CodeLoader>>installProject (in category 'installing') -----
installProject
"Assume that we're loading a single file and it's a project"
| aStream |
+ aStream _ sourceFiles first contentStream.
- aStream := sourceFiles first contentStream.
aStream ifNil:[^self error:'Project was not loaded'].
+ ProjectLoading openOn: aStream!
- ProjectLoading
- openName: nil "<--do we want to cache this locally? Need a name if so"
- stream: aStream
- fromDirectory: nil
- withProjectView: nil.
- !
Item was changed:
----- Method: ExternalDropHandler class>>defaultProjectHandler (in category 'private') -----
defaultProjectHandler
+ ^ ExternalDropHandler
- ^ExternalDropHandler
type: nil
extension: 'pr'
+ action: [:stream | ProjectLoading openOn: stream]!
- action: [:stream |
- ProjectLoading
- openName: nil
- stream: stream
- fromDirectory: nil
- withProjectView: nil]
- !
Item was changed:
----- Method: ExternalSettings class>>assuredPreferenceDirectory (in category 'accessing') -----
assuredPreferenceDirectory
"Answer the preference directory, creating it if necessary"
+ | prefDir topDir |
- | prefDir |
prefDir := self preferenceDirectory.
prefDir
ifNil:
+ [topDir := Preferences startInUntrustedDirectory
+ ifTrue: [FileDirectory on: SecurityManager default secureUserDirectory]
+ ifFalse: [FileDirectory default].
+ prefDir := topDir directoryNamed: self preferenceDirectoryName.
- [prefDir := FileDirectory default directoryNamed: self preferenceDirectoryName.
prefDir assureExistence].
^ prefDir!
Item was added:
+ ----- Method: GetTextTranslator>>moFiles (in category 'private') -----
+ moFiles
+
+ ^ moFiles!
Item was changed:
----- Method: ImageSegment>>declareAndPossiblyRename: (in category 'fileIn/Out') -----
declareAndPossiblyRename: classThatIsARoot
| existing catInstaller |
"The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was installed with associationDeclareAt:."
+ catInstaller _ [
- catInstaller := [
classThatIsARoot superclass name == #Player
ifTrue: [classThatIsARoot category: Object categoryForUniclasses]
ifFalse: [(classThatIsARoot superclass name beginsWith: 'WonderLandActor')
ifTrue: [classThatIsARoot category: 'Balloon3D-UserObjects']
+ ifFalse: [classThatIsARoot category: Object categoryForUniclasses]].
- ifFalse: [classThatIsARoot category: 'Morphic-Imported']].
].
classThatIsARoot superclass addSubclass: classThatIsARoot.
(Smalltalk includesKey: classThatIsARoot name) ifFalse: [
"Class entry in Smalltalk not referred to in Segment, install anyway."
catInstaller value.
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
+ existing _ Smalltalk at: classThatIsARoot name.
- existing := Smalltalk at: classThatIsARoot name.
existing xxxClass == ImageSegmentRootStub ifTrue: [
"We are that segment!! Must ask it carefully!!"
catInstaller value.
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
existing == false | (existing == nil) ifTrue: [
"association is in outPointers, just installed"
catInstaller value.
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
"Conflict with existing global or copy of the class"
(existing isKindOf: Class) ifTrue: [
classThatIsARoot isSystemDefined not ifTrue: [
"UniClass. give it a new name"
classThatIsARoot setName: classThatIsARoot baseUniclass chooseUniqueClassName.
catInstaller value. "must be after new name"
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
"Take the incoming one"
self inform: 'Using newly arrived version of ', classThatIsARoot name.
classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case"
(Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot.
catInstaller value.
^ classThatIsARoot superclass addSubclass: classThatIsARoot].
self error: 'Name already in use by a non-class: ', classThatIsARoot name.
!
Item was changed:
----- Method: ImageSegment>>smartFillRoots: (in category 'read/write segment') -----
smartFillRoots: dummy
+ | refs known ours ww blockers |
- | refs ours blockers known |
"Put all traced objects into my arrayOfRoots. Remove some
that want to be in outPointers. Return blockers, an
IdentityDictionary of objects to replace in outPointers."
+ blockers _ dummy blockers.
+ known _ (refs _ dummy references) size.
- blockers := dummy blockers.
- known := (refs := dummy references) size.
refs keys do: [:obj | "copy keys to be OK with removing items"
+ (obj isSymbol) ifTrue: [refs removeKey: obj. known _ known-1].
- (obj isSymbol) ifTrue: [refs removeKey: obj.
- known := known-1].
(obj class == PasteUpMorph) ifTrue: [
obj isWorldMorph & (obj owner == nil) ifTrue: [
+ (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [
+ refs removeKey: obj. known _ known-1.
- obj == dummy project world ifFalse: [
- refs removeKey: obj. known := known-1.
blockers at: obj put:
+ (StringMorph contents: 'The worldMorph of a different world')]]].
- (StringMorph
- contents: 'The worldMorph of a different world')]]].
"Make a ProjectViewMorph here"
"obj class == Project ifTrue: [Transcript show: obj; cr]."
(blockers includesKey: obj) ifTrue: [
+ refs removeKey: obj ifAbsent: [known _ known+1]. known _ known-1].
- refs removeKey: obj ifAbsent: [known :=
- known+1]. known := known-1].
].
+ ours _ dummy project ifNotNil: [dummy project world] ifNil: [ActiveWorld].
+ refs keysDo: [:obj |
- ours := dummy project world.
- refs keysDo: [:obj | | ww |
obj isMorph ifTrue: [
+ ww _ obj world.
- ww := obj world.
(ww == ours) | (ww == nil) ifFalse: [
+ refs removeKey: obj. known _ known-1.
+ blockers at: obj put: (StringMorph contents:
+ obj printString, ' from another world')]]].
- refs removeKey: obj. known := known-1.
- blockers at: obj put:
- (StringMorph contents:
- obj
- printString, ' from another world')]]].
"keep original roots on the front of the list"
(dummy rootObject) do: [:rr | refs removeKey: rr ifAbsent: []].
+ self classOrganizersBeRoots: dummy.
+ ^ dummy rootObject, refs fasterKeys asArray.!
- ^ dummy rootObject, refs keys asArray.
-
- !
Item was changed:
----- Method: Locale class>>localeChangedGently (in category 'notification') -----
localeChangedGently
+ SystemNavigation default allBehaviorsDo: [:b | b == self ifFalse: [b localeChangedGently]].!
- self class environment allBehaviorsDo: [:b | b localeChangedGently].!
Item was changed:
----- Method: MOFile>>searchByDictionary: (in category 'public') -----
searchByDictionary: aString
| index |
+ index := translations at: aString ifAbsentPut: [nil].
+ index ifNil: [^ nil].
+ ^self translatedString: index!
- index := translations at: aString ifAbsent: [^nil].
- ^self translatedString: index
-
- !
Item was added:
+ ----- Method: MOFile>>translations (in category 'private') -----
+ translations
+
+ ^ translations!
Item was changed:
----- Method: MczInstaller class>>serviceLoadVersion (in category 'services') -----
serviceLoadVersion
^ SimpleServiceEntry
provider: self
+ label: 'load' translatedNoop
- label: 'load'
selector: #loadVersionFile:
+ description: 'load a package version' translatedNoop!
- description: 'load a package version'!
Item was changed:
----- Method: NaturalLanguageTranslator class>>translateWithoutLoading:toLocaleID:inDomain: (in category 'translation') -----
translateWithoutLoading: aString toLocaleID: localeID inDomain: aDomainName
"try to translate with small footprint:
if GetTextTranslator hasn't loaded MO, try to use InternalTranslator.
if InternalTranslator isn't available, then actually load MO and use it"
| translator |
translator := self availableForLocaleID: localeID.
+ translator class = NaturalLanguageTranslator ifTrue: [^ aString].
(translator isDomainLoaded: aDomainName) ifFalse: [
(InternalTranslator availableLanguageLocaleIDs includes: localeID)
ifTrue: [translator := InternalTranslator localeID: localeID].
].
^translator translate: aString inDomain: aDomainName!
Item was added:
+ ----- Method: Object>>translatedNoop (in category '*System-Localization-locales') -----
+ translatedNoop
+ "This is correspondence gettext_noop() in gettext."
+ ^ self
+ !
Item was changed:
----- Method: Preference>>helpString (in category 'menu') -----
helpString
"Answer the help string provided for the receiver"
+ ^ helpString ifNil: ['no help available' translatedNoop]!
- ^ helpString ifNil: ['no help available']!
Item was removed:
- ----- Method: Preferences class>>alwaysShowConnectionVocabulary (in category 'standard queries') -----
- alwaysShowConnectionVocabulary
- ^ self
- valueOfFlag: #alwaysShowConnectionVocabulary
- ifAbsent: [false]!
Item was changed:
+ ----- Method: Preferences class>>chooseEToysTitleFont (in category 'fonts') -----
- ----- Method: Preferences class>>chooseEToysTitleFont (in category 'prefs - fonts') -----
chooseEToysTitleFont
+ "Present a menu with the possible fonts for etoy titles"
+
- "present a menu with the possible fonts for the eToys"
self
+ chooseFontWithPrompt: 'Choose the etoy title font' translated
- chooseFontWithPrompt: 'eToys Title font...' translated
andSendTo: self
withSelector: #setEToysTitleFontTo:
+ highlight: self standardEToysTitleFont!
- highlightSelector: #standardEToysTitleFont!
Item was removed:
- ----- Method: Preferences class>>haloTheme (in category 'prefs - halos') -----
- haloTheme
- ^ self
- valueOfFlag: #haloTheme
- ifAbsent: [ #iconicHaloSpecifications ]!
Item was changed:
+ ----- Method: Preferences class>>iconicHaloSpecifications (in category 'halos') -----
- ----- Method: Preferences class>>iconicHaloSpecifications (in category 'prefs - halos') -----
iconicHaloSpecifications
"Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme"
"Preferences resetHaloSpecifications"
^ #(
" selector horiz vert color info icon key
--------- ------ ----------- ------------------------------- ---------------"
(addCollapseHandle: left topCenter (tan) 'Halo-Collapse')
(addPoohHandle: right center (white) 'Halo-Pooh')
(addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug')
(addDismissHandle: left top (red muchLighter) 'Halo-Dismiss')
(addRotateHandle: left bottom (blue) 'Halo-Rot')
+ (addMenuHandle: leftCenter top (white) 'Halo-Menu')
- (addMenuHandle: leftCenter top (red) 'Halo-Menu')
(addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile')
(addViewHandle: left center (cyan) 'Halo-View')
(addGrabHandle: center top (black) 'Halo-Grab')
(addDragHandle: rightCenter top (brown) 'Halo-Drag')
(addDupHandle: right top (green) 'Halo-Dup')
(addMakeSiblingHandle: right top (green muchDarker) 'Halo-Dup')
(addHelpHandle: center bottom (lightBlue) 'Halo-Help')
(addGrowHandle: right bottom (yellow) 'Halo-Scale')
(addScaleHandle: right bottom (lightOrange) 'Halo-Scale')
(addScriptHandle: rightCenter bottom (green muchLighter) 'Halo-Script')
(addPaintBgdHandle: right center (lightGray) 'Halo-Paint')
(addViewingHandle: leftCenter bottom (lightGreen lighter) 'Halo-View')
(addRepaintHandle: right center (lightGray) 'Halo-Paint')
(addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize')
(addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle')
(addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph')
(addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor')
(addChooseGraphicHandle: right bottomCenter (green muchLighter) 'Halo-ChooseGraphic')
) !
Item was changed:
+ ----- Method: Preferences class>>menuColorString (in category 'misc') -----
- ----- Method: Preferences class>>menuColorString (in category 'support - misc') -----
menuColorString
^ ((self valueOfFlag: #menuColorFromWorld)
+ ifTrue: ['stop menu-color-from-world' translated]
+ ifFalse: ['start menu-color-from-world' translated]) !
- ifTrue: ['stop menu-color-from-world']
- ifFalse: ['start menu-color-from-world']) translated!
Item was changed:
+ ----- Method: Preferences class>>restorePersonalPreferences (in category 'personalization') -----
- ----- Method: Preferences class>>restorePersonalPreferences (in category 'initialization - save/load') -----
restorePersonalPreferences
"Restore all the user's saved personal preference settings"
| savedPrefs |
+ savedPrefs _ self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet' translated].
- savedPrefs := self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet'].
savedPrefs associationsDo:
+ [:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNilDo:
- [:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNil:
[:pref | pref preferenceValue: assoc value preferenceValue]]!
Item was changed:
+ ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'personalization') -----
- ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'initialization - save/load') -----
restorePreferencesFromDisk
+ | result |
+ result := (FileList2 modalFileSelectorForSuffixes: #('prefs')) .
+ result ifNil: [^ self].
+ self restorePreferencesFromDisk: result fullName
+
- (FileDirectory default fileExists: 'my.prefs')
- ifTrue: [ Cursor wait showWhile: [
- [ self loadPreferencesFrom: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error restoring the preferences' ]
- ] ]
- ifFalse: [ self inform: 'you haven''t saved your preferences yet!!' ].
!
Item was removed:
- ----- Method: Preferences class>>showAdvancedNavigatorButtons (in category 'standard queries') -----
- showAdvancedNavigatorButtons
- ^ self
- valueOfFlag: #showAdvancedNavigatorButtons
- ifAbsent: [ true ]!
Item was changed:
+ ----- Method: Preferences class>>storePreferencesToDisk (in category 'personalization') -----
- ----- Method: Preferences class>>storePreferencesToDisk (in category 'initialization - save/load') -----
storePreferencesToDisk
+ | newName |
+ newName := UIManager default request: 'Please confirm name for save...' initialAnswer: 'myPreferences'.
+ newName isEmpty
+ ifTrue: [^ self].
+ Cursor wait
+ showWhile: [[self storePreferencesIn: newName , '.prefs']
+ on: Error
+ do: [:ex | self inform: 'there was an error storing your preferences to disk. you probably already have stored your preferences' translated]]!
- Cursor wait showWhile: [
- [ self storePreferencesIn: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error storing your preferences to disk' ]]!
Item was removed:
- ----- Method: Preferences class>>useSmartLabels (in category 'standard queries') -----
- useSmartLabels
- ^ self
- valueOfFlag: #useSmartLabels
- ifAbsent: [false]!
Item was changed:
----- Method: Project class>>mostRecent:onServer: (in category 'squeaklet on server') -----
mostRecent: projName onServer: aServerDirectory
| stem list max goodName triple num stem1 stem2 rawList nothingFound unEscName |
"Find the exact fileName of the most recent version of project with the stem name of projName. Names are of the form 'projName|mm.pr' where mm is a mime-encoded integer version number.
File names may or may not be HTTP escaped, %20 on the server."
self flag: #bob. "do we want to handle unversioned projects as well?"
+ "I think we do now - Yoshiki."
+ nothingFound _ {nil. -1}.
- nothingFound := {nil. -1}.
aServerDirectory ifNil: [^nothingFound].
"23 sept 2000 - some old projects have periods in name so be more careful"
+ unEscName _ projName unescapePercents.
+ triple _ Project parseProjectFileName: unEscName.
+ stem _ triple first.
+ rawList _ aServerDirectory fileNames.
- unEscName := projName unescapePercents.
- triple := Project parseProjectFileName: unEscName.
- stem := triple first.
- rawList := aServerDirectory fileNames.
+ rawList isString ifTrue: [self inform: 'server is unavailable' translated. ^nothingFound].
+ list _ rawList collect: [:nnn | nnn unescapePercents].
+ max _ -1. goodName _ nil.
- rawList isString ifTrue: [self inform: 'server is unavailable'. ^nothingFound].
- list := rawList collect: [:nnn | nnn unescapePercents].
- max := -1. goodName := nil.
list withIndexDo: [:aName :ind |
+ ((aName beginsWith: stem)) ifTrue: [
+ ((aName endsWith: triple last) or: [triple last = '' and: [aName endsWith: '.pr']]) ifTrue: [
+ num _ (Project parseProjectFileName: aName) second.
+ num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]].
- (aName beginsWith: stem) ifTrue: [
- num := (Project parseProjectFileName: aName) second.
- num > max ifTrue: [max := num. goodName := (rawList at: ind)]]].
max = -1 ifFalse: [^ Array with: goodName with: max].
"try with underbar for spaces on server"
(stem includes: $ ) ifTrue: [
+ stem1 _ stem copyReplaceAll: ' ' with: '_'.
- stem1 := stem copyReplaceAll: ' ' with: '_'.
list withIndexDo: [:aName :ind |
(aName beginsWith: stem1) ifTrue: [
+ num _ (Project parseProjectFileName: aName) second.
+ num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]].
- num := (Project parseProjectFileName: aName) second.
- num > max ifTrue: [max := num. goodName := (rawList at: ind)]]]].
max = -1 ifFalse: [^ Array with: goodName with: max].
"try without the marker | "
+ stem1 _ stem allButLast, '.pr'.
+ stem2 _ stem1 copyReplaceAll: ' ' with: '_'. "and with spaces replaced"
- stem1 := stem allButLast, '.pr'.
- stem2 := stem1 copyReplaceAll: ' ' with: '_'. "and with spaces replaced"
list withIndexDo: [:aName :ind |
(aName beginsWith: stem1) | (aName beginsWith: stem2) ifTrue: [
+ (triple _ aName findTokens: '.') size >= 2 ifTrue: [
+ max _ 0. goodName _ (rawList at: ind)]]]. "no other versions"
- (triple := aName findTokens: '.') size >= 2 ifTrue: [
- max := 0. goodName := (rawList at: ind)]]]. "no other versions"
max = -1 ifFalse: [^ Array with: goodName with: max].
^nothingFound "no matches"
!
Item was changed:
----- Method: Project class>>squeakletDirectory (in category 'squeaklet on server') -----
squeakletDirectory
| squeakletDirectoryName |
+ squeakletDirectoryName := SugarLauncher current
+ parameterAt: 'SQUEAKLETS'
+ ifAbsent: ['Squeaklets'].
- squeakletDirectoryName := 'Squeaklets'.
(FileDirectory default directoryExists: squeakletDirectoryName) ifFalse: [
FileDirectory default createDirectory: squeakletDirectoryName
].
^FileDirectory default directoryNamed: squeakletDirectoryName!
Item was changed:
----- Method: Project class>>sweep: (in category 'squeaklet on server') -----
sweep: aServerDirectory
| repository list parts ind entry projectName versions |
"On the server, move all but the three most recent versions of each Squeaklet to a folder called 'older'"
"Project sweep: ((ServerDirectory serverNamed: 'DaniOnJumbo') clone
directory: '/vol0/people/dani/Squeaklets/2.7')"
"Ensure the 'older' directory"
(aServerDirectory includesKey: 'older')
ifFalse: [aServerDirectory createDirectory: 'older'].
+ repository _ aServerDirectory clone directory: aServerDirectory directory, '/older'.
- repository := aServerDirectory clone directory: aServerDirectory directory, '/older'.
"Collect each name, and decide on versions"
+ list _ aServerDirectory fileNames.
+ list isString ifTrue: [^ self inform: 'server is unavailable' translated].
+ list _ list asSortedCollection asOrderedCollection.
+ parts _ list collect: [:en | Project parseProjectFileName: en].
+ parts _ parts select: [:en | en third = 'pr'].
+ ind _ 1.
+ [entry _ list at: ind.
+ projectName _ entry first asLowercase.
+ versions _ OrderedCollection new. versions add: entry.
+ [(ind _ ind + 1) > list size
- list := aServerDirectory fileNames.
- list isString ifTrue: [^ self inform: 'server is unavailable'].
- list := list asSortedCollection asOrderedCollection.
- parts := list collect: [:en | Project parseProjectFileName: en].
- parts := parts select: [:en | en third = 'pr'].
- ind := 1.
- [entry := list at: ind.
- projectName := entry first asLowercase.
- versions := OrderedCollection new. versions add: entry.
- [(ind := ind + 1) > list size
ifFalse: [(parts at: ind) first asLowercase = projectName
ifTrue: [versions add: (parts at: ind). true]
ifFalse: [false]]
ifTrue: [false]] whileTrue.
aServerDirectory moveYoungest: 3 in: versions to: repository.
ind > list size] whileFalse.
!
Item was changed:
----- Method: Project>>depth (in category 'active process') -----
depth
"Return the depth of this project from the top.
topProject = 0, next = 1, etc."
"Project current depth."
+ | depth project |
+ depth _ 0.
+ project _ self.
- | depth topProject project |
- depth := 0.
- topProject := Project topProject.
- project := self.
+ [project class == DiskProxy ifTrue: [^ depth].
+ project isTopProject]
+ whileFalse:
+ [project _ project parent.
+ depth _ depth + 1].
- [project ~= topProject and:[project notNil]]
- whileTrue:
- [project := project parent.
- depth := depth + 1].
^ depth!
Item was changed:
----- Method: Project>>doWeWantToRename (in category 'menu messages') -----
doWeWantToRename
| want |
self hasBadNameForStoring ifTrue: [^true].
+ (self name beginsWith: 'Unnamed' translated) ifTrue: [^true].
+ want _ world valueOfProperty: #SuperSwikiRename ifAbsent: [false].
- (self name beginsWith: 'Unnamed') ifTrue: [^true].
- want := world valueOfProperty: #SuperSwikiRename ifAbsent: [false].
world removeProperty: #SuperSwikiRename.
^want
!
Item was changed:
----- Method: Project>>htmlPagePrototype (in category 'file in/out') -----
htmlPagePrototype
"Return the HTML page prototype"
^'<html>
<head>
<title>Squeak Project</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body bgcolor="#FFFFFF">
<EMBED
type="application/x-squeak-source"
ALIGN="CENTER"
WIDTH="$$WIDTH$$"
HEIGHT="$$HEIGHT$$"
src="$$PROJECT$$"
+ pluginspage="http://www.squeakland.org/download/">
- pluginspage="http://www.squeakland.org/plugin/detect/detectinstaller.html">
</EMBED>
</body>
</html>
'!
Item was changed:
----- Method: Project>>revert (in category 'file in/out') -----
revert
| |
"Exit this project and do not save it. Warn user unless in dangerous projectRevertNoAsk mode. Exit to the parent project. Do a revert on a clone of the segment, to allow later reverts."
+ projectParameters ifNil: [^ self inform: 'nothing to revert to' translated].
- projectParameters ifNil: [^ self inform: 'nothing to revert to'].
parentProject enter: false revert: true saveForRevert: false.
"does not return!!"
!
Item was changed:
----- Method: Project>>storeOnServer (in category 'file in/out') -----
storeOnServer
"Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded."
world setProperty: #optimumExtentFromAuthor toValue: world extent.
+ self validateProjectNameIfOK: [:details |
+ self acceptProjectDetails: details.
- self validateProjectNameIfOK: [
self isCurrentProject ifTrue: ["exit, then do the command"
^ self
armsLengthCommand: #storeOnServerAssumingNameValid
withDescription: 'Publishing' translated
].
self storeOnServerWithProgressInfo.
].!
Item was changed:
----- Method: Project>>storeOnServerAssumingNameValid (in category 'file in/out') -----
storeOnServerAssumingNameValid
"Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded."
-
world setProperty: #optimumExtentFromAuthor toValue: world extent.
self isCurrentProject ifTrue: ["exit, then do the command"
+ Flaps globalFlapTabsIfAny do: [:each | Flaps removeFlapTab: each keepInList: true].
^ self
armsLengthCommand: #storeOnServerAssumingNameValid
withDescription: 'Publishing' translated
].
self storeOnServerWithProgressInfo.
!
Item was changed:
----- Method: Project>>storeOnServerShowProgressOn:forgetURL: (in category 'file in/out') -----
storeOnServerShowProgressOn: aMorphOrNil forgetURL: forget
"Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded."
world setProperty: #optimumExtentFromAuthor toValue: world extent.
+ self validateProjectNameIfOK: [:details |
+ self acceptProjectDetails: details.
- self validateProjectNameIfOK: [
self isCurrentProject ifTrue: ["exit, then do the command"
forget
ifTrue: [self forgetExistingURL]
ifFalse: [urlList isEmptyOrNil ifTrue: [urlList := parentProject urlList copy]].
^self
armsLengthCommand: #storeOnServerAssumingNameValid
withDescription: 'Publishing' translated
].
self storeOnServerWithProgressInfoOn: aMorphOrNil.
].
!
Item was changed:
----- Method: Project>>validateProjectNameIfOK: (in category 'menu messages') -----
validateProjectNameIfOK: aBlock
| details |
details := world valueOfProperty: #ProjectDetails.
details ifNotNil: ["ensure project info matches real project name"
details at: 'projectname' put: self name.
].
+ self doWeWantToRename ifFalse: [^ aBlock value: details].
- self doWeWantToRename ifFalse: [^aBlock value].
(Smalltalk at: #EToyProjectDetailsMorph) ifNotNil: [:etpdm |
etpdm
getFullInfoFor: self
+ ifValid: [:d |
- ifValid: [
World displayWorldSafely.
+ aBlock value: d
- aBlock value.
]
expandedFormat: false]
!
Item was changed:
----- Method: ProjectLauncher>>loginAs: (in category 'eToy login') -----
loginAs: userName
"Assuming that we have a valid user url; read its contents and see if the user is really there."
| actualName userList |
eToyAuthentificationServer ifNil:[
self proceedWithLogin.
^true].
+ userList _ eToyAuthentificationServer eToyUserList.
- userList := eToyAuthentificationServer eToyUserList.
userList ifNil:[
self inform:
'Sorry, I cannot find the user list.
(this may be due to a network problem)
+ Please hit Cancel if you wish to use Squeak.' translated.
- Please hit Cancel if you wish to use Squeak.'.
^false].
"case insensitive search"
+ actualName _ userList detect:[:any| any sameAs: userName] ifNone:[nil].
- actualName := userList detect:[:any| any sameAs: userName] ifNone:[nil].
actualName isNil ifTrue:[
+ self inform: 'Unknown user: ' translated ,userName.
- self inform: 'Unknown user: ',userName.
^false].
Utilities authorName: actualName.
eToyAuthentificationServer eToyUserName: actualName.
self proceedWithLogin.
^true!
Item was changed:
----- Method: SARInstaller class>>serviceFileInSAR (in category 'class initialization') -----
serviceFileInSAR
"Answer a service for opening a changelist browser on a file"
^ SimpleServiceEntry
provider: self
+ label: 'install SAR' translatedNoop
- label: 'install SAR'
selector: #installSAR:
+ description: 'install this Squeak ARchive into the image.' translatedNoop
+ buttonLabel: 'install' translatedNoop!
- description: 'install this Squeak ARchive into the image.'
- buttonLabel: 'install'!
Item was changed:
----- Method: SystemVersion>>majorMinorVersion (in category 'accessing') -----
majorMinorVersion
"Return the major/minor version number of the form X.Y, without any 'alpha' or 'beta' or other suffix."
- "(SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion" " --> 'Squeak3.7' "
- "SystemVersion current majorMinorVersion"
| char stream |
+ ^ (version includes: $.)
+ ifTrue:
+ [stream := ReadStream on: version, 'x'.
+ stream upTo: $..
+ char := stream next.
+ [char isDigit]
+ whileTrue: [char := stream next].
+ version copyFrom: 1 to: stream position - 1]
+ ifFalse:
+ [version]
+
+ "
+ (SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion
+ (SystemVersion new version: 'Testing') majorMinorVersion
+ SystemVersion current majorMinorVersion
+ "
+
- stream := ReadStream on: version, 'x'.
- stream upTo: $..
- char := stream next.
- char ifNil: [^ version]. "eg: 'Jasmine-rc1' has no $. in it."
- [char isDigit]
- whileTrue: [char := stream next].
- ^ version copyFrom: 1 to: stream position - 1
!
Item was changed:
----- Method: TextStyle>>addNewFontSize: (in category '*System-Fonts') -----
addNewFontSize: pointSize
"Add a font in specified size to the array of fonts."
| f d newArray t isSet |
fontArray first emphasis ~= 0 ifTrue: [
t := TextConstants at: self fontArray first familyName asSymbol.
t fonts first emphasis = 0 ifTrue: [
^ t addNewFontSize: pointSize.
].
].
pointSize <= 0 ifTrue: [^ nil].
fontArray do: [:s |
s pointSize = pointSize ifTrue: [^ s].
].
(isSet := fontArray first isKindOf: TTCFontSet)
ifTrue:[
| fonts |
fonts := fontArray first fontArray collect: [ :font |
| newFont |
(font isNil)
ifTrue: [newFont := nil]
ifFalse: [
newFont := (font ttcDescription size > 256)
ifTrue: [MultiTTCFont new initialize]
ifFalse: [TTCFont new initialize].
newFont ttcDescription: font ttcDescription.
newFont pixelSize: pointSize * 96 // 72.
font derivativeFonts notEmpty ifTrue: [font derivativeFonts do: [ :proto |
proto ifNotNil: [
d := proto class new initialize.
d ttcDescription: proto ttcDescription.
d pixelSize: newFont pixelSize.
newFont derivativeFont: d]]].
].
newFont].
f := TTCFontSet newFontArray: fonts]
ifFalse: [
f := fontArray first class new initialize: fontArray first.
f pointSize: pointSize.
fontArray first derivativeFonts do: [:proto |
proto ifNotNil: [
+ d := TTCFont new initialize: proto.
- d := proto class new initialize: proto.
d pointSize: f pointSize.
+ f derivativeFont: d.
- f derivativeFont: d mainFont: proto.
].
].
].
newArray := (fontArray copyWith: f) asArray sort: [:a :b | a pointSize <= b pointSize].
self newFontArray: newArray.
isSet ifTrue: [
TTCFontSet register: newArray at: newArray first familyName asSymbol.
].
^ self fontOfPointSize: pointSize
!
Item was changed:
----- Method: Utilities class>>floatPrecisionForDecimalPlaces: (in category 'miscellaneous') -----
floatPrecisionForDecimalPlaces: places
"Answer the floatPrecision that corresponds to the given number of decimal places"
^ places caseOf:
{[0]->[1] .
+ [1]-> [0.1] .
+ [2]-> [0.01] .
+ [3]-> [0.001] .
+ [4]-> [0.0001] .
+ [5]-> [0.00001] .
+ [6]-> [0.000001] .
+ [7]-> [0.0000001] .
+ [8]-> [0.00000001] .
+ [9]-> [0.000000001].
+ [10]->[0.0000000001]}
- [1]->[0.1] .
- [2]->[0.01] .
- [3]->[0.001] .
- [4]->[0.0001] .
- [5]->[0.00001] .
- [6]->[0.000001] .
- [7]->[0.0000001] .
- [8]->[0.00000001] .
- [9]->[0.000000001]}
otherwise:
[(10.0 raisedTo: places negated) asFloat]
"
(0 to: 6) collect: [:i | Utilities floatPrecisionForDecimalPlaces: i]
(-10 to: 20) collect: [:i | Utilities floatPrecisionForDecimalPlaces: i]
"!
Item was changed:
----- Method: Utilities class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#Utilities. #recentSubmissionsWindow. 'Recent' translatedNoop. 'A message browser that tracks the most recently-submitted methods' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods')
forFlapNamed: 'Tools'.]!
1
0
Tim Felgentreff uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-tfel.880.mcz
==================== Summary ====================
Name: System-tfel.880
Author: tfel
Time: 10 August 2016, 3:25:06.212665 pm
UUID: 8363ffbe-86d8-a54f-811e-07a91aeb6a61
Ancestors: System-tfel.879
Import Etoys and SISS independent bits for storing and loading images also from sexps from the Squeakland release. Mostly this just refactors the Project loading code into multiple different methods, but it also puts the junctions in there to save and load SISS SExpressions rather than image segments, if SISS and Etoys are loaded
=============== Diff against System-cmm.876 ===============
Item was changed:
----- Method: CodeLoader>>installProject (in category 'installing') -----
installProject
"Assume that we're loading a single file and it's a project"
| aStream |
+ aStream _ sourceFiles first contentStream.
- aStream := sourceFiles first contentStream.
aStream ifNil:[^self error:'Project was not loaded'].
+ ProjectLoading openOn: aStream!
- ProjectLoading
- openName: nil "<--do we want to cache this locally? Need a name if so"
- stream: aStream
- fromDirectory: nil
- withProjectView: nil.
- !
Item was changed:
----- Method: ExternalDropHandler class>>defaultProjectHandler (in category 'private') -----
defaultProjectHandler
+ ^ ExternalDropHandler
- ^ExternalDropHandler
type: nil
extension: 'pr'
+ action: [:stream | ProjectLoading openOn: stream]!
- action: [:stream |
- ProjectLoading
- openName: nil
- stream: stream
- fromDirectory: nil
- withProjectView: nil]
- !
Item was changed:
----- Method: ExternalSettings class>>assuredPreferenceDirectory (in category 'accessing') -----
assuredPreferenceDirectory
"Answer the preference directory, creating it if necessary"
+ | prefDir topDir |
- | prefDir |
prefDir := self preferenceDirectory.
prefDir
ifNil:
+ [topDir := Preferences startInUntrustedDirectory
+ ifTrue: [FileDirectory on: SecurityManager default secureUserDirectory]
+ ifFalse: [FileDirectory default].
+ prefDir := topDir directoryNamed: self preferenceDirectoryName.
- [prefDir := FileDirectory default directoryNamed: self preferenceDirectoryName.
prefDir assureExistence].
^ prefDir!
Item was added:
+ ----- Method: GetTextTranslator>>moFiles (in category 'private') -----
+ moFiles
+
+ ^ moFiles!
Item was changed:
----- Method: ImageSegment>>declareAndPossiblyRename: (in category 'fileIn/Out') -----
declareAndPossiblyRename: classThatIsARoot
| existing catInstaller |
"The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was installed with associationDeclareAt:."
+ catInstaller _ [
- catInstaller := [
classThatIsARoot superclass name == #Player
ifTrue: [classThatIsARoot category: Object categoryForUniclasses]
ifFalse: [(classThatIsARoot superclass name beginsWith: 'WonderLandActor')
ifTrue: [classThatIsARoot category: 'Balloon3D-UserObjects']
+ ifFalse: [classThatIsARoot category: Object categoryForUniclasses]].
- ifFalse: [classThatIsARoot category: 'Morphic-Imported']].
].
classThatIsARoot superclass addSubclass: classThatIsARoot.
(Smalltalk includesKey: classThatIsARoot name) ifFalse: [
"Class entry in Smalltalk not referred to in Segment, install anyway."
catInstaller value.
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
+ existing _ Smalltalk at: classThatIsARoot name.
- existing := Smalltalk at: classThatIsARoot name.
existing xxxClass == ImageSegmentRootStub ifTrue: [
"We are that segment!! Must ask it carefully!!"
catInstaller value.
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
existing == false | (existing == nil) ifTrue: [
"association is in outPointers, just installed"
catInstaller value.
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
"Conflict with existing global or copy of the class"
(existing isKindOf: Class) ifTrue: [
classThatIsARoot isSystemDefined not ifTrue: [
"UniClass. give it a new name"
classThatIsARoot setName: classThatIsARoot baseUniclass chooseUniqueClassName.
catInstaller value. "must be after new name"
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
"Take the incoming one"
self inform: 'Using newly arrived version of ', classThatIsARoot name.
classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case"
(Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot.
catInstaller value.
^ classThatIsARoot superclass addSubclass: classThatIsARoot].
self error: 'Name already in use by a non-class: ', classThatIsARoot name.
!
Item was changed:
----- Method: ImageSegment>>smartFillRoots: (in category 'read/write segment') -----
smartFillRoots: dummy
+ | refs known ours ww blockers |
- | refs ours blockers known |
"Put all traced objects into my arrayOfRoots. Remove some
that want to be in outPointers. Return blockers, an
IdentityDictionary of objects to replace in outPointers."
+ blockers _ dummy blockers.
+ known _ (refs _ dummy references) size.
- blockers := dummy blockers.
- known := (refs := dummy references) size.
refs keys do: [:obj | "copy keys to be OK with removing items"
+ (obj isSymbol) ifTrue: [refs removeKey: obj. known _ known-1].
- (obj isSymbol) ifTrue: [refs removeKey: obj.
- known := known-1].
(obj class == PasteUpMorph) ifTrue: [
obj isWorldMorph & (obj owner == nil) ifTrue: [
+ (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [
+ refs removeKey: obj. known _ known-1.
- obj == dummy project world ifFalse: [
- refs removeKey: obj. known := known-1.
blockers at: obj put:
+ (StringMorph contents: 'The worldMorph of a different world')]]].
- (StringMorph
- contents: 'The worldMorph of a different world')]]].
"Make a ProjectViewMorph here"
"obj class == Project ifTrue: [Transcript show: obj; cr]."
(blockers includesKey: obj) ifTrue: [
+ refs removeKey: obj ifAbsent: [known _ known+1]. known _ known-1].
- refs removeKey: obj ifAbsent: [known :=
- known+1]. known := known-1].
].
+ ours _ dummy project ifNotNil: [dummy project world] ifNil: [ActiveWorld].
+ refs keysDo: [:obj |
- ours := dummy project world.
- refs keysDo: [:obj | | ww |
obj isMorph ifTrue: [
+ ww _ obj world.
- ww := obj world.
(ww == ours) | (ww == nil) ifFalse: [
+ refs removeKey: obj. known _ known-1.
+ blockers at: obj put: (StringMorph contents:
+ obj printString, ' from another world')]]].
- refs removeKey: obj. known := known-1.
- blockers at: obj put:
- (StringMorph contents:
- obj
- printString, ' from another world')]]].
"keep original roots on the front of the list"
(dummy rootObject) do: [:rr | refs removeKey: rr ifAbsent: []].
+ self classOrganizersBeRoots: dummy.
+ ^ dummy rootObject, refs fasterKeys asArray.!
- ^ dummy rootObject, refs keys asArray.
-
- !
Item was changed:
----- Method: Locale class>>localeChangedGently (in category 'notification') -----
localeChangedGently
+ SystemNavigation default allBehaviorsDo: [:b | b == self ifFalse: [b localeChangedGently]].!
- self class environment allBehaviorsDo: [:b | b localeChangedGently].!
Item was changed:
----- Method: MOFile>>searchByDictionary: (in category 'public') -----
searchByDictionary: aString
| index |
+ index := translations at: aString ifAbsentPut: [nil].
+ index ifNil: [^ nil].
+ ^self translatedString: index!
- index := translations at: aString ifAbsent: [^nil].
- ^self translatedString: index
-
- !
Item was added:
+ ----- Method: MOFile>>translations (in category 'private') -----
+ translations
+
+ ^ translations!
Item was changed:
----- Method: MczInstaller class>>serviceLoadVersion (in category 'services') -----
serviceLoadVersion
^ SimpleServiceEntry
provider: self
+ label: 'load' translatedNoop
- label: 'load'
selector: #loadVersionFile:
+ description: 'load a package version' translatedNoop!
- description: 'load a package version'!
Item was changed:
----- Method: NaturalLanguageTranslator class>>translateWithoutLoading:toLocaleID:inDomain: (in category 'translation') -----
translateWithoutLoading: aString toLocaleID: localeID inDomain: aDomainName
"try to translate with small footprint:
if GetTextTranslator hasn't loaded MO, try to use InternalTranslator.
if InternalTranslator isn't available, then actually load MO and use it"
| translator |
translator := self availableForLocaleID: localeID.
+ translator class = NaturalLanguageTranslator ifTrue: [^ aString].
(translator isDomainLoaded: aDomainName) ifFalse: [
(InternalTranslator availableLanguageLocaleIDs includes: localeID)
ifTrue: [translator := InternalTranslator localeID: localeID].
].
^translator translate: aString inDomain: aDomainName!
Item was added:
+ ----- Method: Object>>translatedNoop (in category '*System-Localization-locales') -----
+ translatedNoop
+ "This is correspondence gettext_noop() in gettext."
+ ^ self
+ !
Item was changed:
----- Method: Preference>>helpString (in category 'menu') -----
helpString
"Answer the help string provided for the receiver"
+ ^ helpString ifNil: ['no help available' translatedNoop]!
- ^ helpString ifNil: ['no help available']!
Item was removed:
- ----- Method: Preferences class>>alwaysShowConnectionVocabulary (in category 'standard queries') -----
- alwaysShowConnectionVocabulary
- ^ self
- valueOfFlag: #alwaysShowConnectionVocabulary
- ifAbsent: [false]!
Item was changed:
+ ----- Method: Preferences class>>chooseEToysTitleFont (in category 'fonts') -----
- ----- Method: Preferences class>>chooseEToysTitleFont (in category 'prefs - fonts') -----
chooseEToysTitleFont
+ "Present a menu with the possible fonts for etoy titles"
+
- "present a menu with the possible fonts for the eToys"
self
+ chooseFontWithPrompt: 'Choose the etoy title font' translated
- chooseFontWithPrompt: 'eToys Title font...' translated
andSendTo: self
withSelector: #setEToysTitleFontTo:
+ highlight: self standardEToysTitleFont!
- highlightSelector: #standardEToysTitleFont!
Item was removed:
- ----- Method: Preferences class>>haloTheme (in category 'prefs - halos') -----
- haloTheme
- ^ self
- valueOfFlag: #haloTheme
- ifAbsent: [ #iconicHaloSpecifications ]!
Item was changed:
+ ----- Method: Preferences class>>iconicHaloSpecifications (in category 'halos') -----
- ----- Method: Preferences class>>iconicHaloSpecifications (in category 'prefs - halos') -----
iconicHaloSpecifications
"Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme"
"Preferences resetHaloSpecifications"
^ #(
" selector horiz vert color info icon key
--------- ------ ----------- ------------------------------- ---------------"
(addCollapseHandle: left topCenter (tan) 'Halo-Collapse')
(addPoohHandle: right center (white) 'Halo-Pooh')
(addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug')
(addDismissHandle: left top (red muchLighter) 'Halo-Dismiss')
(addRotateHandle: left bottom (blue) 'Halo-Rot')
+ (addMenuHandle: leftCenter top (white) 'Halo-Menu')
- (addMenuHandle: leftCenter top (red) 'Halo-Menu')
(addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile')
(addViewHandle: left center (cyan) 'Halo-View')
(addGrabHandle: center top (black) 'Halo-Grab')
(addDragHandle: rightCenter top (brown) 'Halo-Drag')
(addDupHandle: right top (green) 'Halo-Dup')
(addMakeSiblingHandle: right top (green muchDarker) 'Halo-Dup')
(addHelpHandle: center bottom (lightBlue) 'Halo-Help')
(addGrowHandle: right bottom (yellow) 'Halo-Scale')
(addScaleHandle: right bottom (lightOrange) 'Halo-Scale')
(addScriptHandle: rightCenter bottom (green muchLighter) 'Halo-Script')
(addPaintBgdHandle: right center (lightGray) 'Halo-Paint')
(addViewingHandle: leftCenter bottom (lightGreen lighter) 'Halo-View')
(addRepaintHandle: right center (lightGray) 'Halo-Paint')
(addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize')
(addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle')
(addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph')
(addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor')
(addChooseGraphicHandle: right bottomCenter (green muchLighter) 'Halo-ChooseGraphic')
) !
Item was changed:
+ ----- Method: Preferences class>>menuColorString (in category 'misc') -----
- ----- Method: Preferences class>>menuColorString (in category 'support - misc') -----
menuColorString
^ ((self valueOfFlag: #menuColorFromWorld)
+ ifTrue: ['stop menu-color-from-world' translated]
+ ifFalse: ['start menu-color-from-world' translated]) !
- ifTrue: ['stop menu-color-from-world']
- ifFalse: ['start menu-color-from-world']) translated!
Item was changed:
+ ----- Method: Preferences class>>restorePersonalPreferences (in category 'personalization') -----
- ----- Method: Preferences class>>restorePersonalPreferences (in category 'initialization - save/load') -----
restorePersonalPreferences
"Restore all the user's saved personal preference settings"
| savedPrefs |
+ savedPrefs _ self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet' translated].
- savedPrefs := self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet'].
savedPrefs associationsDo:
+ [:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNilDo:
- [:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNil:
[:pref | pref preferenceValue: assoc value preferenceValue]]!
Item was changed:
+ ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'personalization') -----
- ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'initialization - save/load') -----
restorePreferencesFromDisk
+ | result |
+ result := (FileList2 modalFileSelectorForSuffixes: #('prefs')) .
+ result ifNil: [^ self].
+ self restorePreferencesFromDisk: result fullName
+
- (FileDirectory default fileExists: 'my.prefs')
- ifTrue: [ Cursor wait showWhile: [
- [ self loadPreferencesFrom: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error restoring the preferences' ]
- ] ]
- ifFalse: [ self inform: 'you haven''t saved your preferences yet!!' ].
!
Item was removed:
- ----- Method: Preferences class>>showAdvancedNavigatorButtons (in category 'standard queries') -----
- showAdvancedNavigatorButtons
- ^ self
- valueOfFlag: #showAdvancedNavigatorButtons
- ifAbsent: [ true ]!
Item was changed:
+ ----- Method: Preferences class>>storePreferencesToDisk (in category 'personalization') -----
- ----- Method: Preferences class>>storePreferencesToDisk (in category 'initialization - save/load') -----
storePreferencesToDisk
+ | newName |
+ newName := UIManager default request: 'Please confirm name for save...' initialAnswer: 'myPreferences'.
+ newName isEmpty
+ ifTrue: [^ self].
+ Cursor wait
+ showWhile: [[self storePreferencesIn: newName , '.prefs']
+ on: Error
+ do: [:ex | self inform: 'there was an error storing your preferences to disk. you probably already have stored your preferences' translated]]!
- Cursor wait showWhile: [
- [ self storePreferencesIn: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error storing your preferences to disk' ]]!
Item was removed:
- ----- Method: Preferences class>>useSmartLabels (in category 'standard queries') -----
- useSmartLabels
- ^ self
- valueOfFlag: #useSmartLabels
- ifAbsent: [false]!
Item was changed:
----- Method: Project class>>mostRecent:onServer: (in category 'squeaklet on server') -----
mostRecent: projName onServer: aServerDirectory
| stem list max goodName triple num stem1 stem2 rawList nothingFound unEscName |
"Find the exact fileName of the most recent version of project with the stem name of projName. Names are of the form 'projName|mm.pr' where mm is a mime-encoded integer version number.
File names may or may not be HTTP escaped, %20 on the server."
self flag: #bob. "do we want to handle unversioned projects as well?"
+ "I think we do now - Yoshiki."
+ nothingFound _ {nil. -1}.
- nothingFound := {nil. -1}.
aServerDirectory ifNil: [^nothingFound].
"23 sept 2000 - some old projects have periods in name so be more careful"
+ unEscName _ projName unescapePercents.
+ triple _ Project parseProjectFileName: unEscName.
+ stem _ triple first.
+ rawList _ aServerDirectory fileNames.
- unEscName := projName unescapePercents.
- triple := Project parseProjectFileName: unEscName.
- stem := triple first.
- rawList := aServerDirectory fileNames.
+ rawList isString ifTrue: [self inform: 'server is unavailable' translated. ^nothingFound].
+ list _ rawList collect: [:nnn | nnn unescapePercents].
+ max _ -1. goodName _ nil.
- rawList isString ifTrue: [self inform: 'server is unavailable'. ^nothingFound].
- list := rawList collect: [:nnn | nnn unescapePercents].
- max := -1. goodName := nil.
list withIndexDo: [:aName :ind |
+ ((aName beginsWith: stem)) ifTrue: [
+ ((aName endsWith: triple last) or: [triple last = '' and: [aName endsWith: '.pr']]) ifTrue: [
+ num _ (Project parseProjectFileName: aName) second.
+ num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]].
- (aName beginsWith: stem) ifTrue: [
- num := (Project parseProjectFileName: aName) second.
- num > max ifTrue: [max := num. goodName := (rawList at: ind)]]].
max = -1 ifFalse: [^ Array with: goodName with: max].
"try with underbar for spaces on server"
(stem includes: $ ) ifTrue: [
+ stem1 _ stem copyReplaceAll: ' ' with: '_'.
- stem1 := stem copyReplaceAll: ' ' with: '_'.
list withIndexDo: [:aName :ind |
(aName beginsWith: stem1) ifTrue: [
+ num _ (Project parseProjectFileName: aName) second.
+ num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]].
- num := (Project parseProjectFileName: aName) second.
- num > max ifTrue: [max := num. goodName := (rawList at: ind)]]]].
max = -1 ifFalse: [^ Array with: goodName with: max].
"try without the marker | "
+ stem1 _ stem allButLast, '.pr'.
+ stem2 _ stem1 copyReplaceAll: ' ' with: '_'. "and with spaces replaced"
- stem1 := stem allButLast, '.pr'.
- stem2 := stem1 copyReplaceAll: ' ' with: '_'. "and with spaces replaced"
list withIndexDo: [:aName :ind |
(aName beginsWith: stem1) | (aName beginsWith: stem2) ifTrue: [
+ (triple _ aName findTokens: '.') size >= 2 ifTrue: [
+ max _ 0. goodName _ (rawList at: ind)]]]. "no other versions"
- (triple := aName findTokens: '.') size >= 2 ifTrue: [
- max := 0. goodName := (rawList at: ind)]]]. "no other versions"
max = -1 ifFalse: [^ Array with: goodName with: max].
^nothingFound "no matches"
!
Item was added:
+ ----- Method: Project class>>publishInSexp (in category 'preferences') -----
+ publishInSexp
+
+ Smalltalk at: #SISSDictionaryForScanning ifPresent: [:siss | ^ siss publishInSexp].
+ ^ false
+ !
Item was changed:
----- Method: Project class>>squeakletDirectory (in category 'squeaklet on server') -----
squeakletDirectory
| squeakletDirectoryName |
+ squeakletDirectoryName := (Smalltalk at: #SugarLauncher ifPresent: [:c |
+ c current parameterAt: 'SQUEAKLETS' ifAbsent: []]) ifNil: ['Squeaklets'].
- squeakletDirectoryName := 'Squeaklets'.
(FileDirectory default directoryExists: squeakletDirectoryName) ifFalse: [
FileDirectory default createDirectory: squeakletDirectoryName
].
^FileDirectory default directoryNamed: squeakletDirectoryName!
Item was changed:
----- Method: Project class>>sweep: (in category 'squeaklet on server') -----
sweep: aServerDirectory
| repository list parts ind entry projectName versions |
"On the server, move all but the three most recent versions of each Squeaklet to a folder called 'older'"
"Project sweep: ((ServerDirectory serverNamed: 'DaniOnJumbo') clone
directory: '/vol0/people/dani/Squeaklets/2.7')"
"Ensure the 'older' directory"
(aServerDirectory includesKey: 'older')
ifFalse: [aServerDirectory createDirectory: 'older'].
+ repository _ aServerDirectory clone directory: aServerDirectory directory, '/older'.
- repository := aServerDirectory clone directory: aServerDirectory directory, '/older'.
"Collect each name, and decide on versions"
+ list _ aServerDirectory fileNames.
+ list isString ifTrue: [^ self inform: 'server is unavailable' translated].
+ list _ list asSortedCollection asOrderedCollection.
+ parts _ list collect: [:en | Project parseProjectFileName: en].
+ parts _ parts select: [:en | en third = 'pr'].
+ ind _ 1.
+ [entry _ list at: ind.
+ projectName _ entry first asLowercase.
+ versions _ OrderedCollection new. versions add: entry.
+ [(ind _ ind + 1) > list size
- list := aServerDirectory fileNames.
- list isString ifTrue: [^ self inform: 'server is unavailable'].
- list := list asSortedCollection asOrderedCollection.
- parts := list collect: [:en | Project parseProjectFileName: en].
- parts := parts select: [:en | en third = 'pr'].
- ind := 1.
- [entry := list at: ind.
- projectName := entry first asLowercase.
- versions := OrderedCollection new. versions add: entry.
- [(ind := ind + 1) > list size
ifFalse: [(parts at: ind) first asLowercase = projectName
ifTrue: [versions add: (parts at: ind). true]
ifFalse: [false]]
ifTrue: [false]] whileTrue.
aServerDirectory moveYoungest: 3 in: versions to: repository.
ind > list size] whileFalse.
!
Item was added:
+ ----- Method: Project>>acceptProjectDetails: (in category 'file in/out') -----
+ acceptProjectDetails: details
+ "Store project details back into a property of the world, and if a name is provided, make sure the name is properly installed in the project."
+
+ world setProperty: #ProjectDetails toValue: details.
+ details at: 'projectname' ifPresent: [ :newName |
+ self renameTo: newName]!
Item was added:
+ ----- Method: Project>>compressFilesIn:to:in: (in category 'file in/out') -----
+ compressFilesIn: tempDir to: localName in: localDirectory
+ "Compress all the files in tempDir making up a zip file in localDirectory named localName"
+
+ | archive archiveName entry fileNames |
+ archive := ZipArchive new.
+ fileNames := tempDir fileNames.
+ (fileNames includes: 'manifest')
+ ifTrue: [fileNames := #('manifest'), (fileNames copyWithout: 'manifest')].
+ fileNames do:[:fn|
+ archiveName := fn.
+ entry := archive addFile: (tempDir fullNameFor: fn) as: archiveName.
+ entry desiredCompressionMethod: (
+ fn = 'manifest'
+ ifTrue: [ZipArchive compressionLevelNone]
+ ifFalse: [ZipArchive compressionDeflated]).
+ ].
+ archive writeToFileNamed: (localDirectory fullNameFor: localName).
+ archive close.
+ tempDir fileNames do:[:fn|
+ tempDir deleteFileNamed: fn ifAbsent:[]].
+ localDirectory deleteDirectory: tempDir localName.!
Item was added:
+ ----- Method: Project>>createViewIfAppropriate (in category 'utilities') -----
+ createViewIfAppropriate
+ "overridden in subclasses"
+ ^ self!
Item was changed:
----- Method: Project>>depth (in category 'active process') -----
depth
"Return the depth of this project from the top.
topProject = 0, next = 1, etc."
"Project current depth."
+ | depth project |
+ depth _ 0.
+ project _ self.
- | depth topProject project |
- depth := 0.
- topProject := Project topProject.
- project := self.
+ [project class == DiskProxy ifTrue: [^ depth].
+ project isTopProject]
+ whileFalse:
+ [project _ project parent.
+ depth _ depth + 1].
- [project ~= topProject and:[project notNil]]
- whileTrue:
- [project := project parent.
- depth := depth + 1].
^ depth!
Item was changed:
----- Method: Project>>doWeWantToRename (in category 'menu messages') -----
doWeWantToRename
| want |
self hasBadNameForStoring ifTrue: [^true].
+ (self name beginsWith: 'Unnamed' translated) ifTrue: [^true].
+ want _ world valueOfProperty: #SuperSwikiRename ifAbsent: [false].
- (self name beginsWith: 'Unnamed') ifTrue: [^true].
- want := world valueOfProperty: #SuperSwikiRename ifAbsent: [false].
world removeProperty: #SuperSwikiRename.
^want
!
Item was changed:
----- Method: Project>>exportSegmentFileName:directory: (in category 'file in/out') -----
exportSegmentFileName: aFileName directory: aDirectory
+ ^ self exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: false!
- | exportChangeSet |
-
- "An experimental version to fileout a changeSet first so that a project can contain its own classes"
-
- "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg.
- Player classes are included automatically."
-
- exportChangeSet := nil.
- (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [
- (self confirm:
- 'Would you like to include all the changes in the change set
- as part of this publishing operation?' translated) ifTrue: [
- exportChangeSet := changeSet
- ].
- ].
- ^ self
- exportSegmentWithChangeSet: exportChangeSet
- fileName: aFileName
- directory: aDirectory
- !
Item was added:
+ ----- Method: Project>>exportSegmentFileName:directory:withoutInteraction: (in category 'file in/out') -----
+ exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+
+ | exportChangeSet |
+
+ "An experimental version to fileout a changeSet first so that a project can contain its own classes"
+
+ "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg.
+ Player classes are included automatically."
+ exportChangeSet := nil.
+ (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [
+ (noInteraction or: [self confirm:
+ 'Would you like to include all the changes in the change set
+ as part of this publishing operation?' translated]) ifTrue: [
+ exportChangeSet := changeSet
+ ].
+ ].
+
+ Project publishInSexp ifTrue: [
+ ^ self exportSegmentInSexpWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+ ].
+ ^ self
+ exportSegmentWithChangeSet: exportChangeSet
+ fileName: aFileName
+ directory: aDirectory
+ withoutInteraction: noInteraction
+ !
Item was added:
+ ----- Method: Project>>exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: (in category 'file in/out') -----
+ exportSegmentInSexpWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+
+ self subclassResponsibility!
Item was changed:
----- Method: Project>>htmlPagePrototype (in category 'file in/out') -----
htmlPagePrototype
"Return the HTML page prototype"
^'<html>
<head>
<title>Squeak Project</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body bgcolor="#FFFFFF">
<EMBED
type="application/x-squeak-source"
ALIGN="CENTER"
WIDTH="$$WIDTH$$"
HEIGHT="$$HEIGHT$$"
src="$$PROJECT$$"
+ pluginspage="http://www.squeakland.org/download/">
- pluginspage="http://www.squeakland.org/plugin/detect/detectinstaller.html">
</EMBED>
</body>
</html>
'!
Item was changed:
----- Method: Project>>revert (in category 'file in/out') -----
revert
| |
"Exit this project and do not save it. Warn user unless in dangerous projectRevertNoAsk mode. Exit to the parent project. Do a revert on a clone of the segment, to allow later reverts."
+ projectParameters ifNil: [^ self inform: 'nothing to revert to' translated].
- projectParameters ifNil: [^ self inform: 'nothing to revert to'].
parentProject enter: false revert: true saveForRevert: false.
"does not return!!"
!
Item was changed:
----- Method: Project>>storeOnServer (in category 'file in/out') -----
storeOnServer
"Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded."
world setProperty: #optimumExtentFromAuthor toValue: world extent.
+ self validateProjectNameIfOK: [:details |
+ self acceptProjectDetails: details.
- self validateProjectNameIfOK: [
self isCurrentProject ifTrue: ["exit, then do the command"
^ self
armsLengthCommand: #storeOnServerAssumingNameValid
withDescription: 'Publishing' translated
].
self storeOnServerWithProgressInfo.
].!
Item was changed:
----- Method: Project>>storeOnServerAssumingNameValid (in category 'file in/out') -----
storeOnServerAssumingNameValid
"Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded."
-
world setProperty: #optimumExtentFromAuthor toValue: world extent.
self isCurrentProject ifTrue: ["exit, then do the command"
+ Flaps globalFlapTabsIfAny do: [:each | Flaps removeFlapTab: each keepInList: true].
^ self
armsLengthCommand: #storeOnServerAssumingNameValid
withDescription: 'Publishing' translated
].
self storeOnServerWithProgressInfo.
!
Item was changed:
----- Method: Project>>storeOnServerShowProgressOn:forgetURL: (in category 'file in/out') -----
storeOnServerShowProgressOn: aMorphOrNil forgetURL: forget
"Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded."
world setProperty: #optimumExtentFromAuthor toValue: world extent.
+ self validateProjectNameIfOK: [:details |
+ self acceptProjectDetails: details.
- self validateProjectNameIfOK: [
self isCurrentProject ifTrue: ["exit, then do the command"
forget
ifTrue: [self forgetExistingURL]
ifFalse: [urlList isEmptyOrNil ifTrue: [urlList := parentProject urlList copy]].
^self
armsLengthCommand: #storeOnServerAssumingNameValid
withDescription: 'Publishing' translated
].
self storeOnServerWithProgressInfoOn: aMorphOrNil.
].
!
Item was changed:
----- Method: Project>>validateProjectNameIfOK: (in category 'menu messages') -----
validateProjectNameIfOK: aBlock
| details |
details := world valueOfProperty: #ProjectDetails.
details ifNotNil: ["ensure project info matches real project name"
details at: 'projectname' put: self name.
].
+ self doWeWantToRename ifFalse: [^ aBlock value: details].
- self doWeWantToRename ifFalse: [^aBlock value].
(Smalltalk at: #EToyProjectDetailsMorph) ifNotNil: [:etpdm |
etpdm
getFullInfoFor: self
+ ifValid: [:d |
- ifValid: [
World displayWorldSafely.
+ aBlock value: d
- aBlock value.
]
expandedFormat: false]
!
Item was changed:
----- Method: ProjectLauncher>>loginAs: (in category 'eToy login') -----
loginAs: userName
"Assuming that we have a valid user url; read its contents and see if the user is really there."
| actualName userList |
eToyAuthentificationServer ifNil:[
self proceedWithLogin.
^true].
+ userList _ eToyAuthentificationServer eToyUserList.
- userList := eToyAuthentificationServer eToyUserList.
userList ifNil:[
self inform:
'Sorry, I cannot find the user list.
(this may be due to a network problem)
+ Please hit Cancel if you wish to use Squeak.' translated.
- Please hit Cancel if you wish to use Squeak.'.
^false].
"case insensitive search"
+ actualName _ userList detect:[:any| any sameAs: userName] ifNone:[nil].
- actualName := userList detect:[:any| any sameAs: userName] ifNone:[nil].
actualName isNil ifTrue:[
+ self inform: 'Unknown user: ' translated ,userName.
- self inform: 'Unknown user: ',userName.
^false].
Utilities authorName: actualName.
eToyAuthentificationServer eToyUserName: actualName.
self proceedWithLogin.
^true!
Item was added:
+ ----- Method: ProjectLoading class>>checkSecurity:preStream:projStream: (in category 'utilities') -----
+ checkSecurity: aFileName preStream: preStream projStream: projStream
+ "Answer true if passed"
+ | trusted enterRestricted |
+ trusted := SecurityManager default positionToSecureContentsOf:
+ projStream.
+ trusted ifFalse:
+ [enterRestricted := (preStream isTypeHTTP or:
+ [aFileName isNil])
+ ifTrue: [Preferences securityChecksEnabled]
+ ifFalse: [Preferences standaloneSecurityChecksEnabled].
+ enterRestricted
+ ifTrue: [SecurityManager default enterRestrictedMode
+ ifFalse:
+ [preStream close.
+ ^ false]]].
+ ^ true
+ !
Item was added:
+ ----- Method: ProjectLoading class>>checkStream: (in category 'utilities') -----
+ checkStream: aStream
+ (aStream isNil
+ or: [aStream size = 0])
+ ifFalse: [^ false].
+ ProgressNotification signal: '9999 about to enter
+ project'.
+ "the hard part is over"
+ self inform: 'It looks like a problem occurred while
+ getting this project. It may be temporary,
+ so you may want to try again,' translated.
+ ^ true!
Item was added:
+ ----- Method: ProjectLoading class>>fileInName:archive:morphOrList: (in category 'utilities') -----
+ fileInName: aFileName archive: archive morphOrList: morphOrList
+ | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr |
+ ResourceCollector current: ResourceCollector new.
+ baseChangeSet := ChangeSet current.
+ self useTempChangeSet. "named zzTemp"
+ "The actual reading happens here"
+ substituteFont := Preferences standardDefaultTextFont copy.
+ numberOfFontSubstitutes := 0.
+ exceptions := Set new.
+ [[anObject := morphOrList fileInObjectAndCodeForProject]
+ on: MissingFont do: [ :ex |
+ exceptions add: ex.
+ numberOfFontSubstitutes := numberOfFontSubstitutes + 1.
+ ex resume: substituteFont ]]
+ ensure: [ ChangeSet newChanges: baseChangeSet].
+ mgr := ResourceManager new initializeFrom: ResourceCollector current.
+ mgr fixJISX0208Resource.
+ mgr registerUnloadedResources.
+ archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName].
+ ResourceCollector current: nil.
+ ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}!
Item was added:
+ ----- Method: ProjectLoading class>>loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: (in category 'loading') -----
+ loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr
+
+ | proj projectsToBeDeleted ef |
+ Smalltalk at: #Flaps ifPresent: [:flaps |
+ (flaps globalFlapTabWithID: 'Navigator' translated)ifNotNil: [:f | f hideFlap]].
+ proj := morphOrList arrayOfRoots
+ detect: [:mm | mm isKindOf: Project]
+ ifNone: [^ nil].
+ numberOfFontSubstitutes > 0 ifTrue: [
+ proj projectParameterAt: #substitutedFont put: substituteFont].
+ ef := proj projectParameterAt: #eToysFont.
+ (ef isNil or: [ef ~= substituteFont familySizeFace]) ifTrue: [
+ proj projectParameterAt: #substitutedFont put: substituteFont.
+ ].
+ proj projectParameters at: #MultiSymbolInWrongPlace put: false.
+ "Yoshiki did not put MultiSymbols into outPointers in older images!!"
+ morphOrList arrayOfRoots do: [:obj |
+ obj fixUponLoad: proj seg: morphOrList "imageSegment"].
+ (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [
+ morphOrList arrayOfRoots do: [:obj | (obj isKindOf: Set) ifTrue: [obj rehash]]].
+
+ proj resourceManager: mgr.
+ "proj versionFrom: preStream."
+ proj lastDirectory: aDirectoryOrNil.
+ proj setParent: Project current.
+ projectsToBeDeleted := OrderedCollection new.
+ existingView == #none ifFalse: [
+ self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted].
+ ChangeSorter allChangeSets add: proj changeSet.
+ Project current projectParameters
+ at: #deleteWhenEnteringNewProject
+ ifPresent: [ :ignored |
+ projectsToBeDeleted add: Project current.
+ Project current removeParameter: #deleteWhenEnteringNewProject.
+ ].
+ projectsToBeDeleted isEmpty ifFalse: [
+ proj projectParameters
+ at: #projectsToBeDeleted
+ put: projectsToBeDeleted.
+ ].
+ proj removeParameter: #eToysFont.
+ ^ proj!
Item was added:
+ ----- Method: ProjectLoading class>>makeExistingView:project:projectsToBeDeleted: (in category 'utilities') -----
+ makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted
+ existingView ifNil: [
+ proj createViewIfAppropriate.
+ ChangeSorter allChangeSets add: proj changeSet.
+ Project current openProject: proj.
+ ] ifNotNil: [
+ (existingView project isKindOf: DiskProxy) ifFalse: [
+ existingView project changeSet name:
+ ChangeSet defaultName.
+ projectsToBeDeleted add: existingView project.
+ ].
+ (existingView owner isSystemWindow) ifTrue: [
+ existingView owner model: proj
+ ].
+ existingView project: proj.
+ ].
+ !
Item was added:
+ ----- Method: ProjectLoading class>>morphOrList:stream:fromDirectory:archive: (in category 'utilities') -----
+ morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive
+ "Answer morphOrList or nil if problem happened"
+ | projStream localDir morphOrList |
+ projStream := archive
+ ifNil: [preStream]
+ ifNotNil: [self projectStreamFromArchive: archive].
+ (self checkSecurity: aFileName preStream: preStream projStream: projStream)
+ ifFalse: [^nil].
+ localDir := Project squeakletDirectory.
+ aFileName ifNotNil: [
+ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName
+ ~= localDir pathName]) ifTrue: [
+ localDir deleteFileNamed: aFileName.
+ (localDir fileNamed: aFileName) binary
+ nextPutAll: preStream remainingContents;
+ close.
+ ].
+ ].
+ morphOrList := projStream asUnZippedStream.
+ preStream sleep. "if ftp, let the connection close"
+ ^ morphOrList
+ !
Item was changed:
----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView: (in category 'loading') -----
openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
withProjectView: existingView
- "Reconstitute a Morph from the selected file, presumed to be
- represent a Morph saved via the SmartRefStream mechanism, and open it
- in an appropriate Morphic world."
+ ^ self openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
+ withProjectView: existingView clearOriginFlag: false.
- | morphOrList proj trusted localDir projStream archive mgr
- projectsToBeDeleted baseChangeSet enterRestricted substituteFont
- numberOfFontSubstitutes exceptions |
- (preStream isNil or: [preStream size = 0]) ifTrue: [
- ProgressNotification signal: '9999 about to enter
- project'. "the hard part is over"
- ^self inform:
- 'It looks like a problem occurred while
- getting this project. It may be temporary,
- so you may want to try again,' translated
- ].
- ProgressNotification signal: '2:fileSizeDetermined
- ',preStream size printString.
- preStream isZipArchive
- ifTrue:[ archive := ZipArchive new readFrom: preStream.
- projStream := self
- projectStreamFromArchive: archive]
- ifFalse:[projStream := preStream].
- trusted := SecurityManager default positionToSecureContentsOf:
- projStream.
- trusted ifFalse:
- [enterRestricted := (preStream isTypeHTTP or:
- [aFileName isNil])
- ifTrue: [Preferences securityChecksEnabled]
- ifFalse: [Preferences standaloneSecurityChecksEnabled].
- enterRestricted
- ifTrue: [SecurityManager default enterRestrictedMode
- ifFalse:
- [preStream close.
- ^ self]]].
- localDir := Project squeakletDirectory.
- aFileName ifNotNil: [
- (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName
- ~= localDir pathName]) ifTrue: [
- localDir deleteFileNamed: aFileName.
- (localDir fileNamed: aFileName) binary
- nextPutAll: preStream contents;
- close.
- ].
- ].
- morphOrList := projStream asUnZippedStream.
- preStream sleep. "if ftp, let the connection close"
- ProgressNotification signal: '3:unzipped'.
- ResourceCollector current: ResourceCollector new.
- baseChangeSet := ChangeSet current.
- self useTempChangeSet. "named zzTemp"
- "The actual reading happens here"
- substituteFont := Preferences standardEToysFont copy.
- numberOfFontSubstitutes := 0.
- exceptions := Set new.
- [[morphOrList := morphOrList fileInObjectAndCodeForProject]
- on: MissingFont do: [ :ex |
- exceptions add: ex.
- numberOfFontSubstitutes :=
- numberOfFontSubstitutes + 1.
- ex resume: substituteFont ]]
- ensure: [ ChangeSet newChanges: baseChangeSet].
- mgr := ResourceManager new initializeFrom: ResourceCollector current.
- mgr fixJISX0208Resource.
- mgr registerUnloadedResources.
- archive ifNotNil:[mgr preLoadFromArchive: archive cacheName:
- aFileName].
- (preStream respondsTo: #close) ifTrue:[preStream close].
- ResourceCollector current: nil.
- ProgressNotification signal: '4:filedIn'.
- ProgressNotification signal: '9999 about to enter project'.
- "the hard part is over"
- (morphOrList isKindOf: ImageSegment) ifTrue: [
- proj := morphOrList arrayOfRoots
- detect: [:mm | mm isKindOf: Project]
- ifNone: [^self inform: 'No project found in
- this file'].
- proj projectParameters at: #substitutedFont put: (
- numberOfFontSubstitutes > 0
- ifTrue: [substituteFont]
- ifFalse: [#none]).
- proj projectParameters at: #MultiSymbolInWrongPlace put: false.
- "Yoshiki did not put MultiSymbols into
- outPointers in older images!!"
- morphOrList arrayOfRoots do: [:obj |
- obj fixUponLoad: proj seg: morphOrList "imageSegment"].
- (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [
- morphOrList arrayOfRoots do: [:obj | (obj
- isKindOf: HashedCollection) ifTrue: [obj rehash]]].
-
- proj resourceManager: mgr.
- "proj versionFrom: preStream."
- proj lastDirectory: aDirectoryOrNil.
- proj setParent: Project current.
- projectsToBeDeleted := OrderedCollection new.
- existingView ifNil: [
- ChangeSet allChangeSets add: proj changeSet.
- Project current openProject: proj.
- "Note: in MVC we get no further than the above"
- ] ifNotNil: [
- (existingView project isKindOf: DiskProxy) ifFalse: [
- existingView project changeSet name:
- ChangeSet defaultName.
- projectsToBeDeleted add: existingView project.
- ].
- (existingView owner isSystemWindow) ifTrue: [
- existingView owner model: proj
- ].
- existingView project: proj.
- ].
- ChangeSet allChangeSets add: proj changeSet.
- Project current projectParameters
- at: #deleteWhenEnteringNewProject
- ifPresent: [ :ignored |
- projectsToBeDeleted add: Project current.
- Project current removeParameter:
- #deleteWhenEnteringNewProject.
- ].
- projectsToBeDeleted isEmpty ifFalse: [
- proj projectParameters
- at: #projectsToBeDeleted
- put: projectsToBeDeleted.
- ].
- ^ ProjectEntryNotification signal: proj
- ].
- Project current openViewAndEnter: morphOrList
!
Item was added:
+ ----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView:clearOriginFlag: (in category 'loading') -----
+ openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
+ withProjectView: existingView clearOriginFlag: clearOriginFlag
+ "Reconstitute a Morph from the selected file, presumed to
+ represent a Morph saved via the SmartRefStream mechanism, and open it
+ in an appropriate Morphic world."
+
+ | morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict |
+ (self checkStream: preStream) ifTrue: [^ self].
+ ProgressNotification signal: '0.2'.
+ archive _ preStream isZipArchive
+ ifTrue:[ZipArchive new readFrom: preStream]
+ ifFalse:[nil].
+ archive ifNotNil:[
+ manifests _ (archive membersMatching: '*manifest').
+ (manifests size = 1 and: [((dict _ self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression'])
+ ifTrue: [
+ ^ (self respondsTo: #openSexpProjectDict:stream:fromDirectory:withProjectView:)
+ ifTrue: [self openSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView]
+ ifFalse: [self inform: 'Cannot load S-Expression format projects without Etoys' translated]]].
+
+ morphOrList _ self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive.
+ morphOrList ifNil: [^ self].
+ ProgressNotification signal: '0.4'.
+ resultArray _ self fileInName: aFileName archive: archive morphOrList: morphOrList.
+ anObject _ resultArray first.
+ numberOfFontSubstitutes _ resultArray second.
+ substituteFont _ resultArray third.
+ mgr _ resultArray fourth.
+ preStream close.
+ ProgressNotification signal: '0.7'.
+ "the hard part is over"
+ (anObject isKindOf: ImageSegment) ifTrue: [
+ project _ self loadImageSegment: anObject
+ fromDirectory: aDirectoryOrNil
+ withProjectView: existingView
+ numberOfFontSubstitutes: numberOfFontSubstitutes
+ substituteFont: substituteFont
+ mgr: mgr.
+ project noteManifestDetailsIn: dict.
+ project removeParameter: #sugarProperties.
+ Smalltalk at: #SugarPropertiesNotification ifPresent: [:sp |
+ sp signal ifNotNilDo: [:props |
+ project keepSugarProperties: props monitor: true]].
+ clearOriginFlag ifTrue: [project forgetExistingURL].
+ ProgressNotification signal: '0.8'.
+ ^ project
+ ifNil: [self inform: 'No project found in this file' translated]
+ ifNotNil: [ProjectEntryNotification signal: project]].
+ Project current openViewAndEnter: anObject!
Item was added:
+ ----- Method: ProjectLoading class>>parseManifest: (in category 'utilities') -----
+ parseManifest: aString
+
+ | dict line index key value aStream |
+ aStream := aString readStream.
+ dict := Dictionary new.
+ [(line := aStream nextLine) notNil] whileTrue: [
+ index := line indexOf: $:.
+ index > 0 ifTrue: [
+ key := line copyFrom: 1 to: index - 1.
+ value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed.
+ dict at: key put: value.
+ ].
+ ].
+ ^ dict.!
Item was changed:
----- Method: ProjectLoading class>>projectStreamFromArchive: (in category 'accessing') -----
projectStreamFromArchive: archive
| ext prFiles entry unzipped |
ext := FileDirectory dot, Project projectExtension.
prFiles := archive members select:[:any| any fileName endsWith: ext].
+ prFiles isEmpty ifTrue:
+ [ext := FileDirectory dot, 'sexp'.
+ prFiles := archive members select:[:any| any fileName endsWith: ext]].
+ prFiles isEmpty ifTrue: [''].
- prFiles isEmpty ifTrue:[^''].
entry := prFiles first.
+ unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize).
- unzipped := RWBinaryOrTextStream on: (ByteArray new: entry uncompressedSize).
entry extractTo: unzipped.
^unzipped reset!
Item was changed:
----- Method: SARInstaller class>>serviceFileInSAR (in category 'class initialization') -----
serviceFileInSAR
"Answer a service for opening a changelist browser on a file"
^ SimpleServiceEntry
provider: self
+ label: 'install SAR' translatedNoop
- label: 'install SAR'
selector: #installSAR:
+ description: 'install this Squeak ARchive into the image.' translatedNoop
+ buttonLabel: 'install' translatedNoop!
- description: 'install this Squeak ARchive into the image.'
- buttonLabel: 'install'!
Item was changed:
----- Method: SystemVersion>>majorMinorVersion (in category 'accessing') -----
majorMinorVersion
"Return the major/minor version number of the form X.Y, without any 'alpha' or 'beta' or other suffix."
- "(SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion" " --> 'Squeak3.7' "
- "SystemVersion current majorMinorVersion"
| char stream |
+ ^ (version includes: $.)
+ ifTrue:
+ [stream := ReadStream on: version, 'x'.
+ stream upTo: $..
+ char := stream next.
+ [char isDigit]
+ whileTrue: [char := stream next].
+ version copyFrom: 1 to: stream position - 1]
+ ifFalse:
+ [version]
+
+ "
+ (SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion
+ (SystemVersion new version: 'Testing') majorMinorVersion
+ SystemVersion current majorMinorVersion
+ "
+
- stream := ReadStream on: version, 'x'.
- stream upTo: $..
- char := stream next.
- char ifNil: [^ version]. "eg: 'Jasmine-rc1' has no $. in it."
- [char isDigit]
- whileTrue: [char := stream next].
- ^ version copyFrom: 1 to: stream position - 1
!
Item was changed:
----- Method: TextStyle>>addNewFontSize: (in category '*System-Fonts') -----
addNewFontSize: pointSize
"Add a font in specified size to the array of fonts."
| f d newArray t isSet |
fontArray first emphasis ~= 0 ifTrue: [
t := TextConstants at: self fontArray first familyName asSymbol.
t fonts first emphasis = 0 ifTrue: [
^ t addNewFontSize: pointSize.
].
].
pointSize <= 0 ifTrue: [^ nil].
fontArray do: [:s |
s pointSize = pointSize ifTrue: [^ s].
].
(isSet := fontArray first isKindOf: TTCFontSet)
ifTrue:[
| fonts |
fonts := fontArray first fontArray collect: [ :font |
| newFont |
(font isNil)
ifTrue: [newFont := nil]
ifFalse: [
newFont := (font ttcDescription size > 256)
ifTrue: [MultiTTCFont new initialize]
ifFalse: [TTCFont new initialize].
newFont ttcDescription: font ttcDescription.
newFont pixelSize: pointSize * 96 // 72.
font derivativeFonts notEmpty ifTrue: [font derivativeFonts do: [ :proto |
proto ifNotNil: [
d := proto class new initialize.
d ttcDescription: proto ttcDescription.
d pixelSize: newFont pixelSize.
newFont derivativeFont: d]]].
].
newFont].
f := TTCFontSet newFontArray: fonts]
ifFalse: [
f := fontArray first class new initialize: fontArray first.
f pointSize: pointSize.
fontArray first derivativeFonts do: [:proto |
proto ifNotNil: [
+ d := TTCFont new initialize: proto.
- d := proto class new initialize: proto.
d pointSize: f pointSize.
+ f derivativeFont: d.
- f derivativeFont: d mainFont: proto.
].
].
].
newArray := (fontArray copyWith: f) asArray sort: [:a :b | a pointSize <= b pointSize].
self newFontArray: newArray.
isSet ifTrue: [
TTCFontSet register: newArray at: newArray first familyName asSymbol.
].
^ self fontOfPointSize: pointSize
!
Item was changed:
----- Method: Utilities class>>floatPrecisionForDecimalPlaces: (in category 'miscellaneous') -----
floatPrecisionForDecimalPlaces: places
"Answer the floatPrecision that corresponds to the given number of decimal places"
^ places caseOf:
{[0]->[1] .
+ [1]-> [0.1] .
+ [2]-> [0.01] .
+ [3]-> [0.001] .
+ [4]-> [0.0001] .
+ [5]-> [0.00001] .
+ [6]-> [0.000001] .
+ [7]-> [0.0000001] .
+ [8]-> [0.00000001] .
+ [9]-> [0.000000001].
+ [10]->[0.0000000001]}
- [1]->[0.1] .
- [2]->[0.01] .
- [3]->[0.001] .
- [4]->[0.0001] .
- [5]->[0.00001] .
- [6]->[0.000001] .
- [7]->[0.0000001] .
- [8]->[0.00000001] .
- [9]->[0.000000001]}
otherwise:
[(10.0 raisedTo: places negated) asFloat]
"
(0 to: 6) collect: [:i | Utilities floatPrecisionForDecimalPlaces: i]
(-10 to: 20) collect: [:i | Utilities floatPrecisionForDecimalPlaces: i]
"!
Item was changed:
----- Method: Utilities class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#Utilities. #recentSubmissionsWindow. 'Recent' translatedNoop. 'A message browser that tracks the most recently-submitted methods' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods')
forFlapNamed: 'Tools'.]!
1
0
Tim Felgentreff uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-tfel.902.mcz
==================== Summary ====================
Name: System-tfel.902
Author: tfel
Time: 21 August 2016, 4:49:50.260391 pm
UUID: 3646f16c-8148-4f44-92df-000c079b45dd
Ancestors: System-mt.901, System-tfel.882
merge trunk
=============== Diff against System-mt.901 ===============
Item was changed:
----- Method: CodeLoader>>installProject (in category 'installing') -----
installProject
"Assume that we're loading a single file and it's a project"
| aStream |
+ aStream _ sourceFiles first contentStream.
- aStream := sourceFiles first contentStream.
aStream ifNil:[^self error:'Project was not loaded'].
+ ProjectLoading openOn: aStream!
- ProjectLoading
- openName: nil "<--do we want to cache this locally? Need a name if so"
- stream: aStream
- fromDirectory: nil
- withProjectView: nil.
- !
Item was changed:
----- Method: DiskProxy>>enter:revert:saveForRevert: (in category 'exceptions') -----
enter: returningFlag revert: revertFlag saveForRevert: saveForRevert
"Look for our project on the server, then try to enter it!! DiskProxy is acting as a stub for the real thing. Called from a ProjectViewMorph in the current project. If have url, use it. Else look in current Project's server and folder."
+ constructorSelector == #namedExample: ifTrue: ["Project namedUrl: xxx"
+ ^ ((Smalltalk at: globalObjectName) perform: #fromExampleEtoys:
+ withArguments: constructorArgs) ].
constructorSelector == #namedUrl: ifTrue: ["Project namedUrl: xxx"
^ ((Smalltalk at: globalObjectName) perform: #fromUrl:
withArguments: constructorArgs) ].
constructorSelector == #named: ifTrue: [
Project current fromMyServerLoad: constructorArgs first]. "name"
!
Item was changed:
----- Method: ExternalDropHandler class>>defaultProjectHandler (in category 'private') -----
defaultProjectHandler
+ ^ ExternalDropHandler
- ^ExternalDropHandler
type: nil
extension: 'pr'
+ action: [:stream | ProjectLoading openOn: stream]!
- action: [:stream |
- ProjectLoading
- openName: nil
- stream: stream
- fromDirectory: nil
- withProjectView: nil]
- !
Item was changed:
----- Method: ExternalSettings class>>assuredPreferenceDirectory (in category 'accessing') -----
assuredPreferenceDirectory
"Answer the preference directory, creating it if necessary"
+ | prefDir topDir |
- | prefDir |
prefDir := self preferenceDirectory.
prefDir
ifNil:
+ [topDir := Preferences startInUntrustedDirectory
+ ifTrue: [FileDirectory on: SecurityManager default secureUserDirectory]
+ ifFalse: [FileDirectory default].
+ prefDir := topDir directoryNamed: self preferenceDirectoryName.
- [prefDir := FileDirectory default directoryNamed: self preferenceDirectoryName.
prefDir assureExistence].
^ prefDir!
Item was added:
+ ----- Method: GetTextTranslator>>moFiles (in category 'private') -----
+ moFiles
+
+ ^ moFiles!
Item was changed:
----- Method: ImageSegment>>declareAndPossiblyRename: (in category 'fileIn/Out') -----
declareAndPossiblyRename: classThatIsARoot
| existing catInstaller |
"The class just arrived in this segment. How fit it into the Smalltalk dictionary? If it had an association, that was installed with associationDeclareAt:."
+ catInstaller _ [
- catInstaller := [
classThatIsARoot superclass name == #Player
ifTrue: [classThatIsARoot category: Object categoryForUniclasses]
ifFalse: [(classThatIsARoot superclass name beginsWith: 'WonderLandActor')
ifTrue: [classThatIsARoot category: 'Balloon3D-UserObjects']
+ ifFalse: [classThatIsARoot category: Object categoryForUniclasses]].
- ifFalse: [classThatIsARoot category: 'Morphic-Imported']].
].
classThatIsARoot superclass addSubclass: classThatIsARoot.
(Smalltalk includesKey: classThatIsARoot name) ifFalse: [
"Class entry in Smalltalk not referred to in Segment, install anyway."
catInstaller value.
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
+ existing _ Smalltalk at: classThatIsARoot name.
- existing := Smalltalk at: classThatIsARoot name.
existing xxxClass == ImageSegmentRootStub ifTrue: [
"We are that segment!! Must ask it carefully!!"
catInstaller value.
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
existing == false | (existing == nil) ifTrue: [
"association is in outPointers, just installed"
catInstaller value.
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
"Conflict with existing global or copy of the class"
(existing isKindOf: Class) ifTrue: [
classThatIsARoot isSystemDefined not ifTrue: [
"UniClass. give it a new name"
classThatIsARoot setName: classThatIsARoot baseUniclass chooseUniqueClassName.
catInstaller value. "must be after new name"
^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
"Take the incoming one"
self inform: 'Using newly arrived version of ', classThatIsARoot name.
classThatIsARoot superclass removeSubclass: classThatIsARoot. "just in case"
(Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot.
catInstaller value.
^ classThatIsARoot superclass addSubclass: classThatIsARoot].
self error: 'Name already in use by a non-class: ', classThatIsARoot name.
!
Item was changed:
----- Method: ImageSegment>>smartFillRoots: (in category 'read/write segment') -----
smartFillRoots: dummy
+ | refs known ours ww blockers |
- | refs ours blockers known |
"Put all traced objects into my arrayOfRoots. Remove some
that want to be in outPointers. Return blockers, an
IdentityDictionary of objects to replace in outPointers."
+ blockers _ dummy blockers.
+ known _ (refs _ dummy references) size.
- blockers := dummy blockers.
- known := (refs := dummy references) size.
refs keys do: [:obj | "copy keys to be OK with removing items"
+ (obj isSymbol) ifTrue: [refs removeKey: obj. known _ known-1].
- (obj isSymbol) ifTrue: [refs removeKey: obj.
- known := known-1].
(obj class == PasteUpMorph) ifTrue: [
obj isWorldMorph & (obj owner == nil) ifTrue: [
+ (dummy project ~~ nil and: [obj == dummy project world]) ifFalse: [
+ refs removeKey: obj. known _ known-1.
- obj == dummy project world ifFalse: [
- refs removeKey: obj. known := known-1.
blockers at: obj put:
+ (StringMorph contents: 'The worldMorph of a different world')]]].
- (StringMorph
- contents: 'The worldMorph of a different world')]]].
"Make a ProjectViewMorph here"
"obj class == Project ifTrue: [Transcript show: obj; cr]."
(blockers includesKey: obj) ifTrue: [
+ refs removeKey: obj ifAbsent: [known _ known+1]. known _ known-1].
- refs removeKey: obj ifAbsent: [known :=
- known+1]. known := known-1].
].
+ ours _ dummy project ifNotNil: [dummy project world] ifNil: [ActiveWorld].
+ refs keysDo: [:obj |
- ours := dummy project world.
- refs keysDo: [:obj | | ww |
obj isMorph ifTrue: [
+ ww _ obj world.
- ww := obj world.
(ww == ours) | (ww == nil) ifFalse: [
+ refs removeKey: obj. known _ known-1.
+ blockers at: obj put: (StringMorph contents:
+ obj printString, ' from another world')]]].
- refs removeKey: obj. known := known-1.
- blockers at: obj put:
- (StringMorph contents:
- obj
- printString, ' from another world')]]].
"keep original roots on the front of the list"
(dummy rootObject) do: [:rr | refs removeKey: rr ifAbsent: []].
+ self classOrganizersBeRoots: dummy.
+ ^ dummy rootObject, refs fasterKeys asArray.!
- ^ dummy rootObject, refs keys asArray.
-
- !
Item was changed:
----- Method: MOFile>>searchByDictionary: (in category 'public') -----
searchByDictionary: aString
| index |
+ index := translations at: aString ifAbsentPut: [nil].
+ index ifNil: [^ nil].
+ ^self translatedString: index!
- index := translations at: aString ifAbsent: [^nil].
- ^self translatedString: index
-
- !
Item was added:
+ ----- Method: MOFile>>translations (in category 'private') -----
+ translations
+
+ ^ translations!
Item was changed:
----- Method: MczInstaller class>>serviceLoadVersion (in category 'services') -----
serviceLoadVersion
^ SimpleServiceEntry
provider: self
+ label: 'load' translatedNoop
- label: 'load'
selector: #loadVersionFile:
+ description: 'load a package version' translatedNoop!
- description: 'load a package version'!
Item was changed:
----- Method: NaturalLanguageTranslator class>>availableLanguageLocaleIDs (in category 'accessing') -----
availableLanguageLocaleIDs
"Return the locale ids for the currently available languages.
Meaning those which either internally or externally have
translations available."
"NaturalLanguageTranslator availableLanguageLocaleIDs"
^ self translators values collect:[:each | each localeID]!
Item was changed:
----- Method: NaturalLanguageTranslator class>>translateWithoutLoading:toLocaleID:inDomain: (in category 'translation') -----
translateWithoutLoading: aString toLocaleID: localeID inDomain: aDomainName
"try to translate with small footprint:
if GetTextTranslator hasn't loaded MO, try to use InternalTranslator.
if InternalTranslator isn't available, then actually load MO and use it"
| translator |
translator := self availableForLocaleID: localeID.
+ translator class = NaturalLanguageTranslator ifTrue: [^ aString].
(translator isDomainLoaded: aDomainName) ifFalse: [
(InternalTranslator availableLanguageLocaleIDs includes: localeID)
ifTrue: [translator := InternalTranslator localeID: localeID].
].
^translator translate: aString inDomain: aDomainName!
Item was added:
+ ----- Method: Object>>translatedNoop (in category '*System-Localization-locales') -----
+ translatedNoop
+ "This is correspondence gettext_noop() in gettext."
+ ^ self
+ !
Item was changed:
----- Method: Preference>>helpString (in category 'menu') -----
helpString
"Answer the help string provided for the receiver"
+ ^ helpString ifNil: ['no help available' translatedNoop]!
- ^ helpString ifNil: ['no help available']!
Item was added:
+ ----- Method: Preferences class>>allowCelesteTell (in category 'standard queries') -----
+ allowCelesteTell
+ ^ self
+ valueOfFlag: #allowCelesteTell
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>allowEtoyUserCustomEvents (in category 'standard queries') -----
+ allowEtoyUserCustomEvents
+ ^ self
+ valueOfFlag: #allowEtoyUserCustomEvents
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>alternativeScrollbarLook (in category 'standard queries') -----
+ alternativeScrollbarLook
+ ^ self
+ valueOfFlag: #alternativeScrollbarLook
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>alternativeWindowLook (in category 'standard queries') -----
+ alternativeWindowLook
+ ^ self
+ valueOfFlag: #alternativeWindowLook
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>ansiAssignmentOperatorWhenPrettyPrinting (in category 'standard queries') -----
+ ansiAssignmentOperatorWhenPrettyPrinting
+ ^ self
+ valueOfFlag: #ansiAssignmentOperatorWhenPrettyPrinting
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>autoAccessors (in category 'standard queries') -----
+ autoAccessors
+ ^ self
+ valueOfFlag: #autoAccessors
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>biggerCursors (in category 'standard queries') -----
+ biggerCursors
+ ^ self
+ valueOfFlag: #biggerCursors
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>blinkParen (in category 'standard queries') -----
+ blinkParen
+ ^ self
+ valueOfFlag: #blinkParen
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>browseWithDragNDrop (in category 'standard queries') -----
+ browseWithDragNDrop
+ ^ self
+ valueOfFlag: #browseWithDragNDrop
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>browseWithPrettyPrint (in category 'standard queries') -----
+ browseWithPrettyPrint
+ ^ self
+ valueOfFlag: #browseWithPrettyPrint
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>browserNagIfNoClassComment (in category 'standard queries') -----
+ browserNagIfNoClassComment
+ ^ self
+ valueOfFlag: #browserNagIfNoClassComment
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>browserShowsPackagePane (in category 'standard queries') -----
+ browserShowsPackagePane
+ ^ self
+ valueOfFlag: #browserShowsPackagePane
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>canRecordWhilePlaying (in category 'standard queries') -----
+ canRecordWhilePlaying
+ ^ self
+ valueOfFlag: #canRecordWhilePlaying
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>celesteHasStatusPane (in category 'standard queries') -----
+ celesteHasStatusPane
+ ^ self
+ valueOfFlag: #celesteHasStatusPane
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>celesteShowsAttachmentsFlag (in category 'standard queries') -----
+ celesteShowsAttachmentsFlag
+ ^ self
+ valueOfFlag: #celesteShowsAttachmentsFlag
+ ifAbsent: [false]!
Item was changed:
+ ----- Method: Preferences class>>chooseEToysTitleFont (in category 'fonts') -----
- ----- Method: Preferences class>>chooseEToysTitleFont (in category 'prefs - fonts') -----
chooseEToysTitleFont
+ "Present a menu with the possible fonts for etoy titles"
+
- "present a menu with the possible fonts for the eToys"
self
+ chooseFontWithPrompt: 'Choose the etoy title font' translated
- chooseFontWithPrompt: 'eToys Title font...' translated
andSendTo: self
withSelector: #setEToysTitleFontTo:
+ highlight: self standardEToysTitleFont!
- highlightSelector: #standardEToysTitleFont!
Item was added:
+ ----- Method: Preferences class>>classicNewMorphMenu (in category 'standard queries') -----
+ classicNewMorphMenu
+ ^ self
+ valueOfFlag: #classicNewMorphMenu
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>colorWhenPrettyPrinting (in category 'standard queries') -----
+ colorWhenPrettyPrinting
+ ^ self
+ valueOfFlag: #colorWhenPrettyPrinting
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>cpuWatcherEnabled (in category 'standard queries') -----
+ cpuWatcherEnabled
+ ^ self
+ valueOfFlag: #cpuWatcherEnabled
+ ifAbsent: [false]!
Item was changed:
----- Method: Preferences class>>debugLogTimestamp (in category 'standard queries') -----
debugLogTimestamp
^ self
valueOfFlag: #debugLogTimestamp
ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>dismissEventTheatreUponPublish (in category 'standard queries') -----
+ dismissEventTheatreUponPublish
+ ^ self
+ valueOfFlag: #dismissEventTheatreUponPublish
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>enableInternetConfig (in category 'standard queries') -----
+ enableInternetConfig
+ ^ self
+ valueOfFlag: #enableInternetConfig
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>enablePortraitMode (in category 'standard queries') -----
+ enablePortraitMode
+ ^ self
+ valueOfFlag: #enablePortraitMode
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>enableVirtualOLPCDisplay (in category 'standard queries') -----
+ enableVirtualOLPCDisplay
+ ^ self
+ valueOfFlag: #enableVirtualOLPCDisplay
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>escapeKeyProducesMenu (in category 'standard queries') -----
+ escapeKeyProducesMenu
+ ^ self
+ valueOfFlag: #escapeKeyProducesMenu
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>gradientMenu (in category 'standard queries') -----
+ gradientMenu
+ ^ self
+ valueOfFlag: #gradientMenu
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>gradientScrollBars (in category 'standard queries') -----
+ gradientScrollBars
+ ^ self
+ valueOfFlag: #gradientScrollBars
+ ifAbsent: [true]!
Item was changed:
+ ----- Method: Preferences class>>haloTheme (in category 'standard queries') -----
- ----- Method: Preferences class>>haloTheme (in category 'prefs - halos') -----
haloTheme
^ self
valueOfFlag: #haloTheme
+ ifAbsent: [#iconicHaloSpecifications]!
- ifAbsent: [ #iconicHaloSpecifications ]!
Item was changed:
+ ----- Method: Preferences class>>iconicHaloSpecifications (in category 'halos') -----
- ----- Method: Preferences class>>iconicHaloSpecifications (in category 'prefs - halos') -----
iconicHaloSpecifications
"Answer an array that characterizes the locations, colors, icons, and selectors of the halo handles that may be used in the iconic halo scheme"
"Preferences resetHaloSpecifications"
^ #(
" selector horiz vert color info icon key
--------- ------ ----------- ------------------------------- ---------------"
(addCollapseHandle: left topCenter (tan) 'Halo-Collapse')
(addPoohHandle: right center (white) 'Halo-Pooh')
(addDebugHandle: right topCenter (blue veryMuchLighter) 'Halo-Debug')
(addDismissHandle: left top (red muchLighter) 'Halo-Dismiss')
(addRotateHandle: left bottom (blue) 'Halo-Rot')
+ (addMenuHandle: leftCenter top (white) 'Halo-Menu')
- (addMenuHandle: leftCenter top (red) 'Halo-Menu')
(addTileHandle: left bottomCenter (lightBrown) 'Halo-Tile')
(addViewHandle: left center (cyan) 'Halo-View')
(addGrabHandle: center top (black) 'Halo-Grab')
(addDragHandle: rightCenter top (brown) 'Halo-Drag')
(addDupHandle: right top (green) 'Halo-Dup')
(addMakeSiblingHandle: right top (green muchDarker) 'Halo-Dup')
(addHelpHandle: center bottom (lightBlue) 'Halo-Help')
(addGrowHandle: right bottom (yellow) 'Halo-Scale')
(addScaleHandle: right bottom (lightOrange) 'Halo-Scale')
(addScriptHandle: rightCenter bottom (green muchLighter) 'Halo-Script')
(addPaintBgdHandle: right center (lightGray) 'Halo-Paint')
(addViewingHandle: leftCenter bottom (lightGreen lighter) 'Halo-View')
(addRepaintHandle: right center (lightGray) 'Halo-Paint')
(addFontSizeHandle: leftCenter bottom (lightGreen) 'Halo-FontSize')
(addFontStyleHandle: center bottom (lightRed) 'Halo-FontStyle')
(addFontEmphHandle: rightCenter bottom (lightBrown darker) 'Halo-FontEmph')
(addRecolorHandle: right bottomCenter (magenta darker) 'Halo-Recolor')
(addChooseGraphicHandle: right bottomCenter (green muchLighter) 'Halo-ChooseGraphic')
) !
Item was added:
+ ----- Method: Preferences class>>ignoreStyleIfOnlyBold (in category 'standard queries') -----
+ ignoreStyleIfOnlyBold
+ ^ self
+ valueOfFlag: #ignoreStyleIfOnlyBold
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>implicitSelfInTiles (in category 'standard queries') -----
+ implicitSelfInTiles
+ ^ self
+ valueOfFlag: #implicitSelfInTiles
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>inboardScrollbars (in category 'standard queries') -----
+ inboardScrollbars
+ ^ self
+ valueOfFlag: #inboardScrollbars
+ ifAbsent: [true]!
Item was changed:
+ ----- Method: Preferences class>>menuColorString (in category 'misc') -----
- ----- Method: Preferences class>>menuColorString (in category 'support - misc') -----
menuColorString
^ ((self valueOfFlag: #menuColorFromWorld)
+ ifTrue: ['stop menu-color-from-world' translated]
+ ifFalse: ['start menu-color-from-world' translated]) !
- ifTrue: ['stop menu-color-from-world']
- ifFalse: ['start menu-color-from-world']) translated!
Item was added:
+ ----- Method: Preferences class>>morphicProgressStyle (in category 'standard queries') -----
+ morphicProgressStyle
+ ^ self
+ valueOfFlag: #morphicProgressStyle
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>preserveTrash (in category 'standard queries') -----
+ preserveTrash
+ ^ self
+ valueOfFlag: #preserveTrash
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>printAlternateSyntax (in category 'standard queries') -----
+ printAlternateSyntax
+ ^ self
+ valueOfFlag: #printAlternateSyntax
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>promptForUpdateServer (in category 'standard queries') -----
+ promptForUpdateServer
+ ^ self
+ valueOfFlag: #promptForUpdateServer
+ ifAbsent: [false]!
Item was changed:
+ ----- Method: Preferences class>>restorePersonalPreferences (in category 'personalization') -----
- ----- Method: Preferences class>>restorePersonalPreferences (in category 'initialization - save/load') -----
restorePersonalPreferences
"Restore all the user's saved personal preference settings"
| savedPrefs |
+ savedPrefs _ self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet' translated].
- savedPrefs := self parameterAt: #PersonalDictionaryOfPreferences ifAbsent: [^ self inform: 'There are no personal preferences saved in this image yet'].
savedPrefs associationsDo:
+ [:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNilDo:
- [:assoc | (self preferenceAt: assoc key ifAbsent: [nil]) ifNotNil:
[:pref | pref preferenceValue: assoc value preferenceValue]]!
Item was changed:
+ ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'personalization') -----
- ----- Method: Preferences class>>restorePreferencesFromDisk (in category 'initialization - save/load') -----
restorePreferencesFromDisk
+ | result |
+ result := (FileList2 modalFileSelectorForSuffixes: #('prefs')) .
+ result ifNil: [^ self].
+ self restorePreferencesFromDisk: result fullName
+
- (FileDirectory default fileExists: 'my.prefs')
- ifTrue: [ Cursor wait showWhile: [
- [ self loadPreferencesFrom: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error restoring the preferences' ]
- ] ]
- ifFalse: [ self inform: 'you haven''t saved your preferences yet!!' ].
!
Item was added:
+ ----- Method: Preferences class>>rotationAndScaleHandlesInPaintBox (in category 'standard queries') -----
+ rotationAndScaleHandlesInPaintBox
+ ^ self
+ valueOfFlag: #rotationAndScaleHandlesInPaintBox
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>roundedMenuCorners (in category 'standard queries') -----
+ roundedMenuCorners
+ ^ self
+ valueOfFlag: #roundedMenuCorners
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>roundedScrollBarLook (in category 'standard queries') -----
+ roundedScrollBarLook
+ ^ self
+ valueOfFlag: #roundedScrollBarLook
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>roundedWindowCorners (in category 'standard queries') -----
+ roundedWindowCorners
+ ^ self
+ valueOfFlag: #roundedWindowCorners
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>scrollBarsWithoutMenuButton (in category 'standard queries') -----
+ scrollBarsWithoutMenuButton
+ ^ self
+ valueOfFlag: #scrollBarsWithoutMenuButton
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>selectionsMayShrink (in category 'standard queries') -----
+ selectionsMayShrink
+ ^ self
+ valueOfFlag: #selectionsMayShrink
+ ifAbsent: [true]!
Item was changed:
----- Method: Preferences class>>showAdvancedNavigatorButtons (in category 'standard queries') -----
showAdvancedNavigatorButtons
^ self
valueOfFlag: #showAdvancedNavigatorButtons
+ ifAbsent: [false]!
- ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>showDeprecationWarnings (in category 'standard queries') -----
+ showDeprecationWarnings
+ ^ self
+ valueOfFlag: #showDeprecationWarnings
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>showLinesInHierarchyViews (in category 'standard queries') -----
+ showLinesInHierarchyViews
+ ^ self
+ valueOfFlag: #showLinesInHierarchyViews
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>slideDismissalsToTrash (in category 'standard queries') -----
+ slideDismissalsToTrash
+ ^ self
+ valueOfFlag: #slideDismissalsToTrash
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>soundQuickStart (in category 'standard queries') -----
+ soundQuickStart
+ ^ self
+ valueOfFlag: #soundQuickStart
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>soundReverb (in category 'standard queries') -----
+ soundReverb
+ ^ self
+ valueOfFlag: #soundReverb
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>soundStopWhenDone (in category 'standard queries') -----
+ soundStopWhenDone
+ ^ self
+ valueOfFlag: #soundStopWhenDone
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>soundsEnabled (in category 'standard queries') -----
+ soundsEnabled
+ ^ self
+ valueOfFlag: #soundsEnabled
+ ifAbsent: [true]!
Item was changed:
+ ----- Method: Preferences class>>storePreferencesToDisk (in category 'personalization') -----
- ----- Method: Preferences class>>storePreferencesToDisk (in category 'initialization - save/load') -----
storePreferencesToDisk
+ | newName |
+ newName := UIManager default request: 'Please confirm name for save...' initialAnswer: 'myPreferences'.
+ newName isEmpty
+ ifTrue: [^ self].
+ Cursor wait
+ showWhile: [[self storePreferencesIn: newName , '.prefs']
+ on: Error
+ do: [:ex | self inform: 'there was an error storing your preferences to disk. you probably already have stored your preferences' translated]]!
- Cursor wait showWhile: [
- [ self storePreferencesIn: 'my.prefs' ] on: Error do: [ :ex | self inform: 'there was an error storing your preferences to disk' ]]!
Item was added:
+ ----- Method: Preferences class>>sugarAutoSave (in category 'standard queries') -----
+ sugarAutoSave
+ ^ self
+ valueOfFlag: #sugarAutoSave
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>testRunnerShowAbstractClasses (in category 'standard queries') -----
+ testRunnerShowAbstractClasses
+ ^ self
+ valueOfFlag: #testRunnerShowAbstractClasses
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>twoSidedPoohTextures (in category 'standard queries') -----
+ twoSidedPoohTextures
+ ^ self
+ valueOfFlag: #twoSidedPoohTextures
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>unifyNestedProgressBars (in category 'standard queries') -----
+ unifyNestedProgressBars
+ ^ self
+ valueOfFlag: #unifyNestedProgressBars
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>updateFromServerAtStartup (in category 'standard queries') -----
+ updateFromServerAtStartup
+ ^ self
+ valueOfFlag: #updateFromServerAtStartup
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>updateSavesFile (in category 'standard queries') -----
+ updateSavesFile
+ ^ self
+ valueOfFlag: #updateSavesFile
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>useArtificialSweetenerBar (in category 'standard queries') -----
+ useArtificialSweetenerBar
+ ^ self
+ valueOfFlag: #useArtificialSweetenerBar
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>useBiggerPaintingBox (in category 'standard queries') -----
+ useBiggerPaintingBox
+ ^ self
+ valueOfFlag: #useBiggerPaintingBox
+ ifAbsent: [true]!
Item was changed:
----- Method: Preferences class>>useButtonPropertiesToFire (in category 'standard queries') -----
useButtonPropertiesToFire
^ self
+ valueOfFlag: #useButtonPropertiesToFire
+ ifAbsent: [false]!
- valueOfFlag: #useButtonProprtiesToFire
- ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>useFileList2 (in category 'standard queries') -----
+ useFileList2
+ ^ self
+ valueOfFlag: #useFileList2
+ ifAbsent: [true]!
Item was changed:
+ ----- Method: Preferences class>>useFormsInPaintBox (in category 'standard queries') -----
- ----- Method: Preferences class>>useFormsInPaintBox (in category 'prefs - misc') -----
useFormsInPaintBox
+ ^ self
+ valueOfFlag: #useFormsInPaintBox
+ ifAbsent: [false]!
-
- ^ self valueOfFlag: #useFormsInPaintBox!
Item was added:
+ ----- Method: Preferences class>>usePangoRenderer (in category 'standard queries') -----
+ usePangoRenderer
+ ^ self
+ valueOfFlag: #usePangoRenderer
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>usePlatformFonts (in category 'standard queries') -----
+ usePlatformFonts
+ ^ self
+ valueOfFlag: #usePlatformFonts
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>usePopUpArrows (in category 'standard queries') -----
+ usePopUpArrows
+ ^ self
+ valueOfFlag: #usePopUpArrows
+ ifAbsent: [true]!
Item was added:
+ ----- Method: Preferences class>>warnIfChangesFileReadOnly (in category 'standard queries') -----
+ warnIfChangesFileReadOnly
+ ^ self
+ valueOfFlag: #warnIfChangesFileReadOnly
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>warningForMacOSFileNameLength (in category 'standard queries') -----
+ warningForMacOSFileNameLength
+ ^ self
+ valueOfFlag: #warningForMacOSFileNameLength
+ ifAbsent: [false]!
Item was changed:
----- Method: Project class>>mostRecent:onServer: (in category 'squeaklet on server') -----
mostRecent: projName onServer: aServerDirectory
| stem list max goodName triple num stem1 stem2 rawList nothingFound unEscName |
"Find the exact fileName of the most recent version of project with the stem name of projName. Names are of the form 'projName|mm.pr' where mm is a mime-encoded integer version number.
File names may or may not be HTTP escaped, %20 on the server."
self flag: #bob. "do we want to handle unversioned projects as well?"
+ "I think we do now - Yoshiki."
+ nothingFound _ {nil. -1}.
- nothingFound := {nil. -1}.
aServerDirectory ifNil: [^nothingFound].
"23 sept 2000 - some old projects have periods in name so be more careful"
+ unEscName _ projName unescapePercents.
+ triple _ Project parseProjectFileName: unEscName.
+ stem _ triple first.
+ rawList _ aServerDirectory fileNames.
- unEscName := projName unescapePercents.
- triple := Project parseProjectFileName: unEscName.
- stem := triple first.
- rawList := aServerDirectory fileNames.
+ rawList isString ifTrue: [self inform: 'server is unavailable' translated. ^nothingFound].
+ list _ rawList collect: [:nnn | nnn unescapePercents].
+ max _ -1. goodName _ nil.
- rawList isString ifTrue: [self inform: 'server is unavailable'. ^nothingFound].
- list := rawList collect: [:nnn | nnn unescapePercents].
- max := -1. goodName := nil.
list withIndexDo: [:aName :ind |
+ ((aName beginsWith: stem)) ifTrue: [
+ ((aName endsWith: triple last) or: [triple last = '' and: [aName endsWith: '.pr']]) ifTrue: [
+ num _ (Project parseProjectFileName: aName) second.
+ num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]].
- (aName beginsWith: stem) ifTrue: [
- num := (Project parseProjectFileName: aName) second.
- num > max ifTrue: [max := num. goodName := (rawList at: ind)]]].
max = -1 ifFalse: [^ Array with: goodName with: max].
"try with underbar for spaces on server"
(stem includes: $ ) ifTrue: [
+ stem1 _ stem copyReplaceAll: ' ' with: '_'.
- stem1 := stem copyReplaceAll: ' ' with: '_'.
list withIndexDo: [:aName :ind |
(aName beginsWith: stem1) ifTrue: [
+ num _ (Project parseProjectFileName: aName) second.
+ num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]].
- num := (Project parseProjectFileName: aName) second.
- num > max ifTrue: [max := num. goodName := (rawList at: ind)]]]].
max = -1 ifFalse: [^ Array with: goodName with: max].
"try without the marker | "
+ stem1 _ stem allButLast, '.pr'.
+ stem2 _ stem1 copyReplaceAll: ' ' with: '_'. "and with spaces replaced"
- stem1 := stem allButLast, '.pr'.
- stem2 := stem1 copyReplaceAll: ' ' with: '_'. "and with spaces replaced"
list withIndexDo: [:aName :ind |
(aName beginsWith: stem1) | (aName beginsWith: stem2) ifTrue: [
+ (triple _ aName findTokens: '.') size >= 2 ifTrue: [
+ max _ 0. goodName _ (rawList at: ind)]]]. "no other versions"
- (triple := aName findTokens: '.') size >= 2 ifTrue: [
- max := 0. goodName := (rawList at: ind)]]]. "no other versions"
max = -1 ifFalse: [^ Array with: goodName with: max].
^nothingFound "no matches"
!
Item was added:
+ ----- Method: Project class>>publishInSexp (in category 'preferences') -----
+ publishInSexp
+
+ Smalltalk at: #SISSDictionaryForScanning ifPresent: [:siss | ^ siss publishInSexp].
+ ^ false!
Item was changed:
----- Method: Project class>>squeakletDirectory (in category 'squeaklet on server') -----
squeakletDirectory
| squeakletDirectoryName |
+ squeakletDirectoryName := (Smalltalk at: #SugarLauncher ifPresent: [:c |
+ c current parameterAt: 'SQUEAKLETS' ifAbsent: []]) ifNil: ['Squeaklets'].
- squeakletDirectoryName := 'Squeaklets'.
(FileDirectory default directoryExists: squeakletDirectoryName) ifFalse: [
FileDirectory default createDirectory: squeakletDirectoryName
].
^FileDirectory default directoryNamed: squeakletDirectoryName!
Item was changed:
----- Method: Project class>>sweep: (in category 'squeaklet on server') -----
sweep: aServerDirectory
| repository list parts ind entry projectName versions |
"On the server, move all but the three most recent versions of each Squeaklet to a folder called 'older'"
"Project sweep: ((ServerDirectory serverNamed: 'DaniOnJumbo') clone
directory: '/vol0/people/dani/Squeaklets/2.7')"
"Ensure the 'older' directory"
(aServerDirectory includesKey: 'older')
ifFalse: [aServerDirectory createDirectory: 'older'].
+ repository _ aServerDirectory clone directory: aServerDirectory directory, '/older'.
- repository := aServerDirectory clone directory: aServerDirectory directory, '/older'.
"Collect each name, and decide on versions"
+ list _ aServerDirectory fileNames.
+ list isString ifTrue: [^ self inform: 'server is unavailable' translated].
+ list _ list asSortedCollection asOrderedCollection.
+ parts _ list collect: [:en | Project parseProjectFileName: en].
+ parts _ parts select: [:en | en third = 'pr'].
+ ind _ 1.
+ [entry _ list at: ind.
+ projectName _ entry first asLowercase.
+ versions _ OrderedCollection new. versions add: entry.
+ [(ind _ ind + 1) > list size
- list := aServerDirectory fileNames.
- list isString ifTrue: [^ self inform: 'server is unavailable'].
- list := list asSortedCollection asOrderedCollection.
- parts := list collect: [:en | Project parseProjectFileName: en].
- parts := parts select: [:en | en third = 'pr'].
- ind := 1.
- [entry := list at: ind.
- projectName := entry first asLowercase.
- versions := OrderedCollection new. versions add: entry.
- [(ind := ind + 1) > list size
ifFalse: [(parts at: ind) first asLowercase = projectName
ifTrue: [versions add: (parts at: ind). true]
ifFalse: [false]]
ifTrue: [false]] whileTrue.
aServerDirectory moveYoungest: 3 in: versions to: repository.
ind > list size] whileFalse.
!
Item was added:
+ ----- Method: Project>>acceptProjectDetails: (in category 'file in/out') -----
+ acceptProjectDetails: details
+ "Store project details back into a property of the world, and if a name is provided, make sure the name is properly installed in the project."
+
+ world setProperty: #ProjectDetails toValue: details.
+ details at: 'projectname' ifPresent: [ :newName |
+ self renameTo: newName]!
Item was added:
+ ----- Method: Project>>compressFilesIn:to:in: (in category 'file in/out') -----
+ compressFilesIn: tempDir to: localName in: localDirectory
+ "Compress all the files in tempDir making up a zip file in localDirectory named localName"
+
+ | archive archiveName entry fileNames |
+ archive := ZipArchive new.
+ fileNames := tempDir fileNames.
+ (fileNames includes: 'manifest')
+ ifTrue: [fileNames := #('manifest'), (fileNames copyWithout: 'manifest')].
+ fileNames do:[:fn|
+ archiveName := fn.
+ entry := archive addFile: (tempDir fullNameFor: fn) as: archiveName.
+ entry desiredCompressionMethod: (
+ fn = 'manifest'
+ ifTrue: [ZipArchive compressionLevelNone]
+ ifFalse: [ZipArchive compressionDeflated]).
+ ].
+ archive writeToFileNamed: (localDirectory fullNameFor: localName).
+ archive close.
+ tempDir fileNames do:[:fn|
+ tempDir deleteFileNamed: fn ifAbsent:[]].
+ localDirectory deleteDirectory: tempDir localName.!
Item was added:
+ ----- Method: Project>>createViewIfAppropriate (in category 'utilities') -----
+ createViewIfAppropriate
+ "overridden in subclasses"
+ ^ self!
Item was changed:
----- Method: Project>>depth (in category 'active process') -----
depth
"Return the depth of this project from the top.
topProject = 0, next = 1, etc."
"Project current depth."
+ | depth project |
+ depth _ 0.
+ project _ self.
- | depth topProject project |
- depth := 0.
- topProject := Project topProject.
- project := self.
+ [project class == DiskProxy ifTrue: [^ depth].
+ project isTopProject]
+ whileFalse:
+ [project _ project parent.
+ depth _ depth + 1].
- [project ~= topProject and:[project notNil]]
- whileTrue:
- [project := project parent.
- depth := depth + 1].
^ depth!
Item was changed:
----- Method: Project>>doWeWantToRename (in category 'menu messages') -----
doWeWantToRename
| want |
self hasBadNameForStoring ifTrue: [^true].
+ (self name beginsWith: 'Unnamed' translated) ifTrue: [^true].
+ want _ world valueOfProperty: #SuperSwikiRename ifAbsent: [false].
- (self name beginsWith: 'Unnamed') ifTrue: [^true].
- want := world valueOfProperty: #SuperSwikiRename ifAbsent: [false].
world removeProperty: #SuperSwikiRename.
^want
!
Item was changed:
----- Method: Project>>exportSegmentFileName:directory: (in category 'file in/out') -----
exportSegmentFileName: aFileName directory: aDirectory
+ ^ self exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: false!
- | exportChangeSet |
-
- "An experimental version to fileout a changeSet first so that a project can contain its own classes"
-
- "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg.
- Player classes are included automatically."
-
- exportChangeSet := nil.
- (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [
- (self confirm:
- 'Would you like to include all the changes in the change set
- as part of this publishing operation?' translated) ifTrue: [
- exportChangeSet := changeSet
- ].
- ].
- ^ self
- exportSegmentWithChangeSet: exportChangeSet
- fileName: aFileName
- directory: aDirectory
- !
Item was added:
+ ----- Method: Project>>exportSegmentFileName:directory:withoutInteraction: (in category 'file in/out') -----
+ exportSegmentFileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+
+ | exportChangeSet |
+
+ "An experimental version to fileout a changeSet first so that a project can contain its own classes"
+
+ "Store my project out on the disk as an *exported* ImageSegment. Put all outPointers in a form that can be resolved in the target image. Name it <project name>.extSeg.
+ Player classes are included automatically."
+ exportChangeSet := nil.
+ (changeSet notNil and: [changeSet isEmpty not]) ifTrue: [
+ (noInteraction or: [self confirm:
+ 'Would you like to include all the changes in the change set
+ as part of this publishing operation?' translated]) ifTrue: [
+ exportChangeSet := changeSet
+ ].
+ ].
+
+ Project publishInSexp ifTrue: [
+ ^ self exportSegmentInSexpWithChangeSet: exportChangeSet fileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+ ].
+ ^ self
+ exportSegmentWithChangeSet: exportChangeSet
+ fileName: aFileName
+ directory: aDirectory
+ withoutInteraction: noInteraction!
Item was added:
+ ----- Method: Project>>exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: (in category 'file in/out') -----
+ exportSegmentInSexpWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+
+ self subclassResponsibility!
Item was changed:
----- Method: Project>>htmlPagePrototype (in category 'file in/out') -----
htmlPagePrototype
"Return the HTML page prototype"
^'<html>
<head>
<title>Squeak Project</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
</head>
<body bgcolor="#FFFFFF">
<EMBED
type="application/x-squeak-source"
ALIGN="CENTER"
WIDTH="$$WIDTH$$"
HEIGHT="$$HEIGHT$$"
src="$$PROJECT$$"
+ pluginspage="http://www.squeakland.org/download/">
- pluginspage="http://www.squeakland.org/plugin/detect/detectinstaller.html">
</EMBED>
</body>
</html>
'!
Item was changed:
----- Method: Project>>revert (in category 'file in/out') -----
revert
| |
"Exit this project and do not save it. Warn user unless in dangerous projectRevertNoAsk mode. Exit to the parent project. Do a revert on a clone of the segment, to allow later reverts."
+ projectParameters ifNil: [^ self inform: 'nothing to revert to' translated].
- projectParameters ifNil: [^ self inform: 'nothing to revert to'].
parentProject enter: false revert: true saveForRevert: false.
"does not return!!"
!
Item was changed:
----- Method: Project>>storeOnServer (in category 'file in/out') -----
storeOnServer
"Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded."
world setProperty: #optimumExtentFromAuthor toValue: world extent.
+ self validateProjectNameIfOK: [:details |
+ self acceptProjectDetails: details.
- self validateProjectNameIfOK: [
self isCurrentProject ifTrue: ["exit, then do the command"
^ self
armsLengthCommand: #storeOnServerAssumingNameValid
withDescription: 'Publishing' translated
].
self storeOnServerWithProgressInfo.
].!
Item was changed:
----- Method: Project>>storeOnServerAssumingNameValid (in category 'file in/out') -----
storeOnServerAssumingNameValid
"Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded."
-
world setProperty: #optimumExtentFromAuthor toValue: world extent.
self isCurrentProject ifTrue: ["exit, then do the command"
+ Flaps globalFlapTabsIfAny do: [:each | Flaps removeFlapTab: each keepInList: true].
^ self
armsLengthCommand: #storeOnServerAssumingNameValid
withDescription: 'Publishing' translated
].
self storeOnServerWithProgressInfo.
!
Item was changed:
----- Method: Project>>storeOnServerShowProgressOn:forgetURL: (in category 'file in/out') -----
storeOnServerShowProgressOn: aMorphOrNil forgetURL: forget
"Save to disk as an Export Segment. Then put that file on the server I came from, as a new version. Version is literal piece of file name. Mime encoded and http encoded."
world setProperty: #optimumExtentFromAuthor toValue: world extent.
+ self validateProjectNameIfOK: [:details |
+ self acceptProjectDetails: details.
- self validateProjectNameIfOK: [
self isCurrentProject ifTrue: ["exit, then do the command"
forget
ifTrue: [self forgetExistingURL]
ifFalse: [urlList isEmptyOrNil ifTrue: [urlList := parentProject urlList copy]].
^self
armsLengthCommand: #storeOnServerAssumingNameValid
withDescription: 'Publishing' translated
].
self storeOnServerWithProgressInfoOn: aMorphOrNil.
].
!
Item was changed:
----- Method: Project>>validateProjectNameIfOK: (in category 'menu messages') -----
validateProjectNameIfOK: aBlock
| details |
details := world valueOfProperty: #ProjectDetails.
details ifNotNil: ["ensure project info matches real project name"
details at: 'projectname' put: self name.
].
+ self doWeWantToRename ifFalse: [^ aBlock value: details].
- self doWeWantToRename ifFalse: [^aBlock value].
(Smalltalk at: #EToyProjectDetailsMorph) ifNotNil: [:etpdm |
etpdm
getFullInfoFor: self
+ ifValid: [:d |
- ifValid: [
World displayWorldSafely.
+ aBlock value: d
- aBlock value.
]
expandedFormat: false]
!
Item was changed:
----- Method: ProjectLauncher>>loginAs: (in category 'eToy login') -----
loginAs: userName
"Assuming that we have a valid user url; read its contents and see if the user is really there."
| actualName userList |
eToyAuthentificationServer ifNil:[
self proceedWithLogin.
^true].
+ userList _ eToyAuthentificationServer eToyUserList.
- userList := eToyAuthentificationServer eToyUserList.
userList ifNil:[
self inform:
'Sorry, I cannot find the user list.
(this may be due to a network problem)
+ Please hit Cancel if you wish to use Squeak.' translated.
- Please hit Cancel if you wish to use Squeak.'.
^false].
"case insensitive search"
+ actualName _ userList detect:[:any| any sameAs: userName] ifNone:[nil].
- actualName := userList detect:[:any| any sameAs: userName] ifNone:[nil].
actualName isNil ifTrue:[
+ self inform: 'Unknown user: ' translated ,userName.
- self inform: 'Unknown user: ',userName.
^false].
Utilities authorName: actualName.
eToyAuthentificationServer eToyUserName: actualName.
self proceedWithLogin.
^true!
Item was added:
+ ----- Method: ProjectLoading class>>checkSecurity:preStream:projStream: (in category 'utilities') -----
+ checkSecurity: aFileName preStream: preStream projStream: projStream
+ "Answer true if passed"
+ | trusted enterRestricted |
+ trusted := SecurityManager default positionToSecureContentsOf:
+ projStream.
+ trusted ifFalse:
+ [enterRestricted := (preStream isTypeHTTP or:
+ [aFileName isNil])
+ ifTrue: [Preferences securityChecksEnabled]
+ ifFalse: [Preferences standaloneSecurityChecksEnabled].
+ enterRestricted
+ ifTrue: [SecurityManager default enterRestrictedMode
+ ifFalse:
+ [preStream close.
+ ^ false]]].
+ ^ true!
Item was added:
+ ----- Method: ProjectLoading class>>checkStream: (in category 'utilities') -----
+ checkStream: aStream
+ (aStream isNil
+ or: [aStream size = 0])
+ ifFalse: [^ false].
+ ProgressNotification signal: '9999 about to enter
+ project'.
+ "the hard part is over"
+ self inform: 'It looks like a problem occurred while
+ getting this project. It may be temporary,
+ so you may want to try again,' translated.
+ ^ true!
Item was added:
+ ----- Method: ProjectLoading class>>fileInName:archive:morphOrList: (in category 'utilities') -----
+ fileInName: aFileName archive: archive morphOrList: morphOrList
+ | baseChangeSet substituteFont numberOfFontSubstitutes exceptions anObject mgr |
+ ResourceCollector current: ResourceCollector new.
+ baseChangeSet := ChangeSet current.
+ self useTempChangeSet. "named zzTemp"
+ "The actual reading happens here"
+ substituteFont := Preferences standardDefaultTextFont copy.
+ numberOfFontSubstitutes := 0.
+ exceptions := Set new.
+ [[anObject := morphOrList fileInObjectAndCodeForProject]
+ on: MissingFont do: [ :ex |
+ exceptions add: ex.
+ numberOfFontSubstitutes := numberOfFontSubstitutes + 1.
+ ex resume: substituteFont ]]
+ ensure: [ ChangeSet newChanges: baseChangeSet].
+ mgr := ResourceManager new initializeFrom: ResourceCollector current.
+ mgr fixJISX0208Resource.
+ mgr registerUnloadedResources.
+ archive ifNotNil:[mgr preLoadFromArchive: archive cacheName: aFileName].
+ ResourceCollector current: nil.
+ ^ {anObject. numberOfFontSubstitutes. substituteFont. mgr}!
Item was added:
+ ----- Method: ProjectLoading class>>loadImageSegment:fromDirectory:withProjectView:numberOfFontSubstitutes:substituteFont:mgr: (in category 'loading') -----
+ loadImageSegment: morphOrList fromDirectory: aDirectoryOrNil withProjectView: existingView numberOfFontSubstitutes: numberOfFontSubstitutes substituteFont: substituteFont mgr: mgr
+
+ | proj projectsToBeDeleted ef |
+ Smalltalk at: #Flaps ifPresent: [:flaps |
+ (flaps globalFlapTabWithID: 'Navigator' translated)ifNotNil: [:f | f hideFlap]].
+ proj := morphOrList arrayOfRoots
+ detect: [:mm | mm isKindOf: Project]
+ ifNone: [^ nil].
+ numberOfFontSubstitutes > 0 ifTrue: [
+ proj projectParameterAt: #substitutedFont put: substituteFont].
+ ef := proj projectParameterAt: #eToysFont.
+ (ef isNil or: [ef ~= substituteFont familySizeFace]) ifTrue: [
+ proj projectParameterAt: #substitutedFont put: substituteFont.
+ ].
+ proj projectParameters at: #MultiSymbolInWrongPlace put: false.
+ "Yoshiki did not put MultiSymbols into outPointers in older images!!"
+ morphOrList arrayOfRoots do: [:obj |
+ obj fixUponLoad: proj seg: morphOrList "imageSegment"].
+ (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [
+ morphOrList arrayOfRoots do: [:obj | (obj isKindOf: Set) ifTrue: [obj rehash]]].
+
+ proj resourceManager: mgr.
+ "proj versionFrom: preStream."
+ proj lastDirectory: aDirectoryOrNil.
+ proj setParent: Project current.
+ projectsToBeDeleted := OrderedCollection new.
+ existingView == #none ifFalse: [
+ self makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted].
+ ChangeSorter allChangeSets add: proj changeSet.
+ Project current projectParameters
+ at: #deleteWhenEnteringNewProject
+ ifPresent: [ :ignored |
+ projectsToBeDeleted add: Project current.
+ Project current removeParameter: #deleteWhenEnteringNewProject.
+ ].
+ projectsToBeDeleted isEmpty ifFalse: [
+ proj projectParameters
+ at: #projectsToBeDeleted
+ put: projectsToBeDeleted.
+ ].
+ proj removeParameter: #eToysFont.
+ ^ proj!
Item was added:
+ ----- Method: ProjectLoading class>>makeExistingView:project:projectsToBeDeleted: (in category 'utilities') -----
+ makeExistingView: existingView project: proj projectsToBeDeleted: projectsToBeDeleted
+ existingView ifNil: [
+ proj createViewIfAppropriate.
+ ChangeSorter allChangeSets add: proj changeSet.
+ Project current openProject: proj.
+ ] ifNotNil: [
+ (existingView project isKindOf: DiskProxy) ifFalse: [
+ existingView project changeSet name:
+ ChangeSet defaultName.
+ projectsToBeDeleted add: existingView project.
+ ].
+ (existingView owner isSystemWindow) ifTrue: [
+ existingView owner model: proj
+ ].
+ existingView project: proj.
+ ].!
Item was added:
+ ----- Method: ProjectLoading class>>morphOrList:stream:fromDirectory:archive: (in category 'utilities') -----
+ morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive
+ "Answer morphOrList or nil if problem happened"
+ | projStream localDir morphOrList |
+ projStream := archive
+ ifNil: [preStream]
+ ifNotNil: [self projectStreamFromArchive: archive].
+ (self checkSecurity: aFileName preStream: preStream projStream: projStream)
+ ifFalse: [^nil].
+ localDir := Project squeakletDirectory.
+ aFileName ifNotNil: [
+ (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName
+ ~= localDir pathName]) ifTrue: [
+ localDir deleteFileNamed: aFileName.
+ (localDir fileNamed: aFileName) binary
+ nextPutAll: preStream remainingContents;
+ close.
+ ].
+ ].
+ morphOrList := projStream asUnZippedStream.
+ preStream sleep. "if ftp, let the connection close"
+ ^ morphOrList!
Item was changed:
----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView: (in category 'loading') -----
openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
withProjectView: existingView
- "Reconstitute a Morph from the selected file, presumed to be
- represent a Morph saved via the SmartRefStream mechanism, and open it
- in an appropriate Morphic world."
+ ^ self openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
+ withProjectView: existingView clearOriginFlag: false.!
- | morphOrList proj trusted localDir projStream archive mgr
- projectsToBeDeleted baseChangeSet enterRestricted substituteFont
- numberOfFontSubstitutes exceptions |
- (preStream isNil or: [preStream size = 0]) ifTrue: [
- ProgressNotification signal: '9999 about to enter
- project'. "the hard part is over"
- ^self inform:
- 'It looks like a problem occurred while
- getting this project. It may be temporary,
- so you may want to try again,' translated
- ].
- ProgressNotification signal: '2:fileSizeDetermined
- ',preStream size printString.
- preStream isZipArchive
- ifTrue:[ archive := ZipArchive new readFrom: preStream.
- projStream := self
- projectStreamFromArchive: archive]
- ifFalse:[projStream := preStream].
- trusted := SecurityManager default positionToSecureContentsOf:
- projStream.
- trusted ifFalse:
- [enterRestricted := (preStream isTypeHTTP or:
- [aFileName isNil])
- ifTrue: [Preferences securityChecksEnabled]
- ifFalse: [Preferences standaloneSecurityChecksEnabled].
- enterRestricted
- ifTrue: [SecurityManager default enterRestrictedMode
- ifFalse:
- [preStream close.
- ^ self]]].
-
- localDir := Project squeakletDirectory.
- aFileName ifNotNil: [
- (aDirectoryOrNil isNil or: [aDirectoryOrNil pathName
- ~= localDir pathName]) ifTrue: [
- localDir deleteFileNamed: aFileName.
- (localDir fileNamed: aFileName) binary
- nextPutAll: preStream contents;
- close.
- ].
- ].
- morphOrList := projStream asUnZippedStream.
- preStream sleep. "if ftp, let the connection close"
- ProgressNotification signal: '3:unzipped'.
- ResourceCollector current: ResourceCollector new.
- baseChangeSet := ChangeSet current.
- self useTempChangeSet. "named zzTemp"
- "The actual reading happens here"
- substituteFont := Preferences standardEToysFont copy.
- numberOfFontSubstitutes := 0.
- exceptions := Set new.
- [[morphOrList := morphOrList fileInObjectAndCodeForProject]
- on: MissingFont do: [ :ex |
- exceptions add: ex.
- numberOfFontSubstitutes :=
- numberOfFontSubstitutes + 1.
- ex resume: substituteFont ]]
- ensure: [ ChangeSet newChanges: baseChangeSet].
- mgr := ResourceManager new initializeFrom: ResourceCollector current.
- mgr fixJISX0208Resource.
- mgr registerUnloadedResources.
- archive ifNotNil:[mgr preLoadFromArchive: archive cacheName:
- aFileName].
- (preStream respondsTo: #close) ifTrue:[preStream close].
- ResourceCollector current: nil.
- ProgressNotification signal: '4:filedIn'.
- ProgressNotification signal: '9999 about to enter project'.
- "the hard part is over"
- (morphOrList isKindOf: ImageSegment) ifTrue: [
- proj := morphOrList arrayOfRoots
- detect: [:mm | mm isKindOf: Project]
- ifNone: [^self inform: 'No project found in
- this file'].
- proj projectParameters at: #substitutedFont put: (
- numberOfFontSubstitutes > 0
- ifTrue: [substituteFont]
- ifFalse: [#none]).
- proj projectParameters at: #MultiSymbolInWrongPlace put: false.
- "Yoshiki did not put MultiSymbols into
- outPointers in older images!!"
- morphOrList arrayOfRoots do: [:obj |
- obj fixUponLoad: proj seg: morphOrList "imageSegment"].
- (proj projectParameters at: #MultiSymbolInWrongPlace) ifTrue: [
- morphOrList arrayOfRoots do: [:obj | (obj
- isKindOf: HashedCollection) ifTrue: [obj rehash]]].
-
- proj resourceManager: mgr.
- "proj versionFrom: preStream."
- proj lastDirectory: aDirectoryOrNil.
- proj setParent: Project current.
- projectsToBeDeleted := OrderedCollection new.
- existingView ifNil: [
- ChangeSet allChangeSets add: proj changeSet.
- Project current openProject: proj.
- "Note: in MVC we get no further than the above"
- ] ifNotNil: [
- (existingView project isKindOf: DiskProxy) ifFalse: [
- existingView project changeSet name:
- ChangeSet defaultName.
- projectsToBeDeleted add: existingView project.
- ].
- (existingView owner isSystemWindow) ifTrue: [
- existingView owner model: proj
- ].
- existingView project: proj.
- ].
- ChangeSet allChangeSets add: proj changeSet.
- Project current projectParameters
- at: #deleteWhenEnteringNewProject
- ifPresent: [ :ignored |
- projectsToBeDeleted add: Project current.
- Project current removeParameter:
- #deleteWhenEnteringNewProject.
- ].
- projectsToBeDeleted isEmpty ifFalse: [
- proj projectParameters
- at: #projectsToBeDeleted
- put: projectsToBeDeleted.
- ].
- ^ ProjectEntryNotification signal: proj
- ].
- Project current openViewAndEnter: morphOrList
- !
Item was added:
+ ----- Method: ProjectLoading class>>openName:stream:fromDirectory:withProjectView:clearOriginFlag: (in category 'loading') -----
+ openName: aFileName stream: preStream fromDirectory: aDirectoryOrNil
+ withProjectView: existingView clearOriginFlag: clearOriginFlag
+ "Reconstitute a Morph from the selected file, presumed to
+ represent a Morph saved via the SmartRefStream mechanism, and open it
+ in an appropriate Morphic world."
+
+ | morphOrList archive mgr substituteFont numberOfFontSubstitutes resultArray anObject project manifests dict |
+ (self checkStream: preStream) ifTrue: [^ self].
+ ProgressNotification signal: '0.2'.
+ archive _ preStream isZipArchive
+ ifTrue:[ZipArchive new readFrom: preStream]
+ ifFalse:[nil].
+ archive ifNotNil:[
+ manifests _ (archive membersMatching: '*manifest').
+ (manifests size = 1 and: [((dict _ self parseManifest: manifests first contents) at: 'Project-Format' ifAbsent: []) = 'S-Expression'])
+ ifTrue: [
+ ^ (self respondsTo: #openSexpProjectDict:stream:fromDirectory:withProjectView:)
+ ifTrue: [self openSexpProjectDict: dict stream: preStream fromDirectory: aDirectoryOrNil withProjectView: existingView]
+ ifFalse: [self inform: 'Cannot load S-Expression format projects without Etoys' translated]]].
+
+ morphOrList _ self morphOrList: aFileName stream: preStream fromDirectory: aDirectoryOrNil archive: archive.
+ morphOrList ifNil: [^ self].
+ ProgressNotification signal: '0.4'.
+ resultArray _ self fileInName: aFileName archive: archive morphOrList: morphOrList.
+ anObject _ resultArray first.
+ numberOfFontSubstitutes _ resultArray second.
+ substituteFont _ resultArray third.
+ mgr _ resultArray fourth.
+ preStream close.
+ ProgressNotification signal: '0.7'.
+ "the hard part is over"
+ (anObject isKindOf: ImageSegment) ifTrue: [
+ project _ self loadImageSegment: anObject
+ fromDirectory: aDirectoryOrNil
+ withProjectView: existingView
+ numberOfFontSubstitutes: numberOfFontSubstitutes
+ substituteFont: substituteFont
+ mgr: mgr.
+ project noteManifestDetailsIn: dict.
+ project removeParameter: #sugarProperties.
+ Smalltalk at: #SugarPropertiesNotification ifPresent: [:sp |
+ sp signal ifNotNilDo: [:props |
+ project keepSugarProperties: props monitor: true]].
+ clearOriginFlag ifTrue: [project forgetExistingURL].
+ ProgressNotification signal: '0.8'.
+ ^ project
+ ifNil: [self inform: 'No project found in this file' translated]
+ ifNotNil: [ProjectEntryNotification signal: project]].
+ Project current openViewAndEnter: anObject!
Item was added:
+ ----- Method: ProjectLoading class>>parseManifest: (in category 'utilities') -----
+ parseManifest: aString
+
+ | dict line index key value aStream |
+ aStream := aString readStream.
+ dict := Dictionary new.
+ [(line := aStream nextLine) notNil] whileTrue: [
+ index := line indexOf: $:.
+ index > 0 ifTrue: [
+ key := line copyFrom: 1 to: index - 1.
+ value := (line copyFrom: index + 1 to: line size) withBlanksTrimmed.
+ dict at: key put: value.
+ ].
+ ].
+ ^ dict.!
Item was changed:
----- Method: ProjectLoading class>>projectStreamFromArchive: (in category 'accessing') -----
projectStreamFromArchive: archive
| ext prFiles entry unzipped |
ext := FileDirectory dot, Project projectExtension.
prFiles := archive members select:[:any| any fileName endsWith: ext].
+ prFiles isEmpty ifTrue:
+ [ext := FileDirectory dot, 'sexp'.
+ prFiles := archive members select:[:any| any fileName endsWith: ext]].
+ prFiles isEmpty ifTrue: [''].
- prFiles isEmpty ifTrue:[^''].
entry := prFiles first.
+ unzipped := MultiByteBinaryOrTextStream on: (ByteArray new: entry uncompressedSize).
- unzipped := RWBinaryOrTextStream on: (ByteArray new: entry uncompressedSize).
entry extractTo: unzipped.
^unzipped reset!
Item was changed:
----- Method: SARInstaller class>>serviceFileInSAR (in category 'class initialization') -----
serviceFileInSAR
"Answer a service for opening a changelist browser on a file"
^ SimpleServiceEntry
provider: self
+ label: 'install SAR' translatedNoop
- label: 'install SAR'
selector: #installSAR:
+ description: 'install this Squeak ARchive into the image.' translatedNoop
+ buttonLabel: 'install' translatedNoop!
- description: 'install this Squeak ARchive into the image.'
- buttonLabel: 'install'!
Item was changed:
----- Method: SqueakTheme class>>addSyntaxHighlighting: (in category 'instance creation') -----
addSyntaxHighlighting: theme
+ "This was the former sub-dued highlighting."
- "This was the former sub-dued highlighting.
- self create apply.
- "
theme
+ set: #color for: #TextAction to: (Color r: 0.4 g: 0.0 b: 1);
- set: #color for: #TextAction to: Color aqua;
set: #default for: #SHTextStylerST80 to: {Color black};
set: #invalid for: #SHTextStylerST80 to: {Color red};
set: #excessCode for: #SHTextStylerST80 to: {Color red};
set: #comment for: #SHTextStylerST80 to: {Color cyan muchDarker};
set: #unfinishedComment for: #SHTextStylerST80 to: {Color red muchDarker. TextEmphasis italic};
set: #'$' for: #SHTextStylerST80 to: {Color red muchDarker};
set: #character for: #SHTextStylerST80 to: {Color red muchDarker};
set: #integer for: #SHTextStylerST80 to: {Color red muchDarker};
set: #number for: #SHTextStylerST80 to: {Color red muchDarker};
set: #- for: #SHTextStylerST80 to: {Color red muchDarker};
set: #symbol for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #stringSymbol for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #literalArray for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #string for: #SHTextStylerST80 to: {Color magenta muchDarker. TextEmphasis normal};
set: #unfinishedString for: #SHTextStylerST80 to: {Color red. TextEmphasis normal};
set: #assignment for: #SHTextStylerST80 to: {nil. TextEmphasis bold};
set: #ansiAssignment for: #SHTextStylerST80 to: {nil. TextEmphasis bold};
set: #literal for: #SHTextStylerST80 to: {nil. TextEmphasis italic};
set: #keyword for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #binary for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #unary for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #incompleteKeyword for: #SHTextStylerST80 to: {Color gray muchDarker. TextEmphasis underlined};
set: #incompleteBinary for: #SHTextStylerST80 to: {Color gray muchDarker. TextEmphasis underlined};
set: #incompleteUnary for: #SHTextStylerST80 to: {Color gray muchDarker. TextEmphasis underlined};
set: #undefinedKeyword for: #SHTextStylerST80 to: {Color red};
set: #undefinedBinary for: #SHTextStylerST80 to: {Color red};
set: #undefinedUnary for: #SHTextStylerST80 to: {Color red};
set: #patternKeyword for: #SHTextStylerST80 to: {nil. TextEmphasis bold};
set: #patternBinary for: #SHTextStylerST80 to: {nil. TextEmphasis bold};
set: #patternUnary for: #SHTextStylerST80 to: {nil. TextEmphasis bold};
set: #self for: #SHTextStylerST80 to: {Color red muchDarker};
set: #super for: #SHTextStylerST80 to: {Color red muchDarker};
set: #true for: #SHTextStylerST80 to: {Color red muchDarker};
set: #false for: #SHTextStylerST80 to: {Color red muchDarker};
set: #nil for: #SHTextStylerST80 to: {Color red muchDarker};
set: #thisContext for: #SHTextStylerST80 to: {Color red muchDarker};
set: #return for: #SHTextStylerST80 to: {Color red muchDarker};
set: #patternArg for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #methodArg for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #blockPatternArg for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #blockArg for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #argument for: #SHTextStylerST80 to: {Color blue muchDarker};
set: #blockArgColon for: #SHTextStylerST80 to: {Color black};
set: #leftParenthesis for: #SHTextStylerST80 to: {Color black};
set: #rightParenthesis for: #SHTextStylerST80 to: {Color black};
set: #leftParenthesis1 for: #SHTextStylerST80 to: {Color green muchDarker};
set: #rightParenthesis1 for: #SHTextStylerST80 to: {Color green muchDarker};
set: #leftParenthesis2 for: #SHTextStylerST80 to: {Color magenta muchDarker};
set: #rightParenthesis2 for: #SHTextStylerST80 to: {Color magenta muchDarker};
set: #leftParenthesis3 for: #SHTextStylerST80 to: {Color red muchDarker};
set: #rightParenthesis3 for: #SHTextStylerST80 to: {Color red muchDarker};
set: #leftParenthesis4 for: #SHTextStylerST80 to: {Color green darker};
set: #rightParenthesis4 for: #SHTextStylerST80 to: {Color green darker};
set: #leftParenthesis5 for: #SHTextStylerST80 to: {Color orange darker};
set: #rightParenthesis5 for: #SHTextStylerST80 to: {Color orange darker};
set: #leftParenthesis6 for: #SHTextStylerST80 to: {Color magenta darker};
set: #rightParenthesis6 for: #SHTextStylerST80 to: {Color magenta darker};
set: #leftParenthesis7 for: #SHTextStylerST80 to: {Color blue};
set: #rightParenthesis7 for: #SHTextStylerST80 to: {Color blue};
set: #blockStart for: #SHTextStylerST80 to: {Color black};
set: #blockEnd for: #SHTextStylerST80 to: {Color black};
set: #blockStart1 for: #SHTextStylerST80 to: {Color green muchDarker};
set: #blockEnd1 for: #SHTextStylerST80 to: {Color green muchDarker};
set: #blockStart2 for: #SHTextStylerST80 to: {Color magenta muchDarker};
set: #blockEnd2 for: #SHTextStylerST80 to: {Color magenta muchDarker};
set: #blockStart3 for: #SHTextStylerST80 to: {Color red muchDarker};
set: #blockEnd3 for: #SHTextStylerST80 to: {Color red muchDarker};
set: #blockStart4 for: #SHTextStylerST80 to: {Color green darker};
set: #blockEnd4 for: #SHTextStylerST80 to: {Color green darker};
set: #blockStart5 for: #SHTextStylerST80 to: {Color orange darker};
set: #blockEnd5 for: #SHTextStylerST80 to: {Color orange darker};
set: #blockStart6 for: #SHTextStylerST80 to: {Color magenta darker};
set: #blockEnd6 for: #SHTextStylerST80 to: {Color magenta darker};
set: #blockStart7 for: #SHTextStylerST80 to: {Color blue};
set: #blockEnd7 for: #SHTextStylerST80 to: {Color blue};
set: #arrayStart for: #SHTextStylerST80 to: {Color black};
set: #arrayEnd for: #SHTextStylerST80 to: {Color black};
set: #arrayStart1 for: #SHTextStylerST80 to: {Color black};
set: #arrayEnd1 for: #SHTextStylerST80 to: {Color black};
set: #byteArrayStart for: #SHTextStylerST80 to: {Color black};
set: #byteArrayEnd for: #SHTextStylerST80 to: {Color black};
set: #byteArrayStart1 for: #SHTextStylerST80 to: {Color black};
set: #byteArrayEnd1 for: #SHTextStylerST80 to: {Color black};
set: #leftBrace for: #SHTextStylerST80 to: {Color black};
set: #rightBrace for: #SHTextStylerST80 to: {Color black};
set: #cascadeSeparator for: #SHTextStylerST80 to: {Color black};
set: #statementSeparator for: #SHTextStylerST80 to: {Color black};
set: #externalCallType for: #SHTextStylerST80 to: {Color black};
set: #externalCallTypePointerIndicator for: #SHTextStylerST80 to: {Color black};
set: #primitiveOrExternalCallStart for: #SHTextStylerST80 to: {Color black};
set: #primitiveOrExternalCallEnd for: #SHTextStylerST80 to: {Color black};
set: #methodTempBar for: #SHTextStylerST80 to: {Color gray};
set: #blockTempBar for: #SHTextStylerST80 to: {Color gray};
set: #blockArgsBar for: #SHTextStylerST80 to: {Color gray};
set: #primitive for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold};
set: #pragmaKeyword for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold};
set: #pragmaUnary for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold};
set: #pragmaBinary for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold};
set: #externalFunctionCallingConvention for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold};
set: #module for: #SHTextStylerST80 to: {Color green muchDarker. TextEmphasis bold};
set: #blockTempVar for: #SHTextStylerST80 to: {Color gray};
set: #blockPatternTempVar for: #SHTextStylerST80 to: {Color gray};
set: #instVar for: #SHTextStylerST80 to: {Color black};
set: #workspaceVar for: #SHTextStylerST80 to: {Color black};
set: #undefinedIdentifier for: #SHTextStylerST80 to: {Color red};
set: #incompleteIdentifier for: #SHTextStylerST80 to: {Color gray darker. {TextEmphasis italic. TextEmphasis underlined}};
set: #tempVar for: #SHTextStylerST80 to: {Color gray darker};
set: #patternTempVar for: #SHTextStylerST80 to: {Color gray darker};
set: #poolConstant for: #SHTextStylerST80 to: {Color gray muchDarker};
set: #classVar for: #SHTextStylerST80 to: {Color gray muchDarker};
set: #globalVar for: #SHTextStylerST80 to: {Color black}.
"And the text differ"
theme
set: #insertTextAttributes for: #TextDiffBuilder to: { TextColor red };
set: #removeTextAttributes for: #TextDiffBuilder to: { TextEmphasis struckOut. TextColor blue };
set: #normalTextAttributes for: #TextDiffBuilder to: { TextEmphasis normal }.!
Item was changed:
----- Method: SystemVersion>>majorMinorVersion (in category 'accessing') -----
majorMinorVersion
"Return the major/minor version number of the form X.Y, without any 'alpha' or 'beta' or other suffix."
- "(SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion" " --> 'Squeak3.7' "
- "SystemVersion current majorMinorVersion"
| char stream |
+ ^ (version includes: $.)
+ ifTrue:
+ [stream := ReadStream on: version, 'x'.
+ stream upTo: $..
+ char := stream next.
+ [char isDigit]
+ whileTrue: [char := stream next].
+ version copyFrom: 1 to: stream position - 1]
+ ifFalse:
+ [version]
+
+ "
+ (SystemVersion new version: 'Squeak3.7alpha') majorMinorVersion
+ (SystemVersion new version: 'Testing') majorMinorVersion
+ SystemVersion current majorMinorVersion
+ "
+
- stream := ReadStream on: version, 'x'.
- stream upTo: $..
- char := stream next.
- char ifNil: [^ version]. "eg: 'Jasmine-rc1' has no $. in it."
- [char isDigit]
- whileTrue: [char := stream next].
- ^ version copyFrom: 1 to: stream position - 1
!
Item was changed:
----- Method: TextStyle>>addNewFontSize: (in category '*System-Fonts') -----
addNewFontSize: pointSize
"Add a font in specified size to the array of fonts."
| f d newArray t isSet |
fontArray first emphasis ~= 0 ifTrue: [
t := TextConstants at: self fontArray first familyName asSymbol.
t fonts first emphasis = 0 ifTrue: [
^ t addNewFontSize: pointSize.
].
].
pointSize <= 0 ifTrue: [^ nil].
fontArray do: [:s |
s pointSize = pointSize ifTrue: [^ s].
].
(isSet := fontArray first isKindOf: TTCFontSet)
ifTrue:[
| fonts |
fonts := fontArray first fontArray collect: [ :font |
| newFont |
(font isNil)
ifTrue: [newFont := nil]
ifFalse: [
newFont := (font ttcDescription size > 256)
ifTrue: [MultiTTCFont new initialize]
ifFalse: [TTCFont new initialize].
newFont ttcDescription: font ttcDescription.
newFont pixelSize: pointSize * 96 // 72.
font derivativeFonts notEmpty ifTrue: [font derivativeFonts do: [ :proto |
proto ifNotNil: [
d := proto class new initialize.
d ttcDescription: proto ttcDescription.
d pixelSize: newFont pixelSize.
newFont derivativeFont: d]]].
].
newFont].
f := TTCFontSet newFontArray: fonts]
ifFalse: [
f := fontArray first class new initialize: fontArray first.
f pointSize: pointSize.
fontArray first derivativeFonts do: [:proto |
proto ifNotNil: [
+ d := TTCFont new initialize: proto.
- d := proto class new initialize: proto.
d pointSize: f pointSize.
+ f derivativeFont: d.
- f derivativeFont: d mainFont: proto.
].
].
].
newArray := (fontArray copyWith: f) asArray sort: [:a :b | a pointSize <= b pointSize].
self newFontArray: newArray.
isSet ifTrue: [
TTCFontSet register: newArray at: newArray first familyName asSymbol.
].
^ self fontOfPointSize: pointSize
!
Item was changed:
----- Method: Utilities class>>floatPrecisionForDecimalPlaces: (in category 'miscellaneous') -----
floatPrecisionForDecimalPlaces: places
"Answer the floatPrecision that corresponds to the given number of decimal places"
^ places caseOf:
{[0]->[1] .
+ [1]-> [0.1] .
+ [2]-> [0.01] .
+ [3]-> [0.001] .
+ [4]-> [0.0001] .
+ [5]-> [0.00001] .
+ [6]-> [0.000001] .
+ [7]-> [0.0000001] .
+ [8]-> [0.00000001] .
+ [9]-> [0.000000001].
+ [10]->[0.0000000001]}
- [1]->[0.1] .
- [2]->[0.01] .
- [3]->[0.001] .
- [4]->[0.0001] .
- [5]->[0.00001] .
- [6]->[0.000001] .
- [7]->[0.0000001] .
- [8]->[0.00000001] .
- [9]->[0.000000001]}
otherwise:
[(10.0 raisedTo: places negated) asFloat]
"
(0 to: 6) collect: [:i | Utilities floatPrecisionForDecimalPlaces: i]
(-10 to: 20) collect: [:i | Utilities floatPrecisionForDecimalPlaces: i]
"!
Item was changed:
----- Method: Utilities class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#Utilities. #recentSubmissionsWindow. 'Recent' translatedNoop. 'A message browser that tracks the most recently-submitted methods' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(Utilities recentSubmissionsWindow 'Recent' 'A message browser that tracks the most recently-submitted methods')
forFlapNamed: 'Tools'.]!
1
0
Tim Felgentreff uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-tfel.179.mcz
==================== Summary ====================
Name: MorphicExtras-tfel.179
Author: tfel
Time: 2 August 2016, 10:01:30.750368 am
UUID: ec9ac811-e2b4-ce43-bccd-07fc59af5837
Ancestors: MorphicExtras-tfel.178, MorphicExtras-kfr.80
merge from Squeakland Etoys image
=============== Diff against MorphicExtras-tfel.178 ===============
Item was changed:
----- Method: AlignmentMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Extra items for parts bins"
^ {DescriptionForPartsBin
+ formalName: 'Column' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a column' translatedNoop
- formalName: 'Column'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a column'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #columnPrototype.
DescriptionForPartsBin
+ formalName: 'Row' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a row' translatedNoop
- formalName: 'Row'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a row'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #rowPrototype}!
Item was changed:
+ ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'olpc support') -----
+ fancyText: aString font: aFont color: aColor
+ "Answer a morph containing a TextMorph containing the given string in the given font with the given color."
+
+ | answer tm |
+ answer _ self inAColumn: {
+ tm _ TextMorph new
+ textColor: aColor;
+ contents: aString;
+ beAllFont: aFont;
+ yourself
+ }.
+
- ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'as yet unclassified') -----
- fancyText: aString font: aFont color: aColor
- | answer tm col |
- col := ColorTheme current dialog3DTitles
- ifTrue: [aColor]
- ifFalse: [aColor negated].
- tm := TextMorph new.
- tm beAllFont: aFont;
- color: col;
- contents: aString.
- answer := self inAColumn: {tm}.
- ColorTheme current dialog3DTitles
- ifTrue: [""
- tm addDropShadow.
- tm shadowPoint: 5 @ 5 + tm bounds center].
tm lock.
+ ^ answer
+ !
- ^ answer!
Item was changed:
----- Method: BOBTransformationMorph>>recomputeExtent (in category 'as yet unclassified') -----
recomputeExtent
| scalePt newScale theGreenThingie greenIBE myNewExtent |
submorphs isEmpty ifTrue: [^self extent].
+ worldBoundsToShow ifNil: [worldBoundsToShow _ self firstSubmorph bounds].
- worldBoundsToShow ifNil: [worldBoundsToShow := self firstSubmorph bounds].
worldBoundsToShow area = 0 ifTrue: [^self extent].
+ scalePt _ owner innerBounds extent / worldBoundsToShow extent.
+ newScale _ scalePt x min: scalePt y.
+ theGreenThingie _ owner.
+ greenIBE _ theGreenThingie innerBounds extent.
+ myNewExtent _ (greenIBE min: worldBoundsToShow extent * newScale) truncated.
- scalePt := owner innerBounds extent / worldBoundsToShow extent.
- newScale := scalePt x min: scalePt y.
- theGreenThingie := owner.
- greenIBE := theGreenThingie innerBounds extent.
- myNewExtent := (greenIBE min: worldBoundsToShow extent * newScale) truncated.
self
scale: newScale;
offset: worldBoundsToShow origin * newScale.
+ smoothing _ (newScale < 1.0) ifTrue: [1] ifFalse: [1].
- smoothing := (newScale < 1.0) ifTrue: [2] ifFalse: [1].
^myNewExtent!
Item was changed:
----- Method: BasicButton class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'button' translatedNoop!
- ^ 'button'!
Item was changed:
+ ----- Method: BasicButton>>label:font: (in category 'initialization') -----
- ----- Method: BasicButton>>label:font: (in category 'as yet unclassified') -----
label: aString font: aFontOrNil
+ "Set the receiver's label and font as indicated."
| oldLabel m aFont |
+ (oldLabel _ self findA: StringMorph)
- (oldLabel := self findA: StringMorph)
ifNotNil: [oldLabel delete].
+ aFont _ aFontOrNil ifNil: [Preferences standardEToysButtonFont].
+ m _ StringMorph contents: aString font: aFont.
- aFont := aFontOrNil ifNil: [Preferences standardButtonFont].
- m := StringMorph contents: aString font: aFont.
self extent: (m width + 6) @ (m height + 6).
m position: self center - (m extent // 2).
self addMorph: m.
m lock
!
Item was changed:
----- Method: BookMorph class>>alreadyInFromUrl: (in category 'url') -----
alreadyInFromUrl: aUrl
"Does a bookMorph living in some world in this image represent the same set of server pages? If so, don't create another one. It will steal pages from the existing one. Go delete the first one."
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world ifNotNil: [
+ self inform: 'This book is already open in some project' translated.
- self inform: 'This book is already open in some project'.
^ true]]]].
^ false!
Item was changed:
----- Method: BookMorph class>>authoringPrototype (in category 'scripting') -----
authoringPrototype
"Answer an instance of the receiver suitable for placing in a parts bin for authors"
| book |
+ book := self new initializeToStandAlone.
+ book markAsPartsDonor.
- book := self new markAsPartsDonor.
- book removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
- book borderWidth: 1; borderColor: Color black.
- book beSticky.
- book showPageControls; insertPage.
^ book!
Item was changed:
----- Method: BookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Book' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'Multi-page structures' translatedNoop
+ sampleImageForm: (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAAMgAAACgCAYAAABJ/yOpAAAABHNCSVQFBQUBSsjp7wAABMtJ
+ REFUeF7l3S2S4kAAgFEkEonkCEiOgEQikUgkEolEcgSOgEQiOcYcAZfdniqmpnaBkE43JHni
+ 7dZuzWR7m3z5ISHT6/X6hc/ne+TvL9fr1efz/cMPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5OhLI
+ 19eXz9dZfiA+nx+Iz+cH4vN1K5Dz+fxUEyaoCWP0xwAF8ntSy94l+NQL0IQx+mMAA3llop+9
+ AO+K49Nj9MeABfLqVujVrVTOvcYnx+iPAQwkxWTn3kI1YYz+GMBAckx4kw4lUo3RH4MfiB9I
+ hTHU/ZSbH0gLAsk54akmvuoYY+5LKxvjvTGkDCR2DKnnoq2RZAkkNo4cK2DKOGJv3Hw0xkdj
+ SB1IzBhyzEedSC6XS7Hf74vFYlGMx+Nit9uVfs9yufz++jrLaFwg75r0KmMsW/nkQKrMSexr
+ dTgc/vs/rlar0u/r9/vfkdRZRiMDecekvzrGV1Y+PZBX5yX2tTqdTsVmsymOx+PPir5er0uj
+ CoGE74ldRpZA6px7xK6Mud7OrLtSPhvjszHkCKTqGHLMQYpzkdvKXbb1D3uO0WhUaxmNDyTX
+ pKdeMXIFkvoQNXcgMfMQG0jZ1n84HP4cXsUuoxWB5Jj0sjGm3GprgZSN+x17kHA4Fb4mfG3n
+ 9yA5Jj3H4Y1/iBU3hhx7kHCuMRgMau+F/ED8QFobyLOt/2QyKebzee3zGP8Qyz/Eau0h1qOt
+ f7jWEd69Ctc7iD2If5Lun6RX2fqHi3/PDq86tQfx3+b13+atuvUPh1az2SzJO2H+hUL/QmEr
+ LhTermuELX5Y+cO/F84zwp/D34d3rX5fPd9ut7WW4d9q0pJbTVLOX5tvNbmdeIf7p+79frta
+ ftszhPOQ2GX4Nyu26GbFNgTSpDt6w02I0+nUv93dv93dv9390Qn6o4uD/gem/A9M+R+Y8j9R
+ 6H/k1v/Irf/QBv+hDf5DG/zH/viP/fHH4AfiPzjOH4MfiP/oUf/Ro/6jR/2HV/sPr/YfXu3/
+ +AOfzw/E5/MD8fn8QHy+pgfi8/k/BtqfDJ/PD8Tn8wPx+fxAfD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fzw/E5/MD8fn8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8QPx+fxAfD4/EJ/PD8Tn8wPx+fxAfL47ro3i
+ B+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8wPx+fxAfD4/EJ/PD8QPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5/EB8Pj8Qn88PxOfz
+ A/H5fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiB+Iz+cH4vP5gfg+o6P8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHw+PxCfz+cH4vP5gfh8fiA+nx+Iz+cH
+ 4vP5gfh8fiA+nx+Iz+cH4vP5gfiB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+
+ ID6fzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHy+jgXi8/nu+wM79mpMjbRBXAAAAABJRU5E
+ rkJggg==' readStream) readStream) nextImage!
- ^ self partName: 'Book'
- categories: #('Presentation')
- documentation: 'Multi-page structures'!
Item was changed:
----- Method: BookMorph class>>initialize (in category 'class initialization') -----
initialize
- FileList registerFileReader: self.
-
self registerInFlapsRegistry. !
Item was changed:
----- Method: BookMorph class>>isInWorld:withUrl: (in category 'url') -----
isInWorld: aWorld withUrl: aUrl
| urls bks short |
"If a book with this url is in the that (current) world, return it. Say if it is out or in another world."
+ urls _ OrderedCollection new.
+ bks _ OrderedCollection new.
- urls := OrderedCollection new.
- bks := OrderedCollection new.
aWorld allMorphsDo: [:aBook | (aBook isKindOf: BookMorph) ifTrue: [
bks add: aBook.
(urls add: (aBook valueOfProperty: #url)) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]]]]. "shortcut"
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]
ifFalse: [
+ self inform: 'Book may be open in some other project' translated.
- self inform: 'Book may be open in some other project'.
^ aBook]]]].
"if same book name, use it"
+ short _ (aUrl findTokens: '/') last.
- short := (aUrl findTokens: '/') last.
urls withIndexDo: [:kk :ind | (kk findTokens: '/') last = short ifTrue: [
^ bks at: ind]].
^ #out!
Item was changed:
----- Method: BookMorph class>>nextPageButton (in category 'scripting') -----
nextPageButton
+ "Answer a button that will take the user to the next page of its
+ enclosing book"
- "Answer a button that will take the user to the next page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #NextPage.
+ aButton target: aButton.
+ aButton actionSelector: #nextOwnerPage.
+ aButton arguments: #().
+ aButton setNameTo: 'previous'.
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #nextOwnerPage; label: '->'; color: Color yellow.
- aButton setNameTo: 'next'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>openFromFile: (in category 'fileIn/Out') -----
openFromFile: fullName
"Reconstitute a Morph from the selected file, presumed to be represent
a Morph saved via the SmartRefStream mechanism, and open it in an
appropriate Morphic world"
| book aFileStream |
Smalltalk verifyMorphicAvailability ifFalse: [^ self].
+ aFileStream _ FileStream readOnlyFileNamed: fullName.
+ book _ BookMorph new.
- aFileStream := FileStream oldFileNamed: fullName.
- book := BookMorph new.
book setProperty: #url toValue: aFileStream url.
book fromRemoteStream: aFileStream.
aFileStream close.
Smalltalk isMorphic
ifTrue: [ActiveWorld addMorphsAndModel: book]
ifFalse:
[book isMorph ifFalse: [^self inform: 'Can only load a single morph
+ into an mvc project via this mechanism.' translated].
- into an mvc project via this mechanism.'].
book openInWorld].
book goToPage: 1!
Item was changed:
----- Method: BookMorph class>>previousPageButton (in category 'scripting') -----
previousPageButton
+ "Answer a button that will take the user to the previous page of its
+ enclosing book"
- "Answer a button that will take the user to the previous page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #PrevPage.
+ aButton target: aButton.
+ aButton actionSelector: #previousOwnerPage.
+ aButton arguments: #().
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #previousOwnerPage; color: Color yellow; label: '<-'.
aButton setNameTo: 'previous'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BookMorph . #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'Supplies']!
Item was changed:
----- Method: BookMorph class>>serviceLoadAsBook (in category 'fileIn/Out') -----
serviceLoadAsBook
^ SimpleServiceEntry
provider: self
+ label: 'load as book' translatedNoop
- label: 'load as book'
selector: #openFromFile:
+ description: 'open as bookmorph' translatedNoop!
- description: 'open as bookmorph'!
Item was changed:
----- Method: BookMorph>>goToPageMorph:transitionSpec: (in category 'navigation') -----
goToPageMorph: newPage transitionSpec: transitionSpec
+ "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided."
+
| pageIndex aWorld oldPageIndex ascending tSpec readIn |
pages isEmpty ifTrue: [^self].
self setProperty: #searchContainer toValue: nil. "forget previous search"
self setProperty: #searchOffset toValue: nil.
self setProperty: #searchKey toValue: nil.
pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"].
readIn := newPage isInMemory not.
oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil].
ascending := (oldPageIndex isNil or: [newPage == currentPage])
ifTrue: [nil]
ifFalse: [oldPageIndex < pageIndex].
tSpec := transitionSpec ifNil:
["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec
ifAbsent:
[" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]].
self flag: #arNote. "Probably unnecessary"
(aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus].
currentPage ifNotNil: [currentPage updateCachedThumbnail].
self currentPage notNil
ifTrue:
[(((pages at: pageIndex) owner isKindOf: TransitionMorph)
and: [(pages at: pageIndex) isInWorld])
ifTrue: [^self "In the process of a prior pageTurn"].
self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts].
+ self removeViewersOnSubsIn: ActiveWorld presenter.
ascending ifNotNil:
["Show appropriate page transition and start new page when done"
currentPage stopStepping.
(pages at: pageIndex) position: currentPage position.
^(TransitionMorph
effect: tSpec second
direction: tSpec third
inverse: (ascending or: [transitionSpec notNil]) not)
showTransitionFrom: currentPage
to: (pages at: pageIndex)
in: self
whenStart: [self playPageFlipSound: tSpec first]
whenDone:
[currentPage
delete;
fullReleaseCachedState.
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrlInBook: self url.
currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page"
currentPage
delete;
fullReleaseCachedState].
+ self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage"
- self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
-
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrl.
+ currentPage sqkPage computeThumbnail "just store it"].
+ ActiveWorld ifNotNil: [ActiveWorld presenter flushPlayerListCache]!
- currentPage sqkPage computeThumbnail "just store it"]!
Item was changed:
----- Method: BookMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
+ super initializeToStandAlone.
+ self removeEverything; pageSize: 360@228; color: Color white.
- self initialize.
- self removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
self borderWidth: 1; borderColor: Color black.
self beSticky.
self showPageControls; insertPage.
^ self!
Item was changed:
----- Method: BookMorph>>pasteBookPage (in category 'menu') -----
pasteBookPage
+ "If the paste buffer has something to paste, paste it as a book page."
+
| aPage |
+ aPage _ self primaryHand objectToPaste.
+ aPage removeProperty: #revertKey.
- aPage := self primaryHand objectToPaste.
self insertPage: aPage pageSize: aPage extent atIndex: ((pages indexOf: currentPage) - 1).
"self goToPageMorph: aPage"!
Item was changed:
----- Method: BookMorph>>setNewPagePrototype (in category 'menu') -----
setNewPagePrototype
"Record the current page as the prototype to be copied when inserting new pages."
currentPage ifNotNil:
+ [newPagePrototype _ currentPage veryDeepCopy.
+ newPagePrototype removeProperty: #revertKey].
+ "When a new page is inserted, it will not have any original page to revert to. After author improves the new page, he can save it for later revert."
- [newPagePrototype := currentPage veryDeepCopy].
!
Item was changed:
+ ----- Method: BookPageSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: BookPageSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
+ | bb r str aCheckbox aWrapper |
+ r _ AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
+ r wrapCentering: #center; cellPositioning: #leftCenter;
- | bb r aButton str |
- r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
- r wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated.
+ r addTransparentSpacerOfSize: 12.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete)).
+ bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated; actionSelector: #acceptSort)).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated; actionSelector: #delete)).
+ "eliminate the parts-bin button on the book-page sorters...
+ r addTransparentSpacerOfSize: 24 @ 0.
+
+ aCheckbox := UpdatingThreePhaseButtonMorph checkBox.
+ aCheckbox
- r addTransparentSpacerOfSize: 8 @ 0.
- r addMorphBack: (self wrapperFor: (aButton := UpdatingThreePhaseButtonMorph checkBox)).
- aButton
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ str _ StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons.
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
+ addMorphBack: (self wrapperFor: aCheckbox);
+ addMorphBack: (self wrapperFor: str lock).
+ r addMorphBack: aWrapper."
- str := StringMorph contents: 'Parts bin' translated.
- r addMorphBack: (self wrapperFor: str lock).
+ self addMorphFront: r
- self addMorphFront: r.
!
Item was changed:
----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'as yet unclassified') -----
book: aBookMorph morphsToSort: morphList
+ | innerBounds scrollPane newHeight |
+ book _ aBookMorph.
+ newHeight _ self currentWorld height.
- | innerBounds |
- book := aBookMorph.
pageHolder removeAllMorphs.
pageHolder addAllMorphs: morphList.
pageHolder extent: pageHolder width@pageHolder fullBounds height.
+ innerBounds _ Rectangle merging: (morphList collect: [:m | m bounds]).
+ pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.
+ (pageHolder height > newHeight) ifTrue: [
+ scrollPane _ ScrollPane new.
+
+ self height: newHeight.
+ scrollPane model: pageHolder.
+ scrollPane extent: pageHolder width@(newHeight - aBookMorph submorphs first height - 28).
+ self addMorph: scrollPane inFrontOf: pageHolder.
+ scrollPane scroller addMorph: pageHolder.
+ scrollPane scrollBarOnLeft: false.
+ scrollPane retractable: false.
+ scrollPane hideHScrollBarIndefinitely: true.
+ scrollPane borderWidth: 1; borderColor: Color gray.
+ ].
+ !
- innerBounds := Rectangle merging: (morphList collect: [:m | m bounds]).
- pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.!
Item was changed:
----- Method: BookPageSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: Display extent - 100;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ pageHolder _ PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
- pageHolder := PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
pageHolder hResizing: #shrinkWrap.
+ pageHolder wantsMouseOverHalos: false.
"pageHolder cursor: 0."
"causes a walkback as of 5/25/2000"
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: BookPageThumbnailMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
| f |
super initialize.
+ flipOnClick _ false.
- ""
- flipOnClick := false.
+ f _ Form extent: 160@120 depth: Display depth.
- f := Form extent: 60 @ 80 depth: Display depth.
f fill: f boundingBox fillColor: color.
self form: f!
Item was changed:
----- Method: BooklikeMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
"This factoring allows subclasses to have different menu yet still use the super call for the rest of the metamenu."
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ aCustomMenu add: 'book...' translated target: self action: #invokeBookMenu.
+
+ "self addBookMenuItemsTo: aCustomMenu hand: aHandMorph"!
- self addBookMenuItemsTo: aCustomMenu hand: aHandMorph!
Item was changed:
----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') -----
currentPlayerDo: aBlock
| aPlayer aPage |
(aPage := self currentPage) ifNil: [^ self].
+ aPage allMorphsDo:[ :m|
+ (aPlayer := m player) ifNotNil:
+ [aBlock value: aPlayer]]!
- (aPlayer := aPage player) ifNotNil:
- [aBlock value: aPlayer]!
Item was changed:
----- Method: BooklikeMorph>>shortControlSpecs (in category 'page controls') -----
shortControlSpecs
+ "Answer specs defining the widgets in the short form of the control panel."
+
^ {
#spacer.
#variableSpacer.
{'<'. #previousPage. 'Previous page' translated}.
#spacer.
+ {#MenuIcon. #invokeShortBookMenu. 'Click here to get a menu of options for this book.' translated}.
- {'·'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}.
#spacer.
{'>'. #nextPage. 'Next page' translated}.
#spacer.
#variableSpacer.
+ {#RightCaret. #showMoreControls. 'More controls' translated}
- {'³'. #showMoreControls. 'More controls' translated}
}
!
Item was changed:
----- Method: BooklikeMorph>>showingFullScreenString (in category 'misc') -----
showingFullScreenString
+ "Answer a string characterizing whether the receiver is operating in full-screen mode."
+
+ ^ (self isInFullScreenMode ifTrue: ['<yes>'] ifFalse: ['<no>']), 'view pages full-screen' translated!
- ^ (self isInFullScreenMode
- ifTrue: ['exit full screen']
- ifFalse: ['show full screen']) translated!
Item was changed:
----- Method: BooklikeMorph>>showingPageControlsString (in category 'misc') -----
showingPageControlsString
+ "Answer a string characterizing whether page controls are currently showing."
+
+ ^ (self pageControlsVisible ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'page controls visible' translated!
- ^ (self pageControlsVisible
- ifTrue: ['hide page controls']
- ifFalse: ['show page controls']) translated!
Item was changed:
----- Method: BouncingAtomsMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'BouncingAtoms' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney' translatedNoop!
- ^ self partName: 'BouncingAtoms'
- categories: #('Demo')
- documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney'!
Item was changed:
----- Method: BouncingAtomsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BouncingAtomsMorph, #new. 'Bouncing Atoms' translatedNoop. 'Atoms, mate' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BouncingAtomsMorph new 'Bouncing Atoms' 'Atoms, mate')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: ClockMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Answer a description for use in parts bins."
+
+ ^ self partName: 'Digital Clock' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A digital clock' translatedNoop!
- ^ self partName: 'Clock'
- categories: #('Useful')
- documentation: 'A digital clock'!
Item was changed:
----- Method: ClockMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ClockMorph, #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: ClockMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
+ "Add toggles for showing-seconds and display-24-hrs to the halo menu"
+
+ "NB: intentionallyi no super call here!!"
+
+ aCustomMenu add: 'change font' translated action: #changeFont.
+
+ aCustomMenu addUpdating: #showingSecondsString action: #toggleShowingSeconds.
+ aCustomMenu addUpdating: #displaying24HourString action: #toggleShowing24hr!
- "Note minor loose end here -- if the menu is persistent, then the wording will be wrong half the time"
- | item |
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- item := showSeconds == true
- ifTrue: ['stop showing seconds']
- ifFalse: ['start showing seconds'].
- aCustomMenu add: item translated target: self action: #toggleShowingSeconds.
- item := show24hr == true
- ifTrue: ['display Am/Pm']
- ifFalse: ['display 24 hour'].
- aCustomMenu add: item translated target: self action: #toggleShowing24hr.
-
- !
Item was changed:
----- Method: ClockMorph>>initialize (in category 'initialization') -----
initialize
+ "initialize the state of the receiver"
+
- "initialize the state of the receiver"
super initialize.
+
+ showSeconds _ true.
+ show24hr _ false.
+ self font: Preferences standardMenuFont emphasis: 1.
- ""
- showSeconds := true.
- show24hr := false.
self step!
Item was changed:
----- Method: ClockMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
super initializeToStandAlone.
+ showSeconds _ false.
+ self font: (Preferences standardMenuFont emphasized: 1).
- showSeconds := true.
self step!
Item was changed:
----- Method: CurveMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#CurveMorph, #authoringPrototype. 'Curve' translatedNoop, 'A curve' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#CurveMorph. #authoringPrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}
- cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: CurveMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Curvy Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.' translatedNoop
- formalName: 'Curvy Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.'
globalReceiverSymbol: #CurveMorph
nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: EllipseMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: EnvelopeEditorMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: menu hand: aHandMorph
super addCustomMenuItems: menu hand: aHandMorph.
menu addLine.
envelope updateSelector = #ratio: ifTrue:
[menu add: 'choose denominator...' translated action: #chooseDenominator:].
menu add: 'adjust scale...' translated action: #adjustScale:.
- SoundPlayer isReverbOn
- ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb]
- ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb].
menu addLine.
menu add: 'get sound from lib' translated action: #chooseSound:.
menu add: 'put sound in lib' translated action: #saveSound:.
menu add: 'read sound from disk...' translated action: #readFromDisk:.
menu add: 'save sound on disk...' translated action: #saveToDisk:.
menu add: 'save library on disk...' translated action: #saveLibToDisk:.
!
Item was changed:
----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'editing') -----
buildScalesIn: frame
+ | env |
+ env _ envelope.
+ pixPerTick _ graphArea width // (self maxTime//10) max: 1.
+ "hminortick _ ( 1 + ( self maxTime // 800 ) ) * 10.
+ hmajortick _ ( 1 + ( self maxTime // 800 ) ) * 100."
+ hScale _ (Morph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) color: Color lightGreen.
+ " hScale _ (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
- | env hmajortick hminortick |
- env := envelope.
- pixPerTick := graphArea width // (self maxTime//10) max: 1.
- hminortick := ( 1 + ( self maxTime // 800 ) ) * 10.
- hmajortick := ( 1 + ( self maxTime // 800 ) ) * 100.
- hScale := (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
start: 0 stop: self maxTime
minorTick: hminortick minorTickLength: 3
majorTick: hmajortick majorTickLength: 10
caption: 'milliseconds' tickPrintBlock: [:v | v printString].
+ "
self addMorph: hScale.
+ vScale _ (Morph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))) color: Color lightGreen.
+ "vScale _ ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))."
- vScale := ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left)).
env name = 'pitch'
ifTrue:
[env scale >= 2.0
ifTrue:
[vScale start: 0 stop: env scale
minorTick: env scale / 24 minorTickLength: 3
majorTick: env scale / 2.0 majorTickLength: 10
caption: 'pitch (octaves)'
tickPrintBlock: [:v | (v-(env scale/2)) asInteger printString]]
ifFalse:
[vScale start: 0 stop: env scale
minorTick: 1.0/48.0 minorTickLength: 3
majorTick: 1.0/12.0 majorTickLength: 10
caption: 'pitch (half-steps)'
tickPrintBlock: [:v | (v-(env scale/2)*12) rounded printString]]]
ifFalse: [
env name = 'random pitch:'
ifTrue: [
vScale start: 0.9 stop: 1.1
minorTick: 0.2 / 50.0 minorTickLength: 3
majorTick: 0.2 / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]]
ifFalse: [
vScale start: 0 stop: env scale
minorTick: env scale / 50.0 minorTickLength: 3
majorTick: env scale / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]].
].
+ vScale _ TransformationMorph new asFlexOf: vScale.
- vScale := TransformationMorph new asFlexOf: vScale.
vScale angle: Float pi / 2.0.
self addMorph: vScale.
vScale position: (frame left)@(graphArea top-1) - (3@1).
!
Item was changed:
----- Method: EventRecorderMorph>>addButtons (in category 'initialization') -----
addButtons
+ | r b w |
- | r b |
caption ifNotNil: ["Special setup for play-only interface"
+ (r _ self makeARowForButtons)
- (r := self makeARowForButtons)
addMorphBack: (SimpleButtonMorph new target: self;
+ label: caption font: Preferences standardButtonFont; actionSelector: #play);
- label: caption; actionSelector: #play);
- addMorphBack: self makeASpacer;
- addMorphBack: self makeStatusLight;
addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
+ addMorphBack: self makeASpacer.
^ self addMorphBack: r
].
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#record. nil. 'Begin recording'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#record. nil. 'Begin recording'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#stop. b width. 'Stop recording - you can also use the ESC key to stop it'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#play. b width. 'Play current recording'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#readTape. b width. 'Get a new recording from disk'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
+ addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
addMorphBack: self makeASpacer;
+ addMorphBack: (self buttonFor: {#createPlayButton. b width. 'Make a simple button to play this recording'}).
- addMorphBack: self makeStatusLight;
- addMorphBack: self makeASpacer;
- addMorphBack: (self buttonFor: {#button. b width. 'Make a simple button to play this recording'}).
self addMorph: r.
self setStatusLight: #ready.!
Item was changed:
----- Method: EventRecorderMorph>>handleListenEvent: (in category 'events-processing') -----
handleListenEvent: anEvent
"Record the given event"
+ anEvent hand == recHand ifFalse: [^ self]. "not for me"
+ state == #record ifFalse: [
+ "If user got an error while recording and deleted recorder, will still be listening"
+ recHand ifNotNil: [recHand removeEventListener: self].
+ ^self].
- (state == #record and:[anEvent hand == recHand])
- ifFalse:[^self].
anEvent = lastEvent ifTrue: [^ self].
(anEvent isKeyboard and:[anEvent keyValue = 27 "esc"])
ifTrue: [^ self stop].
+ time _ anEvent timeStamp.
- time := anEvent timeStamp.
tapeStream nextPut: (anEvent copy setHand: nil).
journalFile ifNotNil:
[journalFile store: anEvent; cr; flush].
+ lastEvent _ anEvent.!
- lastEvent := anEvent.!
Item was changed:
----- Method: EventRecorderMorph>>pauseIn: (in category 'pause/resume') -----
pauseIn: aWorld
"Suspend playing or recording, either as part of a stop command,
or as part of a project switch, after which it will be resumed."
self setStatusLight: #ready.
state = #play ifTrue:
+ [state _ #suspendedPlay.
+ playHand halo ifNotNil: [playHand halo delete].
- [state := #suspendedPlay.
playHand delete.
aWorld removeHand: playHand.
+ playHand _ nil].
- playHand := nil].
state = #record ifTrue:
+ [state _ #suspendedRecord.
- [state := #suspendedRecord.
recHand removeEventListener: self.
+ recHand _ nil].
- recHand := nil].
voiceRecorder ifNotNil:
[voiceRecorder pause.
startSoundEvent ifNotNil:
[startSoundEvent argument: voiceRecorder recordedSound.
voiceRecorder clearRecordedSound.
+ startSoundEvent _ nil]].
- startSoundEvent := nil]].
!
Item was changed:
----- Method: EventRecorderMorph>>resumeIn: (in category 'pause/resume') -----
resumeIn: aWorld
"Resume playing or recording after a project switch."
+ self state = #suspendedPlay ifTrue:
- state = #suspendedPlay ifTrue:
[self resumePlayIn: aWorld].
+ self state = #suspendedRecord ifTrue:
- state = #suspendedRecord ifTrue:
[self resumeRecordIn: aWorld].
!
Item was changed:
----- Method: EventRecorderMorph>>resumePlayIn: (in category 'pause/resume') -----
resumePlayIn: aWorld
+ playHand _ HandMorphForReplay new recorder: self.
- playHand := HandMorphForReplay new recorder: self.
playHand position: tapeStream peek position.
aWorld addHand: playHand.
playHand newKeyboardFocus: aWorld.
playHand userInitials: 'play' andPicture: nil.
+ lastEvent _ nil.
+ lastDelta _ 0@0.
+ self findPlayOffset.
+ state _ #play.
- lastEvent := nil.
- lastDelta := 0@0.
- state := #play.
self synchronize.
!
Item was changed:
----- Method: EventRecorderMorph>>synchronize (in category 'event handling') -----
synchronize
+ time _ lastInterpolation _ Time millisecondClockValue.
+ deltaTime _ nil.!
- time := Time millisecondClockValue.
- deltaTime := nil.!
Item was changed:
----- Method: EventRecorderMorph>>writeTape: (in category 'fileIn/Out') -----
writeTape: fileName
+ | name bb |
+ name _ self writeFileNamed: fileName.
+ bb _ self findDeepSubmorphThat: [:mm | (mm isKindOf: SimpleButtonMorph)
+ and: [mm label = 'writeTape']]
+ ifAbsent: [^ self].
+ bb actionSelector: #writeTape:.
+ bb arguments: (Array with: name).
- | b name |
- name := self writeFileNamed: fileName.
- (b := self button: 'writeTape') ifNotNil: [
- b actionSelector: #writeTape:.
- b arguments: (Array with: name)].
!
Item was changed:
----- Method: FlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'flap tab' translatedNoop!
- ^ 'flap tab'!
Item was changed:
----- Method: FlapTab>>adaptToWorld (in category 'initialization') -----
adaptToWorld
| wasShowing new |
+ (wasShowing _ self flapShowing) ifTrue:
- (wasShowing := self flapShowing) ifTrue:
[self hideFlap].
(self respondsTo: #unhibernate) ifTrue: [
+ (new _ self unhibernate) == self ifFalse: [
- (new := self unhibernate) == self ifFalse: [
^ new adaptToWorld]].
- self spanWorld.
- self positionObject: self.
wasShowing ifTrue:
+ [self spanWorld.
+ self positionObject: self.
+ self showFlap]!
- [self showFlap]!
Item was changed:
----- Method: FlapTab>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aMenu hand: aHandMorph
"Add further items to the menu as appropriate"
aMenu add: 'tab color...' translated target: self action: #changeColor.
aMenu add: 'flap color...' translated target: self action: #changeFlapColor.
aMenu addLine.
aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo.
aMenu addLine.
aMenu addUpdating: #textualTabString action: #textualTab.
aMenu addUpdating: #graphicalTabString action: #graphicalTab.
aMenu addUpdating: #solidTabString enablement: #notSolid action: #solidTab.
aMenu addLine.
(referent isKindOf: PasteUpMorph) ifTrue:
[aMenu addUpdating: #partsBinString action: #togglePartsBinMode].
aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior.
aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior.
aMenu addLine.
aMenu addUpdating: #isGlobalFlapString enablement: #sharedFlapsAllowed action: #toggleIsGlobalFlap.
+ aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.' translated.
- aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.,' translated.
aMenu addLine.
+ aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap.
aMenu add: 'destroy this flap' translated action: #destroyFlap.
"aMenu addUpdating: #slideString action: #toggleSlideBehavior.
aMenu addUpdating: #inboardString action: #toggleInboardness.
aMenu addUpdating: #thicknessString ('thickness... (current: ', self thickness printString, ')') action: #setThickness."
!
Item was changed:
----- Method: FlapTab>>balloonTextForFlapsMenu (in category 'miscellaneous') -----
balloonTextForFlapsMenu
"Answer the balloon text to show on a menu item in the flaps menu that governs the visibility of the receiver in the current project"
| id |
+ id _ self flapID.
- id := self flapID.
#(
+ ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects' translatedNoop)
+ ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.' translatedNoop)
+ ('Widgets' 'A variety of controls and media tools' translatedNoop)
+ ('Supplies' 'Supplies' translatedNoop)
+ ('Help' 'A flap providing documentation, tutorials, and other help' translatedNoop)
+ ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented' translatedNoop)
+ ('Scripting' 'Tools useful when doing tile scripting' translatedNoop)
+ ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment' translatedNoop)
+ ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting' translatedNoop)) do:
- ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects')
- ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.')
- ('Widgets' 'A variety of controls and media tools')
- ('Supplies' 'A source for many basic types of objects')
- ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented')
- ('Scripting' 'Tools useful when doing tile scripting')
- ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment')
- ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting')) do:
[:pair | (FlapTab givenID: id matches: pair first translated) ifTrue: [^ pair second translated]].
^ self balloonText!
Item was changed:
----- Method: FlapTab>>computeEdgeFraction (in category 'edge') -----
computeEdgeFraction
"Compute and remember the edge fraction"
| aBox aFraction |
self isCurrentlySolid ifTrue: [^ edgeFraction ifNil: [self edgeFraction: 0.5]].
+ aBox := ((self pasteUpMorph ifNil: [self currentWorld]) bounds) insetBy: (self extent // 2).
- aBox := ((owner ifNil: [ActiveWorld]) bounds) insetBy: (self extent // 2).
aFraction := self
ifVertical:
[(self center y - aBox top) / (aBox height max: 1)]
ifHorizontal:
[(self center x - aBox left) / (aBox width max: 1)].
^ self edgeFraction: aFraction!
Item was changed:
----- Method: FlapTab>>destroyFlap (in category 'menu') -----
destroyFlap
"Destroy the receiver"
| reply request |
+ request _ self isGlobalFlap
- request := self isGlobalFlap
ifTrue:
['Caution -- this would permanently
remove this flap, so it would no longer be
available in this or any other project.
+ Do you really want to this? ' translated]
- Do you really want to this? ']
ifFalse:
['Caution -- this is permanent!! Do
+ you really want to do this? ' translated].
+ reply _ self confirm: request translated orCancel: [^ self].
- you really want to do this? '].
- reply := self confirm: request translated orCancel: [^ self].
reply ifTrue:
[self isGlobalFlap
ifTrue:
[Flaps removeFlapTab: self keepInList: false.
self currentWorld reformulateUpdatingMenus]
ifFalse:
[referent isInWorld ifTrue: [referent delete].
self delete]]!
Item was changed:
----- Method: FlapTab>>flapMenuTitle (in category 'menu') -----
flapMenuTitle
+ ^ 'flap: ' translated , self wording!
- ^ 'flap: ', self wording!
Item was changed:
----- Method: FlapTab>>graphicalTabString (in category 'graphical tabs') -----
graphicalTabString
^ (self isCurrentlyGraphical
+ ifTrue: ['choose new graphic...' translated]
+ ifFalse: ['use graphical tab' translated]) !
- ifTrue: ['choose new graphic...']
- ifFalse: ['use graphical tab']) translated!
Item was changed:
----- Method: FlapTab>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "Handle a mouse-move event. The event, a MorphicEvent, is passed in."
+
| aPosition newReferentThickness adjustedPosition thick |
dragged ifFalse: [(thick := self referentThickness) > 0
ifTrue: [lastReferentThickness := thick]].
((self containsPoint: (aPosition := evt cursorPoint)) and: [dragged not])
ifFalse:
[flapShowing ifFalse: [self showFlap].
adjustedPosition := aPosition - evt hand targetOffset.
(edgeToAdhereTo == #bottom)
ifTrue:
[newReferentThickness := inboard
ifTrue:
[self world height - adjustedPosition y]
ifFalse:
[self world height - adjustedPosition y - self height]].
(edgeToAdhereTo == #left)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition x + self width]
ifFalse:
[adjustedPosition x]].
(edgeToAdhereTo == #right)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[self world width - adjustedPosition x]
ifFalse:
[self world width - adjustedPosition x - self width]].
(edgeToAdhereTo == #top)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition y + self height]
ifFalse:
[adjustedPosition y]].
self isCurrentlySolid ifFalse:
[(#(left right) includes: edgeToAdhereTo)
ifFalse:
[self left: adjustedPosition x]
ifTrue:
[self top: adjustedPosition y]].
+ ((edgeToAdhereTo == #left) and: [(self valueOfProperty: #rigidThickness) notNil]) ifTrue:
+ [newReferentThickness := referent width].
+
self applyThickness: newReferentThickness.
dragged := true.
self fitOnScreen.
self computeEdgeFraction]!
Item was changed:
----- Method: FlapTab>>solidTabString (in category 'solid tabs') -----
solidTabString
^ (self isCurrentlySolid
+ ifTrue: ['currently using solid tab' translated]
+ ifFalse: ['use solid tab' translated]) !
- ifTrue: ['currently using solid tab']
- ifFalse: ['use solid tab']) translated!
Item was changed:
----- Method: FlapTab>>textualTabString (in category 'textual tabs') -----
textualTabString
^ (self isCurrentlyTextual
+ ifTrue: ['change tab wording...' translated]
+ ifFalse: ['use textual tab' translated]) !
- ifTrue: ['change tab wording...']
- ifFalse: ['use textual tab']) translated!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category 'flaps registry') -----
defaultsQuadsDefiningScriptingFlap
"Answer a structure defining the default items in the Scripting flap.
previously in quadsDeiningScriptingFlap"
+ ^ {
+ {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
+ {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}.
- ^ #(
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
- (ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#FunctionTile. #randomNumberTile. 'Random' translatedNoop. 'A tile that will produce a random number in a given range' translatedNoop}.
+ {#ScriptingSystem. #anyButtonPressedTiles. 'ButtonDown?' translatedNoop. 'Tiles for querying whether the mouse button is down' translatedNoop}.
+ {#ScriptingSystem. #noButtonPressedTiles. 'ButtonUp?' translatedNoop. 'Tiles for querying whether the mouse button is up' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (RandomNumberTile new 'Random' 'A tile that will produce a random number in a given range')
- (ScriptingSystem anyButtonPressedTiles 'ButtonDown?' 'Tiles for querying whether the mouse button is down')
- (ScriptingSystem noButtonPressedTiles 'ButtonUp?' 'Tiles for querying whether the mouse button is up')
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}.
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (TextFieldMorph exampleBackgroundField 'Scrolling Field' 'A scrolling data field which will have a different value on every card of the background')
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#TextMorph. #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}.
+ {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop}
+ } asOrderedCollection!
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (TextMorph exampleBackgroundLabel 'Background Label' 'A piece of text that will occur on every card of the background')
- (TextMorph exampleBackgroundField 'Background Field' 'A data field which will have a different value on every card of the background')
-
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningStackToolsFlap (in category 'flaps registry') -----
defaultsQuadsDefiningStackToolsFlap
"Answer a structure defining the items on the default system Stack Tools flap.
previously in quadsDefiningStackToolsFlap"
+ ^ {
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}.
+ {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}.
+ {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Scriptable Button' translatedNoop. 'A button whose script will be a method of the background Player' translatedNoop}.
+ {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}.
+ {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection
- ^ #(
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (StackMorph stackHelpWindow 'Stack Help' 'Some hints about how to use Stacks')
- (TextMorph authoringPrototype 'Simple Text' 'Text that you can edit into anything you wish')
- (TextMorph fancyPrototype 'Fancy Text' 'A text field with a rounded shadowed border, with a fancy font.')
- (ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
- (ScriptableButton authoringPrototype 'Scriptable Button' 'A button whose script will be a method of the background Player')
- (StackMorph previousCardButton 'Previous Card' 'A button that takes the user to the previous card in the stack')
- (StackMorph nextCardButton 'Next Card' 'A button that takes the user to the next card in the stack')) asOrderedCollection
!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningSuppliesFlap (in category 'flaps registry') -----
defaultsQuadsDefiningSuppliesFlap
"Answer a list of quads which define the objects to appear in the default Supplies flap.
previously in quadsDefiningSuppliesFlap"
+ ^ {
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}.
+ {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
+ } asOrderedCollection!
- ^ #(
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'TabbedPalette' 'A structure with tabs')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>disableGlobalFlaps: (in category 'menu commands') -----
disableGlobalFlaps: interactive
"Clobber all the shared flaps structures. First read the user her Miranda rights."
interactive
ifTrue: [(self confirm:
'CAUTION!! This will destroy all the shared
flaps, so that they will not be present in
*any* project. If, later, you want them
back, you will have to reenable them, from
this same menu, whereupon the standard
default set of shared flaps will be created.
Do you really want to go ahead and clobber
all shared flaps at this time?' translated) ifFalse: [^ self]].
self globalFlapTabsIfAny do:
[:aFlapTab | self removeFlapTab: aFlapTab keepInList: false.
aFlapTab isInWorld ifTrue: [self error: 'Flap problem' translated]].
self clobberFlapTabList.
+ self initializeFlapsQuads.
+ SharedFlapsAllowed _ false.
- SharedFlapsAllowed := false.
Smalltalk isMorphic ifTrue:
[ActiveWorld restoreMorphicDisplay.
ActiveWorld reformulateUpdatingMenus].
"The following reduces the risk that flaps will be created with variant IDs
such as 'Stack Tools2', potentially causing some shared flap logic to fail."
"Smalltalk garbageCollect." "-- see if we are OK without this"
!
Item was changed:
----- Method: Flaps class>>explainFlapsText (in category 'menu commands') -----
explainFlapsText
"Answer the text, in English, to show in a help-window about Flaps."
^'Flaps are like drawers on the edge of the screen, which can be opened so that you can use what is inside them, and closed when you do not need them. They have many possible uses, a few of which are illustrated by the default set of flaps you can get as described below.
+ ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
- ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
+ To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
- To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
+ ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
- ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
+ If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
- If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
+ If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
- If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
+ Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
- Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
+ You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
- You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
+ You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
- You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
+ Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
- Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
+ If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
- If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
+ The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
- The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
+ tab color... Lets you change the color of the flap''s tab.
+ flap color... Lets you change the color of the flap itself.
- tab color... Lets you change the color of the flap''s tab.
- flap color... Lets you change the color of the flap itself.
+ use textual tab... If the tab is not textual, makes it become textual.
+ change tab wording... If the tab is already textual, allows you to edit
- use textual tab... If the tab is not textual, makes it become textual.
- change tab wording... If the tab is already textual, allows you to edit
its wording.
+ use graphical tab... If the tab is not graphical, makes it become
- use graphical tab... If the tab is not graphical, makes it become
graphical.
+ choose tab graphic... If the tab is already graphical, allows you
- choose tab graphic... If the tab is already graphical, allows you
to change the picture.
+ use solid tab... If the tab is not solid, makes it become solid, i.e.
- use solid tab... If the tab is not solid, makes it become solid, i.e.
appear as a solid band of color along the
entire length or width of the screen.
+ parts-bin behavior If set, then dragging an object from the flap
- parts-bin behavior If set, then dragging an object from the flap
tears off a new copy of the object.
+ dragover If set, the flap opens on dragover and closes
- dragover If set, the flap opens on dragover and closes
again on drag-leave.
+
+ mouseover If set, the flap opens on mouseover and closes
- mouseover If set, the flap opens on mouseover and closes
again on mouse-leave.
+ cling to edge... Governs which edge (left, right, top, bottom)
- cling to edge... Governs which edge (left, right, top, bottom)
the flap adheres to.
+ shared If set, the same flap will be available in all projects; if not, the
- shared If set, the same flap will be available in all projects; if not, the
flap will will occur only in one project.
+ destroy this flap Deletes the flap.
- destroy this flap Deletes the flap.
+ To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
- To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
+ To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
- To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
+ To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
- To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
+ Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.' translated!
- Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.'!
Item was changed:
----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') -----
newLoneSuppliesFlap
+ "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch. We're still evidently nurturing this method along, but it is a disused branch, whose lone sender has no senders..."
- "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch"
| aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly"
+ aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: {
- aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: #(
+ {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph . #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#SimpleSliderMorph . #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ " {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}."
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'Tabs' translatedNoop. 'A structure with tabs' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle' )
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph authoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, ec.')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'Tabs' 'A structure with tabs')
+ {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}.
+ {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}.
- (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
- (MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ClockMorph. #authoringPrototype, 'Clock' translatedNoop, 'A simple digital clock' translatedNoop}.
+ {#BookMorph, #previousPageButton, 'Previous' translatedNoop, 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph, #nextPageButton, 'Next' translatedNoop, 'A button that takes you to the next page' translatedNoop}.
+ }.
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'Previous' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'Next' 'A button that takes you to the next page')
- ).
+ aFlapTab _ FlapTab new referent: aStrip beSticky.
- aFlapTab := FlapTab new referent: aStrip beSticky.
aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter.
aStrip extent: self currentWorld width @ 78.
+ leftEdge _ ((Display width - (16 + aFlapTab width)) + 556) // 2.
- leftEdge := ((Display width - (16 + aFlapTab width)) + 556) // 2.
aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)).
aStrip beFlap: true.
aStrip autoLineLayout: true.
^ aFlapTab!
Item was changed:
----- Method: Flaps class>>newNavigatorFlap (in category 'predefined flaps') -----
newNavigatorFlap
"Answer a newly-created flap which adheres to the bottom edge of the screen and which holds the project navigator controls. "
| aFlapTab navBar aFlap |
+ navBar _ ProjectNavigationMorph preferredNavigator new addButtons.
+ aFlap _ PasteUpMorph newSticky borderWidth: 0;
- navBar := ProjectNavigationMorph preferredNavigator new.
- aFlap := PasteUpMorph newSticky borderWidth: 0;
extent: navBar extent + (0@20);
color: (Color orange alpha: 0.8);
beFlap: true;
addMorph: navBar beSticky.
aFlap hResizing: #shrinkWrap; vResizing: #shrinkWrap.
aFlap useRoundedCorners.
aFlap setNameTo: 'Navigator Flap' translated.
navBar fullBounds. "to establish width"
+ aFlapTab _ FlapTab new referent: aFlap.
- aFlapTab := FlapTab new referent: aFlap.
aFlapTab setName: 'Navigator' translated edge: #bottom color: Color orange.
aFlapTab position: ((navBar width // 2) - (aFlapTab width // 2))
@ (self currentWorld height - aFlapTab height).
aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Navigator' translated "
!
Item was changed:
----- Method: Flasher class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver for use in a parts bin"
+ ^ self partName: 'Flasher' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A circle that flashes' translatedNoop!
- ^ self partName: 'Flasher'
- categories: #('Demo')
- documentation: 'A circle that flashes'!
Item was changed:
----- Method: FrameRateMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'FrameRate' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A readout that allows you to monitor the frame rate of your system' translatedNoop!
- ^ self partName: 'FrameRate'
- categories: #('Useful')
- documentation: 'A readout that allows you to monitor the frame rate of your system'!
Item was changed:
----- Method: FrameRateMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#FrameRateMorph. #authoringPrototype. 'Frame Rate' translatedNoop. 'An indicator of how fast your system is running' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(FrameRateMorph authoringPrototype 'Frame Rate' 'An indicator of how fast your system is running')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: FrameRateMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ lastDisplayTime _ 0.
+ framesSinceLastDisplay _ 0.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ !
- lastDisplayTime := 0.
- framesSinceLastDisplay := 0!
Item was changed:
----- Method: FrameRateMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
"Initialize the receiver as a stand-alone entity"
super initializeToStandAlone.
self color: Color blue.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ self step.
+ !
- self step!
Item was changed:
----- Method: GrabPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver's instances for a parts bin"
+ ^ self partName: 'Grab Patch' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Use this to grab a rectangular patch from the screen' translatedNoop!
- ^ self partName: 'Grab Patch'
- categories: #('Graphics')
- documentation: 'Use this to grab a rectangular patch from the screen'!
Item was changed:
----- Method: GrabPatchMorph>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initialize.
+ self image: (ScriptingSystem formAtKey: 'GrabPatch').
+ self setProperty: #ignorePartsBinDrop toValue: true!
- self image: (ScriptingSystem formAtKey: 'GrabPatch')!
Item was changed:
----- Method: GraphMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Graph' translatedNoop
+ categories: #()
+ documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.' translatedNoop!
- ^ self partName: 'Graph'
- categories: #('Useful')
- documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.'!
Item was changed:
----- Method: GraphMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: 365 @ 80.
+ dataColor _ Color darkGray.
+ cursor _ 1.0.
+ samplingRate := 11025.
- dataColor := Color darkGray.
- cursor := 1.0.
"may be fractional"
+ cursorColor _ Color red.
+ cursorColorAtZeroCrossings _ Color red.
+ startIndex _ 1.
+ hasChanged _ false.
- cursorColor := Color red.
- cursorColorAtZeroCrossings := Color red.
- startIndex := 1.
- hasChanged := false.
self
data: ((0 to: 360 - 1)
collect: [:x | (100.0 * x degreesToRadians sin) asInteger])!
Item was changed:
----- Method: GraphicalDictionaryMenu class>>openOn:withLabel: (in category 'instance creation') -----
openOn: aFormDictionary withLabel: aLabel
"open a graphical dictionary in a window having the label aLabel.
aFormDictionary should be a dictionary containing as value a form."
| inst aWindow |
+ aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!' translated].
- aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!'].
inst := self new initializeFor: nil fromDictionary: aFormDictionary.
+ aWindow _ (SystemWindow labelled: aLabel) model: inst.
- aWindow := (SystemWindow labelled: aLabel) model: inst.
aWindow addMorph: inst frame: (0@0 extent: 1@1).
aWindow extent: inst fullBounds extent + (3 @ aWindow labelHeight + 3);
minimumExtent: inst minimumExtent + (3 @ aWindow labelHeight + 3).
HandMorph attach: aWindow.
^ inst!
Item was changed:
----- Method: GraphicalDictionaryMenu>>renameGraphicTo: (in category 'menu commands') -----
renameGraphicTo: newName
| curr |
+ curr _ entryNames at: currentIndex.
- curr := entryNames at: currentIndex.
(newName isEmptyOrNil or: [newName = curr]) ifTrue: [^ Beeper beep].
(baseDictionary includesKey: newName) ifTrue:
[^ self inform: 'sorry that conflicts with
the name of another
+ entry in this dictionary' translated].
- entry in this dictionary'].
baseDictionary at: newName put: (baseDictionary at: curr).
baseDictionary removeKey: curr.
self baseDictionary: baseDictionary.
+ currentIndex _ entryNames indexOf: newName.
- currentIndex := entryNames indexOf: newName.
self updateThumbnail!
Item was changed:
----- Method: GraphicalMenu>>initializeFor:withForms:coexist: (in category 'initialization') -----
initializeFor: aTarget withForms: formList coexist: aBoolean
"World primaryHand attachMorph:
(GraphicalMenu new initializeFor: nil
withForms: Form allInstances coexist: true)"
| buttons bb anIndex buttonCage |
target := aTarget.
coexistWithOriginal := aBoolean.
formChoices := formList.
currentIndex := 1.
self borderWidth: 1;
cellPositioning: #center;
color: Color white;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap.
buttons := AlignmentMorph newRow.
buttons borderWidth: 0;
layoutInset: 0.
buttons hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5 @ 5.
buttons wrapCentering: #topLeft.
buttonCage := AlignmentMorph newColumn.
buttonCage hResizing: #shrinkWrap;
vResizing: #spaceFill.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Prev' translated;
- buttons addMorphBack: (bb label: 'Prev';
actionSelector: #downArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 9 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Next' translated;
- buttons addMorphBack: (bb label: 'Next';
actionSelector: #upArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 5 @ 0.
buttons submorphs last color: Color white.
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 12.
buttons := AlignmentMorph newRow.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'OK' translated;
- buttons addMorphBack: (bb label: 'OK';
actionSelector: #okay).
buttons addTransparentSpacerOfSize: 5 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Cancel' translated;
- buttons addMorphBack: (bb label: 'Cancel';
actionSelector: #cancel).
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
self addMorphFront: buttonCage.
formDisplayMorph := Thumbnail new extent: 100 @ 100;
maxWidth: 100 minHeight: 30;
yourself.
self addMorphBack: (Morph new color: Color white;
layoutPolicy: TableLayout new;
layoutInset: 4 @ 4;
hResizing: #spaceFill;
vResizing: #spaceFill;
listCentering: #center;
addMorphBack: formDisplayMorph;
yourself).
target
ifNotNil: [(anIndex := formList
indexOf: target form
ifAbsent: [])
ifNotNil: [currentIndex := anIndex]].
self updateThumbnail!
Item was changed:
----- Method: HandMorphForReplay>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
+ suspended := false.
+ self showTemporaryCursor: Cursor normal
- self showTemporaryCursor: Cursor normal.
!
Item was changed:
----- Method: HandMorphForReplay>>processEvents (in category 'event handling') -----
processEvents
"Play back the next event"
+ | evt hadMouse hadAny tracker |
+ suspended == true ifTrue: [^ self].
- | evt hadMouse hadAny |
hadMouse := hadAny := false.
+ tracker := recorder objectTrackingEvents.
[(evt := recorder nextEventToPlay) isNil] whileFalse:
+ [
+ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self].
+ tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp].
+ evt type == #EOF
- [evt type == #EOF
ifTrue:
+ [recorder pauseIn: ActiveWorld.
+ ^ self].
- [recorder pauseIn: self world.
- ^self].
evt type == #startSound
ifTrue:
+ [recorder perhapsPlaySound: evt argument.
- [evt argument play.
recorder synchronize.
+ ^ self].
+ evt type == #startEventPlayback
+ ifTrue:
+ [evt argument launchPlayback.
+ recorder synchronize.
+ ^ self].
+
+ evt type == #noteTheatreBounds
+ ifTrue:
+ ["The argument holds the content rect --for now we don't make any use of that info in this form."
+ ^ self].
+
- ^self].
evt isMouse ifTrue: [hadMouse := true].
(evt isMouse or: [evt isKeyboard])
ifTrue:
[self handleEvent: (evt setHand: self) resetHandlerFields.
hadAny := true]].
(mouseClickState notNil and: [hadMouse not])
ifTrue:
["No mouse events during this cycle. Make sure click states time out accordingly"
mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
hadAny
ifFalse:
["No pending events. Make sure z-order is up to date"
self mouseOverHandler processMouseOver: lastMouseEvent]!
Item was changed:
----- Method: HandMorphForReplay>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
+ "Handmorph blocks deep copy. Go up to Morph"
+
+ ^ self perform: #veryDeepCopyWith: withArguments: {deepCopier} inSuperclass: Morph!
- ^ self copy!
Item was changed:
----- Method: IndexTabs class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'tabs' translatedNoop!
- ^ 'tabs'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>cacheThumbnailFor: (in category 'thumbnails') -----
cacheThumbnailFor: aProject
+ "Save a thumbnail of the given project in my thumbnail cache."
| form |
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
-
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
CachedThumbnails
at: aProject name
+ put: (form _ self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter).
+ ^ form
- put: (form := self sorterFormForProject: aProject sized: nil).
- ^form
!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'ThreadNavigator' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A tool that lets you navigate through a thread of projects.' translatedNoop!
- ^ self partName: 'ThreadNavigator'
- categories: #('Navigation')
- documentation: 'A tool that lets you navigate through a thread of projects.'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>getThumbnailFor: (in category 'thumbnails') -----
getThumbnailFor: aProject
+ "Answer a thumbnail for the given project, retrieving it from a cache of such objects if possible, else creating a fresh thumbnail, storing it in the cache, and answering it."
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
^CachedThumbnails
at: aProject name
+ ifAbsentPut: [self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter]!
- ifAbsentPut: [self sorterFormForProject: aProject sized: nil]!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>sorterFormForProject:sized: (in category 'sorter') -----
+ sorterFormForProject: aProject sized: aSize
+ "Answer a form to use in a project-sorter to represent the project."
- sorterFormForProject: aProject sized: ignored
+ ^ (ProjectViewMorph on: aProject) imageForm scaledToSize: aSize
- ^(ProjectViewMorph on: aProject) imageForm scaledToSize: 80@60.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>buttonForMenu (in category 'navigation') -----
buttonForMenu
+ ^self makeButton: '?' balloonText: 'More commands' translated for: #moreCommands.
- ^self makeButton: '?' balloonText: 'More commands' for: #moreCommands.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>editThisThread (in category 'navigation') -----
editThisThread
| sorter |
+ sorter _ ProjectSorterMorph new.
- sorter := ProjectSorterMorph new.
sorter navigator: self listOfPages: listOfPages.
self currentWorld addMorphFront: sorter.
+ sorter align: sorter topCenter with: self currentWorld topCenter.
- sorter align: sorter center with: self currentWorld center.
self delete.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>positionAppropriately (in category 'navigation') -----
positionAppropriately
+ | others otherRects overlaps bottomRight |
- | others otherRects overlaps |
-
(self ownerThatIsA: HandMorph) ifNotNil: [^self].
+ others _ ActiveWorld submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
+ otherRects _ others collect: [ :each | each bounds].
+ bottomRight _ (ActiveWorld hasProperty: #threadNavigatorPosition) ifTrue: [
+ ActiveWorld valueOfProperty: #threadNavigatorPosition.
+ ] ifFalse: [
+ ActiveWorld bottomRight.
+ ].
+ self align: self fullBounds bottomRight with: bottomRight.
- others := self world submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
- otherRects := others collect: [ :each | each bounds].
- self align: self fullBounds bottomRight with: self world bottomRight.
self setProperty: #previousWorldBounds toValue: self world bounds.
[
+ overlaps _ false.
- overlaps := false.
otherRects do: [ :r |
+ (r intersects: bounds) ifTrue: [overlaps _ true. self bottom: r top].
- (r intersects: bounds) ifTrue: [overlaps := true. self bottom: r top].
].
self top < self world top ifTrue: [
+ self bottom: bottomRight y.
- self bottom: self world bottom.
self right: self left - 1.
].
overlaps
] whileTrue.!
Item was changed:
----- Method: InternalThreadNavigationMorph>>sizeRatio (in category 'accessing') -----
sizeRatio
"answer the size ratio for the receiver"
+ ^ 1.0
+
+ "^ Preferences standardMenuFont height / 12" "Good grief!!"!
- ^ Preferences standardMenuFont height / 12!
Item was changed:
----- Method: LassoPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver to be used in a parts bin"
+ ^ self partName: 'Lasso' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Drop this icon to grab a patch from the screen with a lasso.' translatedNoop!
- ^ self partName: 'Lasso'
- categories: #('Graphics')
- documentation: 'Drop this icon to grab a patch from the screen with a lasso.'!
Item was changed:
----- Method: LassoPatchMorph>>wantsToBeDroppedInto: (in category 'dropping') -----
wantsToBeDroppedInto: aMorph
+ "Only wanted by the world"
- "Only into PasteUps that are not part bins"
+ ^ aMorph isWorldMorph!
- ^ aMorph isPlayfieldLike!
Item was changed:
----- Method: MagnifierMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Magnifier' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A magnifying glass' translatedNoop!
- ^ self partName: 'Magnifier'
- categories: #('Useful')
- documentation: 'A magnifying glass'!
Item was changed:
----- Method: MagnifierMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MagnifierMorph. #newRound. 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: MagnifierMorph class>>supplementaryPartsDescriptions (in category 'parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundGlass' translatedNoop
+ categoryList: {'Just for Fun' translatedNoop}
+ documentation: 'A round magnifying glass' translatedNoop
- formalName: 'RoundGlass'
- categoryList: #(Useful)
- documentation: 'A round magnifying glass'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newRound.
DescriptionForPartsBin
+ formalName: 'Hand Magnifier' translatedNoop
+ categoryList: #()
+ documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.' translatedNoop
- formalName: 'Hand Magnifier'
- categoryList: #(Useful)
- documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newShowingPointer }!
Item was changed:
----- Method: MagnifierMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
+ | stencil newForm bb |
+
- super drawOn: aCanvas. "border and fill"
aCanvas isShadowDrawing ifFalse: [
"Optimize because #magnifiedForm is expensive"
+ self isRound
+ ifTrue:[stencil := (EllipseMorph new extent: self extent; color: Color white) imageForm.
+ bb := BitBlt toForm: stencil.
+ newForm := (bb copyForm: self magnifiedForm to: 0@0 rule: Form and) destForm.
+ aCanvas paintImage: newForm at: self innerBounds origin ]
+ ifFalse:[super drawOn: aCanvas. "border and fill"
+ aCanvas paintImage: self magnifiedForm at: self innerBounds origin]]
+
+ !
- aCanvas paintImage: self magnifiedForm at: self innerBounds origin]!
Item was changed:
----- Method: MagnifierMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
+ trackPointer _ true.
+ showPointer _ false.
+ magnification _ 2.
+ roundness := false.
- trackPointer := true.
- showPointer := false.
- magnification := 2.
-
self extent: 128 @ 128!
Item was changed:
----- Method: MagnifierMorph>>isRound (in category 'round view') -----
isRound
+ ^ roundness == true!
- ^ owner isMemberOf: ScreeningMorph!
Item was changed:
----- Method: MagnifierMorph>>showingPointerString (in category 'menu') -----
showingPointerString
+ "Answer a string characterizing whether or not I'm showing the pointer."
+
+ ^ (self showPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'show pointer' translated!
- ^ (self showPointer
- ifTrue: ['stop showing pointer']
- ifFalse: ['start showing pointer']) translated!
Item was changed:
----- Method: MagnifierMorph>>sourcePoint (in category 'magnifying') -----
sourcePoint
"If we are being dragged use our center, otherwise use pointer position"
^(trackPointer not or: [owner notNil and: [owner isHandMorph]])
+ ifTrue: [self isFlexed ifTrue:[owner center] ifFalse:[self center]]
- ifTrue: [self center]
ifFalse: [self currentHand position]!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundString (in category 'round view') -----
toggleRoundString
+ "Answer a string describing whether the receiver is currently round."
+
+ ^ (self isRound ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'round' translated!
- ^ (self isRound
- ifTrue: ['be square']
- ifFalse: ['be round']) translated!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundness (in category 'round view') -----
toggleRoundness
+ roundness := roundness not.
+ self fullBounds changed
+ !
- | sm w |
- w := self world.
- self isRound
- ifTrue: [owner delete.
- w addMorph: self]
- ifFalse: [sm := ScreeningMorph new position: self position.
- sm addMorph: self.
- sm addMorph: (EllipseMorph newBounds: self bounds).
- w addMorph: sm]!
Item was changed:
----- Method: MagnifierMorph>>trackingPointerString (in category 'menu') -----
trackingPointerString
+ "Answer a string describing whether or not I'm currently tracking the pointer."
+
^ (trackPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'track pointer' translated!
- ifTrue: ['stop tracking pointer']
- ifFalse: ['start tracking pointer']) translated!
Item was changed:
----- Method: MessageNames class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MessageNames. #prototypicalToolWindow. 'Message Names' translatedNoop. 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: Morph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
^ { DescriptionForPartsBin
+ formalName: 'Status' translatedNoop
+ categoryList: #()
+ documentation: 'Buttons to run, stop, or single-step scripts' translatedNoop
- formalName: 'Status'
- categoryList: #(Scripting)
- documentation: 'Buttons to run, stop, or single-step scripts'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #scriptControlButtons.
DescriptionForPartsBin
+ formalName: 'Scripting' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop
- formalName: 'Scripting'
- categoryList: #(Scripting)
- documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #newScriptingSpace.
DescriptionForPartsBin
+ formalName: 'Random' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A tile that will produce a random number in a given range' translatedNoop
+ globalReceiverSymbol: #FunctionTile
+ nativitySelector: #randomNumberTile.
- formalName: 'Random'
- categoryList: #(Scripting)
- documentation: 'A tile that will produce a random number in a given range'
- globalReceiverSymbol: #RandomNumberTile
- nativitySelector: #new.
DescriptionForPartsBin
+ formalName: 'ButtonDown?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is down' translatedNoop
- formalName: 'ButtonDown?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is down'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #anyButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'ButtonUp?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is up' translatedNoop
- formalName: 'ButtonUp?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is up'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #noButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'NextPage' translatedNoop
+ categoryList: {'Multimedia' translatedNoop}
+ documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop
- formalName: 'NextPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #nextPageButton.
DescriptionForPartsBin
+ formalName: 'PreviousPage' translatedNoop
+ categoryList: {'Multimedia'}
+ documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop
- formalName: 'PreviousPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #previousPageButton.},
+ self partsDescriptionsFromToolsFlap!
- (Flaps quadsDefiningToolsFlap collect:
- [:aQuad | DescriptionForPartsBin fromQuad: aQuad categoryList: #(Tools)])!
Item was changed:
----- Method: ObjectsTool class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Objects' translatedNoop
+ categories: #()
+ documentation: 'A place to obtain many kinds of objects' translatedNoop!
- ^ self partName: 'Objects'
- categories: #('Useful')
- documentation: 'A place to obtain many kinds of objects'!
Item was changed:
----- Method: ObjectsTool class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ObjectsTool. #newStandAlone. 'Object Catalog' translatedNoop. 'A tool that lets you browse the catalog of objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ObjectsTool . #newStandAlone. 'Object Catalog' translatedNoop.'A tool that lets you browse the catalog of objects' translatedNoop}
- cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: ObjectsTool>>minimumWidth (in category 'layout') -----
minimumWidth
+ "Answer a width that assures that the alphabet fits in two rows. For olpc, this is increased in order to make the Connectors category not too absurdly tall."
- "Answer a width that assures that the alphabet fits in two rows"
+ ^ 400!
- ^ 300!
Item was changed:
----- Method: PackagePaneBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PackagePaneBrowser. #prototypicalToolWindow . 'Packages' translatedNoop. 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: PaintBoxMorph>>offsetFromMaxBounds (in category 'other') -----
offsetFromMaxBounds
"location of normal PaintBox within maxBounds."
+ | left |
+ left _ self left.
+ Preferences useBiggerPaintingBox ifTrue: [left _ left - (( self width * 1.5)- self width)].
+ ^ left - colorMemory left @ 0!
-
- ^ self left - colorMemory left @ 0!
Item was changed:
----- Method: PaintBoxMorph>>recentColor: (in category 'recent colors') -----
recentColor: aColor
"Remember the color as one of our recent colors"
+ Prototype currentColor: aColor.
+ (recentColors anySatisfy: [:any | any color = aColor])
+ ifTrue: [^self]. "already remembered"
+ RecentColors := {aColor}, RecentColors allButLast.
+ RecentColors keysAndValuesDo: [:i :each |
+ (recentColors at: i) color: each]!
-
- (recentColors anySatisfy: [:any | any color = aColor]) ifTrue: [^self]. "already remembered"
- recentColors size to: 2
- by: -1
- do:
- [:i |
- (recentColors at: i) color: (recentColors at: i - 1) color.
- RecentColors at: i put: (RecentColors at: i - 1)].
- (recentColors first) color: aColor.
- RecentColors at: 1 put: aColor!
Item was changed:
----- Method: PaintBoxMorph>>showColorPalette: (in category 'actions') -----
showColorPalette: evt
| w box |
self comeToFront.
colorMemory align: colorMemory bounds topRight
with: colorMemoryThin bounds topRight.
"make sure color memory fits or else align with left"
+ w _ self world.
+ box _ self bounds: colorMemory fullBounds in: w.
- w := self world.
- box := self bounds: colorMemory fullBounds in: w.
box left < 0 ifTrue:[
colorMemory align: colorMemory bounds topLeft
with: colorMemoryThin bounds topLeft].
+ self addMorphFront: colorMemory.
+ self changed!
- self addMorphFront: colorMemory.!
Item was changed:
----- Method: PaintBoxMorph>>toggleShapes (in category 'actions') -----
toggleShapes
| tab sh stamps |
"The sub panel that has the shape tools on it. Rect, line..."
+ stamps _ self submorphNamed: 'stamps'.
+ tab _ self submorphNamed: 'shapeTab'.
+ (sh _ self submorphNamed: 'shapes') visible
- stamps := self submorphNamed: 'stamps'.
- tab := self submorphNamed: 'shapeTab'.
- (sh := self submorphNamed: 'shapes') visible
ifTrue: [sh hide. tab top: stamps bottom-1]
ifFalse: [sh comeToFront. sh top: stamps bottom-9.
sh show. tab top: sh bottom - tab height + 10].
self layoutChanged.
+ self changed
!
Item was changed:
----- Method: PaintBoxMorph>>toggleStamps (in category 'actions') -----
toggleStamps
| tab otherTab st shapes |
"The sub panel that has the stamps in it. For saving and moving parts of an image."
+ shapes _ self submorphNamed: 'shapes'.
+ otherTab _ self submorphNamed: 'shapeTab'.
+ tab _ self submorphNamed: 'stampTab'.
+ (st _ self submorphNamed: 'stamps') visible
- shapes := self submorphNamed: 'shapes'.
- otherTab := self submorphNamed: 'shapeTab'.
- tab := self submorphNamed: 'stampTab'.
- (st := self submorphNamed: 'stamps') visible
ifTrue: [st hide. st bottom: self bottom. tab top: self bottom-1.
shapes top: self bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [self bottom-1])]
ifFalse: [st top: self bottom-10. st show. tab top: st bottom-0.
shapes top: st bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [st bottom-0])].
+ self layoutChanged.
+ self changed!
- self layoutChanged.!
Item was changed:
----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Paint' translatedNoop
+ categories: #()
+ documentation: 'Drop this icon to start painting a new object.' translatedNoop!
- ^ self partName: 'Paint'
- categories: #('Basic' 'Graphics')
- documentation: 'Drop this icon to start painting a new object.'!
Item was changed:
----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PartsBin>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
wantsDroppedMorph: aMorph event: evt
"Answer whether the receiver would like to accept the given morph. For a Parts bin, we accept just about anything except something that just originated from ourselves"
(aMorph hasProperty: #beFullyVisibleAfterDrop) ifTrue:
+ [^ true].
- ["Sign that this was launched from a parts bun, probably indeed this very parts bin"
- ^ false].
^ super wantsDroppedMorph: aMorph event: evt!
Item was changed:
----- Method: PasteUpMorph class>>initialize (in category '*MorphicExtras-class initialization') -----
initialize
"Initialize the class"
+ #('keyStroke') translatedNoop.
+
self registerInFlapsRegistry.
+ ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' translatedNoop targetMorphClass: PasteUpMorph.!
- ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' targetMorphClass: PasteUpMorph.!
Item was changed:
----- Method: PasteUpMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Holder' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop
- formalName: 'Holder'
- categoryList: #(Scripting)
- documentation: 'A place for storing alternative pictures in an animation, ec.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #prototypicalHolder}!
Item was changed:
----- Method: PianoKeyboardMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'PianoKeyboard' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A piano keyboard' translatedNoop!
- ^ self partName: 'PianoKeyboard'
- categories: #('Multimedia')
- documentation: 'A piano keyboard'!
Item was changed:
----- Method: PianoKeyboardMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+
+ whiteKeyColor _ Color gray: 0.95.
+ blackKeyColor _ Color black.
+ playingKeyColor _ Color red.
+ nOctaves _ 6.
-
- whiteKeyColor := Color gray: 0.95.
- blackKeyColor := Color black.
- playingKeyColor := Color red.
- nOctaves := 6.
self buildKeyboard.
+ soundPrototype _ FMSound brass1 duration: 9.9.
+ frequency _ 0.
+ soundPrototype _ FMSound new.
+ allowingChord _ false. "Sorry!!"
+ soundPlayingList _ Array new: self submorphs size.
+ !
- soundPrototype := FMSound brass1 duration: 9.9!
Item was changed:
----- Method: PolygonMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: PolygonMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-instance creation') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {DescriptionForPartsBin
+ formalName: 'Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.' translatedNoop
- formalName: 'Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.'
globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #arrowPrototype.
+ DescriptionForPartsBin
+ formalName: 'Triangle' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A three-sided polygon.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #trianglePrototype.
+
+ DescriptionForPartsBin
+ formalName: 'Curve' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A smooth wiggly curve, or a curved solid. Shift-click to get handles and move the points. Using the halo menu, can be coverted into a polygon, and can be made "open" rather than closed.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #curvePrototype.
+ }
+
+
- nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFlaps (in category 'the buttons') -----
buttonFlaps
^self inFlapsSuppressedMode ifTrue: [
+ self makeButton: 'Show tabs' translated balloonText: 'Show tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Show tabs' balloonText: 'Show tabs' for: #toggleFlapsSuppressed
] ifFalse: [
+ self makeButton: 'Hide tabs' translated balloonText: 'Hide tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Hide tabs' balloonText: 'Hide tabs' for: #toggleFlapsSuppressed
].
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFullScreen (in category 'the buttons') -----
buttonFullScreen
^self inFullScreenMode ifTrue: [
+ self makeButton: 'Browser Reentry' translated balloonText: 'Re-enter the browser' translated for: #fullScreenOff
- self makeButton: 'Browser Reentry' balloonText: 'Re-enter the browser' for: #fullScreenOff
] ifFalse: [
+ self makeButton: 'Escape Browser' translated balloonText: 'Use the full screen' translated for: #fullScreenOn
- self makeButton: 'Escape Browser' balloonText: 'Use the full screen' for: #fullScreenOn
]
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonGoTo (in category 'the buttons') -----
buttonGoTo
+ ^self makeButton: 'GO TO' translated balloonText: 'Go to another project' translated for: #gotoAnother
- ^self makeButton: 'GO TO' balloonText: 'Go to another project' for: #gotoAnother
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewProject (in category 'the buttons') -----
buttonNewProject
+ ^self makeButton: 'NEW' translated balloonText: 'Start a new project' translated for: #newProject
- ^self makeButton: 'NEW' balloonText: 'Start a new project' for: #newProject
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewer (in category 'the buttons') -----
buttonNewer
+ ^self makeButton: 'Newer?' translated balloonText: 'Is there a newer version of this project ?' translated for: #getNewerVersionIfAvailable!
- ^self makeButton: 'Newer?' balloonText: 'Is there a newer version of this project ?' for: #getNewerVersionIfAvailable!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNext (in category 'the buttons') -----
buttonNext
+ ^self makeButton: 'NEXT >' translated balloonText: 'Next project' translated for: #nextProject!
- ^self makeButton: 'NEXT >' balloonText: 'Next project' for: #nextProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPaint (in category 'the buttons') -----
buttonPaint
| pb oldArgs brush myButton m |
+ myButton _ self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting.
+ pb _ PaintBoxMorph new submorphNamed: #paint:.
- myButton := self makeButton: '' balloonText: 'Make a painting' for: #doNewPainting.
- pb := PaintBoxMorph new submorphNamed: #paint:.
pb ifNil: [
+ (brush _ Form extent: 16@16 depth: 16) fillColor: Color red
- (brush := Form extent: 16@16 depth: 16) fillColor: Color red
] ifNotNil: [
+ oldArgs _ pb arguments.
+ brush _ oldArgs third.
+ brush _ brush copy: (2@0 extent: 42@38).
+ brush _ brush scaledToSize: brush extent // 2.
- oldArgs := pb arguments.
- brush := oldArgs third.
- brush := brush copy: (2@0 extent: 42@38).
- brush := brush scaledToSize: brush extent // 2.
].
+ myButton addMorph: (m _ brush asMorph lock).
- myButton addMorph: (m := brush asMorph lock).
myButton extent: m extent + (myButton borderWidth + 6).
m position: myButton center - (m extent // 2).
^myButton
+ "brush _ (ScriptingSystem formAtKey: 'Painting')."
- "brush := (ScriptingSystem formAtKey: 'Painting')."
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPrev (in category 'the buttons') -----
buttonPrev
+ ^self makeButton: '< PREV' translated balloonText: 'Previous project' translated for: #previousProject!
- ^self makeButton: '< PREV' balloonText: 'Previous project' for: #previousProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonQuit (in category 'the buttons') -----
buttonQuit
+ "Make and answer a button whose pressing will result in quitting out of Squeak."
+ ^self makeButton: 'QUIT' translated balloonText: 'Quit Etoys (without saving)' translated for: #quitSqueak
- ^self makeButton: 'QUIT' balloonText: 'Quit Squeak altogether' for: #quitSqueak
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonTell (in category 'the buttons') -----
buttonTell
+ ^self makeButton: 'Tell!!' translated balloonText: 'Tell a friend about this project' translated for: #tellAFriend
- ^self makeButton: 'Tell!!' balloonText: 'Tell a friend about this project' for: #tellAFriend
!
Item was changed:
----- Method: ProjectNavigationMorph>>fontForButtons (in category 'as yet unclassified') -----
fontForButtons
+ ^ Preferences standardButtonFont!
-
- ^TextStyle defaultFont!
Item was changed:
----- Method: ProjectNavigationMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self layoutInset: 6;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
useRoundedCorners.
+ mouseInside _ false.
+ !
- mouseInside := false.
- self addButtons!
Item was changed:
----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'as yet unclassified') -----
makeButton: aString balloonText: anotherString for: aSymbol
- self flag: #yo.
- "In principle, this method shouldn't call #translated."
-
^ SimpleButtonDelayedMenuMorph new target: self;
borderColor: #raised;
color: self colorForButtons;
+ label: aString font: self fontForButtons;
+ setBalloonText: anotherString;
- label: aString translated font: self fontForButtons;
- setBalloonText: anotherString translated;
actionSelector: aSymbol!
Item was changed:
----- Method: ProjectNavigationMorph>>publishDifferent (in category 'the actions') -----
publishDifferent
self
+ publishStyle: #initialDirectoryListForProjects
- publishStyle: #initialDirectoryList
forgetURL: true
withRename: false
!
Item was changed:
----- Method: ProjectNavigationMorph>>publishStyle:forgetURL:withRename: (in category 'the actions') -----
publishStyle: aSymbol forgetURL: aBoolean withRename: renameBoolean
| w saveOwner primaryServer rename |
+ w _ self world ifNil: [^Beeper beep].
- w := self world ifNil: [^Beeper beep].
w setProperty: #SuperSwikiPublishOptions toValue: aSymbol.
+ primaryServer _ w project primaryServerIfNil: [nil].
+ rename _ ((primaryServer notNil
- primaryServer := w project primaryServerIfNil: [nil].
- rename := ((primaryServer notNil
and: [primaryServer acceptsUploads]) not)
or: [renameBoolean].
+ rename := rename or: [(primaryServer isKindOf: DAVMultiUserServerDirectory)].
w setProperty: #SuperSwikiRename toValue: rename.
+ saveOwner _ owner.
- saveOwner := owner.
self delete.
[w project
storeOnServerShowProgressOn: self
forgetURL: aBoolean | rename]
ensure: [saveOwner addMorphFront: self]!
Item was changed:
+ ----- Method: ProjectSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: ProjectSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
- | b r partsBinButton newButton |
+ | b r partsBinButton newButton aWrapper |
+ newButton _ ImageMorph new image: (World project makeThumbnail scaledToSize: 48@36).
- newButton := ImageMorph new image: (World project makeThumbnail scaledToSize: 24@18).
newButton on: #mouseDown send: #insertNewProject: to: self.
newButton setBalloonText: 'Make a new Project' translated.
+ (partsBinButton _ UpdatingThreePhaseButtonMorph checkBox)
- (partsBinButton := UpdatingThreePhaseButtonMorph checkBox)
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ (r _ AlignmentMorph newRow)
- (r := AlignmentMorph newRow)
color: Color transparent;
borderWidth: 0;
layoutInset: 0;
+ cellInset: 10@0;
wrapCentering: #center;
+ cellPositioning: #leftCenter;
- cellPositioning: #topCenter;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5@5.
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- r addMorphBack: (self wrapperFor: (b label: 'Okay' translated; actionSelector: #acceptSort)).
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete));
- r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated; actionSelector: #delete));
- addMorphBack: (self wrapperFor: (newButton));
addTransparentSpacerOfSize: 8 @ 0;
+ addMorphBack: (self wrapperFor: (newButton));
+ addTransparentSpacerOfSize: 8 @ 0.
+
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
addMorphBack: (self wrapperFor: partsBinButton);
+ addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons) lock).
+ r addMorphBack: aWrapper.
- addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated) lock).
self addMorphFront: r.
!
Item was changed:
----- Method: ProjectSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
super initialize.
- ""
self useRoundedCorners.
pageHolder useRoundedCorners; borderWidth: 0;
color: (self
gridFormOrigin: 0 @ 0
+ grid: ScriptingSystem sorterGridSize
- grid: 16 @ 16
background: Color white
line: Color blue muchLighter)!
Item was changed:
----- Method: ProjectSorterMorph>>sorterMorphForProjectNamed: (in category 'as yet unclassified') -----
sorterMorphForProjectNamed: projName
| pvm proj |
+ (proj _ Project named: projName) ifNil: [^nil].
+ pvm _ (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
- (proj := Project named: projName) ifNil: [^nil].
- pvm := (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
pvm setProperty: #nameOfThisProject toValue: projName.
+ pvm isOpaque: true.
pvm setBalloonText: projName.
pvm on: #mouseDown send: #clickFromSorterEvent:morph: to: self.
pvm on: #mouseUp send: #clickFromSorterEvent:morph: to: self.
^pvm
!
Item was changed:
----- Method: RecordingControlsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.'}
- cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: RecordingControlsMorph>>addButtonRows (in category 'initialization') -----
addButtonRows
+ | r fullWidth |
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- | r |
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Morph' translated action: #makeSoundMorph).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Tile' translated action: #makeTile).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Trim' translated action: #trim).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Show' translated action: #showEditor).
- r addMorphBack: (self buttonName: 'Show' translated action: #show).
self addMorphBack: r.
+ r layoutChanged.
+ fullWidth := r fullBounds width.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Record' translated action: #record).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Stop' translated action: #stop).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Play' translated action: #playback).
+ r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Codec' translated action: #chooseCodec).
r addMorphBack: self makeStatusLight.
self addMorphBack: r.
+ self changeCodec: OggSpeexCodec name: 'Speex'.
+ r layoutChanged.
+ fullWidth := fullWidth max: r fullBounds width.
+ ^ fullWidth@(r fullBounds height).
!
Item was changed:
----- Method: RecordingControlsMorph>>buttonName:action: (in category 'other') -----
buttonName: aString action: aSymbol
^ SimpleButtonMorph new
target: self;
+ label: aString font: Preferences standardButtonFont;
- label: aString;
actionSelector: aSymbol
!
Item was changed:
----- Method: RecordingControlsMorph>>initialize (in category 'initialization') -----
initialize
+ | r full |
- | r |
super initialize.
self hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ borderWidth _ 2.
- borderWidth := 2.
self listDirection: #topToBottom.
+ recorder _ SoundRecorder new.
+ full := self addButtonRows.
+ self addRecordLevelSliderIn: full.
- recorder := SoundRecorder new.
- self addButtonRows.
- self addRecordLevelSlider.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
+ r addMorphBack: (self makeRecordMeterIn: full).
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
- r addMorphBack: self makeRecordMeter.
self addMorphBack: r.
self extent: 10@10. "make minimum size"
!
Item was changed:
----- Method: RectangleMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RectangleMorph, #roundRectPrototype, 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: RectangleMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundRect' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A rectangle with rounded corners' translatedNoop
- formalName: 'RoundRect'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with rounded corners'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #roundRectPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a horizontal gradient' translatedNoop
- formalName: 'Gradient'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a horizontal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #gradientPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient (slanted)' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a diagonal gradient' translatedNoop
- formalName: 'Gradient (slanted)'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a diagonal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #diagonalPrototype}!
Item was changed:
----- Method: ReferenceMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'ref' translatedNoop!
- ^ 'ref'!
Item was changed:
----- Method: ScrollableField class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Info for build parts-bin entries."
+
+ ^ self partName: 'Scrolling Text' translatedNoop
+ categories: #(Basic)
+ documentation: 'A scrollable, editable body of text' translatedNoop!
- ^ self partName: 'Scrolling Text'
- categories: #('Text' )
- documentation: 'A scrollable, editable body of text'!
Item was changed:
----- Method: ScrollableField class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
forFlapNamed: 'Stack Tools'.]!
Item was changed:
----- Method: SelectorBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SelectorBrowser. #prototypicalToolWindow. 'Method Finder' translatedNoop. 'A tool for discovering methods by providing sample values for arguments and results' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results')
forFlapNamed: 'Tools']
!
Item was changed:
----- Method: SimpleSliderMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'Slider' translatedNoop!
- ^ 'Slider'!
Item was changed:
----- Method: SimpleSliderMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Slider' translatedNoop
+ categories: {'Basic' translatedNoop}
+ documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.' translatedNoop!
- ^ self partName: 'Slider'
- categories: #('Scripting')
- documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.'!
Item was changed:
----- Method: SimpleSliderMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: SimpleSliderMorph>>adjustToValue: (in category 'private') -----
adjustToValue: aNumber
"Adjust the position of this slider to correspond to the given value in the range minVal..maxVal."
"Details: Internal values are normalized to the range 0..1."
+ | toUse |
+ toUse := minVal = maxVal
+ ifTrue:
+ [minVal]
+ ifFalse:
+ [(aNumber - minVal) asFloat / (maxVal - minVal)].
+ self value: toUse
- self value:
- (aNumber - minVal) asFloat / (maxVal - minVal).
!
Item was changed:
----- Method: SimpleSliderMorph>>descendingString (in category 'menu') -----
descendingString
^ (self descending
+ ifTrue: ['switch to ascending' translatedNoop]
+ ifFalse: ['switch to descending' translatedNoop]) translated!
- ifTrue: ['switch to ascending']
- ifFalse: ['switch to descending']) translated!
Item was changed:
----- Method: SimpleSliderMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]!
Item was changed:
----- Method: SimpleSliderMorph>>truncateString (in category 'menu') -----
truncateString
^ (truncate
+ ifTrue: ['turn off truncation' translatedNoop]
+ ifFalse: ['turn on truncation' translatedNoop]) translated!
- ifTrue: ['turn off truncation']
- ifFalse: ['turn on truncation']) translated!
Item was changed:
----- Method: SketchEditorMorph>>addRotationScaleHandles (in category 'start & finish') -----
addRotationScaleHandles
"Rotation and scaling handles"
+ rotationButton _ SketchMorph withForm: (palette rotationTabForm).
- rotationButton := SketchMorph withForm: (palette rotationTabForm).
rotationButton position: bounds topCenter - (6@0).
rotationButton on: #mouseDown send: #rotateScalePrep: to: self.
rotationButton on: #mouseMove send: #rotateBy: to: self.
rotationButton on: #mouseUp send: #rotateDone: to: self.
rotationButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
rotationButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: rotationButton].
- self addMorph: rotationButton.
rotationButton setBalloonText: 'Drag me sideways to
rotate your
picture.' translated.
+ scaleButton _ SketchMorph withForm: (palette scaleTabForm).
- scaleButton := SketchMorph withForm: (palette scaleTabForm).
scaleButton position: bounds rightCenter - ((scaleButton width)@6).
scaleButton on: #mouseDown send: #rotateScalePrep: to: self.
scaleButton on: #mouseMove send: #scaleBy: to: self.
scaleButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
scaleButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: scaleButton].
- self addMorph: scaleButton.
scaleButton setBalloonText: 'Drag me up and down to change
the size
of your picture.' translated.
"REMOVED:
+ fwdButton _ PolygonMorph new.
+ pt _ bounds topCenter.
- fwdButton := PolygonMorph new.
- pt := bounds topCenter.
fwdButton borderWidth: 2; makeOpen; makeBackArrow; borderColor:
(Color r: 0 g: 0.8 b: 0).
fwdButton removeHandles; setVertices: (Array with: pt+(0@7) with:
pt+(0@22)).
fwdButton on: #mouseMove send: #forward:direction: to: self.
fwdButton on: #mouseEnter send: #mouseLeave: to: self.
fwdButton on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdButton toValue: fwdButton.
self addMorph: fwdButton.
fwdButton setBalloonText: 'Drag me around to point
in the direction
I go forward.' translated.
+ toggle _ EllipseMorph
- toggle := EllipseMorph
newBounds: (Rectangle center: fwdButton vertices last +
(-4@4) extent: 8@8)
color: Color gray.
toggle on: #mouseUp send: #toggleDirType:in: to: self.
toggle on: #mouseEnter send: #mouseLeave: to: self.
toggle on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdToggle toValue: toggle.
fwdButton addMorph: toggle.
toggle setBalloonText: 'When your object turns,
how should its
picture change?
It can rotate, face left or right,
face up or down, or not
change.' translated.
"
self setProperty: #rotationStyle toValue: hostView rotationStyle.
" self forward: hostView setupAngle direction: fwdButton. "
"Set to its current value"
!
Item was changed:
----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: (in category 'initialization') -----
initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph
+ "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
+
| aPaintBox newPaintBoxBounds worldBounds requiredWidth newOrigin aPosition aPal aTab paintBoxFullBounds |
+ (aTab _ self world paintingFlapTab) ifNotNil:
- (aTab := self world paintingFlapTab) ifNotNil:
[aTab showFlap.
^ self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: nil].
+ self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
+ aPaintBox _ self world paintBox.
+ worldBounds _ self world bounds.
+ requiredWidth _ aPaintBox width.
- aPaintBox := self world paintBox.
- worldBounds := self world bounds.
- requiredWidth := aPaintBox width.
+ aPosition _ (aPal _ aPasteUpMorph standardPalette)
- aPosition := (aPal := aPasteUpMorph standardPalette)
ifNotNil:
[aPal showNoPalette.
aPal topRight + (aPaintBox width negated @ 0 "aPal tabsMorph height")]
ifNil:
[boundsToUse topRight].
+ newOrigin _ ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
- newOrigin := ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
ifTrue: "will fit to right of aPasteUpMorph"
[aPosition]
ifFalse: "won't fit to right, try left"
[boundsToUse topLeft - (requiredWidth @ 0)].
+ paintBoxFullBounds _ aPaintBox maxBounds.
+ paintBoxFullBounds _ (newOrigin - aPaintBox offsetFromMaxBounds) extent:
- paintBoxFullBounds := aPaintBox maxBounds.
- paintBoxFullBounds := (newOrigin - aPaintBox offsetFromMaxBounds) extent:
paintBoxFullBounds extent.
+ newPaintBoxBounds _ paintBoxFullBounds translatedToBeWithin: worldBounds.
- newPaintBoxBounds := paintBoxFullBounds translatedToBeWithin: worldBounds.
self initializeFor: aSketchMorph inBounds: boundsToUse
pasteUpMorph: aPasteUpMorph
+ paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.
+ !
- paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.!
Item was changed:
----- Method: SketchEditorMorph>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "In the middle of drawing a stroke of any kind."
- "In the middle of drawing a stroke. 6/11/97 19:51 tk"
+ | pt priorEvt actionSelector |
- | pt priorEvt |
WorldState canSurrenderToOS: false. "we want maximum responsiveness"
pt := evt cursorPoint.
priorEvt := self get: #lastEvent for: evt.
(priorEvt notNil and: [pt = priorEvt cursorPoint]) ifTrue: [^self].
+ self perform: (actionSelector _ self getActionFor: evt) with: evt.
- self perform: (self getActionFor: evt) with: evt.
"Each action must do invalidRect:"
self
set: #lastEvent
for: evt
to: evt.
+ "If recording painting, mark these events so they will not be condensed. The actual path the brush takes is important."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: actionSelector]].
false
ifTrue:
["So senders will find the things performed here"
self
paint: nil;
fill: nil;
erase: nil;
pickup: nil;
stamp: nil.
self
rect: nil;
ellipse: nil;
polygon: nil;
line: nil;
star: nil]!
Item was changed:
----- Method: SketchEditorMorph>>mouseUp: (in category 'event handling') -----
mouseUp: evt
| myAction |
"Do nothing except those that work on mouseUp."
+ myAction _ self getActionFor: evt.
- myAction := self getActionFor: evt.
myAction == #fill: ifTrue: [
self perform: myAction with: evt.
"Each action must do invalidRect:"
].
myAction == #pickup: ifTrue: [
self pickupMouseUp: evt].
myAction == #polygon: ifTrue: [self polyEdit: evt]. "a mode lets you drag vertices"
self set: #lastEvent for: evt to: nil.
+ "If recording painting, note that we stopped a stroke. OK to condense points."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: #mouseUp:]].
!
Item was changed:
----- Method: SketchEditorMorph>>paint: (in category 'actions & preps') -----
paint: evt
"While the mouse is down, lay down paint, but only within window bounds.
11/28/96 sw: no longer stop painting when pen strays out of window; once it comes back in, resume painting rather than waiting for a mouse up"
+ | mousePoint startToEnd pfPen newPoint |
+ pfPen _ self get: #paintingFormPen for: evt.
+ mousePoint _ evt cursorPoint.
+ newPoint _ mousePoint - bounds origin.
+ startToEnd _ pfPen regionFor: newPoint.
+ evt shiftPressed
+ ifTrue: [pfPen gotoBack: newPoint]
+ ifFalse: [pfPen goto: newPoint].
- | mousePoint startRect endRect startToEnd pfPen myBrush |
-
- pfPen := self get: #paintingFormPen for: evt.
- myBrush := self getBrushFor: evt.
- mousePoint := evt cursorPoint.
- startRect := pfPen location + myBrush offset extent: myBrush extent.
- pfPen goto: mousePoint - bounds origin.
- endRect := pfPen location + myBrush offset extent: myBrush extent.
- "self render: (startRect merge: endRect). Show the user what happened"
- startToEnd := startRect merge: endRect.
self invalidRect: (startToEnd translateBy: bounds origin).
!
Item was changed:
----- Method: SoundEventMorph>>releaseCachedState (in category 'caching') -----
releaseCachedState
super releaseCachedState.
+ sound isCompressed
+ ifFalse: [sound _ sound compressWith: GSMCodec].
- sound := sound compressWith: GSMCodec.
!
Item was changed:
----- Method: SquishedNameMorph>>fontForName (in category 'as yet unclassified') -----
fontForName
+ ^(TextStyle default fontOfSize: 15) emphasized: 1
- | pickem |
- pickem := 3.
-
- pickem = 1 ifTrue: [
- ^(((TextStyle named: #Helvetica) ifNil: [TextStyle default]) fontOfSize: 13) emphasized: 1.
- ].
- pickem = 2 ifTrue: [
- ^(((TextStyle named: #Palatino) ifNil: [TextStyle default]) fontOfSize: 12) emphasized: 1.
- ].
- ^((TextStyle default) fontAt: 1) emphasized: 1
!
Item was changed:
----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}
- cl registerQuad: #(ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop}
- cl registerQuad: #(ScriptingSystem holderWithAlphabet 'Alphabet' 'A source for single-letter objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: StarMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Star' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'A symmetrical polygon in the shape of a star' translatedNoop!
- ^ self partName: 'Star'
- categories: #('Graphics')
- documentation: 'A symmetrical polygon in the shape of a star'!
Item was changed:
----- Method: StarMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: StickyPadMorph class>>defaultNameStemForInstances (in category 'parts bin') -----
defaultNameStemForInstances
"Answer the default name stem to use"
+ ^ 'tear off' translatedNoop
+ !
- ^ 'tear off'!
Item was changed:
----- Method: StickyPadMorph class>>descriptionForPartsBin (in category 'parts bin') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StickyPadMorph class>>launchPartVia:label: (in category 'parts bin') -----
launchPartVia: aSelector label: aString
"Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins. Overridden here so that all instances will be given the name, unlike the prevailing convention for other object types"
| aMorph |
+ aMorph _ self perform: aSelector.
- aMorph := self perform: aSelector.
aMorph setNameTo: self defaultNameStemForInstances. "i.e., circumvent uniqueness in this case"
aMorph setProperty: #beFullyVisibleAfterDrop toValue: true.
+ aMorph openInHand.
+ ^ aMorph!
- aMorph openInHand!
Item was changed:
----- Method: StickyPadMorph class>>registerInFlapsRegistry (in category 'as yet unclassified') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: StoryboardBookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Storyboard' translatedNoop
+ categories: #()
+ documentation: 'A storyboard authoring tool' translatedNoop!
- ^ self partName: 'Storyboard'
- categories: #('Presentation')
- documentation: 'A storyboard authoring tool'!
Item was changed:
----- Method: StringButtonMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'SButton' translatedNoop!
- ^ 'SButton'!
Item was changed:
----- Method: StringButtonMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]
ifFalse: [nil]!
Item was changed:
----- Method: TabMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tab' translatedNoop!
- ^ 'tab'!
Item was changed:
+ ----- Method: TabSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: TabSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
| b r |
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r _ AlignmentMorph newRow.
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r := AlignmentMorph newRow.
r color: b color; borderWidth: 0; layoutInset: 0.
r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
r wrapCentering: #topLeft.
+ r addMorphBack: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort).
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #cancelSort).
- r addMorphBack: (b label: 'Okay'; actionSelector: #acceptSort).
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (b label: 'Cancel'; actionSelector: #cancelSort).
self addMorphFront: r.
!
Item was changed:
----- Method: TabSorterMorph>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
self removeAllMorphs.
self extent: 300@100.
+ pageHolder _ PasteUpMorph new.
- pageHolder := PasteUpMorph new.
pageHolder vResizeToFit: true; autoLineLayout: true.
pageHolder extent: self extent - borderWidth.
pageHolder padding: 8.
pageHolder cursor: 0.
+ pageHolder wantsMouseOverHalos: false.
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: TabbedPalette class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tabbedPalette' translatedNoop!
- ^ 'tabbedPalette'!
Item was changed:
----- Method: TextMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {
DescriptionForPartsBin
+ formalName: 'Text (border)' translatedNoop
+ categoryList: #()
+ documentation: 'A text field with border' translatedNoop
- formalName: 'Text (border)'
- categoryList: #('Text')
- documentation: 'A text field with border'
globalReceiverSymbol: #TextMorph
nativitySelector: #borderedPrototype.
" DescriptionForPartsBin
+ formalName: 'Text (fancy)' translatedNoop
+ categoryList: {'Text' translatedNoop}
+ documentation: 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop
- formalName: 'Text (fancy)'
- categoryList: #('Text')
- documentation: 'A text field with a rounded shadowed border, with a fancy font.'
globalReceiverSymbol: #TextMorph
nativitySelector: #fancyPrototype."
DescriptionForPartsBin
+ formalName: 'Text' translatedNoop
+ categoryList: {'Basic' translatedNoop}
+ documentation:
+ 'A raw piece of text which you can edit into anything you want' translatedNoop
- formalName: 'Text'
- categoryList: #('Basic' 'Text')
- documentation: 'A raw piece of text which you can edit into anything you want'
globalReceiverSymbol: #TextMorph
+ nativitySelector: #nonwrappingPrototype.
- nativitySelector: #boldAuthoringPrototype.
}
!
Item was changed:
----- Method: Thumbnail>>makeThumbnailFromForm: (in category 'thumnail creation') -----
makeThumbnailFromForm: aForm
"Make a thumbnail from the form provided, obeying my min and max width and height preferences"
+ | scaleX scaleY margin opaque nominalWidth minimumWidth |
+ minimumWidth := self minimumWidth.
+ scaleY _ minimumHeight / aForm height. "keep height invariant"
+
+ scaleX _ ((nominalWidth := aForm width * scaleY) <= maximumWidth)
+ ifTrue:
+ [(nominalWidth < minimumWidth)
+ ifFalse:
+ [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
+ ifTrue:
+ [minimumWidth / aForm width]]
+ ifFalse:
+ [scaleY _ maximumWidth / aForm width].
- | scaleX scaleY margin opaque |
- scaleY := minimumHeight / aForm height. "keep height invariant"
- scaleX := ((aForm width * scaleY) <= maximumWidth)
- ifTrue: [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
- ifFalse: [scaleY := maximumWidth / aForm width].
"self form: (aForm magnify: aForm boundingBox by: (scaleX @ scaleY) smoothing: 2)."
"Note: A problem with magnify:by: fails to reproduce borders properly.
The following code does a better job..."
+ margin _ 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
+ opaque _ (Form extent: aForm extent + margin depth: 32) "fillWhite".
+ aForm displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
+ self form: ((opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2) fixAlpha).
- margin := 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
- opaque := (Form extent: aForm extent + margin depth: 32) "fillWhite".
- aForm fixAlpha displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
- opaque fixAlpha.
- self form: (opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2).
self extent: originalForm extent!
Item was changed:
----- Method: Thumbnail>>setStandardDefaultMetrics (in category 'initialization') -----
setStandardDefaultMetrics
"Provide the current choices for min.max width/height for thumbnails"
+ self maxWidth: 60 minHeight: 32.
+ self setProperty: #minimumWidth toValue: 16!
- self maxWidth: 60 minHeight: 24!
Item was changed:
----- Method: ThumbnailMorph>>step (in category 'stepping and presenter') -----
step
"Optimization: Don't redraw if we're viewing some kind of SketchMorph and its rotated Form hasn't changed."
| viewee f |
+ viewee _ self actualViewee.
+ viewee ifNil: [self stopStepping. ^ self].
+ viewee isSketchMorph
+ ifTrue:
+ [f := viewee rotatedForm.
+ f == lastSketchForm ifTrue: [^ self]. "The optimization"
+ lastSketchForm _ f]
+ ifFalse:
+ [lastSketchForm := nil]. "Avoids subtle bug if sketchMorph removed and then put back in"
+ self changed
- viewee := self actualViewee.
- viewee ifNil: [ self stopStepping. ^self ].
- (viewee isSketchMorph) ifTrue: [
- f := viewee rotatedForm.
- f == lastSketchForm ifTrue: [^ self].
- lastSketchForm := f].
- self changed.
!
Item was changed:
----- Method: TickIndicatorMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ self extent: 30 @ 30.
+ index _ 0!
- self extent: 20 @ 20.
- index := 0!
Item was changed:
----- Method: TransitionMorph class>>allEffects (in category 'available effects') -----
allEffects
+ #('none' 'slide over' 'slide both' 'slide away' 'slide border'
+ 'page forward' 'page back'
+ 'french door' 'zoom frame' 'zoom' 'dissolve') translatedNoop.
^ #(none
slideOver slideBoth slideAway slideBorder
pageForward pageBack
frenchDoor
zoomFrame zoom
dissolve)!
Item was changed:
----- Method: TransitionMorph class>>directionsForEffect: (in category 'available effects') -----
directionsForEffect: eff
"All these arrays are ordered so inverse is atWrap: size//2."
+ #('right' 'down right' 'down' 'down left' 'left' 'up left' 'up' 'up right'
+ 'in' 'in h' 'out' 'out h') translatedNoop.
+
(#(slideOver slideBoth slideAway slideBorder) includes: eff)
ifTrue: [^ #(right downRight down downLeft left upLeft up upRight)].
(#(pageForward pageBack) includes: eff)
ifTrue: [^ #(right down left up)].
(#(frenchDoor) includes: eff)
ifTrue: [^ #(in inH out outH)].
(#(zoomFrame zoom) includes: eff)
ifTrue: [^ #(in out)].
^ Array new!
Item was changed:
----- Method: TrashCanMorph class>>descriptionForPartsBin (in category 'miscellaneous') -----
descriptionForPartsBin
+ ^ self partName: 'Trash' translatedNoop
+ categories: { 'Basic' translatedNoop}
+ documentation: 'a tool for discarding objects' translatedNoop
+ sampleImageForm: (Form extent: 42@54 depth: 8 fromArray: #( 0 0 0 2555943 992034 555814414 587202599 654311424 0 0 0 0 0 654320418 550751400 2829625512 2829625512 2829625357 556007424 0 0 0 0 36 3553874600 2829155709 2105376125 2711726248 2829625512 2728926240 587212583 0 0 0 639882194 3433594237 1400339837 2107746472 2812848296 2829634764 2829623677 2820612864 640090112 0 0 3553809064 2097828727 2108216018 3537030348 3436367016 2829625548 3537021096 2105452577 603989760 0 9427 3537019218 22259922 4141011666 3536637138 4160212129 2712183208 2832398034 2709355944 539103014 0 2413266 3531411713 2110979575 3537031884 3435975671 4157384573 2812846461 2108216055 3430776189 488645135 654311424 651416310 2823946621 4160606930 3537030348 3539466451 2829559720 2829625506 2105398007 3534257533 2718769186 0 601019090 2097238994 4258452178 3537031891 4160213671 2812782760 2829559976 2105387218 4154948989 2099055886 254214144 4174566098 1392595922 4258452178 3537041442 3551045799 2829625512 2829625505 2105396471 3534257533 2098863648 606470144 4275229394 2097238696 4260811474 3536977959 3550980264 2829625512 2829558141 2108225271 2826796413 1998134560 589758464 584241874 3427991891 3438727890 3537031970 3433614504 2829625512 2829164961 3436377804 2709355901 1394154783 589692928 617861842 3534246674 1403572946 3537031890 3536627880 2829625512 2812848338 4157778045 2105376083 1394154527 587202560 265540306 3537030269 1397980584 2831994060 3435964584 2829625512 2831995602 3433594237 2105365330 1394154783 589758464 13871314 3537041106 2826796413 2105385640 2829559976 2829625548 3436367016 2709355901 1397902346 1394220320 606535680 639674536 2831995602 3537030312 2829625256 2829625512 2829634728 2829625469 2105365331 1280463699 186260768 606535680 1037224 2829625512 3436368594 3537030348 3433605288 2829625512 2709355895 1397967954 1376389715 404364814 254214144 9164 2829625512 2829166760 2829625512 2829625505 2709355901 1397951058 1280463370 173167480 421203235 637534208 35 2829625511 2711715197 2105376125 2105376119 1397969747 1397903954 168430156 1397954174 421339392 654311424 0 4174162088 2728492413 2105376125 2105374547 1397969747 1397969490 1280070483 2105350169 438182694 0 0 267898023 2829155709 2105376125 2104981331 1397969747 1397902346 1397979005 2105376282 455025703 0 0 16241320 2832387239 2105376125 2004318035 1397969747 1397980541 2104982910 2105350427 471928576 0 0 653775528 2832388812 2712119464 2829221245 2728960381 2105387170 2104982910 2105350683 488701990 0 0 16700071 2832388818 2829625548 3433603489 2829625469 2105387170 2104982909 2105350683 504233984 0 0 2413224 2815218380 2829559976 3433594237 2829625469 2105387176 2104982910 2105416476 220266496 0 0 2413516 2815218386 2812782760 2829614461 2829625469 2105387176 2104982909 2105416476 220341760 0 0 2413516 2815218386 2829166796 2829623677 2829625469 2105387176 2104982909 2105416733 522397440 0 0 54226 2829636306 2810030284 3433605245 2829625469 2105385640 2104982910 2105416733 522397440 0 0 2619346 2829636306 2829166760 2829625469 2829625505 2105385634 2104982945 2097945629 522462976 0 0 65234 2812859090 2829166760 3433604989 2829625469 2105387176 2104982945 2097945629 539240192 0 0 8914 2829636306 2829166760 3433605245 2829625505 2105387176 2104982945 2098797853 537863936 0 0 9427 2829634770 3433539752 3433604989 2829625505 2105387176 2104982946 2098797597 554641152 0 0 211 3433549010 3433146536 3433605245 2728962209 2105387176 2104983208 2098863389 553658112 0 0 9975 3433539794 3433144744 2829625213 2728962209 2105387176 2104983208 2098863134 234881024 0 0 10238 3433539794 3534201256 3435964321 2712184993 2105387176 2104983202 2115640350 234891008 0 0 35 3534203090 3534266792 3435964577 2108205217 2105387176 2104982946 2115705886 234881024 0 0 36 3550980306 3534268328 2831984801 2108205223 2105385640 2104982946 2115706142 570425344 0 0 0 3551045836 3534266792 2831984801 2108205224 2105385640 2105376161 2115705869 572915712 0 0 38 4155025356 3534266792 2831984801 2108205224 2105385640 2105376161 2115706125 572915712 0 0 39 4174162088 3536626088 2831984801 2108205224 2105385640 2105376126 2115771661 589758464 0 0 0 583837608 3536626087 2831984801 2108205224 2105387176 2105376161 2115771679 589692928 0 0 0 601006503 3537020839 2831984807 2108205224 2102623656 2105385342 2719751456 254214144 0 0 0 617850792 3537020833 2831984808 2108214440 2097238952 2105387170 438111502 0 0 0 0 668191948 3537021095 2829634727 2108205224 2097238952 2726142590 471736591 654311424 0 0 0 2282194 3537020833 2829634728 2711726248 2097238690 2826796314 220275750 0 0 0 0 63442 3537021095 2832387240 2107746472 2709355937 2105350686 539168550 640090112 0 0 0 211 3537030312 3536627879 2712194216 2815677352 2820414989 555885347 588195584 0 0 0 39 584307410 3433605288 2812848295 2714576126 3542093084 504176397 521015079 0 0 0 0 8992 3553414312 2829625512 2820673060 3553470632 2829589020 488579879 0 0 0 0 39 991758 235807524 2564819 3433605288 2829614621 220270375 0 0 0 0 0 0 0 2140364 3536627880 2709356064 571418112 0 0 0 0 0 0 0 581478568 3433605246 2719813120 640090112 0 0 0 0 0 0 0 13880488 2829589793 603989798 0 0 0 0 0 0 0 0 991758 570435111 654311424 0 0) offset: 0@0)!
- ^ self partName: 'Trash'
- categories: #('Useful' 'Basic')
- documentation: 'a tool for discarding objects'!
Item was changed:
----- Method: TrashCanMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'viewerFlapTab' translatedNoop!
- ^ 'viewerFlapTab'!
Item was changed:
----- Method: ViewerFlapTab>>initializeFor:topAt: (in category 'transition') -----
initializeFor: aPlayer topAt: aTop
+ "The assumption is that this is only called at the same time of creation of this instance."
+ beingOpened _ true.
+ scriptedPlayer _ aPlayer.
- scriptedPlayer := aPlayer.
self useGraphicalTab.
self top: aTop!
Item was changed:
----- Method: WaveEditor class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'WaveEditor' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A workbench for seing and editing wave forms' translatedNoop!
- ^ self partName: 'WaveEditor'
- categories: #('Multimedia')
- documentation: 'A workbench for seing and editing wave forms'!
Item was changed:
----- Method: WaveEditor>>addControls (in category 'initialization') -----
addControls
+ | slider aWrapper m aButton |
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: Color transparent;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ extent: 5 @ 5.
+ aWrapper wrapCentering: #topLeft.
+ aButton := self buttonName: 'X' action: #delete.
+ aButton setBalloonText: 'Close WaveEditor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Menu' translated action: #invokeMenu.
+ aButton setBalloonText: 'Open a menu' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play' translated action: #play.
+ aButton setBalloonText: 'Play sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor.
+ aButton setBalloonText: 'Play before cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play After' translated action: #playAfterCursor.
+ aButton setBalloonText: 'Play after cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Loop' translated action: #playLoop.
+ aButton setBalloonText: 'Play the loop' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Test' translated action: #playTestNote.
+ aButton setBalloonText: 'Test the note' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Save' translated action: #saveInstrument.
+ aButton setBalloonText: 'Save the sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd.
+ aButton setBalloonText: 'Set loop end at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle.
+ aButton setBalloonText: 'Set one cycle' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart.
+ aButton setBalloonText: 'Set the loop start at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ self addMorphBack: aWrapper.
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: self color;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #spaceFill;
+ vResizing: #rigid;
+ extent: 5 @ 20;
+ wrapCentering: #center;
+ cellPositioning: #leftCenter.
+ m := StringMorph new contents: 'Index: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #cursor;
+ putSelector: #cursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 71;
+ step.
+ aWrapper addMorphBack: m.
+ m := StringMorph new contents: 'Value: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #valueAtCursor;
+ putSelector: #valueAtCursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 50;
+ step.
+ aWrapper addMorphBack: m.
+ slider := SimpleSliderMorph new color: color;
+ extent: 200 @ 10;
+ target: self;
+ actionSelector: #scrollTime:.
+ aWrapper addMorphBack: slider.
+ m := Morph new color: aWrapper color;
+ extent: 10 @ 5.
+ "spacer"
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #startIndex;
+ putSelector: #startIndex:;
+ font: Preferences standardEToysButtonFont;
+ width: 40;
+ step.
+ aWrapper addMorphBack: m.
+ self addMorphBack: aWrapper!
- | slider bb r m |
- r := AlignmentMorph newRow.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r color: bb color; borderWidth: 0; layoutInset: 0.
- r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
- r wrapCentering: #topLeft.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'X'; actionSelector: #delete).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: '<>'; actWhen: #buttonDown;
- actionSelector: #invokeMenu).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play' translated; actionSelector: #play).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Before' translated; actionSelector: #playBeforeCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play After' translated; actionSelector: #playAfterCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Loop' translated; actionSelector: #playLoop).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Test' translated; actionSelector: #playTestNote).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Save' translated; actionSelector: #saveInstrument).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop End' translated; actionSelector: #setLoopEnd).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'One Cycle' translated; actionSelector: #setOneCycle).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop Start' translated; actionSelector: #setLoopStart).
- self addMorphBack: r.
-
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
-
- m := StringMorph new contents: 'Index: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #cursor; putSelector: #cursor:;
- growable: false; width: 71; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Value: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:;
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- slider := SimpleSliderMorph new
- color: color;
- extent: 200@2;
- target: self;
- actionSelector: #scrollTime:.
- r addMorphBack: slider.
-
- m := Morph new color: r color; extent: 10@5. "spacer"
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #startIndex; putSelector: #startIndex:;
- width: 40; step.
- r addMorphBack: m.
-
- self addMorphBack: r.
-
- !
Item was changed:
----- Method: WaveEditor>>addLoopPointControls (in category 'initialization') -----
addLoopPointControls
+ | m aWrapper |
+ aWrapper _ AlignmentMorph newRow.
+ aWrapper color: self color; borderWidth: 0; layoutInset: 0.
+ aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
- | r m |
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
+ m _ StringMorph new contents: 'Loop end: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- m := StringMorph new contents: 'Loop end: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopEnd; putSelector: #loopEnd:;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop length: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopLength; putSelector: #loopLength:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop cycles: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopCycles; putSelector: #loopCycles:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Frequency: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Frequency: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
- growable: false; width: 50; step.
- r addMorphBack: m.
+ self addMorphBack: aWrapper
- self addMorphBack: r.
!
Item was changed:
----- Method: WaveEditor>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ samplingRate _ SoundPlayer samplingRate.
+ loopEnd _ loopLength _ 0.
+ loopCycles _ 1.
+ perceivedFrequency _ 0.
- samplingRate := SoundPlayer samplingRate.
- loopEnd := loopLength := 0.
- loopCycles := 1.
- perceivedFrequency := 0.
"zero means unknown"
self extent: 5 @ 5;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ graph _ GraphMorph new extent: 450 @ 100.
- graph := GraphMorph new extent: 450 @ 100.
graph cursor: 0.
graph cursorColorAtZeroCrossings: Color blue.
self addControls.
self addLoopPointControls.
self addMorphBack: graph.
self
addMorphBack: (Morph
newBounds: (0 @ 0 extent: 0 @ 3)
color: Color transparent).
+ self addMorphBack: (keyboard _ PianoKeyboardMorph new).
+ "self sound: (SampledSound soundNamed: 'croak')."
- self addMorphBack: (keyboard := PianoKeyboardMorph new).
- self sound: (SampledSound soundNamed: 'croak').
!
Item was changed:
----- Method: Workspace class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#Workspace. #prototypicalToolWindow. 'Workspace' translatedNoop. 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.' translatedNoop} forFlapNamed: 'Tools'.]!
- ifPresent: [:cl | cl registerQuad: #(Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')
- forFlapNamed: 'Tools'.]!
1
0
Tim Felgentreff uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-tfel.181.mcz
==================== Summary ====================
Name: MorphicExtras-tfel.181
Author: tfel
Time: 3 August 2016, 9:23:08.943422 am
UUID: 98c14035-b450-3c40-9a7a-8f1fe57d7620
Ancestors: MorphicExtras-tfel.180
additional merges from Squeakland Etoys
=============== Diff against MorphicExtras-tfel.178 ===============
Item was changed:
----- Method: AlignmentMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Extra items for parts bins"
^ {DescriptionForPartsBin
+ formalName: 'Column' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a column' translatedNoop
- formalName: 'Column'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a column'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #columnPrototype.
DescriptionForPartsBin
+ formalName: 'Row' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a row' translatedNoop
- formalName: 'Row'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a row'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #rowPrototype}!
Item was changed:
+ ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'olpc support') -----
+ fancyText: aString font: aFont color: aColor
+ "Answer a morph containing a TextMorph containing the given string in the given font with the given color."
+
+ | answer tm |
+ answer _ self inAColumn: {
+ tm _ TextMorph new
+ textColor: aColor;
+ contents: aString;
+ beAllFont: aFont;
+ yourself
+ }.
+
- ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'as yet unclassified') -----
- fancyText: aString font: aFont color: aColor
- | answer tm col |
- col := ColorTheme current dialog3DTitles
- ifTrue: [aColor]
- ifFalse: [aColor negated].
- tm := TextMorph new.
- tm beAllFont: aFont;
- color: col;
- contents: aString.
- answer := self inAColumn: {tm}.
- ColorTheme current dialog3DTitles
- ifTrue: [""
- tm addDropShadow.
- tm shadowPoint: 5 @ 5 + tm bounds center].
tm lock.
+ ^ answer
+ !
- ^ answer!
Item was changed:
----- Method: AlignmentMorphBob1>>inARow: (in category 'as yet unclassified') -----
inARow: aCollectionOfMorphs
| row |
row := AlignmentMorph newRow color: Color transparent;
vResizing: #shrinkWrap;
layoutInset: 2;
wrapCentering: #center;
cellPositioning: #leftCenter.
aCollectionOfMorphs
+ do: [:each | each ifNotNil: [row addMorphBack: each]].
- do: [:each | row addMorphBack: each].
^ row!
Item was changed:
----- Method: BOBTransformationMorph>>recomputeExtent (in category 'as yet unclassified') -----
recomputeExtent
| scalePt newScale theGreenThingie greenIBE myNewExtent |
submorphs isEmpty ifTrue: [^self extent].
+ worldBoundsToShow ifNil: [worldBoundsToShow _ self firstSubmorph bounds].
- worldBoundsToShow ifNil: [worldBoundsToShow := self firstSubmorph bounds].
worldBoundsToShow area = 0 ifTrue: [^self extent].
+ scalePt _ owner innerBounds extent / worldBoundsToShow extent.
+ newScale _ scalePt x min: scalePt y.
+ theGreenThingie _ owner.
+ greenIBE _ theGreenThingie innerBounds extent.
+ myNewExtent _ (greenIBE min: worldBoundsToShow extent * newScale) truncated.
- scalePt := owner innerBounds extent / worldBoundsToShow extent.
- newScale := scalePt x min: scalePt y.
- theGreenThingie := owner.
- greenIBE := theGreenThingie innerBounds extent.
- myNewExtent := (greenIBE min: worldBoundsToShow extent * newScale) truncated.
self
scale: newScale;
offset: worldBoundsToShow origin * newScale.
+ smoothing _ (newScale < 1.0) ifTrue: [1] ifFalse: [1].
- smoothing := (newScale < 1.0) ifTrue: [2] ifFalse: [1].
^myNewExtent!
Item was changed:
----- Method: BasicButton class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'button' translatedNoop!
- ^ 'button'!
Item was changed:
+ ----- Method: BasicButton>>label:font: (in category 'initialization') -----
- ----- Method: BasicButton>>label:font: (in category 'as yet unclassified') -----
label: aString font: aFontOrNil
+ "Set the receiver's label and font as indicated."
| oldLabel m aFont |
+ (oldLabel _ self findA: StringMorph)
- (oldLabel := self findA: StringMorph)
ifNotNil: [oldLabel delete].
+ aFont _ aFontOrNil ifNil: [Preferences standardEToysButtonFont].
+ m _ StringMorph contents: aString font: aFont.
- aFont := aFontOrNil ifNil: [Preferences standardButtonFont].
- m := StringMorph contents: aString font: aFont.
self extent: (m width + 6) @ (m height + 6).
m position: self center - (m extent // 2).
self addMorph: m.
m lock
!
Item was changed:
----- Method: BookMorph class>>alreadyInFromUrl: (in category 'url') -----
alreadyInFromUrl: aUrl
"Does a bookMorph living in some world in this image represent the same set of server pages? If so, don't create another one. It will steal pages from the existing one. Go delete the first one."
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world ifNotNil: [
+ self inform: 'This book is already open in some project' translated.
- self inform: 'This book is already open in some project'.
^ true]]]].
^ false!
Item was changed:
----- Method: BookMorph class>>authoringPrototype (in category 'scripting') -----
authoringPrototype
"Answer an instance of the receiver suitable for placing in a parts bin for authors"
| book |
+ book := self new initializeToStandAlone.
+ book markAsPartsDonor.
- book := self new markAsPartsDonor.
- book removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
- book borderWidth: 1; borderColor: Color black.
- book beSticky.
- book showPageControls; insertPage.
^ book!
Item was changed:
----- Method: BookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Book' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'Multi-page structures' translatedNoop
+ sampleImageForm: (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAAMgAAACgCAYAAABJ/yOpAAAABHNCSVQFBQUBSsjp7wAABMtJ
+ REFUeF7l3S2S4kAAgFEkEonkCEiOgEQikUgkEolEcgSOgEQiOcYcAZfdniqmpnaBkE43JHni
+ 7dZuzWR7m3z5ISHT6/X6hc/ne+TvL9fr1efz/cMPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5OhLI
+ 19eXz9dZfiA+nx+Iz+cH4vN1K5Dz+fxUEyaoCWP0xwAF8ntSy94l+NQL0IQx+mMAA3llop+9
+ AO+K49Nj9MeABfLqVujVrVTOvcYnx+iPAQwkxWTn3kI1YYz+GMBAckx4kw4lUo3RH4MfiB9I
+ hTHU/ZSbH0gLAsk54akmvuoYY+5LKxvjvTGkDCR2DKnnoq2RZAkkNo4cK2DKOGJv3Hw0xkdj
+ SB1IzBhyzEedSC6XS7Hf74vFYlGMx+Nit9uVfs9yufz++jrLaFwg75r0KmMsW/nkQKrMSexr
+ dTgc/vs/rlar0u/r9/vfkdRZRiMDecekvzrGV1Y+PZBX5yX2tTqdTsVmsymOx+PPir5er0uj
+ CoGE74ldRpZA6px7xK6Mud7OrLtSPhvjszHkCKTqGHLMQYpzkdvKXbb1D3uO0WhUaxmNDyTX
+ pKdeMXIFkvoQNXcgMfMQG0jZ1n84HP4cXsUuoxWB5Jj0sjGm3GprgZSN+x17kHA4Fb4mfG3n
+ 9yA5Jj3H4Y1/iBU3hhx7kHCuMRgMau+F/ED8QFobyLOt/2QyKebzee3zGP8Qyz/Eau0h1qOt
+ f7jWEd69Ctc7iD2If5Lun6RX2fqHi3/PDq86tQfx3+b13+atuvUPh1az2SzJO2H+hUL/QmEr
+ LhTermuELX5Y+cO/F84zwp/D34d3rX5fPd9ut7WW4d9q0pJbTVLOX5tvNbmdeIf7p+79frta
+ ftszhPOQ2GX4Nyu26GbFNgTSpDt6w02I0+nUv93dv93dv9390Qn6o4uD/gem/A9M+R+Y8j9R
+ 6H/k1v/Irf/QBv+hDf5DG/zH/viP/fHH4AfiPzjOH4MfiP/oUf/Ro/6jR/2HV/sPr/YfXu3/
+ +AOfzw/E5/MD8fn8QHy+pgfi8/k/BtqfDJ/PD8Tn8wPx+fxAfD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fzw/E5/MD8fn8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8QPx+fxAfD4/EJ/PD8Tn8wPx+fxAfL47ro3i
+ B+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8wPx+fxAfD4/EJ/PD8QPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5/EB8Pj8Qn88PxOfz
+ A/H5fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiB+Iz+cH4vP5gfg+o6P8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHw+PxCfz+cH4vP5gfh8fiA+nx+Iz+cH
+ 4vP5gfh8fiA+nx+Iz+cH4vP5gfiB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+
+ ID6fzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHy+jgXi8/nu+wM79mpMjbRBXAAAAABJRU5E
+ rkJggg==' readStream) readStream) nextImage!
- ^ self partName: 'Book'
- categories: #('Presentation')
- documentation: 'Multi-page structures'!
Item was changed:
----- Method: BookMorph class>>initialize (in category 'class initialization') -----
initialize
- FileList registerFileReader: self.
-
self registerInFlapsRegistry. !
Item was changed:
----- Method: BookMorph class>>isInWorld:withUrl: (in category 'url') -----
isInWorld: aWorld withUrl: aUrl
| urls bks short |
"If a book with this url is in the that (current) world, return it. Say if it is out or in another world."
+ urls _ OrderedCollection new.
+ bks _ OrderedCollection new.
- urls := OrderedCollection new.
- bks := OrderedCollection new.
aWorld allMorphsDo: [:aBook | (aBook isKindOf: BookMorph) ifTrue: [
bks add: aBook.
(urls add: (aBook valueOfProperty: #url)) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]]]]. "shortcut"
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]
ifFalse: [
+ self inform: 'Book may be open in some other project' translated.
- self inform: 'Book may be open in some other project'.
^ aBook]]]].
"if same book name, use it"
+ short _ (aUrl findTokens: '/') last.
- short := (aUrl findTokens: '/') last.
urls withIndexDo: [:kk :ind | (kk findTokens: '/') last = short ifTrue: [
^ bks at: ind]].
^ #out!
Item was changed:
----- Method: BookMorph class>>nextPageButton (in category 'scripting') -----
nextPageButton
+ "Answer a button that will take the user to the next page of its
+ enclosing book"
- "Answer a button that will take the user to the next page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #NextPage.
+ aButton target: aButton.
+ aButton actionSelector: #nextOwnerPage.
+ aButton arguments: #().
+ aButton setNameTo: 'previous'.
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #nextOwnerPage; label: '->'; color: Color yellow.
- aButton setNameTo: 'next'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>openFromFile: (in category 'fileIn/Out') -----
openFromFile: fullName
"Reconstitute a Morph from the selected file, presumed to be represent
a Morph saved via the SmartRefStream mechanism, and open it in an
appropriate Morphic world"
| book aFileStream |
Smalltalk verifyMorphicAvailability ifFalse: [^ self].
+ aFileStream _ FileStream readOnlyFileNamed: fullName.
+ book _ BookMorph new.
- aFileStream := FileStream oldFileNamed: fullName.
- book := BookMorph new.
book setProperty: #url toValue: aFileStream url.
book fromRemoteStream: aFileStream.
aFileStream close.
Smalltalk isMorphic
ifTrue: [ActiveWorld addMorphsAndModel: book]
ifFalse:
[book isMorph ifFalse: [^self inform: 'Can only load a single morph
+ into an mvc project via this mechanism.' translated].
- into an mvc project via this mechanism.'].
book openInWorld].
book goToPage: 1!
Item was changed:
----- Method: BookMorph class>>previousPageButton (in category 'scripting') -----
previousPageButton
+ "Answer a button that will take the user to the previous page of its
+ enclosing book"
- "Answer a button that will take the user to the previous page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #PrevPage.
+ aButton target: aButton.
+ aButton actionSelector: #previousOwnerPage.
+ aButton arguments: #().
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #previousOwnerPage; color: Color yellow; label: '<-'.
aButton setNameTo: 'previous'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BookMorph . #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'Supplies']!
Item was changed:
----- Method: BookMorph class>>serviceLoadAsBook (in category 'fileIn/Out') -----
serviceLoadAsBook
^ SimpleServiceEntry
provider: self
+ label: 'load as book' translatedNoop
- label: 'load as book'
selector: #openFromFile:
+ description: 'open as bookmorph' translatedNoop!
- description: 'open as bookmorph'!
Item was changed:
----- Method: BookMorph>>goToPageMorph:transitionSpec: (in category 'navigation') -----
goToPageMorph: newPage transitionSpec: transitionSpec
+ "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided."
+
| pageIndex aWorld oldPageIndex ascending tSpec readIn |
pages isEmpty ifTrue: [^self].
self setProperty: #searchContainer toValue: nil. "forget previous search"
self setProperty: #searchOffset toValue: nil.
self setProperty: #searchKey toValue: nil.
pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"].
readIn := newPage isInMemory not.
oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil].
ascending := (oldPageIndex isNil or: [newPage == currentPage])
ifTrue: [nil]
ifFalse: [oldPageIndex < pageIndex].
tSpec := transitionSpec ifNil:
["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec
ifAbsent:
[" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]].
self flag: #arNote. "Probably unnecessary"
(aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus].
currentPage ifNotNil: [currentPage updateCachedThumbnail].
self currentPage notNil
ifTrue:
[(((pages at: pageIndex) owner isKindOf: TransitionMorph)
and: [(pages at: pageIndex) isInWorld])
ifTrue: [^self "In the process of a prior pageTurn"].
self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts].
+ self removeViewersOnSubsIn: ActiveWorld presenter.
ascending ifNotNil:
["Show appropriate page transition and start new page when done"
currentPage stopStepping.
(pages at: pageIndex) position: currentPage position.
^(TransitionMorph
effect: tSpec second
direction: tSpec third
inverse: (ascending or: [transitionSpec notNil]) not)
showTransitionFrom: currentPage
to: (pages at: pageIndex)
in: self
whenStart: [self playPageFlipSound: tSpec first]
whenDone:
[currentPage
delete;
fullReleaseCachedState.
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrlInBook: self url.
currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page"
currentPage
delete;
fullReleaseCachedState].
+ self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage"
- self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
-
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrl.
+ currentPage sqkPage computeThumbnail "just store it"].
+ ActiveWorld ifNotNil: [ActiveWorld presenter flushPlayerListCache]!
- currentPage sqkPage computeThumbnail "just store it"]!
Item was changed:
----- Method: BookMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
+ super initializeToStandAlone.
+ self removeEverything; pageSize: 360@228; color: Color white.
- self initialize.
- self removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
self borderWidth: 1; borderColor: Color black.
self beSticky.
self showPageControls; insertPage.
^ self!
Item was changed:
----- Method: BookMorph>>pasteBookPage (in category 'menu') -----
pasteBookPage
+ "If the paste buffer has something to paste, paste it as a book page."
+
| aPage |
+ aPage _ self primaryHand objectToPaste.
+ aPage removeProperty: #revertKey.
- aPage := self primaryHand objectToPaste.
self insertPage: aPage pageSize: aPage extent atIndex: ((pages indexOf: currentPage) - 1).
"self goToPageMorph: aPage"!
Item was changed:
----- Method: BookMorph>>setNewPagePrototype (in category 'menu') -----
setNewPagePrototype
"Record the current page as the prototype to be copied when inserting new pages."
currentPage ifNotNil:
+ [newPagePrototype _ currentPage veryDeepCopy.
+ newPagePrototype removeProperty: #revertKey].
+ "When a new page is inserted, it will not have any original page to revert to. After author improves the new page, he can save it for later revert."
- [newPagePrototype := currentPage veryDeepCopy].
!
Item was changed:
+ ----- Method: BookPageSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: BookPageSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
+ | bb r str aCheckbox aWrapper |
+ r _ AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
+ r wrapCentering: #center; cellPositioning: #leftCenter;
- | bb r aButton str |
- r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
- r wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated.
+ r addTransparentSpacerOfSize: 12.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete)).
+ bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated; actionSelector: #acceptSort)).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated; actionSelector: #delete)).
+ "eliminate the parts-bin button on the book-page sorters...
+ r addTransparentSpacerOfSize: 24 @ 0.
+
+ aCheckbox := UpdatingThreePhaseButtonMorph checkBox.
+ aCheckbox
- r addTransparentSpacerOfSize: 8 @ 0.
- r addMorphBack: (self wrapperFor: (aButton := UpdatingThreePhaseButtonMorph checkBox)).
- aButton
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ str _ StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons.
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
+ addMorphBack: (self wrapperFor: aCheckbox);
+ addMorphBack: (self wrapperFor: str lock).
+ r addMorphBack: aWrapper."
- str := StringMorph contents: 'Parts bin' translated.
- r addMorphBack: (self wrapperFor: str lock).
+ self addMorphFront: r
- self addMorphFront: r.
!
Item was changed:
----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'as yet unclassified') -----
book: aBookMorph morphsToSort: morphList
+ | innerBounds scrollPane newHeight |
+ book _ aBookMorph.
+ newHeight _ self currentWorld height.
- | innerBounds |
- book := aBookMorph.
pageHolder removeAllMorphs.
pageHolder addAllMorphs: morphList.
pageHolder extent: pageHolder width@pageHolder fullBounds height.
+ innerBounds _ Rectangle merging: (morphList collect: [:m | m bounds]).
+ pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.
+ (pageHolder height > newHeight) ifTrue: [
+ scrollPane _ ScrollPane new.
+
+ self height: newHeight.
+ scrollPane model: pageHolder.
+ scrollPane extent: pageHolder width@(newHeight - aBookMorph submorphs first height - 28).
+ self addMorph: scrollPane inFrontOf: pageHolder.
+ scrollPane scroller addMorph: pageHolder.
+ scrollPane scrollBarOnLeft: false.
+ scrollPane retractable: false.
+ scrollPane hideHScrollBarIndefinitely: true.
+ scrollPane borderWidth: 1; borderColor: Color gray.
+ ].
+ !
- innerBounds := Rectangle merging: (morphList collect: [:m | m bounds]).
- pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.!
Item was changed:
----- Method: BookPageSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: Display extent - 100;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ pageHolder _ PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
- pageHolder := PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
pageHolder hResizing: #shrinkWrap.
+ pageHolder wantsMouseOverHalos: false.
"pageHolder cursor: 0."
"causes a walkback as of 5/25/2000"
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: BookPageThumbnailMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
| f |
super initialize.
+ flipOnClick _ false.
- ""
- flipOnClick := false.
+ f _ Form extent: 160@120 depth: Display depth.
- f := Form extent: 60 @ 80 depth: Display depth.
f fill: f boundingBox fillColor: color.
self form: f!
Item was changed:
----- Method: BooklikeMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
"This factoring allows subclasses to have different menu yet still use the super call for the rest of the metamenu."
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ aCustomMenu add: 'book...' translated target: self action: #invokeBookMenu.
+
+ "self addBookMenuItemsTo: aCustomMenu hand: aHandMorph"!
- self addBookMenuItemsTo: aCustomMenu hand: aHandMorph!
Item was changed:
----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') -----
currentPlayerDo: aBlock
| aPlayer aPage |
(aPage := self currentPage) ifNil: [^ self].
+ aPage allMorphsDo:[ :m|
+ (aPlayer := m player) ifNotNil:
+ [aBlock value: aPlayer]]!
- (aPlayer := aPage player) ifNotNil:
- [aBlock value: aPlayer]!
Item was changed:
----- Method: BooklikeMorph>>makePageControlsFrom: (in category 'page controls') -----
makePageControlsFrom: controlSpecs
"From the controlSpecs, create a set of page control and return them -- this method does *not* add the controls to the receiver."
| c col row |
c := (color saturation > 0.1) ifTrue: [color slightlyLighter] ifFalse: [color slightlyDarker].
col := AlignmentMorph newColumn.
col color: c; borderWidth: 0; layoutInset: 0.
col hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5.
row := AlignmentMorph newRow.
row color: c; borderWidth: 0; layoutInset: 0.
row hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5.
controlSpecs do: [:spec | | lastGuy b |
+ spec == #showDescription ifTrue: [row addMorphBack: self makeDescriptionViewer].
+ spec == #pageNumber ifTrue: [row addMorphBack: self makePageNumberItem].
+ spec == #spacer ifTrue: [row addTransparentSpacerOfSize: (10 @ 0)].
+ spec == #variableSpacer ifTrue: [
+ row addMorphBack: AlignmentMorph newVariableTransparentSpacer].
+ spec class == Array ifTrue: [
+ spec first isSymbol
+ ifTrue: [b := ThreePhaseButtonMorph labelSymbol: spec first]
+ ifFalse: [b := SimpleButtonMorph new borderWidth: 2;
+ borderColor: Color black; color: Color veryLightGray.
+ b label: spec first font: Preferences standardMenuFont].
+ b target: self; actionSelector: spec second; setBalloonText: spec third.
+ (spec atPin: 4) = #border
+ ifTrue: [b actWhen: #buttonDown]
+ ifFalse: [b borderWidth: 0]. "default is none"
+ row addMorphBack: b.
+ (((lastGuy _ spec last asLowercase) includesSubString: 'menu') or:
+ [lastGuy includesSubString: 'designations'])
+ ifTrue: [b actWhen: #buttonDown]]]. "pop up menu on mouseDown"
- spec == #spacer
- ifTrue:
- [row addTransparentSpacerOfSize: (10 @ 0)]
- ifFalse:
- [spec == #variableSpacer
- ifTrue:
- [row addMorphBack: AlignmentMorph newVariableTransparentSpacer]
- ifFalse:
- [b := SimpleButtonMorph new target: self; borderWidth: 1;
- borderColor: Color veryLightGray; color: c.
- b label: spec first;
- actionSelector: spec second;
- borderWidth: 0;
- setBalloonText: spec third.
- row addMorphBack: b.
- (((lastGuy := spec last asLowercase) includesSubstring: 'menu') or:
- [lastGuy includesSubstring: 'designations'])
- ifTrue: [b actWhen: #buttonDown]]]]. "pop up menu on mouseDown"
col addMorphBack: row.
^ col!
Item was changed:
----- Method: BooklikeMorph>>shortControlSpecs (in category 'page controls') -----
shortControlSpecs
+ "Answer specs defining the widgets in the short form of the control panel."
+
^ {
#spacer.
#variableSpacer.
{'<'. #previousPage. 'Previous page' translated}.
#spacer.
+ {#MenuIcon. #invokeShortBookMenu. 'Click here to get a menu of options for this book.' translated}.
- {'·'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}.
#spacer.
{'>'. #nextPage. 'Next page' translated}.
#spacer.
#variableSpacer.
+ {#RightCaret. #showMoreControls. 'More controls' translated}
- {'³'. #showMoreControls. 'More controls' translated}
}
!
Item was changed:
----- Method: BooklikeMorph>>showingFullScreenString (in category 'misc') -----
showingFullScreenString
+ "Answer a string characterizing whether the receiver is operating in full-screen mode."
+
+ ^ (self isInFullScreenMode ifTrue: ['<yes>'] ifFalse: ['<no>']), 'view pages full-screen' translated!
- ^ (self isInFullScreenMode
- ifTrue: ['exit full screen']
- ifFalse: ['show full screen']) translated!
Item was changed:
----- Method: BooklikeMorph>>showingPageControlsString (in category 'misc') -----
showingPageControlsString
+ "Answer a string characterizing whether page controls are currently showing."
+
+ ^ (self pageControlsVisible ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'page controls visible' translated!
- ^ (self pageControlsVisible
- ifTrue: ['hide page controls']
- ifFalse: ['show page controls']) translated!
Item was changed:
----- Method: BouncingAtomsMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'BouncingAtoms' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney' translatedNoop!
- ^ self partName: 'BouncingAtoms'
- categories: #('Demo')
- documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney'!
Item was changed:
----- Method: BouncingAtomsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BouncingAtomsMorph, #new. 'Bouncing Atoms' translatedNoop. 'Atoms, mate' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BouncingAtomsMorph new 'Bouncing Atoms' 'Atoms, mate')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: ClockMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Answer a description for use in parts bins."
+
+ ^ self partName: 'Digital Clock' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A digital clock' translatedNoop!
- ^ self partName: 'Clock'
- categories: #('Useful')
- documentation: 'A digital clock'!
Item was changed:
----- Method: ClockMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ClockMorph, #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: ClockMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
+ "Add toggles for showing-seconds and display-24-hrs to the halo menu"
+
+ "NB: intentionallyi no super call here!!"
+
+ aCustomMenu add: 'change font' translated action: #changeFont.
+
+ aCustomMenu addUpdating: #showingSecondsString action: #toggleShowingSeconds.
+ aCustomMenu addUpdating: #displaying24HourString action: #toggleShowing24hr!
- "Note minor loose end here -- if the menu is persistent, then the wording will be wrong half the time"
- | item |
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- item := showSeconds == true
- ifTrue: ['stop showing seconds']
- ifFalse: ['start showing seconds'].
- aCustomMenu add: item translated target: self action: #toggleShowingSeconds.
- item := show24hr == true
- ifTrue: ['display Am/Pm']
- ifFalse: ['display 24 hour'].
- aCustomMenu add: item translated target: self action: #toggleShowing24hr.
-
- !
Item was changed:
----- Method: ClockMorph>>initialize (in category 'initialization') -----
initialize
+ "initialize the state of the receiver"
+
- "initialize the state of the receiver"
super initialize.
+
+ showSeconds _ true.
+ show24hr _ false.
+ self font: Preferences standardMenuFont emphasis: 1.
- ""
- showSeconds := true.
- show24hr := false.
self step!
Item was changed:
----- Method: ClockMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
super initializeToStandAlone.
+ showSeconds _ false.
+ self font: (Preferences standardMenuFont emphasized: 1).
- showSeconds := true.
self step!
Item was changed:
----- Method: CurveMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#CurveMorph, #authoringPrototype. 'Curve' translatedNoop, 'A curve' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#CurveMorph. #authoringPrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}
- cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: CurveMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Curvy Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.' translatedNoop
- formalName: 'Curvy Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.'
globalReceiverSymbol: #CurveMorph
nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: EllipseMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: EnvelopeEditorMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: menu hand: aHandMorph
super addCustomMenuItems: menu hand: aHandMorph.
menu addLine.
envelope updateSelector = #ratio: ifTrue:
[menu add: 'choose denominator...' translated action: #chooseDenominator:].
menu add: 'adjust scale...' translated action: #adjustScale:.
- SoundPlayer isReverbOn
- ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb]
- ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb].
menu addLine.
menu add: 'get sound from lib' translated action: #chooseSound:.
menu add: 'put sound in lib' translated action: #saveSound:.
menu add: 'read sound from disk...' translated action: #readFromDisk:.
menu add: 'save sound on disk...' translated action: #saveToDisk:.
menu add: 'save library on disk...' translated action: #saveLibToDisk:.
!
Item was changed:
----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'editing') -----
buildScalesIn: frame
+ | env |
+ env _ envelope.
+ pixPerTick _ graphArea width // (self maxTime//10) max: 1.
+ "hminortick _ ( 1 + ( self maxTime // 800 ) ) * 10.
+ hmajortick _ ( 1 + ( self maxTime // 800 ) ) * 100."
+ hScale _ (Morph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) color: Color lightGreen.
+ " hScale _ (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
- | env hmajortick hminortick |
- env := envelope.
- pixPerTick := graphArea width // (self maxTime//10) max: 1.
- hminortick := ( 1 + ( self maxTime // 800 ) ) * 10.
- hmajortick := ( 1 + ( self maxTime // 800 ) ) * 100.
- hScale := (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
start: 0 stop: self maxTime
minorTick: hminortick minorTickLength: 3
majorTick: hmajortick majorTickLength: 10
caption: 'milliseconds' tickPrintBlock: [:v | v printString].
+ "
self addMorph: hScale.
+ vScale _ (Morph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))) color: Color lightGreen.
+ "vScale _ ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))."
- vScale := ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left)).
env name = 'pitch'
ifTrue:
[env scale >= 2.0
ifTrue:
[vScale start: 0 stop: env scale
minorTick: env scale / 24 minorTickLength: 3
majorTick: env scale / 2.0 majorTickLength: 10
caption: 'pitch (octaves)'
tickPrintBlock: [:v | (v-(env scale/2)) asInteger printString]]
ifFalse:
[vScale start: 0 stop: env scale
minorTick: 1.0/48.0 minorTickLength: 3
majorTick: 1.0/12.0 majorTickLength: 10
caption: 'pitch (half-steps)'
tickPrintBlock: [:v | (v-(env scale/2)*12) rounded printString]]]
ifFalse: [
env name = 'random pitch:'
ifTrue: [
vScale start: 0.9 stop: 1.1
minorTick: 0.2 / 50.0 minorTickLength: 3
majorTick: 0.2 / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]]
ifFalse: [
vScale start: 0 stop: env scale
minorTick: env scale / 50.0 minorTickLength: 3
majorTick: env scale / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]].
].
+ vScale _ TransformationMorph new asFlexOf: vScale.
- vScale := TransformationMorph new asFlexOf: vScale.
vScale angle: Float pi / 2.0.
self addMorph: vScale.
vScale position: (frame left)@(graphArea top-1) - (3@1).
!
Item was changed:
----- Method: EventRecorderMorph>>addButtons (in category 'initialization') -----
addButtons
+ | r b w |
- | r b |
caption ifNotNil: ["Special setup for play-only interface"
+ (r _ self makeARowForButtons)
- (r := self makeARowForButtons)
addMorphBack: (SimpleButtonMorph new target: self;
+ label: caption font: Preferences standardButtonFont; actionSelector: #play);
- label: caption; actionSelector: #play);
- addMorphBack: self makeASpacer;
- addMorphBack: self makeStatusLight;
addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
+ addMorphBack: self makeASpacer.
^ self addMorphBack: r
].
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#record. nil. 'Begin recording'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#record. nil. 'Begin recording'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#stop. b width. 'Stop recording - you can also use the ESC key to stop it'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#play. b width. 'Play current recording'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#readTape. b width. 'Get a new recording from disk'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
+ addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
addMorphBack: self makeASpacer;
+ addMorphBack: (self buttonFor: {#createPlayButton. b width. 'Make a simple button to play this recording'}).
- addMorphBack: self makeStatusLight;
- addMorphBack: self makeASpacer;
- addMorphBack: (self buttonFor: {#button. b width. 'Make a simple button to play this recording'}).
self addMorph: r.
self setStatusLight: #ready.!
Item was changed:
----- Method: EventRecorderMorph>>handleListenEvent: (in category 'events-processing') -----
handleListenEvent: anEvent
"Record the given event"
+ anEvent hand == recHand ifFalse: [^ self]. "not for me"
+ state == #record ifFalse: [
+ "If user got an error while recording and deleted recorder, will still be listening"
+ recHand ifNotNil: [recHand removeEventListener: self].
+ ^self].
- (state == #record and:[anEvent hand == recHand])
- ifFalse:[^self].
anEvent = lastEvent ifTrue: [^ self].
(anEvent isKeyboard and:[anEvent keyValue = 27 "esc"])
ifTrue: [^ self stop].
+ time _ anEvent timeStamp.
- time := anEvent timeStamp.
tapeStream nextPut: (anEvent copy setHand: nil).
journalFile ifNotNil:
[journalFile store: anEvent; cr; flush].
+ lastEvent _ anEvent.!
- lastEvent := anEvent.!
Item was changed:
----- Method: EventRecorderMorph>>pauseIn: (in category 'pause/resume') -----
pauseIn: aWorld
"Suspend playing or recording, either as part of a stop command,
or as part of a project switch, after which it will be resumed."
self setStatusLight: #ready.
state = #play ifTrue:
+ [state _ #suspendedPlay.
+ playHand halo ifNotNil: [playHand halo delete].
- [state := #suspendedPlay.
playHand delete.
aWorld removeHand: playHand.
+ playHand _ nil].
- playHand := nil].
state = #record ifTrue:
+ [state _ #suspendedRecord.
- [state := #suspendedRecord.
recHand removeEventListener: self.
+ recHand _ nil].
- recHand := nil].
voiceRecorder ifNotNil:
[voiceRecorder pause.
startSoundEvent ifNotNil:
[startSoundEvent argument: voiceRecorder recordedSound.
voiceRecorder clearRecordedSound.
+ startSoundEvent _ nil]].
- startSoundEvent := nil]].
!
Item was changed:
----- Method: EventRecorderMorph>>resumeIn: (in category 'pause/resume') -----
resumeIn: aWorld
"Resume playing or recording after a project switch."
+ self state = #suspendedPlay ifTrue:
- state = #suspendedPlay ifTrue:
[self resumePlayIn: aWorld].
+ self state = #suspendedRecord ifTrue:
- state = #suspendedRecord ifTrue:
[self resumeRecordIn: aWorld].
!
Item was changed:
----- Method: EventRecorderMorph>>resumePlayIn: (in category 'pause/resume') -----
resumePlayIn: aWorld
+ playHand _ HandMorphForReplay new recorder: self.
- playHand := HandMorphForReplay new recorder: self.
playHand position: tapeStream peek position.
aWorld addHand: playHand.
playHand newKeyboardFocus: aWorld.
playHand userInitials: 'play' andPicture: nil.
+ lastEvent _ nil.
+ lastDelta _ 0@0.
+ self findPlayOffset.
+ state _ #play.
- lastEvent := nil.
- lastDelta := 0@0.
- state := #play.
self synchronize.
!
Item was changed:
----- Method: EventRecorderMorph>>synchronize (in category 'event handling') -----
synchronize
+ time _ lastInterpolation _ Time millisecondClockValue.
+ deltaTime _ nil.!
- time := Time millisecondClockValue.
- deltaTime := nil.!
Item was changed:
----- Method: EventRecorderMorph>>writeTape: (in category 'fileIn/Out') -----
writeTape: fileName
+ | name bb |
+ name _ self writeFileNamed: fileName.
+ bb _ self findDeepSubmorphThat: [:mm | (mm isKindOf: SimpleButtonMorph)
+ and: [mm label = 'writeTape']]
+ ifAbsent: [^ self].
+ bb actionSelector: #writeTape:.
+ bb arguments: (Array with: name).
- | b name |
- name := self writeFileNamed: fileName.
- (b := self button: 'writeTape') ifNotNil: [
- b actionSelector: #writeTape:.
- b arguments: (Array with: name)].
!
Item was changed:
----- Method: FlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'flap tab' translatedNoop!
- ^ 'flap tab'!
Item was changed:
----- Method: FlapTab>>adaptToWorld (in category 'initialization') -----
adaptToWorld
| wasShowing new |
+ (wasShowing _ self flapShowing) ifTrue:
- (wasShowing := self flapShowing) ifTrue:
[self hideFlap].
(self respondsTo: #unhibernate) ifTrue: [
+ (new _ self unhibernate) == self ifFalse: [
- (new := self unhibernate) == self ifFalse: [
^ new adaptToWorld]].
- self spanWorld.
- self positionObject: self.
wasShowing ifTrue:
+ [self spanWorld.
+ self positionObject: self.
+ self showFlap]!
- [self showFlap]!
Item was changed:
----- Method: FlapTab>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aMenu hand: aHandMorph
"Add further items to the menu as appropriate"
aMenu add: 'tab color...' translated target: self action: #changeColor.
aMenu add: 'flap color...' translated target: self action: #changeFlapColor.
aMenu addLine.
aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo.
aMenu addLine.
aMenu addUpdating: #textualTabString action: #textualTab.
aMenu addUpdating: #graphicalTabString action: #graphicalTab.
aMenu addUpdating: #solidTabString enablement: #notSolid action: #solidTab.
aMenu addLine.
(referent isKindOf: PasteUpMorph) ifTrue:
[aMenu addUpdating: #partsBinString action: #togglePartsBinMode].
aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior.
aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior.
aMenu addLine.
aMenu addUpdating: #isGlobalFlapString enablement: #sharedFlapsAllowed action: #toggleIsGlobalFlap.
+ aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.' translated.
- aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.,' translated.
aMenu addLine.
+ aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap.
aMenu add: 'destroy this flap' translated action: #destroyFlap.
"aMenu addUpdating: #slideString action: #toggleSlideBehavior.
aMenu addUpdating: #inboardString action: #toggleInboardness.
aMenu addUpdating: #thicknessString ('thickness... (current: ', self thickness printString, ')') action: #setThickness."
!
Item was changed:
----- Method: FlapTab>>balloonTextForFlapsMenu (in category 'miscellaneous') -----
balloonTextForFlapsMenu
"Answer the balloon text to show on a menu item in the flaps menu that governs the visibility of the receiver in the current project"
| id |
+ id _ self flapID.
- id := self flapID.
#(
+ ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects' translatedNoop)
+ ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.' translatedNoop)
+ ('Widgets' 'A variety of controls and media tools' translatedNoop)
+ ('Supplies' 'Supplies' translatedNoop)
+ ('Help' 'A flap providing documentation, tutorials, and other help' translatedNoop)
+ ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented' translatedNoop)
+ ('Scripting' 'Tools useful when doing tile scripting' translatedNoop)
+ ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment' translatedNoop)
+ ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting' translatedNoop)) do:
- ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects')
- ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.')
- ('Widgets' 'A variety of controls and media tools')
- ('Supplies' 'A source for many basic types of objects')
- ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented')
- ('Scripting' 'Tools useful when doing tile scripting')
- ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment')
- ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting')) do:
[:pair | (FlapTab givenID: id matches: pair first translated) ifTrue: [^ pair second translated]].
^ self balloonText!
Item was changed:
----- Method: FlapTab>>computeEdgeFraction (in category 'edge') -----
computeEdgeFraction
"Compute and remember the edge fraction"
| aBox aFraction |
self isCurrentlySolid ifTrue: [^ edgeFraction ifNil: [self edgeFraction: 0.5]].
+ aBox := ((self pasteUpMorph ifNil: [self currentWorld]) bounds) insetBy: (self extent // 2).
- aBox := ((owner ifNil: [ActiveWorld]) bounds) insetBy: (self extent // 2).
aFraction := self
ifVertical:
[(self center y - aBox top) / (aBox height max: 1)]
ifHorizontal:
[(self center x - aBox left) / (aBox width max: 1)].
^ self edgeFraction: aFraction!
Item was changed:
----- Method: FlapTab>>destroyFlap (in category 'menu') -----
destroyFlap
"Destroy the receiver"
| reply request |
+ request _ self isGlobalFlap
- request := self isGlobalFlap
ifTrue:
['Caution -- this would permanently
remove this flap, so it would no longer be
available in this or any other project.
+ Do you really want to this? ' translated]
- Do you really want to this? ']
ifFalse:
['Caution -- this is permanent!! Do
+ you really want to do this? ' translated].
+ reply _ self confirm: request translated orCancel: [^ self].
- you really want to do this? '].
- reply := self confirm: request translated orCancel: [^ self].
reply ifTrue:
[self isGlobalFlap
ifTrue:
[Flaps removeFlapTab: self keepInList: false.
self currentWorld reformulateUpdatingMenus]
ifFalse:
[referent isInWorld ifTrue: [referent delete].
self delete]]!
Item was changed:
----- Method: FlapTab>>flapMenuTitle (in category 'menu') -----
flapMenuTitle
+ ^ 'flap: ' translated , self wording!
- ^ 'flap: ', self wording!
Item was changed:
----- Method: FlapTab>>graphicalTabString (in category 'graphical tabs') -----
graphicalTabString
^ (self isCurrentlyGraphical
+ ifTrue: ['choose new graphic...' translated]
+ ifFalse: ['use graphical tab' translated]) !
- ifTrue: ['choose new graphic...']
- ifFalse: ['use graphical tab']) translated!
Item was changed:
----- Method: FlapTab>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "Handle a mouse-move event. The event, a MorphicEvent, is passed in."
+
| aPosition newReferentThickness adjustedPosition thick |
dragged ifFalse: [(thick := self referentThickness) > 0
ifTrue: [lastReferentThickness := thick]].
((self containsPoint: (aPosition := evt cursorPoint)) and: [dragged not])
ifFalse:
[flapShowing ifFalse: [self showFlap].
adjustedPosition := aPosition - evt hand targetOffset.
(edgeToAdhereTo == #bottom)
ifTrue:
[newReferentThickness := inboard
ifTrue:
[self world height - adjustedPosition y]
ifFalse:
[self world height - adjustedPosition y - self height]].
(edgeToAdhereTo == #left)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition x + self width]
ifFalse:
[adjustedPosition x]].
(edgeToAdhereTo == #right)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[self world width - adjustedPosition x]
ifFalse:
[self world width - adjustedPosition x - self width]].
(edgeToAdhereTo == #top)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition y + self height]
ifFalse:
[adjustedPosition y]].
self isCurrentlySolid ifFalse:
[(#(left right) includes: edgeToAdhereTo)
ifFalse:
[self left: adjustedPosition x]
ifTrue:
[self top: adjustedPosition y]].
+ ((edgeToAdhereTo == #left) and: [(self valueOfProperty: #rigidThickness) notNil]) ifTrue:
+ [newReferentThickness := referent width].
+
self applyThickness: newReferentThickness.
dragged := true.
self fitOnScreen.
self computeEdgeFraction]!
Item was changed:
----- Method: FlapTab>>solidTabString (in category 'solid tabs') -----
solidTabString
^ (self isCurrentlySolid
+ ifTrue: ['currently using solid tab' translated]
+ ifFalse: ['use solid tab' translated]) !
- ifTrue: ['currently using solid tab']
- ifFalse: ['use solid tab']) translated!
Item was changed:
----- Method: FlapTab>>textualTabString (in category 'textual tabs') -----
textualTabString
^ (self isCurrentlyTextual
+ ifTrue: ['change tab wording...' translated]
+ ifFalse: ['use textual tab' translated]) !
- ifTrue: ['change tab wording...']
- ifFalse: ['use textual tab']) translated!
Item was changed:
----- Method: Flaps class>>addAndEnableEToyFlaps (in category 'predefined flaps') -----
addAndEnableEToyFlaps
"Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed."
| aSuppliesFlap |
SharedFlapTabs
ifNotNil: [^ self].
SharedFlapTabs := OrderedCollection new.
aSuppliesFlap := self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right.
aSuppliesFlap referent setNameTo: 'Supplies Flap' translated. "Per request from Kim Rose, 7/19/02"
SharedFlapTabs add: aSuppliesFlap. "The #center designation doesn't quite work at the moment"
+ (Preferences valueOfFlag: #sugarNavigator ifAbsent: [false])
+ ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap]
+ ifFalse: [Preferences showProjectNavigator
+ ifTrue:[ SharedFlapTabs add: self newNavigatorFlap]].
- Preferences showProjectNavigator
- ifTrue:[ SharedFlapTabs add: self newNavigatorFlap ].
self enableGlobalFlapWithID: 'Supplies' translated.
+ (Preferences valueOfFlag: #sugarNavigator ifAbsent: [false])
+ ifTrue:
+ [self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated.
+ "(self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNilDo:
+ [:navTab | aSuppliesFlap sugarNavTab: navTab]"]
+ ifFalse: [
+ Preferences showProjectNavigator
+ ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated]].
- Preferences showProjectNavigator
- ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated ].
SharedFlapsAllowed := true.
Project current flapsSuppressed: false.
^ SharedFlapTabs
"Flaps addAndEnableEToyFlaps"!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category 'flaps registry') -----
defaultsQuadsDefiningScriptingFlap
"Answer a structure defining the default items in the Scripting flap.
previously in quadsDeiningScriptingFlap"
+ ^ {
+ {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
+ {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}.
- ^ #(
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
- (ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#FunctionTile. #randomNumberTile. 'Random' translatedNoop. 'A tile that will produce a random number in a given range' translatedNoop}.
+ {#ScriptingSystem. #anyButtonPressedTiles. 'ButtonDown?' translatedNoop. 'Tiles for querying whether the mouse button is down' translatedNoop}.
+ {#ScriptingSystem. #noButtonPressedTiles. 'ButtonUp?' translatedNoop. 'Tiles for querying whether the mouse button is up' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (RandomNumberTile new 'Random' 'A tile that will produce a random number in a given range')
- (ScriptingSystem anyButtonPressedTiles 'ButtonDown?' 'Tiles for querying whether the mouse button is down')
- (ScriptingSystem noButtonPressedTiles 'ButtonUp?' 'Tiles for querying whether the mouse button is up')
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}.
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (TextFieldMorph exampleBackgroundField 'Scrolling Field' 'A scrolling data field which will have a different value on every card of the background')
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#TextMorph. #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}.
+ {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop}
+ } asOrderedCollection!
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (TextMorph exampleBackgroundLabel 'Background Label' 'A piece of text that will occur on every card of the background')
- (TextMorph exampleBackgroundField 'Background Field' 'A data field which will have a different value on every card of the background')
-
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningStackToolsFlap (in category 'flaps registry') -----
defaultsQuadsDefiningStackToolsFlap
"Answer a structure defining the items on the default system Stack Tools flap.
previously in quadsDefiningStackToolsFlap"
+ ^ {
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}.
+ {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}.
+ {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Scriptable Button' translatedNoop. 'A button whose script will be a method of the background Player' translatedNoop}.
+ {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}.
+ {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection
- ^ #(
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (StackMorph stackHelpWindow 'Stack Help' 'Some hints about how to use Stacks')
- (TextMorph authoringPrototype 'Simple Text' 'Text that you can edit into anything you wish')
- (TextMorph fancyPrototype 'Fancy Text' 'A text field with a rounded shadowed border, with a fancy font.')
- (ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
- (ScriptableButton authoringPrototype 'Scriptable Button' 'A button whose script will be a method of the background Player')
- (StackMorph previousCardButton 'Previous Card' 'A button that takes the user to the previous card in the stack')
- (StackMorph nextCardButton 'Next Card' 'A button that takes the user to the next card in the stack')) asOrderedCollection
!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningSuppliesFlap (in category 'flaps registry') -----
defaultsQuadsDefiningSuppliesFlap
"Answer a list of quads which define the objects to appear in the default Supplies flap.
previously in quadsDefiningSuppliesFlap"
+ ^ {
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}.
+ {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
+ } asOrderedCollection!
- ^ #(
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'TabbedPalette' 'A structure with tabs')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>disableGlobalFlaps: (in category 'menu commands') -----
disableGlobalFlaps: interactive
"Clobber all the shared flaps structures. First read the user her Miranda rights."
interactive
ifTrue: [(self confirm:
'CAUTION!! This will destroy all the shared
flaps, so that they will not be present in
*any* project. If, later, you want them
back, you will have to reenable them, from
this same menu, whereupon the standard
default set of shared flaps will be created.
Do you really want to go ahead and clobber
all shared flaps at this time?' translated) ifFalse: [^ self]].
self globalFlapTabsIfAny do:
[:aFlapTab | self removeFlapTab: aFlapTab keepInList: false.
aFlapTab isInWorld ifTrue: [self error: 'Flap problem' translated]].
self clobberFlapTabList.
+ self initializeFlapsQuads.
+ SharedFlapsAllowed _ false.
- SharedFlapsAllowed := false.
Smalltalk isMorphic ifTrue:
[ActiveWorld restoreMorphicDisplay.
ActiveWorld reformulateUpdatingMenus].
"The following reduces the risk that flaps will be created with variant IDs
such as 'Stack Tools2', potentially causing some shared flap logic to fail."
"Smalltalk garbageCollect." "-- see if we are OK without this"
!
Item was changed:
----- Method: Flaps class>>explainFlapsText (in category 'menu commands') -----
explainFlapsText
"Answer the text, in English, to show in a help-window about Flaps."
^'Flaps are like drawers on the edge of the screen, which can be opened so that you can use what is inside them, and closed when you do not need them. They have many possible uses, a few of which are illustrated by the default set of flaps you can get as described below.
+ ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
- ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
+ To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
- To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
+ ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
- ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
+ If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
- If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
+ If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
- If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
+ Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
- Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
+ You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
- You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
+ You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
- You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
+ Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
- Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
+ If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
- If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
+ The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
- The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
+ tab color... Lets you change the color of the flap''s tab.
+ flap color... Lets you change the color of the flap itself.
- tab color... Lets you change the color of the flap''s tab.
- flap color... Lets you change the color of the flap itself.
+ use textual tab... If the tab is not textual, makes it become textual.
+ change tab wording... If the tab is already textual, allows you to edit
- use textual tab... If the tab is not textual, makes it become textual.
- change tab wording... If the tab is already textual, allows you to edit
its wording.
+ use graphical tab... If the tab is not graphical, makes it become
- use graphical tab... If the tab is not graphical, makes it become
graphical.
+ choose tab graphic... If the tab is already graphical, allows you
- choose tab graphic... If the tab is already graphical, allows you
to change the picture.
+ use solid tab... If the tab is not solid, makes it become solid, i.e.
- use solid tab... If the tab is not solid, makes it become solid, i.e.
appear as a solid band of color along the
entire length or width of the screen.
+ parts-bin behavior If set, then dragging an object from the flap
- parts-bin behavior If set, then dragging an object from the flap
tears off a new copy of the object.
+ dragover If set, the flap opens on dragover and closes
- dragover If set, the flap opens on dragover and closes
again on drag-leave.
+
+ mouseover If set, the flap opens on mouseover and closes
- mouseover If set, the flap opens on mouseover and closes
again on mouse-leave.
+ cling to edge... Governs which edge (left, right, top, bottom)
- cling to edge... Governs which edge (left, right, top, bottom)
the flap adheres to.
+ shared If set, the same flap will be available in all projects; if not, the
- shared If set, the same flap will be available in all projects; if not, the
flap will will occur only in one project.
+ destroy this flap Deletes the flap.
- destroy this flap Deletes the flap.
+ To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
- To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
+ To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
- To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
+ To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
- To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
+ Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.' translated!
- Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.'!
Item was changed:
----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') -----
newLoneSuppliesFlap
+ "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch. We're still evidently nurturing this method along, but it is a disused branch, whose lone sender has no senders..."
- "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch"
| aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly"
+ aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: {
- aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: #(
+ {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph . #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#SimpleSliderMorph . #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ " {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}."
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'Tabs' translatedNoop. 'A structure with tabs' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle' )
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph authoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, ec.')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'Tabs' 'A structure with tabs')
+ {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}.
+ {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}.
- (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
- (MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ClockMorph. #authoringPrototype, 'Clock' translatedNoop, 'A simple digital clock' translatedNoop}.
+ {#BookMorph, #previousPageButton, 'Previous' translatedNoop, 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph, #nextPageButton, 'Next' translatedNoop, 'A button that takes you to the next page' translatedNoop}.
+ }.
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'Previous' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'Next' 'A button that takes you to the next page')
- ).
+ aFlapTab _ FlapTab new referent: aStrip beSticky.
- aFlapTab := FlapTab new referent: aStrip beSticky.
aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter.
aStrip extent: self currentWorld width @ 78.
+ leftEdge _ ((Display width - (16 + aFlapTab width)) + 556) // 2.
- leftEdge := ((Display width - (16 + aFlapTab width)) + 556) // 2.
aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)).
aStrip beFlap: true.
aStrip autoLineLayout: true.
^ aFlapTab!
Item was changed:
----- Method: Flaps class>>newNavigatorFlap (in category 'predefined flaps') -----
newNavigatorFlap
"Answer a newly-created flap which adheres to the bottom edge of the screen and which holds the project navigator controls. "
| aFlapTab navBar aFlap |
+ navBar _ ProjectNavigationMorph preferredNavigator new addButtons.
+ aFlap _ PasteUpMorph newSticky borderWidth: 0;
- navBar := ProjectNavigationMorph preferredNavigator new.
- aFlap := PasteUpMorph newSticky borderWidth: 0;
extent: navBar extent + (0@20);
color: (Color orange alpha: 0.8);
beFlap: true;
addMorph: navBar beSticky.
aFlap hResizing: #shrinkWrap; vResizing: #shrinkWrap.
aFlap useRoundedCorners.
aFlap setNameTo: 'Navigator Flap' translated.
navBar fullBounds. "to establish width"
+ aFlapTab _ FlapTab new referent: aFlap.
- aFlapTab := FlapTab new referent: aFlap.
aFlapTab setName: 'Navigator' translated edge: #bottom color: Color orange.
aFlapTab position: ((navBar width // 2) - (aFlapTab width // 2))
@ (self currentWorld height - aFlapTab height).
aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Navigator' translated "
!
Item was changed:
----- Method: Flasher class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver for use in a parts bin"
+ ^ self partName: 'Flasher' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A circle that flashes' translatedNoop!
- ^ self partName: 'Flasher'
- categories: #('Demo')
- documentation: 'A circle that flashes'!
Item was changed:
----- Method: FrameRateMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'FrameRate' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A readout that allows you to monitor the frame rate of your system' translatedNoop!
- ^ self partName: 'FrameRate'
- categories: #('Useful')
- documentation: 'A readout that allows you to monitor the frame rate of your system'!
Item was changed:
----- Method: FrameRateMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#FrameRateMorph. #authoringPrototype. 'Frame Rate' translatedNoop. 'An indicator of how fast your system is running' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(FrameRateMorph authoringPrototype 'Frame Rate' 'An indicator of how fast your system is running')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: FrameRateMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ lastDisplayTime _ 0.
+ framesSinceLastDisplay _ 0.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ !
- lastDisplayTime := 0.
- framesSinceLastDisplay := 0!
Item was changed:
----- Method: FrameRateMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
"Initialize the receiver as a stand-alone entity"
super initializeToStandAlone.
self color: Color blue.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ self step.
+ !
- self step!
Item was changed:
----- Method: GrabPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver's instances for a parts bin"
+ ^ self partName: 'Grab Patch' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Use this to grab a rectangular patch from the screen' translatedNoop!
- ^ self partName: 'Grab Patch'
- categories: #('Graphics')
- documentation: 'Use this to grab a rectangular patch from the screen'!
Item was changed:
----- Method: GrabPatchMorph>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initialize.
+ self image: (ScriptingSystem formAtKey: 'GrabPatch').
+ self setProperty: #ignorePartsBinDrop toValue: true!
- self image: (ScriptingSystem formAtKey: 'GrabPatch')!
Item was changed:
----- Method: GraphMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Graph' translatedNoop
+ categories: #()
+ documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.' translatedNoop!
- ^ self partName: 'Graph'
- categories: #('Useful')
- documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.'!
Item was changed:
----- Method: GraphMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: 365 @ 80.
+ dataColor _ Color darkGray.
+ cursor _ 1.0.
+ samplingRate := 11025.
- dataColor := Color darkGray.
- cursor := 1.0.
"may be fractional"
+ cursorColor _ Color red.
+ cursorColorAtZeroCrossings _ Color red.
+ startIndex _ 1.
+ hasChanged _ false.
- cursorColor := Color red.
- cursorColorAtZeroCrossings := Color red.
- startIndex := 1.
- hasChanged := false.
self
data: ((0 to: 360 - 1)
collect: [:x | (100.0 * x degreesToRadians sin) asInteger])!
Item was changed:
----- Method: GraphicalDictionaryMenu class>>openOn:withLabel: (in category 'instance creation') -----
openOn: aFormDictionary withLabel: aLabel
"open a graphical dictionary in a window having the label aLabel.
aFormDictionary should be a dictionary containing as value a form."
| inst aWindow |
+ aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!' translated].
- aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!'].
inst := self new initializeFor: nil fromDictionary: aFormDictionary.
+ aWindow _ (SystemWindow labelled: aLabel) model: inst.
- aWindow := (SystemWindow labelled: aLabel) model: inst.
aWindow addMorph: inst frame: (0@0 extent: 1@1).
aWindow extent: inst fullBounds extent + (3 @ aWindow labelHeight + 3);
minimumExtent: inst minimumExtent + (3 @ aWindow labelHeight + 3).
HandMorph attach: aWindow.
^ inst!
Item was changed:
----- Method: GraphicalDictionaryMenu>>renameGraphicTo: (in category 'menu commands') -----
renameGraphicTo: newName
| curr |
+ curr _ entryNames at: currentIndex.
- curr := entryNames at: currentIndex.
(newName isEmptyOrNil or: [newName = curr]) ifTrue: [^ Beeper beep].
(baseDictionary includesKey: newName) ifTrue:
[^ self inform: 'sorry that conflicts with
the name of another
+ entry in this dictionary' translated].
- entry in this dictionary'].
baseDictionary at: newName put: (baseDictionary at: curr).
baseDictionary removeKey: curr.
self baseDictionary: baseDictionary.
+ currentIndex _ entryNames indexOf: newName.
- currentIndex := entryNames indexOf: newName.
self updateThumbnail!
Item was changed:
----- Method: GraphicalMenu>>initializeFor:withForms:coexist: (in category 'initialization') -----
initializeFor: aTarget withForms: formList coexist: aBoolean
"World primaryHand attachMorph:
(GraphicalMenu new initializeFor: nil
withForms: Form allInstances coexist: true)"
| buttons bb anIndex buttonCage |
target := aTarget.
coexistWithOriginal := aBoolean.
formChoices := formList.
currentIndex := 1.
self borderWidth: 1;
cellPositioning: #center;
color: Color white;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap.
buttons := AlignmentMorph newRow.
buttons borderWidth: 0;
layoutInset: 0.
buttons hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5 @ 5.
buttons wrapCentering: #topLeft.
buttonCage := AlignmentMorph newColumn.
buttonCage hResizing: #shrinkWrap;
vResizing: #spaceFill.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Prev' translated;
- buttons addMorphBack: (bb label: 'Prev';
actionSelector: #downArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 9 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Next' translated;
- buttons addMorphBack: (bb label: 'Next';
actionSelector: #upArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 5 @ 0.
buttons submorphs last color: Color white.
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 12.
buttons := AlignmentMorph newRow.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'OK' translated;
- buttons addMorphBack: (bb label: 'OK';
actionSelector: #okay).
buttons addTransparentSpacerOfSize: 5 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Cancel' translated;
- buttons addMorphBack: (bb label: 'Cancel';
actionSelector: #cancel).
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
self addMorphFront: buttonCage.
formDisplayMorph := Thumbnail new extent: 100 @ 100;
maxWidth: 100 minHeight: 30;
yourself.
self addMorphBack: (Morph new color: Color white;
layoutPolicy: TableLayout new;
layoutInset: 4 @ 4;
hResizing: #spaceFill;
vResizing: #spaceFill;
listCentering: #center;
addMorphBack: formDisplayMorph;
yourself).
target
ifNotNil: [(anIndex := formList
indexOf: target form
ifAbsent: [])
ifNotNil: [currentIndex := anIndex]].
self updateThumbnail!
Item was changed:
----- Method: HandMorphForReplay>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
+ suspended := false.
+ self showTemporaryCursor: Cursor normal
- self showTemporaryCursor: Cursor normal.
!
Item was changed:
----- Method: HandMorphForReplay>>processEvents (in category 'event handling') -----
processEvents
"Play back the next event"
+ | evt hadMouse hadAny tracker |
+ suspended == true ifTrue: [^ self].
- | evt hadMouse hadAny |
hadMouse := hadAny := false.
+ tracker := recorder objectTrackingEvents.
[(evt := recorder nextEventToPlay) isNil] whileFalse:
+ [
+ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self].
+ tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp].
+ evt type == #EOF
- [evt type == #EOF
ifTrue:
+ [recorder pauseIn: ActiveWorld.
+ ^ self].
- [recorder pauseIn: self world.
- ^self].
evt type == #startSound
ifTrue:
+ [recorder perhapsPlaySound: evt argument.
- [evt argument play.
recorder synchronize.
+ ^ self].
+ evt type == #startEventPlayback
+ ifTrue:
+ [evt argument launchPlayback.
+ recorder synchronize.
+ ^ self].
+
+ evt type == #noteTheatreBounds
+ ifTrue:
+ ["The argument holds the content rect --for now we don't make any use of that info in this form."
+ ^ self].
+
- ^self].
evt isMouse ifTrue: [hadMouse := true].
(evt isMouse or: [evt isKeyboard])
ifTrue:
[self handleEvent: (evt setHand: self) resetHandlerFields.
hadAny := true]].
(mouseClickState notNil and: [hadMouse not])
ifTrue:
["No mouse events during this cycle. Make sure click states time out accordingly"
mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
hadAny
ifFalse:
["No pending events. Make sure z-order is up to date"
self mouseOverHandler processMouseOver: lastMouseEvent]!
Item was changed:
----- Method: HandMorphForReplay>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
+ "Handmorph blocks deep copy. Go up to Morph"
+
+ ^ self perform: #veryDeepCopyWith: withArguments: {deepCopier} inSuperclass: Morph!
- ^ self copy!
Item was changed:
----- Method: IndexTabs class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'tabs' translatedNoop!
- ^ 'tabs'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>cacheThumbnailFor: (in category 'thumbnails') -----
cacheThumbnailFor: aProject
+ "Save a thumbnail of the given project in my thumbnail cache."
| form |
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
-
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
CachedThumbnails
at: aProject name
+ put: (form _ self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter).
+ ^ form
- put: (form := self sorterFormForProject: aProject sized: nil).
- ^form
!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'ThreadNavigator' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A tool that lets you navigate through a thread of projects.' translatedNoop!
- ^ self partName: 'ThreadNavigator'
- categories: #('Navigation')
- documentation: 'A tool that lets you navigate through a thread of projects.'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>getThumbnailFor: (in category 'thumbnails') -----
getThumbnailFor: aProject
+ "Answer a thumbnail for the given project, retrieving it from a cache of such objects if possible, else creating a fresh thumbnail, storing it in the cache, and answering it."
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
^CachedThumbnails
at: aProject name
+ ifAbsentPut: [self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter]!
- ifAbsentPut: [self sorterFormForProject: aProject sized: nil]!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>sorterFormForProject:sized: (in category 'sorter') -----
+ sorterFormForProject: aProject sized: aSize
+ "Answer a form to use in a project-sorter to represent the project."
- sorterFormForProject: aProject sized: ignored
+ ^ (ProjectViewMorph on: aProject) imageForm scaledToSize: aSize
- ^(ProjectViewMorph on: aProject) imageForm scaledToSize: 80@60.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>buttonForMenu (in category 'navigation') -----
buttonForMenu
+ ^self makeButton: '?' balloonText: 'More commands' translated for: #moreCommands.
- ^self makeButton: '?' balloonText: 'More commands' for: #moreCommands.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>editThisThread (in category 'navigation') -----
editThisThread
| sorter |
+ sorter _ ProjectSorterMorph new.
- sorter := ProjectSorterMorph new.
sorter navigator: self listOfPages: listOfPages.
self currentWorld addMorphFront: sorter.
+ sorter align: sorter topCenter with: self currentWorld topCenter.
- sorter align: sorter center with: self currentWorld center.
self delete.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>positionAppropriately (in category 'navigation') -----
positionAppropriately
+ | others otherRects overlaps bottomRight |
- | others otherRects overlaps |
-
(self ownerThatIsA: HandMorph) ifNotNil: [^self].
+ others _ ActiveWorld submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
+ otherRects _ others collect: [ :each | each bounds].
+ bottomRight _ (ActiveWorld hasProperty: #threadNavigatorPosition) ifTrue: [
+ ActiveWorld valueOfProperty: #threadNavigatorPosition.
+ ] ifFalse: [
+ ActiveWorld bottomRight.
+ ].
+ self align: self fullBounds bottomRight with: bottomRight.
- others := self world submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
- otherRects := others collect: [ :each | each bounds].
- self align: self fullBounds bottomRight with: self world bottomRight.
self setProperty: #previousWorldBounds toValue: self world bounds.
[
+ overlaps _ false.
- overlaps := false.
otherRects do: [ :r |
+ (r intersects: bounds) ifTrue: [overlaps _ true. self bottom: r top].
- (r intersects: bounds) ifTrue: [overlaps := true. self bottom: r top].
].
self top < self world top ifTrue: [
+ self bottom: bottomRight y.
- self bottom: self world bottom.
self right: self left - 1.
].
overlaps
] whileTrue.!
Item was changed:
----- Method: InternalThreadNavigationMorph>>sizeRatio (in category 'accessing') -----
sizeRatio
"answer the size ratio for the receiver"
+ ^ 1.0
+
+ "^ Preferences standardMenuFont height / 12" "Good grief!!"!
- ^ Preferences standardMenuFont height / 12!
Item was changed:
----- Method: LassoPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver to be used in a parts bin"
+ ^ self partName: 'Lasso' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Drop this icon to grab a patch from the screen with a lasso.' translatedNoop!
- ^ self partName: 'Lasso'
- categories: #('Graphics')
- documentation: 'Drop this icon to grab a patch from the screen with a lasso.'!
Item was changed:
----- Method: LassoPatchMorph>>wantsToBeDroppedInto: (in category 'dropping') -----
wantsToBeDroppedInto: aMorph
+ "Only wanted by the world"
- "Only into PasteUps that are not part bins"
+ ^ aMorph isWorldMorph!
- ^ aMorph isPlayfieldLike!
Item was changed:
----- Method: MagnifierMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Magnifier' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A magnifying glass' translatedNoop!
- ^ self partName: 'Magnifier'
- categories: #('Useful')
- documentation: 'A magnifying glass'!
Item was changed:
----- Method: MagnifierMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MagnifierMorph. #newRound. 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: MagnifierMorph class>>supplementaryPartsDescriptions (in category 'parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundGlass' translatedNoop
+ categoryList: {'Just for Fun' translatedNoop}
+ documentation: 'A round magnifying glass' translatedNoop
- formalName: 'RoundGlass'
- categoryList: #(Useful)
- documentation: 'A round magnifying glass'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newRound.
DescriptionForPartsBin
+ formalName: 'Hand Magnifier' translatedNoop
+ categoryList: #()
+ documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.' translatedNoop
- formalName: 'Hand Magnifier'
- categoryList: #(Useful)
- documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newShowingPointer }!
Item was changed:
----- Method: MagnifierMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
+ | stencil newForm bb |
+
- super drawOn: aCanvas. "border and fill"
aCanvas isShadowDrawing ifFalse: [
"Optimize because #magnifiedForm is expensive"
+ self isRound
+ ifTrue:[stencil := (EllipseMorph new extent: self extent; color: Color white) imageForm.
+ bb := BitBlt toForm: stencil.
+ newForm := (bb copyForm: self magnifiedForm to: 0@0 rule: Form and) destForm.
+ aCanvas paintImage: newForm at: self innerBounds origin ]
+ ifFalse:[super drawOn: aCanvas. "border and fill"
+ aCanvas paintImage: self magnifiedForm at: self innerBounds origin]]
+
+ !
- aCanvas paintImage: self magnifiedForm at: self innerBounds origin]!
Item was changed:
----- Method: MagnifierMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
+ trackPointer _ true.
+ showPointer _ false.
+ magnification _ 2.
+ roundness := false.
- trackPointer := true.
- showPointer := false.
- magnification := 2.
-
self extent: 128 @ 128!
Item was changed:
----- Method: MagnifierMorph>>isRound (in category 'round view') -----
isRound
+ ^ roundness == true!
- ^ owner isMemberOf: ScreeningMorph!
Item was changed:
----- Method: MagnifierMorph>>showingPointerString (in category 'menu') -----
showingPointerString
+ "Answer a string characterizing whether or not I'm showing the pointer."
+
+ ^ (self showPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'show pointer' translated!
- ^ (self showPointer
- ifTrue: ['stop showing pointer']
- ifFalse: ['start showing pointer']) translated!
Item was changed:
----- Method: MagnifierMorph>>sourcePoint (in category 'magnifying') -----
sourcePoint
"If we are being dragged use our center, otherwise use pointer position"
^(trackPointer not or: [owner notNil and: [owner isHandMorph]])
+ ifTrue: [self isFlexed ifTrue:[owner center] ifFalse:[self center]]
- ifTrue: [self center]
ifFalse: [self currentHand position]!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundString (in category 'round view') -----
toggleRoundString
+ "Answer a string describing whether the receiver is currently round."
+
+ ^ (self isRound ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'round' translated!
- ^ (self isRound
- ifTrue: ['be square']
- ifFalse: ['be round']) translated!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundness (in category 'round view') -----
toggleRoundness
+ roundness := roundness not.
+ self fullBounds changed
+ !
- | sm w |
- w := self world.
- self isRound
- ifTrue: [owner delete.
- w addMorph: self]
- ifFalse: [sm := ScreeningMorph new position: self position.
- sm addMorph: self.
- sm addMorph: (EllipseMorph newBounds: self bounds).
- w addMorph: sm]!
Item was changed:
----- Method: MagnifierMorph>>trackingPointerString (in category 'menu') -----
trackingPointerString
+ "Answer a string describing whether or not I'm currently tracking the pointer."
+
^ (trackPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'track pointer' translated!
- ifTrue: ['stop tracking pointer']
- ifFalse: ['start tracking pointer']) translated!
Item was changed:
----- Method: MessageNames class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MessageNames. #prototypicalToolWindow. 'Message Names' translatedNoop. 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: Morph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
^ { DescriptionForPartsBin
+ formalName: 'Status' translatedNoop
+ categoryList: #()
+ documentation: 'Buttons to run, stop, or single-step scripts' translatedNoop
- formalName: 'Status'
- categoryList: #(Scripting)
- documentation: 'Buttons to run, stop, or single-step scripts'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #scriptControlButtons.
DescriptionForPartsBin
+ formalName: 'Scripting' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop
- formalName: 'Scripting'
- categoryList: #(Scripting)
- documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #newScriptingSpace.
DescriptionForPartsBin
+ formalName: 'Random' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A tile that will produce a random number in a given range' translatedNoop
+ globalReceiverSymbol: #FunctionTile
+ nativitySelector: #randomNumberTile.
- formalName: 'Random'
- categoryList: #(Scripting)
- documentation: 'A tile that will produce a random number in a given range'
- globalReceiverSymbol: #RandomNumberTile
- nativitySelector: #new.
DescriptionForPartsBin
+ formalName: 'ButtonDown?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is down' translatedNoop
- formalName: 'ButtonDown?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is down'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #anyButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'ButtonUp?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is up' translatedNoop
- formalName: 'ButtonUp?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is up'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #noButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'NextPage' translatedNoop
+ categoryList: {'Multimedia' translatedNoop}
+ documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop
- formalName: 'NextPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #nextPageButton.
DescriptionForPartsBin
+ formalName: 'PreviousPage' translatedNoop
+ categoryList: {'Multimedia'}
+ documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop
- formalName: 'PreviousPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #previousPageButton.},
+ self partsDescriptionsFromToolsFlap!
- (Flaps quadsDefiningToolsFlap collect:
- [:aQuad | DescriptionForPartsBin fromQuad: aQuad categoryList: #(Tools)])!
Item was changed:
----- Method: ObjectsTool class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Objects' translatedNoop
+ categories: #()
+ documentation: 'A place to obtain many kinds of objects' translatedNoop!
- ^ self partName: 'Objects'
- categories: #('Useful')
- documentation: 'A place to obtain many kinds of objects'!
Item was changed:
----- Method: ObjectsTool class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ObjectsTool. #newStandAlone. 'Object Catalog' translatedNoop. 'A tool that lets you browse the catalog of objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ObjectsTool . #newStandAlone. 'Object Catalog' translatedNoop.'A tool that lets you browse the catalog of objects' translatedNoop}
- cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: ObjectsTool>>minimumWidth (in category 'layout') -----
minimumWidth
+ "Answer a width that assures that the alphabet fits in two rows. For olpc, this is increased in order to make the Connectors category not too absurdly tall."
- "Answer a width that assures that the alphabet fits in two rows"
+ ^ 400!
- ^ 300!
Item was changed:
----- Method: PackagePaneBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PackagePaneBrowser. #prototypicalToolWindow . 'Packages' translatedNoop. 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: PaintBoxMorph class>>localeChanged (in category 'notification') -----
localeChanged
| caption |
caption := ColorPickerMorph noColorCaption.
+ ColorChart ifNotNil: [
+ caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)].!
- caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)!
Item was changed:
----- Method: PaintBoxMorph>>offsetFromMaxBounds (in category 'other') -----
offsetFromMaxBounds
"location of normal PaintBox within maxBounds."
+ | left |
+ left _ self left.
+ Preferences useBiggerPaintingBox ifTrue: [left _ left - (( self width * 1.5)- self width)].
+ ^ left - colorMemory left @ 0!
-
- ^ self left - colorMemory left @ 0!
Item was changed:
----- Method: PaintBoxMorph>>recentColor: (in category 'recent colors') -----
recentColor: aColor
"Remember the color as one of our recent colors"
+ Prototype currentColor: aColor.
+ (recentColors anySatisfy: [:any | any color = aColor])
+ ifTrue: [^self]. "already remembered"
+ RecentColors := {aColor}, RecentColors allButLast.
+ RecentColors keysAndValuesDo: [:i :each |
+ (recentColors at: i) color: each]!
-
- (recentColors anySatisfy: [:any | any color = aColor]) ifTrue: [^self]. "already remembered"
- recentColors size to: 2
- by: -1
- do:
- [:i |
- (recentColors at: i) color: (recentColors at: i - 1) color.
- RecentColors at: i put: (RecentColors at: i - 1)].
- (recentColors first) color: aColor.
- RecentColors at: 1 put: aColor!
Item was changed:
----- Method: PaintBoxMorph>>showColorPalette: (in category 'actions') -----
showColorPalette: evt
| w box |
self comeToFront.
colorMemory align: colorMemory bounds topRight
with: colorMemoryThin bounds topRight.
"make sure color memory fits or else align with left"
+ w _ self world.
+ box _ self bounds: colorMemory fullBounds in: w.
- w := self world.
- box := self bounds: colorMemory fullBounds in: w.
box left < 0 ifTrue:[
colorMemory align: colorMemory bounds topLeft
with: colorMemoryThin bounds topLeft].
+ self addMorphFront: colorMemory.
+ self changed!
- self addMorphFront: colorMemory.!
Item was changed:
----- Method: PaintBoxMorph>>toggleShapes (in category 'actions') -----
toggleShapes
| tab sh stamps |
"The sub panel that has the shape tools on it. Rect, line..."
+ stamps _ self submorphNamed: 'stamps'.
+ tab _ self submorphNamed: 'shapeTab'.
+ (sh _ self submorphNamed: 'shapes') visible
- stamps := self submorphNamed: 'stamps'.
- tab := self submorphNamed: 'shapeTab'.
- (sh := self submorphNamed: 'shapes') visible
ifTrue: [sh hide. tab top: stamps bottom-1]
ifFalse: [sh comeToFront. sh top: stamps bottom-9.
sh show. tab top: sh bottom - tab height + 10].
self layoutChanged.
+ self changed
!
Item was changed:
----- Method: PaintBoxMorph>>toggleStamps (in category 'actions') -----
toggleStamps
| tab otherTab st shapes |
"The sub panel that has the stamps in it. For saving and moving parts of an image."
+ shapes _ self submorphNamed: 'shapes'.
+ otherTab _ self submorphNamed: 'shapeTab'.
+ tab _ self submorphNamed: 'stampTab'.
+ (st _ self submorphNamed: 'stamps') visible
- shapes := self submorphNamed: 'shapes'.
- otherTab := self submorphNamed: 'shapeTab'.
- tab := self submorphNamed: 'stampTab'.
- (st := self submorphNamed: 'stamps') visible
ifTrue: [st hide. st bottom: self bottom. tab top: self bottom-1.
shapes top: self bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [self bottom-1])]
ifFalse: [st top: self bottom-10. st show. tab top: st bottom-0.
shapes top: st bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [st bottom-0])].
+ self layoutChanged.
+ self changed!
- self layoutChanged.!
Item was changed:
----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Paint' translatedNoop
+ categories: #()
+ documentation: 'Drop this icon to start painting a new object.' translatedNoop!
- ^ self partName: 'Paint'
- categories: #('Basic' 'Graphics')
- documentation: 'Drop this icon to start painting a new object.'!
Item was changed:
----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PartsBin>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
wantsDroppedMorph: aMorph event: evt
"Answer whether the receiver would like to accept the given morph. For a Parts bin, we accept just about anything except something that just originated from ourselves"
(aMorph hasProperty: #beFullyVisibleAfterDrop) ifTrue:
+ [^ true].
- ["Sign that this was launched from a parts bun, probably indeed this very parts bin"
- ^ false].
^ super wantsDroppedMorph: aMorph event: evt!
Item was changed:
----- Method: PasteUpMorph class>>initialize (in category '*MorphicExtras-class initialization') -----
initialize
"Initialize the class"
+ #('keyStroke') translatedNoop.
+
self registerInFlapsRegistry.
+ ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' translatedNoop targetMorphClass: PasteUpMorph.!
- ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' targetMorphClass: PasteUpMorph.!
Item was changed:
----- Method: PasteUpMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Holder' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop
- formalName: 'Holder'
- categoryList: #(Scripting)
- documentation: 'A place for storing alternative pictures in an animation, ec.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #prototypicalHolder}!
Item was changed:
----- Method: PianoKeyboardMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'PianoKeyboard' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A piano keyboard' translatedNoop!
- ^ self partName: 'PianoKeyboard'
- categories: #('Multimedia')
- documentation: 'A piano keyboard'!
Item was changed:
----- Method: PianoKeyboardMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+
+ whiteKeyColor _ Color gray: 0.95.
+ blackKeyColor _ Color black.
+ playingKeyColor _ Color red.
+ nOctaves _ 6.
-
- whiteKeyColor := Color gray: 0.95.
- blackKeyColor := Color black.
- playingKeyColor := Color red.
- nOctaves := 6.
self buildKeyboard.
+ soundPrototype _ FMSound brass1 duration: 9.9.
+ frequency _ 0.
+ soundPrototype _ FMSound new.
+ allowingChord _ false. "Sorry!!"
+ soundPlayingList _ Array new: self submorphs size.
+ !
- soundPrototype := FMSound brass1 duration: 9.9!
Item was changed:
----- Method: PolygonMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: PolygonMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-instance creation') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {DescriptionForPartsBin
+ formalName: 'Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.' translatedNoop
- formalName: 'Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.'
globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #arrowPrototype.
+ DescriptionForPartsBin
+ formalName: 'Triangle' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A three-sided polygon.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #trianglePrototype.
+
+ DescriptionForPartsBin
+ formalName: 'Curve' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A smooth wiggly curve, or a curved solid. Shift-click to get handles and move the points. Using the halo menu, can be coverted into a polygon, and can be made "open" rather than closed.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #curvePrototype.
+ }
+
+
- nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFlaps (in category 'the buttons') -----
buttonFlaps
^self inFlapsSuppressedMode ifTrue: [
+ self makeButton: 'Show tabs' translated balloonText: 'Show tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Show tabs' balloonText: 'Show tabs' for: #toggleFlapsSuppressed
] ifFalse: [
+ self makeButton: 'Hide tabs' translated balloonText: 'Hide tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Hide tabs' balloonText: 'Hide tabs' for: #toggleFlapsSuppressed
].
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFullScreen (in category 'the buttons') -----
buttonFullScreen
^self inFullScreenMode ifTrue: [
+ self makeButton: 'Browser Reentry' translated balloonText: 'Re-enter the browser' translated for: #fullScreenOff
- self makeButton: 'Browser Reentry' balloonText: 'Re-enter the browser' for: #fullScreenOff
] ifFalse: [
+ self makeButton: 'Escape Browser' translated balloonText: 'Use the full screen' translated for: #fullScreenOn
- self makeButton: 'Escape Browser' balloonText: 'Use the full screen' for: #fullScreenOn
]
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonGoTo (in category 'the buttons') -----
buttonGoTo
+ ^self makeButton: 'GO TO' translated balloonText: 'Go to another project' translated for: #gotoAnother
- ^self makeButton: 'GO TO' balloonText: 'Go to another project' for: #gotoAnother
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewProject (in category 'the buttons') -----
buttonNewProject
+ ^self makeButton: 'NEW' translated balloonText: 'Start a new project' translated for: #newProject
- ^self makeButton: 'NEW' balloonText: 'Start a new project' for: #newProject
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewer (in category 'the buttons') -----
buttonNewer
+ ^self makeButton: 'Newer?' translated balloonText: 'Is there a newer version of this project ?' translated for: #getNewerVersionIfAvailable!
- ^self makeButton: 'Newer?' balloonText: 'Is there a newer version of this project ?' for: #getNewerVersionIfAvailable!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNext (in category 'the buttons') -----
buttonNext
+ ^self makeButton: 'NEXT >' translated balloonText: 'Next project' translated for: #nextProject!
- ^self makeButton: 'NEXT >' balloonText: 'Next project' for: #nextProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPaint (in category 'the buttons') -----
buttonPaint
| pb oldArgs brush myButton m |
+ myButton _ self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting.
+ pb _ PaintBoxMorph new submorphNamed: #paint:.
- myButton := self makeButton: '' balloonText: 'Make a painting' for: #doNewPainting.
- pb := PaintBoxMorph new submorphNamed: #paint:.
pb ifNil: [
+ (brush _ Form extent: 16@16 depth: 16) fillColor: Color red
- (brush := Form extent: 16@16 depth: 16) fillColor: Color red
] ifNotNil: [
+ oldArgs _ pb arguments.
+ brush _ oldArgs third.
+ brush _ brush copy: (2@0 extent: 42@38).
+ brush _ brush scaledToSize: brush extent // 2.
- oldArgs := pb arguments.
- brush := oldArgs third.
- brush := brush copy: (2@0 extent: 42@38).
- brush := brush scaledToSize: brush extent // 2.
].
+ myButton addMorph: (m _ brush asMorph lock).
- myButton addMorph: (m := brush asMorph lock).
myButton extent: m extent + (myButton borderWidth + 6).
m position: myButton center - (m extent // 2).
^myButton
+ "brush _ (ScriptingSystem formAtKey: 'Painting')."
- "brush := (ScriptingSystem formAtKey: 'Painting')."
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPrev (in category 'the buttons') -----
buttonPrev
+ ^self makeButton: '< PREV' translated balloonText: 'Previous project' translated for: #previousProject!
- ^self makeButton: '< PREV' balloonText: 'Previous project' for: #previousProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonQuit (in category 'the buttons') -----
buttonQuit
+ "Make and answer a button whose pressing will result in quitting out of Squeak."
+ ^self makeButton: 'QUIT' translated balloonText: 'Quit Etoys (without saving)' translated for: #quitSqueak
- ^self makeButton: 'QUIT' balloonText: 'Quit Squeak altogether' for: #quitSqueak
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonTell (in category 'the buttons') -----
buttonTell
+ ^self makeButton: 'Tell!!' translated balloonText: 'Tell a friend about this project' translated for: #tellAFriend
- ^self makeButton: 'Tell!!' balloonText: 'Tell a friend about this project' for: #tellAFriend
!
Item was changed:
----- Method: ProjectNavigationMorph>>fontForButtons (in category 'as yet unclassified') -----
fontForButtons
+ ^ Preferences standardButtonFont!
-
- ^TextStyle defaultFont!
Item was changed:
----- Method: ProjectNavigationMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self layoutInset: 6;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
useRoundedCorners.
+ mouseInside _ false.
+ !
- mouseInside := false.
- self addButtons!
Item was changed:
----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'as yet unclassified') -----
makeButton: aString balloonText: anotherString for: aSymbol
- self flag: #yo.
- "In principle, this method shouldn't call #translated."
-
^ SimpleButtonDelayedMenuMorph new target: self;
borderColor: #raised;
color: self colorForButtons;
+ label: aString font: self fontForButtons;
+ setBalloonText: anotherString;
- label: aString translated font: self fontForButtons;
- setBalloonText: anotherString translated;
actionSelector: aSymbol!
Item was changed:
----- Method: ProjectNavigationMorph>>publishDifferent (in category 'the actions') -----
publishDifferent
self
+ publishStyle: #initialDirectoryListForProjects
- publishStyle: #initialDirectoryList
forgetURL: true
withRename: false
!
Item was changed:
----- Method: ProjectNavigationMorph>>publishStyle:forgetURL:withRename: (in category 'the actions') -----
publishStyle: aSymbol forgetURL: aBoolean withRename: renameBoolean
| w saveOwner primaryServer rename |
+ w _ self world ifNil: [^Beeper beep].
- w := self world ifNil: [^Beeper beep].
w setProperty: #SuperSwikiPublishOptions toValue: aSymbol.
+ primaryServer _ w project primaryServerIfNil: [nil].
+ rename _ ((primaryServer notNil
- primaryServer := w project primaryServerIfNil: [nil].
- rename := ((primaryServer notNil
and: [primaryServer acceptsUploads]) not)
or: [renameBoolean].
+ rename := rename or: [(primaryServer isKindOf: DAVMultiUserServerDirectory)].
w setProperty: #SuperSwikiRename toValue: rename.
+ saveOwner _ owner.
- saveOwner := owner.
self delete.
[w project
storeOnServerShowProgressOn: self
forgetURL: aBoolean | rename]
ensure: [saveOwner addMorphFront: self]!
Item was changed:
+ ----- Method: ProjectSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: ProjectSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
- | b r partsBinButton newButton |
+ | b r partsBinButton newButton aWrapper |
+ newButton _ ImageMorph new image: (World project makeThumbnail scaledToSize: 48@36).
- newButton := ImageMorph new image: (World project makeThumbnail scaledToSize: 24@18).
newButton on: #mouseDown send: #insertNewProject: to: self.
newButton setBalloonText: 'Make a new Project' translated.
+ (partsBinButton _ UpdatingThreePhaseButtonMorph checkBox)
- (partsBinButton := UpdatingThreePhaseButtonMorph checkBox)
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ (r _ AlignmentMorph newRow)
- (r := AlignmentMorph newRow)
color: Color transparent;
borderWidth: 0;
layoutInset: 0;
+ cellInset: 10@0;
wrapCentering: #center;
+ cellPositioning: #leftCenter;
- cellPositioning: #topCenter;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5@5.
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- r addMorphBack: (self wrapperFor: (b label: 'Okay' translated; actionSelector: #acceptSort)).
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete));
- r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated; actionSelector: #delete));
- addMorphBack: (self wrapperFor: (newButton));
addTransparentSpacerOfSize: 8 @ 0;
+ addMorphBack: (self wrapperFor: (newButton));
+ addTransparentSpacerOfSize: 8 @ 0.
+
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
addMorphBack: (self wrapperFor: partsBinButton);
+ addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons) lock).
+ r addMorphBack: aWrapper.
- addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated) lock).
self addMorphFront: r.
!
Item was changed:
----- Method: ProjectSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
super initialize.
- ""
self useRoundedCorners.
pageHolder useRoundedCorners; borderWidth: 0;
color: (self
gridFormOrigin: 0 @ 0
+ grid: ScriptingSystem sorterGridSize
- grid: 16 @ 16
background: Color white
line: Color blue muchLighter)!
Item was changed:
----- Method: ProjectSorterMorph>>sorterMorphForProjectNamed: (in category 'as yet unclassified') -----
sorterMorphForProjectNamed: projName
| pvm proj |
+ (proj _ Project named: projName) ifNil: [^nil].
+ pvm _ (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
- (proj := Project named: projName) ifNil: [^nil].
- pvm := (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
pvm setProperty: #nameOfThisProject toValue: projName.
+ pvm isOpaque: true.
pvm setBalloonText: projName.
pvm on: #mouseDown send: #clickFromSorterEvent:morph: to: self.
pvm on: #mouseUp send: #clickFromSorterEvent:morph: to: self.
^pvm
!
Item was changed:
----- Method: RealEstateAgent class>>reduceByFlaps: (in category '*MorphicExtras-utilities') -----
reduceByFlaps: aScreenRect
"Return a rectangle that won't interfere with default shared flaps"
Flaps sharedFlapsAllowed ifFalse: [^ aScreenRect copy].
(Flaps globalFlapTabsIfAny allSatisfy:
[:ft | ft flapID = 'Painting' translated or: [ft edgeToAdhereTo == #bottom]])
ifTrue: [^ aScreenRect withHeight: aScreenRect height - 18]
+ ifFalse: [^ aScreenRect insetBy: 64]!
- ifFalse: [^ aScreenRect insetBy: 18]!
Item was changed:
----- Method: RecordingControlsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.'}
- cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: RecordingControlsMorph>>addButtonRows (in category 'initialization') -----
addButtonRows
+ | r fullWidth |
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- | r |
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Morph' translated action: #makeSoundMorph).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Tile' translated action: #makeTile).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Trim' translated action: #trim).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Show' translated action: #showEditor).
- r addMorphBack: (self buttonName: 'Show' translated action: #show).
self addMorphBack: r.
+ r layoutChanged.
+ fullWidth := r fullBounds width.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Record' translated action: #record).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Stop' translated action: #stop).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Play' translated action: #playback).
+ r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Codec' translated action: #chooseCodec).
r addMorphBack: self makeStatusLight.
self addMorphBack: r.
+ self changeCodec: OggSpeexCodec name: 'Speex'.
+ r layoutChanged.
+ fullWidth := fullWidth max: r fullBounds width.
+ ^ fullWidth@(r fullBounds height).
!
Item was changed:
----- Method: RecordingControlsMorph>>buttonName:action: (in category 'other') -----
buttonName: aString action: aSymbol
^ SimpleButtonMorph new
target: self;
+ label: aString font: Preferences standardButtonFont;
- label: aString;
actionSelector: aSymbol
!
Item was changed:
----- Method: RecordingControlsMorph>>initialize (in category 'initialization') -----
initialize
+ | r full |
- | r |
super initialize.
self hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ borderWidth _ 2.
- borderWidth := 2.
self listDirection: #topToBottom.
+ recorder _ SoundRecorder new.
+ full := self addButtonRows.
+ self addRecordLevelSliderIn: full.
- recorder := SoundRecorder new.
- self addButtonRows.
- self addRecordLevelSlider.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
+ r addMorphBack: (self makeRecordMeterIn: full).
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
- r addMorphBack: self makeRecordMeter.
self addMorphBack: r.
self extent: 10@10. "make minimum size"
!
Item was changed:
----- Method: RectangleMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RectangleMorph, #roundRectPrototype, 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: RectangleMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundRect' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A rectangle with rounded corners' translatedNoop
- formalName: 'RoundRect'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with rounded corners'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #roundRectPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a horizontal gradient' translatedNoop
- formalName: 'Gradient'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a horizontal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #gradientPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient (slanted)' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a diagonal gradient' translatedNoop
- formalName: 'Gradient (slanted)'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a diagonal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #diagonalPrototype}!
Item was changed:
----- Method: ReferenceMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'ref' translatedNoop!
- ^ 'ref'!
Item was changed:
----- Method: ScrollableField class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Info for build parts-bin entries."
+
+ ^ self partName: 'Scrolling Text' translatedNoop
+ categories: #(Basic)
+ documentation: 'A scrollable, editable body of text' translatedNoop!
- ^ self partName: 'Scrolling Text'
- categories: #('Text' )
- documentation: 'A scrollable, editable body of text'!
Item was changed:
----- Method: ScrollableField class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
forFlapNamed: 'Stack Tools'.]!
Item was changed:
----- Method: SelectorBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SelectorBrowser. #prototypicalToolWindow. 'Method Finder' translatedNoop. 'A tool for discovering methods by providing sample values for arguments and results' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results')
forFlapNamed: 'Tools']
!
Item was changed:
----- Method: SimpleSliderMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'Slider' translatedNoop!
- ^ 'Slider'!
Item was changed:
----- Method: SimpleSliderMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Slider' translatedNoop
+ categories: {'Basic' translatedNoop}
+ documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.' translatedNoop!
- ^ self partName: 'Slider'
- categories: #('Scripting')
- documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.'!
Item was changed:
----- Method: SimpleSliderMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: SimpleSliderMorph>>adjustToValue: (in category 'private') -----
adjustToValue: aNumber
"Adjust the position of this slider to correspond to the given value in the range minVal..maxVal."
"Details: Internal values are normalized to the range 0..1."
+ | toUse |
+ toUse := minVal = maxVal
+ ifTrue:
+ [minVal]
+ ifFalse:
+ [(aNumber - minVal) asFloat / (maxVal - minVal)].
+ self value: toUse
- self value:
- (aNumber - minVal) asFloat / (maxVal - minVal).
!
Item was changed:
----- Method: SimpleSliderMorph>>descendingString (in category 'menu') -----
descendingString
^ (self descending
+ ifTrue: ['switch to ascending' translatedNoop]
+ ifFalse: ['switch to descending' translatedNoop]) translated!
- ifTrue: ['switch to ascending']
- ifFalse: ['switch to descending']) translated!
Item was changed:
----- Method: SimpleSliderMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]!
Item was changed:
----- Method: SimpleSliderMorph>>truncateString (in category 'menu') -----
truncateString
^ (truncate
+ ifTrue: ['turn off truncation' translatedNoop]
+ ifFalse: ['turn on truncation' translatedNoop]) translated!
- ifTrue: ['turn off truncation']
- ifFalse: ['turn on truncation']) translated!
Item was changed:
----- Method: SketchEditorMorph>>addRotationScaleHandles (in category 'start & finish') -----
addRotationScaleHandles
"Rotation and scaling handles"
+ rotationButton _ SketchMorph withForm: (palette rotationTabForm).
- rotationButton := SketchMorph withForm: (palette rotationTabForm).
rotationButton position: bounds topCenter - (6@0).
rotationButton on: #mouseDown send: #rotateScalePrep: to: self.
rotationButton on: #mouseMove send: #rotateBy: to: self.
rotationButton on: #mouseUp send: #rotateDone: to: self.
rotationButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
rotationButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: rotationButton].
- self addMorph: rotationButton.
rotationButton setBalloonText: 'Drag me sideways to
rotate your
picture.' translated.
+ scaleButton _ SketchMorph withForm: (palette scaleTabForm).
- scaleButton := SketchMorph withForm: (palette scaleTabForm).
scaleButton position: bounds rightCenter - ((scaleButton width)@6).
scaleButton on: #mouseDown send: #rotateScalePrep: to: self.
scaleButton on: #mouseMove send: #scaleBy: to: self.
scaleButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
scaleButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: scaleButton].
- self addMorph: scaleButton.
scaleButton setBalloonText: 'Drag me up and down to change
the size
of your picture.' translated.
"REMOVED:
+ fwdButton _ PolygonMorph new.
+ pt _ bounds topCenter.
- fwdButton := PolygonMorph new.
- pt := bounds topCenter.
fwdButton borderWidth: 2; makeOpen; makeBackArrow; borderColor:
(Color r: 0 g: 0.8 b: 0).
fwdButton removeHandles; setVertices: (Array with: pt+(0@7) with:
pt+(0@22)).
fwdButton on: #mouseMove send: #forward:direction: to: self.
fwdButton on: #mouseEnter send: #mouseLeave: to: self.
fwdButton on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdButton toValue: fwdButton.
self addMorph: fwdButton.
fwdButton setBalloonText: 'Drag me around to point
in the direction
I go forward.' translated.
+ toggle _ EllipseMorph
- toggle := EllipseMorph
newBounds: (Rectangle center: fwdButton vertices last +
(-4@4) extent: 8@8)
color: Color gray.
toggle on: #mouseUp send: #toggleDirType:in: to: self.
toggle on: #mouseEnter send: #mouseLeave: to: self.
toggle on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdToggle toValue: toggle.
fwdButton addMorph: toggle.
toggle setBalloonText: 'When your object turns,
how should its
picture change?
It can rotate, face left or right,
face up or down, or not
change.' translated.
"
self setProperty: #rotationStyle toValue: hostView rotationStyle.
" self forward: hostView setupAngle direction: fwdButton. "
"Set to its current value"
!
Item was changed:
----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: (in category 'initialization') -----
initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph
+ "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
+
| aPaintBox newPaintBoxBounds worldBounds requiredWidth newOrigin aPosition aPal aTab paintBoxFullBounds |
+ (aTab _ self world paintingFlapTab) ifNotNil:
- (aTab := self world paintingFlapTab) ifNotNil:
[aTab showFlap.
^ self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: nil].
+ self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
+ aPaintBox _ self world paintBox.
+ worldBounds _ self world bounds.
+ requiredWidth _ aPaintBox width.
- aPaintBox := self world paintBox.
- worldBounds := self world bounds.
- requiredWidth := aPaintBox width.
+ aPosition _ (aPal _ aPasteUpMorph standardPalette)
- aPosition := (aPal := aPasteUpMorph standardPalette)
ifNotNil:
[aPal showNoPalette.
aPal topRight + (aPaintBox width negated @ 0 "aPal tabsMorph height")]
ifNil:
[boundsToUse topRight].
+ newOrigin _ ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
- newOrigin := ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
ifTrue: "will fit to right of aPasteUpMorph"
[aPosition]
ifFalse: "won't fit to right, try left"
[boundsToUse topLeft - (requiredWidth @ 0)].
+ paintBoxFullBounds _ aPaintBox maxBounds.
+ paintBoxFullBounds _ (newOrigin - aPaintBox offsetFromMaxBounds) extent:
- paintBoxFullBounds := aPaintBox maxBounds.
- paintBoxFullBounds := (newOrigin - aPaintBox offsetFromMaxBounds) extent:
paintBoxFullBounds extent.
+ newPaintBoxBounds _ paintBoxFullBounds translatedToBeWithin: worldBounds.
- newPaintBoxBounds := paintBoxFullBounds translatedToBeWithin: worldBounds.
self initializeFor: aSketchMorph inBounds: boundsToUse
pasteUpMorph: aPasteUpMorph
+ paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.
+ !
- paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.!
Item was changed:
----- Method: SketchEditorMorph>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "In the middle of drawing a stroke of any kind."
- "In the middle of drawing a stroke. 6/11/97 19:51 tk"
+ | pt priorEvt actionSelector |
- | pt priorEvt |
WorldState canSurrenderToOS: false. "we want maximum responsiveness"
pt := evt cursorPoint.
priorEvt := self get: #lastEvent for: evt.
(priorEvt notNil and: [pt = priorEvt cursorPoint]) ifTrue: [^self].
+ self perform: (actionSelector _ self getActionFor: evt) with: evt.
- self perform: (self getActionFor: evt) with: evt.
"Each action must do invalidRect:"
self
set: #lastEvent
for: evt
to: evt.
+ "If recording painting, mark these events so they will not be condensed. The actual path the brush takes is important."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: actionSelector]].
false
ifTrue:
["So senders will find the things performed here"
self
paint: nil;
fill: nil;
erase: nil;
pickup: nil;
stamp: nil.
self
rect: nil;
ellipse: nil;
polygon: nil;
line: nil;
star: nil]!
Item was changed:
----- Method: SketchEditorMorph>>mouseUp: (in category 'event handling') -----
mouseUp: evt
| myAction |
"Do nothing except those that work on mouseUp."
+ myAction _ self getActionFor: evt.
- myAction := self getActionFor: evt.
myAction == #fill: ifTrue: [
self perform: myAction with: evt.
"Each action must do invalidRect:"
].
myAction == #pickup: ifTrue: [
self pickupMouseUp: evt].
myAction == #polygon: ifTrue: [self polyEdit: evt]. "a mode lets you drag vertices"
self set: #lastEvent for: evt to: nil.
+ "If recording painting, note that we stopped a stroke. OK to condense points."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: #mouseUp:]].
!
Item was changed:
----- Method: SketchEditorMorph>>paint: (in category 'actions & preps') -----
paint: evt
"While the mouse is down, lay down paint, but only within window bounds.
11/28/96 sw: no longer stop painting when pen strays out of window; once it comes back in, resume painting rather than waiting for a mouse up"
+ | mousePoint startToEnd pfPen newPoint |
+ pfPen _ self get: #paintingFormPen for: evt.
+ mousePoint _ evt cursorPoint.
+ newPoint _ mousePoint - bounds origin.
+ startToEnd _ pfPen regionFor: newPoint.
+ evt shiftPressed
+ ifTrue: [pfPen gotoBack: newPoint]
+ ifFalse: [pfPen goto: newPoint].
- | mousePoint startRect endRect startToEnd pfPen myBrush |
-
- pfPen := self get: #paintingFormPen for: evt.
- myBrush := self getBrushFor: evt.
- mousePoint := evt cursorPoint.
- startRect := pfPen location + myBrush offset extent: myBrush extent.
- pfPen goto: mousePoint - bounds origin.
- endRect := pfPen location + myBrush offset extent: myBrush extent.
- "self render: (startRect merge: endRect). Show the user what happened"
- startToEnd := startRect merge: endRect.
self invalidRect: (startToEnd translateBy: bounds origin).
!
Item was changed:
----- Method: SoundEventMorph>>releaseCachedState (in category 'caching') -----
releaseCachedState
super releaseCachedState.
+ sound isCompressed
+ ifFalse: [sound _ sound compressWith: GSMCodec].
- sound := sound compressWith: GSMCodec.
!
Item was changed:
----- Method: SquishedNameMorph>>fontForName (in category 'as yet unclassified') -----
fontForName
+ ^(TextStyle default fontOfSize: 15) emphasized: 1
- | pickem |
- pickem := 3.
-
- pickem = 1 ifTrue: [
- ^(((TextStyle named: #Helvetica) ifNil: [TextStyle default]) fontOfSize: 13) emphasized: 1.
- ].
- pickem = 2 ifTrue: [
- ^(((TextStyle named: #Palatino) ifNil: [TextStyle default]) fontOfSize: 12) emphasized: 1.
- ].
- ^((TextStyle default) fontAt: 1) emphasized: 1
!
Item was changed:
----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}
- cl registerQuad: #(ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop}
- cl registerQuad: #(ScriptingSystem holderWithAlphabet 'Alphabet' 'A source for single-letter objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: StarMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Star' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'A symmetrical polygon in the shape of a star' translatedNoop!
- ^ self partName: 'Star'
- categories: #('Graphics')
- documentation: 'A symmetrical polygon in the shape of a star'!
Item was changed:
----- Method: StarMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: StickyPadMorph class>>defaultNameStemForInstances (in category 'parts bin') -----
defaultNameStemForInstances
"Answer the default name stem to use"
+ ^ 'tear off' translatedNoop
+ !
- ^ 'tear off'!
Item was changed:
----- Method: StickyPadMorph class>>descriptionForPartsBin (in category 'parts bin') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StickyPadMorph class>>launchPartVia:label: (in category 'parts bin') -----
launchPartVia: aSelector label: aString
"Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins. Overridden here so that all instances will be given the name, unlike the prevailing convention for other object types"
| aMorph |
+ aMorph _ self perform: aSelector.
- aMorph := self perform: aSelector.
aMorph setNameTo: self defaultNameStemForInstances. "i.e., circumvent uniqueness in this case"
aMorph setProperty: #beFullyVisibleAfterDrop toValue: true.
+ aMorph openInHand.
+ ^ aMorph!
- aMorph openInHand!
Item was changed:
----- Method: StickyPadMorph class>>registerInFlapsRegistry (in category 'as yet unclassified') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: StoryboardBookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Storyboard' translatedNoop
+ categories: #()
+ documentation: 'A storyboard authoring tool' translatedNoop!
- ^ self partName: 'Storyboard'
- categories: #('Presentation')
- documentation: 'A storyboard authoring tool'!
Item was changed:
----- Method: StringButtonMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'SButton' translatedNoop!
- ^ 'SButton'!
Item was changed:
----- Method: StringButtonMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]
ifFalse: [nil]!
Item was changed:
----- Method: TabMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tab' translatedNoop!
- ^ 'tab'!
Item was changed:
+ ----- Method: TabSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: TabSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
| b r |
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r _ AlignmentMorph newRow.
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r := AlignmentMorph newRow.
r color: b color; borderWidth: 0; layoutInset: 0.
r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
r wrapCentering: #topLeft.
+ r addMorphBack: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort).
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #cancelSort).
- r addMorphBack: (b label: 'Okay'; actionSelector: #acceptSort).
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (b label: 'Cancel'; actionSelector: #cancelSort).
self addMorphFront: r.
!
Item was changed:
----- Method: TabSorterMorph>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
self removeAllMorphs.
self extent: 300@100.
+ pageHolder _ PasteUpMorph new.
- pageHolder := PasteUpMorph new.
pageHolder vResizeToFit: true; autoLineLayout: true.
pageHolder extent: self extent - borderWidth.
pageHolder padding: 8.
pageHolder cursor: 0.
+ pageHolder wantsMouseOverHalos: false.
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: TabbedPalette class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tabbedPalette' translatedNoop!
- ^ 'tabbedPalette'!
Item was changed:
----- Method: TextMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {
DescriptionForPartsBin
+ formalName: 'Text (border)' translatedNoop
+ categoryList: #()
+ documentation: 'A text field with border' translatedNoop
- formalName: 'Text (border)'
- categoryList: #('Text')
- documentation: 'A text field with border'
globalReceiverSymbol: #TextMorph
nativitySelector: #borderedPrototype.
" DescriptionForPartsBin
+ formalName: 'Text (fancy)' translatedNoop
+ categoryList: {'Text' translatedNoop}
+ documentation: 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop
- formalName: 'Text (fancy)'
- categoryList: #('Text')
- documentation: 'A text field with a rounded shadowed border, with a fancy font.'
globalReceiverSymbol: #TextMorph
nativitySelector: #fancyPrototype."
DescriptionForPartsBin
+ formalName: 'Text' translatedNoop
+ categoryList: {'Basic' translatedNoop}
+ documentation:
+ 'A raw piece of text which you can edit into anything you want' translatedNoop
- formalName: 'Text'
- categoryList: #('Basic' 'Text')
- documentation: 'A raw piece of text which you can edit into anything you want'
globalReceiverSymbol: #TextMorph
+ nativitySelector: #nonwrappingPrototype.
- nativitySelector: #boldAuthoringPrototype.
}
!
Item was changed:
----- Method: Thumbnail>>makeThumbnailFromForm: (in category 'thumnail creation') -----
makeThumbnailFromForm: aForm
"Make a thumbnail from the form provided, obeying my min and max width and height preferences"
+ | scaleX scaleY margin opaque nominalWidth minimumWidth |
+ minimumWidth := self minimumWidth.
+ scaleY _ minimumHeight / aForm height. "keep height invariant"
+
+ scaleX _ ((nominalWidth := aForm width * scaleY) <= maximumWidth)
+ ifTrue:
+ [(nominalWidth < minimumWidth)
+ ifFalse:
+ [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
+ ifTrue:
+ [minimumWidth / aForm width]]
+ ifFalse:
+ [scaleY _ maximumWidth / aForm width].
- | scaleX scaleY margin opaque |
- scaleY := minimumHeight / aForm height. "keep height invariant"
- scaleX := ((aForm width * scaleY) <= maximumWidth)
- ifTrue: [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
- ifFalse: [scaleY := maximumWidth / aForm width].
"self form: (aForm magnify: aForm boundingBox by: (scaleX @ scaleY) smoothing: 2)."
"Note: A problem with magnify:by: fails to reproduce borders properly.
The following code does a better job..."
+ margin _ 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
+ opaque _ (Form extent: aForm extent + margin depth: 32) "fillWhite".
+ aForm displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
+ self form: ((opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2) fixAlpha).
- margin := 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
- opaque := (Form extent: aForm extent + margin depth: 32) "fillWhite".
- aForm fixAlpha displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
- opaque fixAlpha.
- self form: (opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2).
self extent: originalForm extent!
Item was changed:
----- Method: Thumbnail>>setStandardDefaultMetrics (in category 'initialization') -----
setStandardDefaultMetrics
"Provide the current choices for min.max width/height for thumbnails"
+ self maxWidth: 60 minHeight: 32.
+ self setProperty: #minimumWidth toValue: 16!
- self maxWidth: 60 minHeight: 24!
Item was changed:
----- Method: ThumbnailMorph>>step (in category 'stepping and presenter') -----
step
"Optimization: Don't redraw if we're viewing some kind of SketchMorph and its rotated Form hasn't changed."
| viewee f |
+ viewee _ self actualViewee.
+ viewee ifNil: [self stopStepping. ^ self].
+ viewee isSketchMorph
+ ifTrue:
+ [f := viewee rotatedForm.
+ f == lastSketchForm ifTrue: [^ self]. "The optimization"
+ lastSketchForm _ f]
+ ifFalse:
+ [lastSketchForm := nil]. "Avoids subtle bug if sketchMorph removed and then put back in"
+ self changed
- viewee := self actualViewee.
- viewee ifNil: [ self stopStepping. ^self ].
- (viewee isSketchMorph) ifTrue: [
- f := viewee rotatedForm.
- f == lastSketchForm ifTrue: [^ self].
- lastSketchForm := f].
- self changed.
!
Item was changed:
----- Method: TickIndicatorMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ self extent: 30 @ 30.
+ index _ 0!
- self extent: 20 @ 20.
- index := 0!
Item was changed:
----- Method: TransitionMorph class>>allEffects (in category 'available effects') -----
allEffects
+ #('none' 'slide over' 'slide both' 'slide away' 'slide border'
+ 'page forward' 'page back'
+ 'french door' 'zoom frame' 'zoom' 'dissolve') translatedNoop.
^ #(none
slideOver slideBoth slideAway slideBorder
pageForward pageBack
frenchDoor
zoomFrame zoom
dissolve)!
Item was changed:
----- Method: TransitionMorph class>>directionsForEffect: (in category 'available effects') -----
directionsForEffect: eff
"All these arrays are ordered so inverse is atWrap: size//2."
+ #('right' 'down right' 'down' 'down left' 'left' 'up left' 'up' 'up right'
+ 'in' 'in h' 'out' 'out h') translatedNoop.
+
(#(slideOver slideBoth slideAway slideBorder) includes: eff)
ifTrue: [^ #(right downRight down downLeft left upLeft up upRight)].
(#(pageForward pageBack) includes: eff)
ifTrue: [^ #(right down left up)].
(#(frenchDoor) includes: eff)
ifTrue: [^ #(in inH out outH)].
(#(zoomFrame zoom) includes: eff)
ifTrue: [^ #(in out)].
^ Array new!
Item was changed:
----- Method: TrashCanMorph class>>descriptionForPartsBin (in category 'miscellaneous') -----
descriptionForPartsBin
+ ^ self partName: 'Trash' translatedNoop
+ categories: { 'Basic' translatedNoop}
+ documentation: 'a tool for discarding objects' translatedNoop
+ sampleImageForm: (Form extent: 42@54 depth: 8 fromArray: #( 0 0 0 2555943 992034 555814414 587202599 654311424 0 0 0 0 0 654320418 550751400 2829625512 2829625512 2829625357 556007424 0 0 0 0 36 3553874600 2829155709 2105376125 2711726248 2829625512 2728926240 587212583 0 0 0 639882194 3433594237 1400339837 2107746472 2812848296 2829634764 2829623677 2820612864 640090112 0 0 3553809064 2097828727 2108216018 3537030348 3436367016 2829625548 3537021096 2105452577 603989760 0 9427 3537019218 22259922 4141011666 3536637138 4160212129 2712183208 2832398034 2709355944 539103014 0 2413266 3531411713 2110979575 3537031884 3435975671 4157384573 2812846461 2108216055 3430776189 488645135 654311424 651416310 2823946621 4160606930 3537030348 3539466451 2829559720 2829625506 2105398007 3534257533 2718769186 0 601019090 2097238994 4258452178 3537031891 4160213671 2812782760 2829559976 2105387218 4154948989 2099055886 254214144 4174566098 1392595922 4258452178 3537041442 3551045799 2829625512 2829625505 2105396471 3534257533 2098863648 606470144 4275229394 2097238696 4260811474 3536977959 3550980264 2829625512 2829558141 2108225271 2826796413 1998134560 589758464 584241874 3427991891 3438727890 3537031970 3433614504 2829625512 2829164961 3436377804 2709355901 1394154783 589692928 617861842 3534246674 1403572946 3537031890 3536627880 2829625512 2812848338 4157778045 2105376083 1394154527 587202560 265540306 3537030269 1397980584 2831994060 3435964584 2829625512 2831995602 3433594237 2105365330 1394154783 589758464 13871314 3537041106 2826796413 2105385640 2829559976 2829625548 3436367016 2709355901 1397902346 1394220320 606535680 639674536 2831995602 3537030312 2829625256 2829625512 2829634728 2829625469 2105365331 1280463699 186260768 606535680 1037224 2829625512 3436368594 3537030348 3433605288 2829625512 2709355895 1397967954 1376389715 404364814 254214144 9164 2829625512 2829166760 2829625512 2829625505 2709355901 1397951058 1280463370 173167480 421203235 637534208 35 2829625511 2711715197 2105376125 2105376119 1397969747 1397903954 168430156 1397954174 421339392 654311424 0 4174162088 2728492413 2105376125 2105374547 1397969747 1397969490 1280070483 2105350169 438182694 0 0 267898023 2829155709 2105376125 2104981331 1397969747 1397902346 1397979005 2105376282 455025703 0 0 16241320 2832387239 2105376125 2004318035 1397969747 1397980541 2104982910 2105350427 471928576 0 0 653775528 2832388812 2712119464 2829221245 2728960381 2105387170 2104982910 2105350683 488701990 0 0 16700071 2832388818 2829625548 3433603489 2829625469 2105387170 2104982909 2105350683 504233984 0 0 2413224 2815218380 2829559976 3433594237 2829625469 2105387176 2104982910 2105416476 220266496 0 0 2413516 2815218386 2812782760 2829614461 2829625469 2105387176 2104982909 2105416476 220341760 0 0 2413516 2815218386 2829166796 2829623677 2829625469 2105387176 2104982909 2105416733 522397440 0 0 54226 2829636306 2810030284 3433605245 2829625469 2105385640 2104982910 2105416733 522397440 0 0 2619346 2829636306 2829166760 2829625469 2829625505 2105385634 2104982945 2097945629 522462976 0 0 65234 2812859090 2829166760 3433604989 2829625469 2105387176 2104982945 2097945629 539240192 0 0 8914 2829636306 2829166760 3433605245 2829625505 2105387176 2104982945 2098797853 537863936 0 0 9427 2829634770 3433539752 3433604989 2829625505 2105387176 2104982946 2098797597 554641152 0 0 211 3433549010 3433146536 3433605245 2728962209 2105387176 2104983208 2098863389 553658112 0 0 9975 3433539794 3433144744 2829625213 2728962209 2105387176 2104983208 2098863134 234881024 0 0 10238 3433539794 3534201256 3435964321 2712184993 2105387176 2104983202 2115640350 234891008 0 0 35 3534203090 3534266792 3435964577 2108205217 2105387176 2104982946 2115705886 234881024 0 0 36 3550980306 3534268328 2831984801 2108205223 2105385640 2104982946 2115706142 570425344 0 0 0 3551045836 3534266792 2831984801 2108205224 2105385640 2105376161 2115705869 572915712 0 0 38 4155025356 3534266792 2831984801 2108205224 2105385640 2105376161 2115706125 572915712 0 0 39 4174162088 3536626088 2831984801 2108205224 2105385640 2105376126 2115771661 589758464 0 0 0 583837608 3536626087 2831984801 2108205224 2105387176 2105376161 2115771679 589692928 0 0 0 601006503 3537020839 2831984807 2108205224 2102623656 2105385342 2719751456 254214144 0 0 0 617850792 3537020833 2831984808 2108214440 2097238952 2105387170 438111502 0 0 0 0 668191948 3537021095 2829634727 2108205224 2097238952 2726142590 471736591 654311424 0 0 0 2282194 3537020833 2829634728 2711726248 2097238690 2826796314 220275750 0 0 0 0 63442 3537021095 2832387240 2107746472 2709355937 2105350686 539168550 640090112 0 0 0 211 3537030312 3536627879 2712194216 2815677352 2820414989 555885347 588195584 0 0 0 39 584307410 3433605288 2812848295 2714576126 3542093084 504176397 521015079 0 0 0 0 8992 3553414312 2829625512 2820673060 3553470632 2829589020 488579879 0 0 0 0 39 991758 235807524 2564819 3433605288 2829614621 220270375 0 0 0 0 0 0 0 2140364 3536627880 2709356064 571418112 0 0 0 0 0 0 0 581478568 3433605246 2719813120 640090112 0 0 0 0 0 0 0 13880488 2829589793 603989798 0 0 0 0 0 0 0 0 991758 570435111 654311424 0 0) offset: 0@0)!
- ^ self partName: 'Trash'
- categories: #('Useful' 'Basic')
- documentation: 'a tool for discarding objects'!
Item was changed:
----- Method: TrashCanMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'viewerFlapTab' translatedNoop!
- ^ 'viewerFlapTab'!
Item was changed:
----- Method: ViewerFlapTab>>initializeFor:topAt: (in category 'transition') -----
initializeFor: aPlayer topAt: aTop
+ "The assumption is that this is only called at the same time of creation of this instance."
+ beingOpened _ true.
+ scriptedPlayer _ aPlayer.
- scriptedPlayer := aPlayer.
self useGraphicalTab.
self top: aTop!
Item was changed:
----- Method: WaveEditor class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'WaveEditor' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A workbench for seing and editing wave forms' translatedNoop!
- ^ self partName: 'WaveEditor'
- categories: #('Multimedia')
- documentation: 'A workbench for seing and editing wave forms'!
Item was changed:
----- Method: WaveEditor>>addControls (in category 'initialization') -----
addControls
+ | slider aWrapper m aButton |
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: Color transparent;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ extent: 5 @ 5.
+ aWrapper wrapCentering: #topLeft.
+ aButton := self buttonName: 'X' action: #delete.
+ aButton setBalloonText: 'Close WaveEditor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Menu' translated action: #invokeMenu.
+ aButton setBalloonText: 'Open a menu' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play' translated action: #play.
+ aButton setBalloonText: 'Play sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor.
+ aButton setBalloonText: 'Play before cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play After' translated action: #playAfterCursor.
+ aButton setBalloonText: 'Play after cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Loop' translated action: #playLoop.
+ aButton setBalloonText: 'Play the loop' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Test' translated action: #playTestNote.
+ aButton setBalloonText: 'Test the note' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Save' translated action: #saveInstrument.
+ aButton setBalloonText: 'Save the sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd.
+ aButton setBalloonText: 'Set loop end at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle.
+ aButton setBalloonText: 'Set one cycle' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart.
+ aButton setBalloonText: 'Set the loop start at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ self addMorphBack: aWrapper.
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: self color;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #spaceFill;
+ vResizing: #rigid;
+ extent: 5 @ 20;
+ wrapCentering: #center;
+ cellPositioning: #leftCenter.
+ m := StringMorph new contents: 'Index: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #cursor;
+ putSelector: #cursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 71;
+ step.
+ aWrapper addMorphBack: m.
+ m := StringMorph new contents: 'Value: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #valueAtCursor;
+ putSelector: #valueAtCursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 50;
+ step.
+ aWrapper addMorphBack: m.
+ slider := SimpleSliderMorph new color: color;
+ extent: 200 @ 10;
+ target: self;
+ actionSelector: #scrollTime:.
+ aWrapper addMorphBack: slider.
+ m := Morph new color: aWrapper color;
+ extent: 10 @ 5.
+ "spacer"
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #startIndex;
+ putSelector: #startIndex:;
+ font: Preferences standardEToysButtonFont;
+ width: 40;
+ step.
+ aWrapper addMorphBack: m.
+ self addMorphBack: aWrapper!
- | slider bb r m |
- r := AlignmentMorph newRow.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r color: bb color; borderWidth: 0; layoutInset: 0.
- r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
- r wrapCentering: #topLeft.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'X'; actionSelector: #delete).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: '<>'; actWhen: #buttonDown;
- actionSelector: #invokeMenu).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play' translated; actionSelector: #play).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Before' translated; actionSelector: #playBeforeCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play After' translated; actionSelector: #playAfterCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Loop' translated; actionSelector: #playLoop).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Test' translated; actionSelector: #playTestNote).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Save' translated; actionSelector: #saveInstrument).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop End' translated; actionSelector: #setLoopEnd).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'One Cycle' translated; actionSelector: #setOneCycle).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop Start' translated; actionSelector: #setLoopStart).
- self addMorphBack: r.
-
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
-
- m := StringMorph new contents: 'Index: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #cursor; putSelector: #cursor:;
- growable: false; width: 71; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Value: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:;
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- slider := SimpleSliderMorph new
- color: color;
- extent: 200@2;
- target: self;
- actionSelector: #scrollTime:.
- r addMorphBack: slider.
-
- m := Morph new color: r color; extent: 10@5. "spacer"
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #startIndex; putSelector: #startIndex:;
- width: 40; step.
- r addMorphBack: m.
-
- self addMorphBack: r.
-
- !
Item was changed:
----- Method: WaveEditor>>addLoopPointControls (in category 'initialization') -----
addLoopPointControls
+ | m aWrapper |
+ aWrapper _ AlignmentMorph newRow.
+ aWrapper color: self color; borderWidth: 0; layoutInset: 0.
+ aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
- | r m |
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
+ m _ StringMorph new contents: 'Loop end: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- m := StringMorph new contents: 'Loop end: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopEnd; putSelector: #loopEnd:;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop length: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopLength; putSelector: #loopLength:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop cycles: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopCycles; putSelector: #loopCycles:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Frequency: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Frequency: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
- growable: false; width: 50; step.
- r addMorphBack: m.
+ self addMorphBack: aWrapper
- self addMorphBack: r.
!
Item was changed:
----- Method: WaveEditor>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ samplingRate _ SoundPlayer samplingRate.
+ loopEnd _ loopLength _ 0.
+ loopCycles _ 1.
+ perceivedFrequency _ 0.
- samplingRate := SoundPlayer samplingRate.
- loopEnd := loopLength := 0.
- loopCycles := 1.
- perceivedFrequency := 0.
"zero means unknown"
self extent: 5 @ 5;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ graph _ GraphMorph new extent: 450 @ 100.
- graph := GraphMorph new extent: 450 @ 100.
graph cursor: 0.
graph cursorColorAtZeroCrossings: Color blue.
self addControls.
self addLoopPointControls.
self addMorphBack: graph.
self
addMorphBack: (Morph
newBounds: (0 @ 0 extent: 0 @ 3)
color: Color transparent).
+ self addMorphBack: (keyboard _ PianoKeyboardMorph new).
+ "self sound: (SampledSound soundNamed: 'croak')."
- self addMorphBack: (keyboard := PianoKeyboardMorph new).
- self sound: (SampledSound soundNamed: 'croak').
!
Item was changed:
----- Method: Workspace class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#Workspace. #prototypicalToolWindow. 'Workspace' translatedNoop. 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.' translatedNoop} forFlapNamed: 'Tools'.]!
- ifPresent: [:cl | cl registerQuad: #(Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')
- forFlapNamed: 'Tools'.]!
1
0
Tim Felgentreff uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-tfel.180.mcz
==================== Summary ====================
Name: MorphicExtras-tfel.180
Author: tfel
Time: 2 August 2016, 11:35:46.735786 am
UUID: 35687880-685f-0f49-9e73-7e8a703b4458
Ancestors: MorphicExtras-tfel.179
don't try to add empty morphs
=============== Diff against MorphicExtras-tfel.178 ===============
Item was changed:
----- Method: AlignmentMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Extra items for parts bins"
^ {DescriptionForPartsBin
+ formalName: 'Column' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a column' translatedNoop
- formalName: 'Column'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a column'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #columnPrototype.
DescriptionForPartsBin
+ formalName: 'Row' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a row' translatedNoop
- formalName: 'Row'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a row'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #rowPrototype}!
Item was changed:
+ ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'olpc support') -----
+ fancyText: aString font: aFont color: aColor
+ "Answer a morph containing a TextMorph containing the given string in the given font with the given color."
+
+ | answer tm |
+ answer _ self inAColumn: {
+ tm _ TextMorph new
+ textColor: aColor;
+ contents: aString;
+ beAllFont: aFont;
+ yourself
+ }.
+
- ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'as yet unclassified') -----
- fancyText: aString font: aFont color: aColor
- | answer tm col |
- col := ColorTheme current dialog3DTitles
- ifTrue: [aColor]
- ifFalse: [aColor negated].
- tm := TextMorph new.
- tm beAllFont: aFont;
- color: col;
- contents: aString.
- answer := self inAColumn: {tm}.
- ColorTheme current dialog3DTitles
- ifTrue: [""
- tm addDropShadow.
- tm shadowPoint: 5 @ 5 + tm bounds center].
tm lock.
+ ^ answer
+ !
- ^ answer!
Item was changed:
----- Method: AlignmentMorphBob1>>inARow: (in category 'as yet unclassified') -----
inARow: aCollectionOfMorphs
| row |
row := AlignmentMorph newRow color: Color transparent;
vResizing: #shrinkWrap;
layoutInset: 2;
wrapCentering: #center;
cellPositioning: #leftCenter.
aCollectionOfMorphs
+ do: [:each | each ifNotNil: [row addMorphBack: each]].
- do: [:each | row addMorphBack: each].
^ row!
Item was changed:
----- Method: BOBTransformationMorph>>recomputeExtent (in category 'as yet unclassified') -----
recomputeExtent
| scalePt newScale theGreenThingie greenIBE myNewExtent |
submorphs isEmpty ifTrue: [^self extent].
+ worldBoundsToShow ifNil: [worldBoundsToShow _ self firstSubmorph bounds].
- worldBoundsToShow ifNil: [worldBoundsToShow := self firstSubmorph bounds].
worldBoundsToShow area = 0 ifTrue: [^self extent].
+ scalePt _ owner innerBounds extent / worldBoundsToShow extent.
+ newScale _ scalePt x min: scalePt y.
+ theGreenThingie _ owner.
+ greenIBE _ theGreenThingie innerBounds extent.
+ myNewExtent _ (greenIBE min: worldBoundsToShow extent * newScale) truncated.
- scalePt := owner innerBounds extent / worldBoundsToShow extent.
- newScale := scalePt x min: scalePt y.
- theGreenThingie := owner.
- greenIBE := theGreenThingie innerBounds extent.
- myNewExtent := (greenIBE min: worldBoundsToShow extent * newScale) truncated.
self
scale: newScale;
offset: worldBoundsToShow origin * newScale.
+ smoothing _ (newScale < 1.0) ifTrue: [1] ifFalse: [1].
- smoothing := (newScale < 1.0) ifTrue: [2] ifFalse: [1].
^myNewExtent!
Item was changed:
----- Method: BasicButton class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'button' translatedNoop!
- ^ 'button'!
Item was changed:
+ ----- Method: BasicButton>>label:font: (in category 'initialization') -----
- ----- Method: BasicButton>>label:font: (in category 'as yet unclassified') -----
label: aString font: aFontOrNil
+ "Set the receiver's label and font as indicated."
| oldLabel m aFont |
+ (oldLabel _ self findA: StringMorph)
- (oldLabel := self findA: StringMorph)
ifNotNil: [oldLabel delete].
+ aFont _ aFontOrNil ifNil: [Preferences standardEToysButtonFont].
+ m _ StringMorph contents: aString font: aFont.
- aFont := aFontOrNil ifNil: [Preferences standardButtonFont].
- m := StringMorph contents: aString font: aFont.
self extent: (m width + 6) @ (m height + 6).
m position: self center - (m extent // 2).
self addMorph: m.
m lock
!
Item was changed:
----- Method: BookMorph class>>alreadyInFromUrl: (in category 'url') -----
alreadyInFromUrl: aUrl
"Does a bookMorph living in some world in this image represent the same set of server pages? If so, don't create another one. It will steal pages from the existing one. Go delete the first one."
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world ifNotNil: [
+ self inform: 'This book is already open in some project' translated.
- self inform: 'This book is already open in some project'.
^ true]]]].
^ false!
Item was changed:
----- Method: BookMorph class>>authoringPrototype (in category 'scripting') -----
authoringPrototype
"Answer an instance of the receiver suitable for placing in a parts bin for authors"
| book |
+ book := self new initializeToStandAlone.
+ book markAsPartsDonor.
- book := self new markAsPartsDonor.
- book removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
- book borderWidth: 1; borderColor: Color black.
- book beSticky.
- book showPageControls; insertPage.
^ book!
Item was changed:
----- Method: BookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Book' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'Multi-page structures' translatedNoop
+ sampleImageForm: (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAAMgAAACgCAYAAABJ/yOpAAAABHNCSVQFBQUBSsjp7wAABMtJ
+ REFUeF7l3S2S4kAAgFEkEonkCEiOgEQikUgkEolEcgSOgEQiOcYcAZfdniqmpnaBkE43JHni
+ 7dZuzWR7m3z5ISHT6/X6hc/ne+TvL9fr1efz/cMPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5OhLI
+ 19eXz9dZfiA+nx+Iz+cH4vN1K5Dz+fxUEyaoCWP0xwAF8ntSy94l+NQL0IQx+mMAA3llop+9
+ AO+K49Nj9MeABfLqVujVrVTOvcYnx+iPAQwkxWTn3kI1YYz+GMBAckx4kw4lUo3RH4MfiB9I
+ hTHU/ZSbH0gLAsk54akmvuoYY+5LKxvjvTGkDCR2DKnnoq2RZAkkNo4cK2DKOGJv3Hw0xkdj
+ SB1IzBhyzEedSC6XS7Hf74vFYlGMx+Nit9uVfs9yufz++jrLaFwg75r0KmMsW/nkQKrMSexr
+ dTgc/vs/rlar0u/r9/vfkdRZRiMDecekvzrGV1Y+PZBX5yX2tTqdTsVmsymOx+PPir5er0uj
+ CoGE74ldRpZA6px7xK6Mud7OrLtSPhvjszHkCKTqGHLMQYpzkdvKXbb1D3uO0WhUaxmNDyTX
+ pKdeMXIFkvoQNXcgMfMQG0jZ1n84HP4cXsUuoxWB5Jj0sjGm3GprgZSN+x17kHA4Fb4mfG3n
+ 9yA5Jj3H4Y1/iBU3hhx7kHCuMRgMau+F/ED8QFobyLOt/2QyKebzee3zGP8Qyz/Eau0h1qOt
+ f7jWEd69Ctc7iD2If5Lun6RX2fqHi3/PDq86tQfx3+b13+atuvUPh1az2SzJO2H+hUL/QmEr
+ LhTermuELX5Y+cO/F84zwp/D34d3rX5fPd9ut7WW4d9q0pJbTVLOX5tvNbmdeIf7p+79frta
+ ftszhPOQ2GX4Nyu26GbFNgTSpDt6w02I0+nUv93dv93dv9390Qn6o4uD/gem/A9M+R+Y8j9R
+ 6H/k1v/Irf/QBv+hDf5DG/zH/viP/fHH4AfiPzjOH4MfiP/oUf/Ro/6jR/2HV/sPr/YfXu3/
+ +AOfzw/E5/MD8fn8QHy+pgfi8/k/BtqfDJ/PD8Tn8wPx+fxAfD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fzw/E5/MD8fn8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8QPx+fxAfD4/EJ/PD8Tn8wPx+fxAfL47ro3i
+ B+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8wPx+fxAfD4/EJ/PD8QPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5/EB8Pj8Qn88PxOfz
+ A/H5fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiB+Iz+cH4vP5gfg+o6P8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHw+PxCfz+cH4vP5gfh8fiA+nx+Iz+cH
+ 4vP5gfh8fiA+nx+Iz+cH4vP5gfiB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+
+ ID6fzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHy+jgXi8/nu+wM79mpMjbRBXAAAAABJRU5E
+ rkJggg==' readStream) readStream) nextImage!
- ^ self partName: 'Book'
- categories: #('Presentation')
- documentation: 'Multi-page structures'!
Item was changed:
----- Method: BookMorph class>>initialize (in category 'class initialization') -----
initialize
- FileList registerFileReader: self.
-
self registerInFlapsRegistry. !
Item was changed:
----- Method: BookMorph class>>isInWorld:withUrl: (in category 'url') -----
isInWorld: aWorld withUrl: aUrl
| urls bks short |
"If a book with this url is in the that (current) world, return it. Say if it is out or in another world."
+ urls _ OrderedCollection new.
+ bks _ OrderedCollection new.
- urls := OrderedCollection new.
- bks := OrderedCollection new.
aWorld allMorphsDo: [:aBook | (aBook isKindOf: BookMorph) ifTrue: [
bks add: aBook.
(urls add: (aBook valueOfProperty: #url)) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]]]]. "shortcut"
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]
ifFalse: [
+ self inform: 'Book may be open in some other project' translated.
- self inform: 'Book may be open in some other project'.
^ aBook]]]].
"if same book name, use it"
+ short _ (aUrl findTokens: '/') last.
- short := (aUrl findTokens: '/') last.
urls withIndexDo: [:kk :ind | (kk findTokens: '/') last = short ifTrue: [
^ bks at: ind]].
^ #out!
Item was changed:
----- Method: BookMorph class>>nextPageButton (in category 'scripting') -----
nextPageButton
+ "Answer a button that will take the user to the next page of its
+ enclosing book"
- "Answer a button that will take the user to the next page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #NextPage.
+ aButton target: aButton.
+ aButton actionSelector: #nextOwnerPage.
+ aButton arguments: #().
+ aButton setNameTo: 'previous'.
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #nextOwnerPage; label: '->'; color: Color yellow.
- aButton setNameTo: 'next'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>openFromFile: (in category 'fileIn/Out') -----
openFromFile: fullName
"Reconstitute a Morph from the selected file, presumed to be represent
a Morph saved via the SmartRefStream mechanism, and open it in an
appropriate Morphic world"
| book aFileStream |
Smalltalk verifyMorphicAvailability ifFalse: [^ self].
+ aFileStream _ FileStream readOnlyFileNamed: fullName.
+ book _ BookMorph new.
- aFileStream := FileStream oldFileNamed: fullName.
- book := BookMorph new.
book setProperty: #url toValue: aFileStream url.
book fromRemoteStream: aFileStream.
aFileStream close.
Smalltalk isMorphic
ifTrue: [ActiveWorld addMorphsAndModel: book]
ifFalse:
[book isMorph ifFalse: [^self inform: 'Can only load a single morph
+ into an mvc project via this mechanism.' translated].
- into an mvc project via this mechanism.'].
book openInWorld].
book goToPage: 1!
Item was changed:
----- Method: BookMorph class>>previousPageButton (in category 'scripting') -----
previousPageButton
+ "Answer a button that will take the user to the previous page of its
+ enclosing book"
- "Answer a button that will take the user to the previous page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #PrevPage.
+ aButton target: aButton.
+ aButton actionSelector: #previousOwnerPage.
+ aButton arguments: #().
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #previousOwnerPage; color: Color yellow; label: '<-'.
aButton setNameTo: 'previous'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BookMorph . #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'Supplies']!
Item was changed:
----- Method: BookMorph class>>serviceLoadAsBook (in category 'fileIn/Out') -----
serviceLoadAsBook
^ SimpleServiceEntry
provider: self
+ label: 'load as book' translatedNoop
- label: 'load as book'
selector: #openFromFile:
+ description: 'open as bookmorph' translatedNoop!
- description: 'open as bookmorph'!
Item was changed:
----- Method: BookMorph>>goToPageMorph:transitionSpec: (in category 'navigation') -----
goToPageMorph: newPage transitionSpec: transitionSpec
+ "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided."
+
| pageIndex aWorld oldPageIndex ascending tSpec readIn |
pages isEmpty ifTrue: [^self].
self setProperty: #searchContainer toValue: nil. "forget previous search"
self setProperty: #searchOffset toValue: nil.
self setProperty: #searchKey toValue: nil.
pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"].
readIn := newPage isInMemory not.
oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil].
ascending := (oldPageIndex isNil or: [newPage == currentPage])
ifTrue: [nil]
ifFalse: [oldPageIndex < pageIndex].
tSpec := transitionSpec ifNil:
["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec
ifAbsent:
[" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]].
self flag: #arNote. "Probably unnecessary"
(aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus].
currentPage ifNotNil: [currentPage updateCachedThumbnail].
self currentPage notNil
ifTrue:
[(((pages at: pageIndex) owner isKindOf: TransitionMorph)
and: [(pages at: pageIndex) isInWorld])
ifTrue: [^self "In the process of a prior pageTurn"].
self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts].
+ self removeViewersOnSubsIn: ActiveWorld presenter.
ascending ifNotNil:
["Show appropriate page transition and start new page when done"
currentPage stopStepping.
(pages at: pageIndex) position: currentPage position.
^(TransitionMorph
effect: tSpec second
direction: tSpec third
inverse: (ascending or: [transitionSpec notNil]) not)
showTransitionFrom: currentPage
to: (pages at: pageIndex)
in: self
whenStart: [self playPageFlipSound: tSpec first]
whenDone:
[currentPage
delete;
fullReleaseCachedState.
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrlInBook: self url.
currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page"
currentPage
delete;
fullReleaseCachedState].
+ self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage"
- self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
-
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrl.
+ currentPage sqkPage computeThumbnail "just store it"].
+ ActiveWorld ifNotNil: [ActiveWorld presenter flushPlayerListCache]!
- currentPage sqkPage computeThumbnail "just store it"]!
Item was changed:
----- Method: BookMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
+ super initializeToStandAlone.
+ self removeEverything; pageSize: 360@228; color: Color white.
- self initialize.
- self removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
self borderWidth: 1; borderColor: Color black.
self beSticky.
self showPageControls; insertPage.
^ self!
Item was changed:
----- Method: BookMorph>>pasteBookPage (in category 'menu') -----
pasteBookPage
+ "If the paste buffer has something to paste, paste it as a book page."
+
| aPage |
+ aPage _ self primaryHand objectToPaste.
+ aPage removeProperty: #revertKey.
- aPage := self primaryHand objectToPaste.
self insertPage: aPage pageSize: aPage extent atIndex: ((pages indexOf: currentPage) - 1).
"self goToPageMorph: aPage"!
Item was changed:
----- Method: BookMorph>>setNewPagePrototype (in category 'menu') -----
setNewPagePrototype
"Record the current page as the prototype to be copied when inserting new pages."
currentPage ifNotNil:
+ [newPagePrototype _ currentPage veryDeepCopy.
+ newPagePrototype removeProperty: #revertKey].
+ "When a new page is inserted, it will not have any original page to revert to. After author improves the new page, he can save it for later revert."
- [newPagePrototype := currentPage veryDeepCopy].
!
Item was changed:
+ ----- Method: BookPageSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: BookPageSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
+ | bb r str aCheckbox aWrapper |
+ r _ AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
+ r wrapCentering: #center; cellPositioning: #leftCenter;
- | bb r aButton str |
- r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
- r wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated.
+ r addTransparentSpacerOfSize: 12.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete)).
+ bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated; actionSelector: #acceptSort)).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated; actionSelector: #delete)).
+ "eliminate the parts-bin button on the book-page sorters...
+ r addTransparentSpacerOfSize: 24 @ 0.
+
+ aCheckbox := UpdatingThreePhaseButtonMorph checkBox.
+ aCheckbox
- r addTransparentSpacerOfSize: 8 @ 0.
- r addMorphBack: (self wrapperFor: (aButton := UpdatingThreePhaseButtonMorph checkBox)).
- aButton
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ str _ StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons.
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
+ addMorphBack: (self wrapperFor: aCheckbox);
+ addMorphBack: (self wrapperFor: str lock).
+ r addMorphBack: aWrapper."
- str := StringMorph contents: 'Parts bin' translated.
- r addMorphBack: (self wrapperFor: str lock).
+ self addMorphFront: r
- self addMorphFront: r.
!
Item was changed:
----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'as yet unclassified') -----
book: aBookMorph morphsToSort: morphList
+ | innerBounds scrollPane newHeight |
+ book _ aBookMorph.
+ newHeight _ self currentWorld height.
- | innerBounds |
- book := aBookMorph.
pageHolder removeAllMorphs.
pageHolder addAllMorphs: morphList.
pageHolder extent: pageHolder width@pageHolder fullBounds height.
+ innerBounds _ Rectangle merging: (morphList collect: [:m | m bounds]).
+ pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.
+ (pageHolder height > newHeight) ifTrue: [
+ scrollPane _ ScrollPane new.
+
+ self height: newHeight.
+ scrollPane model: pageHolder.
+ scrollPane extent: pageHolder width@(newHeight - aBookMorph submorphs first height - 28).
+ self addMorph: scrollPane inFrontOf: pageHolder.
+ scrollPane scroller addMorph: pageHolder.
+ scrollPane scrollBarOnLeft: false.
+ scrollPane retractable: false.
+ scrollPane hideHScrollBarIndefinitely: true.
+ scrollPane borderWidth: 1; borderColor: Color gray.
+ ].
+ !
- innerBounds := Rectangle merging: (morphList collect: [:m | m bounds]).
- pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.!
Item was changed:
----- Method: BookPageSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: Display extent - 100;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ pageHolder _ PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
- pageHolder := PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
pageHolder hResizing: #shrinkWrap.
+ pageHolder wantsMouseOverHalos: false.
"pageHolder cursor: 0."
"causes a walkback as of 5/25/2000"
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: BookPageThumbnailMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
| f |
super initialize.
+ flipOnClick _ false.
- ""
- flipOnClick := false.
+ f _ Form extent: 160@120 depth: Display depth.
- f := Form extent: 60 @ 80 depth: Display depth.
f fill: f boundingBox fillColor: color.
self form: f!
Item was changed:
----- Method: BooklikeMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
"This factoring allows subclasses to have different menu yet still use the super call for the rest of the metamenu."
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ aCustomMenu add: 'book...' translated target: self action: #invokeBookMenu.
+
+ "self addBookMenuItemsTo: aCustomMenu hand: aHandMorph"!
- self addBookMenuItemsTo: aCustomMenu hand: aHandMorph!
Item was changed:
----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') -----
currentPlayerDo: aBlock
| aPlayer aPage |
(aPage := self currentPage) ifNil: [^ self].
+ aPage allMorphsDo:[ :m|
+ (aPlayer := m player) ifNotNil:
+ [aBlock value: aPlayer]]!
- (aPlayer := aPage player) ifNotNil:
- [aBlock value: aPlayer]!
Item was changed:
----- Method: BooklikeMorph>>shortControlSpecs (in category 'page controls') -----
shortControlSpecs
+ "Answer specs defining the widgets in the short form of the control panel."
+
^ {
#spacer.
#variableSpacer.
{'<'. #previousPage. 'Previous page' translated}.
#spacer.
+ {#MenuIcon. #invokeShortBookMenu. 'Click here to get a menu of options for this book.' translated}.
- {'·'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}.
#spacer.
{'>'. #nextPage. 'Next page' translated}.
#spacer.
#variableSpacer.
+ {#RightCaret. #showMoreControls. 'More controls' translated}
- {'³'. #showMoreControls. 'More controls' translated}
}
!
Item was changed:
----- Method: BooklikeMorph>>showingFullScreenString (in category 'misc') -----
showingFullScreenString
+ "Answer a string characterizing whether the receiver is operating in full-screen mode."
+
+ ^ (self isInFullScreenMode ifTrue: ['<yes>'] ifFalse: ['<no>']), 'view pages full-screen' translated!
- ^ (self isInFullScreenMode
- ifTrue: ['exit full screen']
- ifFalse: ['show full screen']) translated!
Item was changed:
----- Method: BooklikeMorph>>showingPageControlsString (in category 'misc') -----
showingPageControlsString
+ "Answer a string characterizing whether page controls are currently showing."
+
+ ^ (self pageControlsVisible ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'page controls visible' translated!
- ^ (self pageControlsVisible
- ifTrue: ['hide page controls']
- ifFalse: ['show page controls']) translated!
Item was changed:
----- Method: BouncingAtomsMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'BouncingAtoms' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney' translatedNoop!
- ^ self partName: 'BouncingAtoms'
- categories: #('Demo')
- documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney'!
Item was changed:
----- Method: BouncingAtomsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BouncingAtomsMorph, #new. 'Bouncing Atoms' translatedNoop. 'Atoms, mate' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BouncingAtomsMorph new 'Bouncing Atoms' 'Atoms, mate')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: ClockMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Answer a description for use in parts bins."
+
+ ^ self partName: 'Digital Clock' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A digital clock' translatedNoop!
- ^ self partName: 'Clock'
- categories: #('Useful')
- documentation: 'A digital clock'!
Item was changed:
----- Method: ClockMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ClockMorph, #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: ClockMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
+ "Add toggles for showing-seconds and display-24-hrs to the halo menu"
+
+ "NB: intentionallyi no super call here!!"
+
+ aCustomMenu add: 'change font' translated action: #changeFont.
+
+ aCustomMenu addUpdating: #showingSecondsString action: #toggleShowingSeconds.
+ aCustomMenu addUpdating: #displaying24HourString action: #toggleShowing24hr!
- "Note minor loose end here -- if the menu is persistent, then the wording will be wrong half the time"
- | item |
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- item := showSeconds == true
- ifTrue: ['stop showing seconds']
- ifFalse: ['start showing seconds'].
- aCustomMenu add: item translated target: self action: #toggleShowingSeconds.
- item := show24hr == true
- ifTrue: ['display Am/Pm']
- ifFalse: ['display 24 hour'].
- aCustomMenu add: item translated target: self action: #toggleShowing24hr.
-
- !
Item was changed:
----- Method: ClockMorph>>initialize (in category 'initialization') -----
initialize
+ "initialize the state of the receiver"
+
- "initialize the state of the receiver"
super initialize.
+
+ showSeconds _ true.
+ show24hr _ false.
+ self font: Preferences standardMenuFont emphasis: 1.
- ""
- showSeconds := true.
- show24hr := false.
self step!
Item was changed:
----- Method: ClockMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
super initializeToStandAlone.
+ showSeconds _ false.
+ self font: (Preferences standardMenuFont emphasized: 1).
- showSeconds := true.
self step!
Item was changed:
----- Method: CurveMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#CurveMorph, #authoringPrototype. 'Curve' translatedNoop, 'A curve' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#CurveMorph. #authoringPrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}
- cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: CurveMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Curvy Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.' translatedNoop
- formalName: 'Curvy Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.'
globalReceiverSymbol: #CurveMorph
nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: EllipseMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: EnvelopeEditorMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: menu hand: aHandMorph
super addCustomMenuItems: menu hand: aHandMorph.
menu addLine.
envelope updateSelector = #ratio: ifTrue:
[menu add: 'choose denominator...' translated action: #chooseDenominator:].
menu add: 'adjust scale...' translated action: #adjustScale:.
- SoundPlayer isReverbOn
- ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb]
- ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb].
menu addLine.
menu add: 'get sound from lib' translated action: #chooseSound:.
menu add: 'put sound in lib' translated action: #saveSound:.
menu add: 'read sound from disk...' translated action: #readFromDisk:.
menu add: 'save sound on disk...' translated action: #saveToDisk:.
menu add: 'save library on disk...' translated action: #saveLibToDisk:.
!
Item was changed:
----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'editing') -----
buildScalesIn: frame
+ | env |
+ env _ envelope.
+ pixPerTick _ graphArea width // (self maxTime//10) max: 1.
+ "hminortick _ ( 1 + ( self maxTime // 800 ) ) * 10.
+ hmajortick _ ( 1 + ( self maxTime // 800 ) ) * 100."
+ hScale _ (Morph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) color: Color lightGreen.
+ " hScale _ (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
- | env hmajortick hminortick |
- env := envelope.
- pixPerTick := graphArea width // (self maxTime//10) max: 1.
- hminortick := ( 1 + ( self maxTime // 800 ) ) * 10.
- hmajortick := ( 1 + ( self maxTime // 800 ) ) * 100.
- hScale := (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
start: 0 stop: self maxTime
minorTick: hminortick minorTickLength: 3
majorTick: hmajortick majorTickLength: 10
caption: 'milliseconds' tickPrintBlock: [:v | v printString].
+ "
self addMorph: hScale.
+ vScale _ (Morph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))) color: Color lightGreen.
+ "vScale _ ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))."
- vScale := ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left)).
env name = 'pitch'
ifTrue:
[env scale >= 2.0
ifTrue:
[vScale start: 0 stop: env scale
minorTick: env scale / 24 minorTickLength: 3
majorTick: env scale / 2.0 majorTickLength: 10
caption: 'pitch (octaves)'
tickPrintBlock: [:v | (v-(env scale/2)) asInteger printString]]
ifFalse:
[vScale start: 0 stop: env scale
minorTick: 1.0/48.0 minorTickLength: 3
majorTick: 1.0/12.0 majorTickLength: 10
caption: 'pitch (half-steps)'
tickPrintBlock: [:v | (v-(env scale/2)*12) rounded printString]]]
ifFalse: [
env name = 'random pitch:'
ifTrue: [
vScale start: 0.9 stop: 1.1
minorTick: 0.2 / 50.0 minorTickLength: 3
majorTick: 0.2 / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]]
ifFalse: [
vScale start: 0 stop: env scale
minorTick: env scale / 50.0 minorTickLength: 3
majorTick: env scale / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]].
].
+ vScale _ TransformationMorph new asFlexOf: vScale.
- vScale := TransformationMorph new asFlexOf: vScale.
vScale angle: Float pi / 2.0.
self addMorph: vScale.
vScale position: (frame left)@(graphArea top-1) - (3@1).
!
Item was changed:
----- Method: EventRecorderMorph>>addButtons (in category 'initialization') -----
addButtons
+ | r b w |
- | r b |
caption ifNotNil: ["Special setup for play-only interface"
+ (r _ self makeARowForButtons)
- (r := self makeARowForButtons)
addMorphBack: (SimpleButtonMorph new target: self;
+ label: caption font: Preferences standardButtonFont; actionSelector: #play);
- label: caption; actionSelector: #play);
- addMorphBack: self makeASpacer;
- addMorphBack: self makeStatusLight;
addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
+ addMorphBack: self makeASpacer.
^ self addMorphBack: r
].
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#record. nil. 'Begin recording'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#record. nil. 'Begin recording'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#stop. b width. 'Stop recording - you can also use the ESC key to stop it'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#play. b width. 'Play current recording'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#readTape. b width. 'Get a new recording from disk'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
+ addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
addMorphBack: self makeASpacer;
+ addMorphBack: (self buttonFor: {#createPlayButton. b width. 'Make a simple button to play this recording'}).
- addMorphBack: self makeStatusLight;
- addMorphBack: self makeASpacer;
- addMorphBack: (self buttonFor: {#button. b width. 'Make a simple button to play this recording'}).
self addMorph: r.
self setStatusLight: #ready.!
Item was changed:
----- Method: EventRecorderMorph>>handleListenEvent: (in category 'events-processing') -----
handleListenEvent: anEvent
"Record the given event"
+ anEvent hand == recHand ifFalse: [^ self]. "not for me"
+ state == #record ifFalse: [
+ "If user got an error while recording and deleted recorder, will still be listening"
+ recHand ifNotNil: [recHand removeEventListener: self].
+ ^self].
- (state == #record and:[anEvent hand == recHand])
- ifFalse:[^self].
anEvent = lastEvent ifTrue: [^ self].
(anEvent isKeyboard and:[anEvent keyValue = 27 "esc"])
ifTrue: [^ self stop].
+ time _ anEvent timeStamp.
- time := anEvent timeStamp.
tapeStream nextPut: (anEvent copy setHand: nil).
journalFile ifNotNil:
[journalFile store: anEvent; cr; flush].
+ lastEvent _ anEvent.!
- lastEvent := anEvent.!
Item was changed:
----- Method: EventRecorderMorph>>pauseIn: (in category 'pause/resume') -----
pauseIn: aWorld
"Suspend playing or recording, either as part of a stop command,
or as part of a project switch, after which it will be resumed."
self setStatusLight: #ready.
state = #play ifTrue:
+ [state _ #suspendedPlay.
+ playHand halo ifNotNil: [playHand halo delete].
- [state := #suspendedPlay.
playHand delete.
aWorld removeHand: playHand.
+ playHand _ nil].
- playHand := nil].
state = #record ifTrue:
+ [state _ #suspendedRecord.
- [state := #suspendedRecord.
recHand removeEventListener: self.
+ recHand _ nil].
- recHand := nil].
voiceRecorder ifNotNil:
[voiceRecorder pause.
startSoundEvent ifNotNil:
[startSoundEvent argument: voiceRecorder recordedSound.
voiceRecorder clearRecordedSound.
+ startSoundEvent _ nil]].
- startSoundEvent := nil]].
!
Item was changed:
----- Method: EventRecorderMorph>>resumeIn: (in category 'pause/resume') -----
resumeIn: aWorld
"Resume playing or recording after a project switch."
+ self state = #suspendedPlay ifTrue:
- state = #suspendedPlay ifTrue:
[self resumePlayIn: aWorld].
+ self state = #suspendedRecord ifTrue:
- state = #suspendedRecord ifTrue:
[self resumeRecordIn: aWorld].
!
Item was changed:
----- Method: EventRecorderMorph>>resumePlayIn: (in category 'pause/resume') -----
resumePlayIn: aWorld
+ playHand _ HandMorphForReplay new recorder: self.
- playHand := HandMorphForReplay new recorder: self.
playHand position: tapeStream peek position.
aWorld addHand: playHand.
playHand newKeyboardFocus: aWorld.
playHand userInitials: 'play' andPicture: nil.
+ lastEvent _ nil.
+ lastDelta _ 0@0.
+ self findPlayOffset.
+ state _ #play.
- lastEvent := nil.
- lastDelta := 0@0.
- state := #play.
self synchronize.
!
Item was changed:
----- Method: EventRecorderMorph>>synchronize (in category 'event handling') -----
synchronize
+ time _ lastInterpolation _ Time millisecondClockValue.
+ deltaTime _ nil.!
- time := Time millisecondClockValue.
- deltaTime := nil.!
Item was changed:
----- Method: EventRecorderMorph>>writeTape: (in category 'fileIn/Out') -----
writeTape: fileName
+ | name bb |
+ name _ self writeFileNamed: fileName.
+ bb _ self findDeepSubmorphThat: [:mm | (mm isKindOf: SimpleButtonMorph)
+ and: [mm label = 'writeTape']]
+ ifAbsent: [^ self].
+ bb actionSelector: #writeTape:.
+ bb arguments: (Array with: name).
- | b name |
- name := self writeFileNamed: fileName.
- (b := self button: 'writeTape') ifNotNil: [
- b actionSelector: #writeTape:.
- b arguments: (Array with: name)].
!
Item was changed:
----- Method: FlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'flap tab' translatedNoop!
- ^ 'flap tab'!
Item was changed:
----- Method: FlapTab>>adaptToWorld (in category 'initialization') -----
adaptToWorld
| wasShowing new |
+ (wasShowing _ self flapShowing) ifTrue:
- (wasShowing := self flapShowing) ifTrue:
[self hideFlap].
(self respondsTo: #unhibernate) ifTrue: [
+ (new _ self unhibernate) == self ifFalse: [
- (new := self unhibernate) == self ifFalse: [
^ new adaptToWorld]].
- self spanWorld.
- self positionObject: self.
wasShowing ifTrue:
+ [self spanWorld.
+ self positionObject: self.
+ self showFlap]!
- [self showFlap]!
Item was changed:
----- Method: FlapTab>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aMenu hand: aHandMorph
"Add further items to the menu as appropriate"
aMenu add: 'tab color...' translated target: self action: #changeColor.
aMenu add: 'flap color...' translated target: self action: #changeFlapColor.
aMenu addLine.
aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo.
aMenu addLine.
aMenu addUpdating: #textualTabString action: #textualTab.
aMenu addUpdating: #graphicalTabString action: #graphicalTab.
aMenu addUpdating: #solidTabString enablement: #notSolid action: #solidTab.
aMenu addLine.
(referent isKindOf: PasteUpMorph) ifTrue:
[aMenu addUpdating: #partsBinString action: #togglePartsBinMode].
aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior.
aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior.
aMenu addLine.
aMenu addUpdating: #isGlobalFlapString enablement: #sharedFlapsAllowed action: #toggleIsGlobalFlap.
+ aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.' translated.
- aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.,' translated.
aMenu addLine.
+ aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap.
aMenu add: 'destroy this flap' translated action: #destroyFlap.
"aMenu addUpdating: #slideString action: #toggleSlideBehavior.
aMenu addUpdating: #inboardString action: #toggleInboardness.
aMenu addUpdating: #thicknessString ('thickness... (current: ', self thickness printString, ')') action: #setThickness."
!
Item was changed:
----- Method: FlapTab>>balloonTextForFlapsMenu (in category 'miscellaneous') -----
balloonTextForFlapsMenu
"Answer the balloon text to show on a menu item in the flaps menu that governs the visibility of the receiver in the current project"
| id |
+ id _ self flapID.
- id := self flapID.
#(
+ ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects' translatedNoop)
+ ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.' translatedNoop)
+ ('Widgets' 'A variety of controls and media tools' translatedNoop)
+ ('Supplies' 'Supplies' translatedNoop)
+ ('Help' 'A flap providing documentation, tutorials, and other help' translatedNoop)
+ ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented' translatedNoop)
+ ('Scripting' 'Tools useful when doing tile scripting' translatedNoop)
+ ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment' translatedNoop)
+ ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting' translatedNoop)) do:
- ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects')
- ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.')
- ('Widgets' 'A variety of controls and media tools')
- ('Supplies' 'A source for many basic types of objects')
- ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented')
- ('Scripting' 'Tools useful when doing tile scripting')
- ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment')
- ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting')) do:
[:pair | (FlapTab givenID: id matches: pair first translated) ifTrue: [^ pair second translated]].
^ self balloonText!
Item was changed:
----- Method: FlapTab>>computeEdgeFraction (in category 'edge') -----
computeEdgeFraction
"Compute and remember the edge fraction"
| aBox aFraction |
self isCurrentlySolid ifTrue: [^ edgeFraction ifNil: [self edgeFraction: 0.5]].
+ aBox := ((self pasteUpMorph ifNil: [self currentWorld]) bounds) insetBy: (self extent // 2).
- aBox := ((owner ifNil: [ActiveWorld]) bounds) insetBy: (self extent // 2).
aFraction := self
ifVertical:
[(self center y - aBox top) / (aBox height max: 1)]
ifHorizontal:
[(self center x - aBox left) / (aBox width max: 1)].
^ self edgeFraction: aFraction!
Item was changed:
----- Method: FlapTab>>destroyFlap (in category 'menu') -----
destroyFlap
"Destroy the receiver"
| reply request |
+ request _ self isGlobalFlap
- request := self isGlobalFlap
ifTrue:
['Caution -- this would permanently
remove this flap, so it would no longer be
available in this or any other project.
+ Do you really want to this? ' translated]
- Do you really want to this? ']
ifFalse:
['Caution -- this is permanent!! Do
+ you really want to do this? ' translated].
+ reply _ self confirm: request translated orCancel: [^ self].
- you really want to do this? '].
- reply := self confirm: request translated orCancel: [^ self].
reply ifTrue:
[self isGlobalFlap
ifTrue:
[Flaps removeFlapTab: self keepInList: false.
self currentWorld reformulateUpdatingMenus]
ifFalse:
[referent isInWorld ifTrue: [referent delete].
self delete]]!
Item was changed:
----- Method: FlapTab>>flapMenuTitle (in category 'menu') -----
flapMenuTitle
+ ^ 'flap: ' translated , self wording!
- ^ 'flap: ', self wording!
Item was changed:
----- Method: FlapTab>>graphicalTabString (in category 'graphical tabs') -----
graphicalTabString
^ (self isCurrentlyGraphical
+ ifTrue: ['choose new graphic...' translated]
+ ifFalse: ['use graphical tab' translated]) !
- ifTrue: ['choose new graphic...']
- ifFalse: ['use graphical tab']) translated!
Item was changed:
----- Method: FlapTab>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "Handle a mouse-move event. The event, a MorphicEvent, is passed in."
+
| aPosition newReferentThickness adjustedPosition thick |
dragged ifFalse: [(thick := self referentThickness) > 0
ifTrue: [lastReferentThickness := thick]].
((self containsPoint: (aPosition := evt cursorPoint)) and: [dragged not])
ifFalse:
[flapShowing ifFalse: [self showFlap].
adjustedPosition := aPosition - evt hand targetOffset.
(edgeToAdhereTo == #bottom)
ifTrue:
[newReferentThickness := inboard
ifTrue:
[self world height - adjustedPosition y]
ifFalse:
[self world height - adjustedPosition y - self height]].
(edgeToAdhereTo == #left)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition x + self width]
ifFalse:
[adjustedPosition x]].
(edgeToAdhereTo == #right)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[self world width - adjustedPosition x]
ifFalse:
[self world width - adjustedPosition x - self width]].
(edgeToAdhereTo == #top)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition y + self height]
ifFalse:
[adjustedPosition y]].
self isCurrentlySolid ifFalse:
[(#(left right) includes: edgeToAdhereTo)
ifFalse:
[self left: adjustedPosition x]
ifTrue:
[self top: adjustedPosition y]].
+ ((edgeToAdhereTo == #left) and: [(self valueOfProperty: #rigidThickness) notNil]) ifTrue:
+ [newReferentThickness := referent width].
+
self applyThickness: newReferentThickness.
dragged := true.
self fitOnScreen.
self computeEdgeFraction]!
Item was changed:
----- Method: FlapTab>>solidTabString (in category 'solid tabs') -----
solidTabString
^ (self isCurrentlySolid
+ ifTrue: ['currently using solid tab' translated]
+ ifFalse: ['use solid tab' translated]) !
- ifTrue: ['currently using solid tab']
- ifFalse: ['use solid tab']) translated!
Item was changed:
----- Method: FlapTab>>textualTabString (in category 'textual tabs') -----
textualTabString
^ (self isCurrentlyTextual
+ ifTrue: ['change tab wording...' translated]
+ ifFalse: ['use textual tab' translated]) !
- ifTrue: ['change tab wording...']
- ifFalse: ['use textual tab']) translated!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category 'flaps registry') -----
defaultsQuadsDefiningScriptingFlap
"Answer a structure defining the default items in the Scripting flap.
previously in quadsDeiningScriptingFlap"
+ ^ {
+ {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
+ {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}.
- ^ #(
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
- (ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#FunctionTile. #randomNumberTile. 'Random' translatedNoop. 'A tile that will produce a random number in a given range' translatedNoop}.
+ {#ScriptingSystem. #anyButtonPressedTiles. 'ButtonDown?' translatedNoop. 'Tiles for querying whether the mouse button is down' translatedNoop}.
+ {#ScriptingSystem. #noButtonPressedTiles. 'ButtonUp?' translatedNoop. 'Tiles for querying whether the mouse button is up' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (RandomNumberTile new 'Random' 'A tile that will produce a random number in a given range')
- (ScriptingSystem anyButtonPressedTiles 'ButtonDown?' 'Tiles for querying whether the mouse button is down')
- (ScriptingSystem noButtonPressedTiles 'ButtonUp?' 'Tiles for querying whether the mouse button is up')
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}.
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (TextFieldMorph exampleBackgroundField 'Scrolling Field' 'A scrolling data field which will have a different value on every card of the background')
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#TextMorph. #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}.
+ {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop}
+ } asOrderedCollection!
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (TextMorph exampleBackgroundLabel 'Background Label' 'A piece of text that will occur on every card of the background')
- (TextMorph exampleBackgroundField 'Background Field' 'A data field which will have a different value on every card of the background')
-
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningStackToolsFlap (in category 'flaps registry') -----
defaultsQuadsDefiningStackToolsFlap
"Answer a structure defining the items on the default system Stack Tools flap.
previously in quadsDefiningStackToolsFlap"
+ ^ {
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}.
+ {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}.
+ {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Scriptable Button' translatedNoop. 'A button whose script will be a method of the background Player' translatedNoop}.
+ {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}.
+ {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection
- ^ #(
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (StackMorph stackHelpWindow 'Stack Help' 'Some hints about how to use Stacks')
- (TextMorph authoringPrototype 'Simple Text' 'Text that you can edit into anything you wish')
- (TextMorph fancyPrototype 'Fancy Text' 'A text field with a rounded shadowed border, with a fancy font.')
- (ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
- (ScriptableButton authoringPrototype 'Scriptable Button' 'A button whose script will be a method of the background Player')
- (StackMorph previousCardButton 'Previous Card' 'A button that takes the user to the previous card in the stack')
- (StackMorph nextCardButton 'Next Card' 'A button that takes the user to the next card in the stack')) asOrderedCollection
!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningSuppliesFlap (in category 'flaps registry') -----
defaultsQuadsDefiningSuppliesFlap
"Answer a list of quads which define the objects to appear in the default Supplies flap.
previously in quadsDefiningSuppliesFlap"
+ ^ {
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}.
+ {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
+ } asOrderedCollection!
- ^ #(
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'TabbedPalette' 'A structure with tabs')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>disableGlobalFlaps: (in category 'menu commands') -----
disableGlobalFlaps: interactive
"Clobber all the shared flaps structures. First read the user her Miranda rights."
interactive
ifTrue: [(self confirm:
'CAUTION!! This will destroy all the shared
flaps, so that they will not be present in
*any* project. If, later, you want them
back, you will have to reenable them, from
this same menu, whereupon the standard
default set of shared flaps will be created.
Do you really want to go ahead and clobber
all shared flaps at this time?' translated) ifFalse: [^ self]].
self globalFlapTabsIfAny do:
[:aFlapTab | self removeFlapTab: aFlapTab keepInList: false.
aFlapTab isInWorld ifTrue: [self error: 'Flap problem' translated]].
self clobberFlapTabList.
+ self initializeFlapsQuads.
+ SharedFlapsAllowed _ false.
- SharedFlapsAllowed := false.
Smalltalk isMorphic ifTrue:
[ActiveWorld restoreMorphicDisplay.
ActiveWorld reformulateUpdatingMenus].
"The following reduces the risk that flaps will be created with variant IDs
such as 'Stack Tools2', potentially causing some shared flap logic to fail."
"Smalltalk garbageCollect." "-- see if we are OK without this"
!
Item was changed:
----- Method: Flaps class>>explainFlapsText (in category 'menu commands') -----
explainFlapsText
"Answer the text, in English, to show in a help-window about Flaps."
^'Flaps are like drawers on the edge of the screen, which can be opened so that you can use what is inside them, and closed when you do not need them. They have many possible uses, a few of which are illustrated by the default set of flaps you can get as described below.
+ ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
- ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
+ To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
- To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
+ ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
- ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
+ If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
- If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
+ If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
- If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
+ Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
- Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
+ You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
- You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
+ You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
- You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
+ Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
- Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
+ If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
- If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
+ The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
- The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
+ tab color... Lets you change the color of the flap''s tab.
+ flap color... Lets you change the color of the flap itself.
- tab color... Lets you change the color of the flap''s tab.
- flap color... Lets you change the color of the flap itself.
+ use textual tab... If the tab is not textual, makes it become textual.
+ change tab wording... If the tab is already textual, allows you to edit
- use textual tab... If the tab is not textual, makes it become textual.
- change tab wording... If the tab is already textual, allows you to edit
its wording.
+ use graphical tab... If the tab is not graphical, makes it become
- use graphical tab... If the tab is not graphical, makes it become
graphical.
+ choose tab graphic... If the tab is already graphical, allows you
- choose tab graphic... If the tab is already graphical, allows you
to change the picture.
+ use solid tab... If the tab is not solid, makes it become solid, i.e.
- use solid tab... If the tab is not solid, makes it become solid, i.e.
appear as a solid band of color along the
entire length or width of the screen.
+ parts-bin behavior If set, then dragging an object from the flap
- parts-bin behavior If set, then dragging an object from the flap
tears off a new copy of the object.
+ dragover If set, the flap opens on dragover and closes
- dragover If set, the flap opens on dragover and closes
again on drag-leave.
+
+ mouseover If set, the flap opens on mouseover and closes
- mouseover If set, the flap opens on mouseover and closes
again on mouse-leave.
+ cling to edge... Governs which edge (left, right, top, bottom)
- cling to edge... Governs which edge (left, right, top, bottom)
the flap adheres to.
+ shared If set, the same flap will be available in all projects; if not, the
- shared If set, the same flap will be available in all projects; if not, the
flap will will occur only in one project.
+ destroy this flap Deletes the flap.
- destroy this flap Deletes the flap.
+ To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
- To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
+ To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
- To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
+ To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
- To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
+ Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.' translated!
- Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.'!
Item was changed:
----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') -----
newLoneSuppliesFlap
+ "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch. We're still evidently nurturing this method along, but it is a disused branch, whose lone sender has no senders..."
- "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch"
| aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly"
+ aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: {
- aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: #(
+ {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph . #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#SimpleSliderMorph . #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ " {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}."
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'Tabs' translatedNoop. 'A structure with tabs' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle' )
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph authoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, ec.')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'Tabs' 'A structure with tabs')
+ {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}.
+ {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}.
- (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
- (MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ClockMorph. #authoringPrototype, 'Clock' translatedNoop, 'A simple digital clock' translatedNoop}.
+ {#BookMorph, #previousPageButton, 'Previous' translatedNoop, 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph, #nextPageButton, 'Next' translatedNoop, 'A button that takes you to the next page' translatedNoop}.
+ }.
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'Previous' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'Next' 'A button that takes you to the next page')
- ).
+ aFlapTab _ FlapTab new referent: aStrip beSticky.
- aFlapTab := FlapTab new referent: aStrip beSticky.
aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter.
aStrip extent: self currentWorld width @ 78.
+ leftEdge _ ((Display width - (16 + aFlapTab width)) + 556) // 2.
- leftEdge := ((Display width - (16 + aFlapTab width)) + 556) // 2.
aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)).
aStrip beFlap: true.
aStrip autoLineLayout: true.
^ aFlapTab!
Item was changed:
----- Method: Flaps class>>newNavigatorFlap (in category 'predefined flaps') -----
newNavigatorFlap
"Answer a newly-created flap which adheres to the bottom edge of the screen and which holds the project navigator controls. "
| aFlapTab navBar aFlap |
+ navBar _ ProjectNavigationMorph preferredNavigator new addButtons.
+ aFlap _ PasteUpMorph newSticky borderWidth: 0;
- navBar := ProjectNavigationMorph preferredNavigator new.
- aFlap := PasteUpMorph newSticky borderWidth: 0;
extent: navBar extent + (0@20);
color: (Color orange alpha: 0.8);
beFlap: true;
addMorph: navBar beSticky.
aFlap hResizing: #shrinkWrap; vResizing: #shrinkWrap.
aFlap useRoundedCorners.
aFlap setNameTo: 'Navigator Flap' translated.
navBar fullBounds. "to establish width"
+ aFlapTab _ FlapTab new referent: aFlap.
- aFlapTab := FlapTab new referent: aFlap.
aFlapTab setName: 'Navigator' translated edge: #bottom color: Color orange.
aFlapTab position: ((navBar width // 2) - (aFlapTab width // 2))
@ (self currentWorld height - aFlapTab height).
aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Navigator' translated "
!
Item was changed:
----- Method: Flasher class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver for use in a parts bin"
+ ^ self partName: 'Flasher' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A circle that flashes' translatedNoop!
- ^ self partName: 'Flasher'
- categories: #('Demo')
- documentation: 'A circle that flashes'!
Item was changed:
----- Method: FrameRateMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'FrameRate' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A readout that allows you to monitor the frame rate of your system' translatedNoop!
- ^ self partName: 'FrameRate'
- categories: #('Useful')
- documentation: 'A readout that allows you to monitor the frame rate of your system'!
Item was changed:
----- Method: FrameRateMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#FrameRateMorph. #authoringPrototype. 'Frame Rate' translatedNoop. 'An indicator of how fast your system is running' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(FrameRateMorph authoringPrototype 'Frame Rate' 'An indicator of how fast your system is running')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: FrameRateMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ lastDisplayTime _ 0.
+ framesSinceLastDisplay _ 0.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ !
- lastDisplayTime := 0.
- framesSinceLastDisplay := 0!
Item was changed:
----- Method: FrameRateMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
"Initialize the receiver as a stand-alone entity"
super initializeToStandAlone.
self color: Color blue.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ self step.
+ !
- self step!
Item was changed:
----- Method: GrabPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver's instances for a parts bin"
+ ^ self partName: 'Grab Patch' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Use this to grab a rectangular patch from the screen' translatedNoop!
- ^ self partName: 'Grab Patch'
- categories: #('Graphics')
- documentation: 'Use this to grab a rectangular patch from the screen'!
Item was changed:
----- Method: GrabPatchMorph>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initialize.
+ self image: (ScriptingSystem formAtKey: 'GrabPatch').
+ self setProperty: #ignorePartsBinDrop toValue: true!
- self image: (ScriptingSystem formAtKey: 'GrabPatch')!
Item was changed:
----- Method: GraphMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Graph' translatedNoop
+ categories: #()
+ documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.' translatedNoop!
- ^ self partName: 'Graph'
- categories: #('Useful')
- documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.'!
Item was changed:
----- Method: GraphMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: 365 @ 80.
+ dataColor _ Color darkGray.
+ cursor _ 1.0.
+ samplingRate := 11025.
- dataColor := Color darkGray.
- cursor := 1.0.
"may be fractional"
+ cursorColor _ Color red.
+ cursorColorAtZeroCrossings _ Color red.
+ startIndex _ 1.
+ hasChanged _ false.
- cursorColor := Color red.
- cursorColorAtZeroCrossings := Color red.
- startIndex := 1.
- hasChanged := false.
self
data: ((0 to: 360 - 1)
collect: [:x | (100.0 * x degreesToRadians sin) asInteger])!
Item was changed:
----- Method: GraphicalDictionaryMenu class>>openOn:withLabel: (in category 'instance creation') -----
openOn: aFormDictionary withLabel: aLabel
"open a graphical dictionary in a window having the label aLabel.
aFormDictionary should be a dictionary containing as value a form."
| inst aWindow |
+ aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!' translated].
- aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!'].
inst := self new initializeFor: nil fromDictionary: aFormDictionary.
+ aWindow _ (SystemWindow labelled: aLabel) model: inst.
- aWindow := (SystemWindow labelled: aLabel) model: inst.
aWindow addMorph: inst frame: (0@0 extent: 1@1).
aWindow extent: inst fullBounds extent + (3 @ aWindow labelHeight + 3);
minimumExtent: inst minimumExtent + (3 @ aWindow labelHeight + 3).
HandMorph attach: aWindow.
^ inst!
Item was changed:
----- Method: GraphicalDictionaryMenu>>renameGraphicTo: (in category 'menu commands') -----
renameGraphicTo: newName
| curr |
+ curr _ entryNames at: currentIndex.
- curr := entryNames at: currentIndex.
(newName isEmptyOrNil or: [newName = curr]) ifTrue: [^ Beeper beep].
(baseDictionary includesKey: newName) ifTrue:
[^ self inform: 'sorry that conflicts with
the name of another
+ entry in this dictionary' translated].
- entry in this dictionary'].
baseDictionary at: newName put: (baseDictionary at: curr).
baseDictionary removeKey: curr.
self baseDictionary: baseDictionary.
+ currentIndex _ entryNames indexOf: newName.
- currentIndex := entryNames indexOf: newName.
self updateThumbnail!
Item was changed:
----- Method: GraphicalMenu>>initializeFor:withForms:coexist: (in category 'initialization') -----
initializeFor: aTarget withForms: formList coexist: aBoolean
"World primaryHand attachMorph:
(GraphicalMenu new initializeFor: nil
withForms: Form allInstances coexist: true)"
| buttons bb anIndex buttonCage |
target := aTarget.
coexistWithOriginal := aBoolean.
formChoices := formList.
currentIndex := 1.
self borderWidth: 1;
cellPositioning: #center;
color: Color white;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap.
buttons := AlignmentMorph newRow.
buttons borderWidth: 0;
layoutInset: 0.
buttons hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5 @ 5.
buttons wrapCentering: #topLeft.
buttonCage := AlignmentMorph newColumn.
buttonCage hResizing: #shrinkWrap;
vResizing: #spaceFill.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Prev' translated;
- buttons addMorphBack: (bb label: 'Prev';
actionSelector: #downArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 9 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Next' translated;
- buttons addMorphBack: (bb label: 'Next';
actionSelector: #upArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 5 @ 0.
buttons submorphs last color: Color white.
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 12.
buttons := AlignmentMorph newRow.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'OK' translated;
- buttons addMorphBack: (bb label: 'OK';
actionSelector: #okay).
buttons addTransparentSpacerOfSize: 5 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Cancel' translated;
- buttons addMorphBack: (bb label: 'Cancel';
actionSelector: #cancel).
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
self addMorphFront: buttonCage.
formDisplayMorph := Thumbnail new extent: 100 @ 100;
maxWidth: 100 minHeight: 30;
yourself.
self addMorphBack: (Morph new color: Color white;
layoutPolicy: TableLayout new;
layoutInset: 4 @ 4;
hResizing: #spaceFill;
vResizing: #spaceFill;
listCentering: #center;
addMorphBack: formDisplayMorph;
yourself).
target
ifNotNil: [(anIndex := formList
indexOf: target form
ifAbsent: [])
ifNotNil: [currentIndex := anIndex]].
self updateThumbnail!
Item was changed:
----- Method: HandMorphForReplay>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
+ suspended := false.
+ self showTemporaryCursor: Cursor normal
- self showTemporaryCursor: Cursor normal.
!
Item was changed:
----- Method: HandMorphForReplay>>processEvents (in category 'event handling') -----
processEvents
"Play back the next event"
+ | evt hadMouse hadAny tracker |
+ suspended == true ifTrue: [^ self].
- | evt hadMouse hadAny |
hadMouse := hadAny := false.
+ tracker := recorder objectTrackingEvents.
[(evt := recorder nextEventToPlay) isNil] whileFalse:
+ [
+ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self].
+ tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp].
+ evt type == #EOF
- [evt type == #EOF
ifTrue:
+ [recorder pauseIn: ActiveWorld.
+ ^ self].
- [recorder pauseIn: self world.
- ^self].
evt type == #startSound
ifTrue:
+ [recorder perhapsPlaySound: evt argument.
- [evt argument play.
recorder synchronize.
+ ^ self].
+ evt type == #startEventPlayback
+ ifTrue:
+ [evt argument launchPlayback.
+ recorder synchronize.
+ ^ self].
+
+ evt type == #noteTheatreBounds
+ ifTrue:
+ ["The argument holds the content rect --for now we don't make any use of that info in this form."
+ ^ self].
+
- ^self].
evt isMouse ifTrue: [hadMouse := true].
(evt isMouse or: [evt isKeyboard])
ifTrue:
[self handleEvent: (evt setHand: self) resetHandlerFields.
hadAny := true]].
(mouseClickState notNil and: [hadMouse not])
ifTrue:
["No mouse events during this cycle. Make sure click states time out accordingly"
mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
hadAny
ifFalse:
["No pending events. Make sure z-order is up to date"
self mouseOverHandler processMouseOver: lastMouseEvent]!
Item was changed:
----- Method: HandMorphForReplay>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
+ "Handmorph blocks deep copy. Go up to Morph"
+
+ ^ self perform: #veryDeepCopyWith: withArguments: {deepCopier} inSuperclass: Morph!
- ^ self copy!
Item was changed:
----- Method: IndexTabs class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'tabs' translatedNoop!
- ^ 'tabs'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>cacheThumbnailFor: (in category 'thumbnails') -----
cacheThumbnailFor: aProject
+ "Save a thumbnail of the given project in my thumbnail cache."
| form |
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
-
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
CachedThumbnails
at: aProject name
+ put: (form _ self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter).
+ ^ form
- put: (form := self sorterFormForProject: aProject sized: nil).
- ^form
!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'ThreadNavigator' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A tool that lets you navigate through a thread of projects.' translatedNoop!
- ^ self partName: 'ThreadNavigator'
- categories: #('Navigation')
- documentation: 'A tool that lets you navigate through a thread of projects.'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>getThumbnailFor: (in category 'thumbnails') -----
getThumbnailFor: aProject
+ "Answer a thumbnail for the given project, retrieving it from a cache of such objects if possible, else creating a fresh thumbnail, storing it in the cache, and answering it."
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
^CachedThumbnails
at: aProject name
+ ifAbsentPut: [self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter]!
- ifAbsentPut: [self sorterFormForProject: aProject sized: nil]!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>sorterFormForProject:sized: (in category 'sorter') -----
+ sorterFormForProject: aProject sized: aSize
+ "Answer a form to use in a project-sorter to represent the project."
- sorterFormForProject: aProject sized: ignored
+ ^ (ProjectViewMorph on: aProject) imageForm scaledToSize: aSize
- ^(ProjectViewMorph on: aProject) imageForm scaledToSize: 80@60.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>buttonForMenu (in category 'navigation') -----
buttonForMenu
+ ^self makeButton: '?' balloonText: 'More commands' translated for: #moreCommands.
- ^self makeButton: '?' balloonText: 'More commands' for: #moreCommands.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>editThisThread (in category 'navigation') -----
editThisThread
| sorter |
+ sorter _ ProjectSorterMorph new.
- sorter := ProjectSorterMorph new.
sorter navigator: self listOfPages: listOfPages.
self currentWorld addMorphFront: sorter.
+ sorter align: sorter topCenter with: self currentWorld topCenter.
- sorter align: sorter center with: self currentWorld center.
self delete.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>positionAppropriately (in category 'navigation') -----
positionAppropriately
+ | others otherRects overlaps bottomRight |
- | others otherRects overlaps |
-
(self ownerThatIsA: HandMorph) ifNotNil: [^self].
+ others _ ActiveWorld submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
+ otherRects _ others collect: [ :each | each bounds].
+ bottomRight _ (ActiveWorld hasProperty: #threadNavigatorPosition) ifTrue: [
+ ActiveWorld valueOfProperty: #threadNavigatorPosition.
+ ] ifFalse: [
+ ActiveWorld bottomRight.
+ ].
+ self align: self fullBounds bottomRight with: bottomRight.
- others := self world submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
- otherRects := others collect: [ :each | each bounds].
- self align: self fullBounds bottomRight with: self world bottomRight.
self setProperty: #previousWorldBounds toValue: self world bounds.
[
+ overlaps _ false.
- overlaps := false.
otherRects do: [ :r |
+ (r intersects: bounds) ifTrue: [overlaps _ true. self bottom: r top].
- (r intersects: bounds) ifTrue: [overlaps := true. self bottom: r top].
].
self top < self world top ifTrue: [
+ self bottom: bottomRight y.
- self bottom: self world bottom.
self right: self left - 1.
].
overlaps
] whileTrue.!
Item was changed:
----- Method: InternalThreadNavigationMorph>>sizeRatio (in category 'accessing') -----
sizeRatio
"answer the size ratio for the receiver"
+ ^ 1.0
+
+ "^ Preferences standardMenuFont height / 12" "Good grief!!"!
- ^ Preferences standardMenuFont height / 12!
Item was changed:
----- Method: LassoPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver to be used in a parts bin"
+ ^ self partName: 'Lasso' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Drop this icon to grab a patch from the screen with a lasso.' translatedNoop!
- ^ self partName: 'Lasso'
- categories: #('Graphics')
- documentation: 'Drop this icon to grab a patch from the screen with a lasso.'!
Item was changed:
----- Method: LassoPatchMorph>>wantsToBeDroppedInto: (in category 'dropping') -----
wantsToBeDroppedInto: aMorph
+ "Only wanted by the world"
- "Only into PasteUps that are not part bins"
+ ^ aMorph isWorldMorph!
- ^ aMorph isPlayfieldLike!
Item was changed:
----- Method: MagnifierMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Magnifier' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A magnifying glass' translatedNoop!
- ^ self partName: 'Magnifier'
- categories: #('Useful')
- documentation: 'A magnifying glass'!
Item was changed:
----- Method: MagnifierMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MagnifierMorph. #newRound. 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: MagnifierMorph class>>supplementaryPartsDescriptions (in category 'parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundGlass' translatedNoop
+ categoryList: {'Just for Fun' translatedNoop}
+ documentation: 'A round magnifying glass' translatedNoop
- formalName: 'RoundGlass'
- categoryList: #(Useful)
- documentation: 'A round magnifying glass'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newRound.
DescriptionForPartsBin
+ formalName: 'Hand Magnifier' translatedNoop
+ categoryList: #()
+ documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.' translatedNoop
- formalName: 'Hand Magnifier'
- categoryList: #(Useful)
- documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newShowingPointer }!
Item was changed:
----- Method: MagnifierMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
+ | stencil newForm bb |
+
- super drawOn: aCanvas. "border and fill"
aCanvas isShadowDrawing ifFalse: [
"Optimize because #magnifiedForm is expensive"
+ self isRound
+ ifTrue:[stencil := (EllipseMorph new extent: self extent; color: Color white) imageForm.
+ bb := BitBlt toForm: stencil.
+ newForm := (bb copyForm: self magnifiedForm to: 0@0 rule: Form and) destForm.
+ aCanvas paintImage: newForm at: self innerBounds origin ]
+ ifFalse:[super drawOn: aCanvas. "border and fill"
+ aCanvas paintImage: self magnifiedForm at: self innerBounds origin]]
+
+ !
- aCanvas paintImage: self magnifiedForm at: self innerBounds origin]!
Item was changed:
----- Method: MagnifierMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
+ trackPointer _ true.
+ showPointer _ false.
+ magnification _ 2.
+ roundness := false.
- trackPointer := true.
- showPointer := false.
- magnification := 2.
-
self extent: 128 @ 128!
Item was changed:
----- Method: MagnifierMorph>>isRound (in category 'round view') -----
isRound
+ ^ roundness == true!
- ^ owner isMemberOf: ScreeningMorph!
Item was changed:
----- Method: MagnifierMorph>>showingPointerString (in category 'menu') -----
showingPointerString
+ "Answer a string characterizing whether or not I'm showing the pointer."
+
+ ^ (self showPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'show pointer' translated!
- ^ (self showPointer
- ifTrue: ['stop showing pointer']
- ifFalse: ['start showing pointer']) translated!
Item was changed:
----- Method: MagnifierMorph>>sourcePoint (in category 'magnifying') -----
sourcePoint
"If we are being dragged use our center, otherwise use pointer position"
^(trackPointer not or: [owner notNil and: [owner isHandMorph]])
+ ifTrue: [self isFlexed ifTrue:[owner center] ifFalse:[self center]]
- ifTrue: [self center]
ifFalse: [self currentHand position]!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundString (in category 'round view') -----
toggleRoundString
+ "Answer a string describing whether the receiver is currently round."
+
+ ^ (self isRound ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'round' translated!
- ^ (self isRound
- ifTrue: ['be square']
- ifFalse: ['be round']) translated!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundness (in category 'round view') -----
toggleRoundness
+ roundness := roundness not.
+ self fullBounds changed
+ !
- | sm w |
- w := self world.
- self isRound
- ifTrue: [owner delete.
- w addMorph: self]
- ifFalse: [sm := ScreeningMorph new position: self position.
- sm addMorph: self.
- sm addMorph: (EllipseMorph newBounds: self bounds).
- w addMorph: sm]!
Item was changed:
----- Method: MagnifierMorph>>trackingPointerString (in category 'menu') -----
trackingPointerString
+ "Answer a string describing whether or not I'm currently tracking the pointer."
+
^ (trackPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'track pointer' translated!
- ifTrue: ['stop tracking pointer']
- ifFalse: ['start tracking pointer']) translated!
Item was changed:
----- Method: MessageNames class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MessageNames. #prototypicalToolWindow. 'Message Names' translatedNoop. 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: Morph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
^ { DescriptionForPartsBin
+ formalName: 'Status' translatedNoop
+ categoryList: #()
+ documentation: 'Buttons to run, stop, or single-step scripts' translatedNoop
- formalName: 'Status'
- categoryList: #(Scripting)
- documentation: 'Buttons to run, stop, or single-step scripts'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #scriptControlButtons.
DescriptionForPartsBin
+ formalName: 'Scripting' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop
- formalName: 'Scripting'
- categoryList: #(Scripting)
- documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #newScriptingSpace.
DescriptionForPartsBin
+ formalName: 'Random' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A tile that will produce a random number in a given range' translatedNoop
+ globalReceiverSymbol: #FunctionTile
+ nativitySelector: #randomNumberTile.
- formalName: 'Random'
- categoryList: #(Scripting)
- documentation: 'A tile that will produce a random number in a given range'
- globalReceiverSymbol: #RandomNumberTile
- nativitySelector: #new.
DescriptionForPartsBin
+ formalName: 'ButtonDown?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is down' translatedNoop
- formalName: 'ButtonDown?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is down'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #anyButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'ButtonUp?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is up' translatedNoop
- formalName: 'ButtonUp?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is up'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #noButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'NextPage' translatedNoop
+ categoryList: {'Multimedia' translatedNoop}
+ documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop
- formalName: 'NextPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #nextPageButton.
DescriptionForPartsBin
+ formalName: 'PreviousPage' translatedNoop
+ categoryList: {'Multimedia'}
+ documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop
- formalName: 'PreviousPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #previousPageButton.},
+ self partsDescriptionsFromToolsFlap!
- (Flaps quadsDefiningToolsFlap collect:
- [:aQuad | DescriptionForPartsBin fromQuad: aQuad categoryList: #(Tools)])!
Item was changed:
----- Method: ObjectsTool class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Objects' translatedNoop
+ categories: #()
+ documentation: 'A place to obtain many kinds of objects' translatedNoop!
- ^ self partName: 'Objects'
- categories: #('Useful')
- documentation: 'A place to obtain many kinds of objects'!
Item was changed:
----- Method: ObjectsTool class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ObjectsTool. #newStandAlone. 'Object Catalog' translatedNoop. 'A tool that lets you browse the catalog of objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ObjectsTool . #newStandAlone. 'Object Catalog' translatedNoop.'A tool that lets you browse the catalog of objects' translatedNoop}
- cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: ObjectsTool>>minimumWidth (in category 'layout') -----
minimumWidth
+ "Answer a width that assures that the alphabet fits in two rows. For olpc, this is increased in order to make the Connectors category not too absurdly tall."
- "Answer a width that assures that the alphabet fits in two rows"
+ ^ 400!
- ^ 300!
Item was changed:
----- Method: PackagePaneBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PackagePaneBrowser. #prototypicalToolWindow . 'Packages' translatedNoop. 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: PaintBoxMorph>>offsetFromMaxBounds (in category 'other') -----
offsetFromMaxBounds
"location of normal PaintBox within maxBounds."
+ | left |
+ left _ self left.
+ Preferences useBiggerPaintingBox ifTrue: [left _ left - (( self width * 1.5)- self width)].
+ ^ left - colorMemory left @ 0!
-
- ^ self left - colorMemory left @ 0!
Item was changed:
----- Method: PaintBoxMorph>>recentColor: (in category 'recent colors') -----
recentColor: aColor
"Remember the color as one of our recent colors"
+ Prototype currentColor: aColor.
+ (recentColors anySatisfy: [:any | any color = aColor])
+ ifTrue: [^self]. "already remembered"
+ RecentColors := {aColor}, RecentColors allButLast.
+ RecentColors keysAndValuesDo: [:i :each |
+ (recentColors at: i) color: each]!
-
- (recentColors anySatisfy: [:any | any color = aColor]) ifTrue: [^self]. "already remembered"
- recentColors size to: 2
- by: -1
- do:
- [:i |
- (recentColors at: i) color: (recentColors at: i - 1) color.
- RecentColors at: i put: (RecentColors at: i - 1)].
- (recentColors first) color: aColor.
- RecentColors at: 1 put: aColor!
Item was changed:
----- Method: PaintBoxMorph>>showColorPalette: (in category 'actions') -----
showColorPalette: evt
| w box |
self comeToFront.
colorMemory align: colorMemory bounds topRight
with: colorMemoryThin bounds topRight.
"make sure color memory fits or else align with left"
+ w _ self world.
+ box _ self bounds: colorMemory fullBounds in: w.
- w := self world.
- box := self bounds: colorMemory fullBounds in: w.
box left < 0 ifTrue:[
colorMemory align: colorMemory bounds topLeft
with: colorMemoryThin bounds topLeft].
+ self addMorphFront: colorMemory.
+ self changed!
- self addMorphFront: colorMemory.!
Item was changed:
----- Method: PaintBoxMorph>>toggleShapes (in category 'actions') -----
toggleShapes
| tab sh stamps |
"The sub panel that has the shape tools on it. Rect, line..."
+ stamps _ self submorphNamed: 'stamps'.
+ tab _ self submorphNamed: 'shapeTab'.
+ (sh _ self submorphNamed: 'shapes') visible
- stamps := self submorphNamed: 'stamps'.
- tab := self submorphNamed: 'shapeTab'.
- (sh := self submorphNamed: 'shapes') visible
ifTrue: [sh hide. tab top: stamps bottom-1]
ifFalse: [sh comeToFront. sh top: stamps bottom-9.
sh show. tab top: sh bottom - tab height + 10].
self layoutChanged.
+ self changed
!
Item was changed:
----- Method: PaintBoxMorph>>toggleStamps (in category 'actions') -----
toggleStamps
| tab otherTab st shapes |
"The sub panel that has the stamps in it. For saving and moving parts of an image."
+ shapes _ self submorphNamed: 'shapes'.
+ otherTab _ self submorphNamed: 'shapeTab'.
+ tab _ self submorphNamed: 'stampTab'.
+ (st _ self submorphNamed: 'stamps') visible
- shapes := self submorphNamed: 'shapes'.
- otherTab := self submorphNamed: 'shapeTab'.
- tab := self submorphNamed: 'stampTab'.
- (st := self submorphNamed: 'stamps') visible
ifTrue: [st hide. st bottom: self bottom. tab top: self bottom-1.
shapes top: self bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [self bottom-1])]
ifFalse: [st top: self bottom-10. st show. tab top: st bottom-0.
shapes top: st bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [st bottom-0])].
+ self layoutChanged.
+ self changed!
- self layoutChanged.!
Item was changed:
----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Paint' translatedNoop
+ categories: #()
+ documentation: 'Drop this icon to start painting a new object.' translatedNoop!
- ^ self partName: 'Paint'
- categories: #('Basic' 'Graphics')
- documentation: 'Drop this icon to start painting a new object.'!
Item was changed:
----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PartsBin>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
wantsDroppedMorph: aMorph event: evt
"Answer whether the receiver would like to accept the given morph. For a Parts bin, we accept just about anything except something that just originated from ourselves"
(aMorph hasProperty: #beFullyVisibleAfterDrop) ifTrue:
+ [^ true].
- ["Sign that this was launched from a parts bun, probably indeed this very parts bin"
- ^ false].
^ super wantsDroppedMorph: aMorph event: evt!
Item was changed:
----- Method: PasteUpMorph class>>initialize (in category '*MorphicExtras-class initialization') -----
initialize
"Initialize the class"
+ #('keyStroke') translatedNoop.
+
self registerInFlapsRegistry.
+ ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' translatedNoop targetMorphClass: PasteUpMorph.!
- ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' targetMorphClass: PasteUpMorph.!
Item was changed:
----- Method: PasteUpMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Holder' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop
- formalName: 'Holder'
- categoryList: #(Scripting)
- documentation: 'A place for storing alternative pictures in an animation, ec.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #prototypicalHolder}!
Item was changed:
----- Method: PianoKeyboardMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'PianoKeyboard' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A piano keyboard' translatedNoop!
- ^ self partName: 'PianoKeyboard'
- categories: #('Multimedia')
- documentation: 'A piano keyboard'!
Item was changed:
----- Method: PianoKeyboardMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+
+ whiteKeyColor _ Color gray: 0.95.
+ blackKeyColor _ Color black.
+ playingKeyColor _ Color red.
+ nOctaves _ 6.
-
- whiteKeyColor := Color gray: 0.95.
- blackKeyColor := Color black.
- playingKeyColor := Color red.
- nOctaves := 6.
self buildKeyboard.
+ soundPrototype _ FMSound brass1 duration: 9.9.
+ frequency _ 0.
+ soundPrototype _ FMSound new.
+ allowingChord _ false. "Sorry!!"
+ soundPlayingList _ Array new: self submorphs size.
+ !
- soundPrototype := FMSound brass1 duration: 9.9!
Item was changed:
----- Method: PolygonMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: PolygonMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-instance creation') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {DescriptionForPartsBin
+ formalName: 'Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.' translatedNoop
- formalName: 'Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.'
globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #arrowPrototype.
+ DescriptionForPartsBin
+ formalName: 'Triangle' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A three-sided polygon.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #trianglePrototype.
+
+ DescriptionForPartsBin
+ formalName: 'Curve' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A smooth wiggly curve, or a curved solid. Shift-click to get handles and move the points. Using the halo menu, can be coverted into a polygon, and can be made "open" rather than closed.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #curvePrototype.
+ }
+
+
- nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFlaps (in category 'the buttons') -----
buttonFlaps
^self inFlapsSuppressedMode ifTrue: [
+ self makeButton: 'Show tabs' translated balloonText: 'Show tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Show tabs' balloonText: 'Show tabs' for: #toggleFlapsSuppressed
] ifFalse: [
+ self makeButton: 'Hide tabs' translated balloonText: 'Hide tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Hide tabs' balloonText: 'Hide tabs' for: #toggleFlapsSuppressed
].
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFullScreen (in category 'the buttons') -----
buttonFullScreen
^self inFullScreenMode ifTrue: [
+ self makeButton: 'Browser Reentry' translated balloonText: 'Re-enter the browser' translated for: #fullScreenOff
- self makeButton: 'Browser Reentry' balloonText: 'Re-enter the browser' for: #fullScreenOff
] ifFalse: [
+ self makeButton: 'Escape Browser' translated balloonText: 'Use the full screen' translated for: #fullScreenOn
- self makeButton: 'Escape Browser' balloonText: 'Use the full screen' for: #fullScreenOn
]
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonGoTo (in category 'the buttons') -----
buttonGoTo
+ ^self makeButton: 'GO TO' translated balloonText: 'Go to another project' translated for: #gotoAnother
- ^self makeButton: 'GO TO' balloonText: 'Go to another project' for: #gotoAnother
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewProject (in category 'the buttons') -----
buttonNewProject
+ ^self makeButton: 'NEW' translated balloonText: 'Start a new project' translated for: #newProject
- ^self makeButton: 'NEW' balloonText: 'Start a new project' for: #newProject
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewer (in category 'the buttons') -----
buttonNewer
+ ^self makeButton: 'Newer?' translated balloonText: 'Is there a newer version of this project ?' translated for: #getNewerVersionIfAvailable!
- ^self makeButton: 'Newer?' balloonText: 'Is there a newer version of this project ?' for: #getNewerVersionIfAvailable!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNext (in category 'the buttons') -----
buttonNext
+ ^self makeButton: 'NEXT >' translated balloonText: 'Next project' translated for: #nextProject!
- ^self makeButton: 'NEXT >' balloonText: 'Next project' for: #nextProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPaint (in category 'the buttons') -----
buttonPaint
| pb oldArgs brush myButton m |
+ myButton _ self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting.
+ pb _ PaintBoxMorph new submorphNamed: #paint:.
- myButton := self makeButton: '' balloonText: 'Make a painting' for: #doNewPainting.
- pb := PaintBoxMorph new submorphNamed: #paint:.
pb ifNil: [
+ (brush _ Form extent: 16@16 depth: 16) fillColor: Color red
- (brush := Form extent: 16@16 depth: 16) fillColor: Color red
] ifNotNil: [
+ oldArgs _ pb arguments.
+ brush _ oldArgs third.
+ brush _ brush copy: (2@0 extent: 42@38).
+ brush _ brush scaledToSize: brush extent // 2.
- oldArgs := pb arguments.
- brush := oldArgs third.
- brush := brush copy: (2@0 extent: 42@38).
- brush := brush scaledToSize: brush extent // 2.
].
+ myButton addMorph: (m _ brush asMorph lock).
- myButton addMorph: (m := brush asMorph lock).
myButton extent: m extent + (myButton borderWidth + 6).
m position: myButton center - (m extent // 2).
^myButton
+ "brush _ (ScriptingSystem formAtKey: 'Painting')."
- "brush := (ScriptingSystem formAtKey: 'Painting')."
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPrev (in category 'the buttons') -----
buttonPrev
+ ^self makeButton: '< PREV' translated balloonText: 'Previous project' translated for: #previousProject!
- ^self makeButton: '< PREV' balloonText: 'Previous project' for: #previousProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonQuit (in category 'the buttons') -----
buttonQuit
+ "Make and answer a button whose pressing will result in quitting out of Squeak."
+ ^self makeButton: 'QUIT' translated balloonText: 'Quit Etoys (without saving)' translated for: #quitSqueak
- ^self makeButton: 'QUIT' balloonText: 'Quit Squeak altogether' for: #quitSqueak
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonTell (in category 'the buttons') -----
buttonTell
+ ^self makeButton: 'Tell!!' translated balloonText: 'Tell a friend about this project' translated for: #tellAFriend
- ^self makeButton: 'Tell!!' balloonText: 'Tell a friend about this project' for: #tellAFriend
!
Item was changed:
----- Method: ProjectNavigationMorph>>fontForButtons (in category 'as yet unclassified') -----
fontForButtons
+ ^ Preferences standardButtonFont!
-
- ^TextStyle defaultFont!
Item was changed:
----- Method: ProjectNavigationMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self layoutInset: 6;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
useRoundedCorners.
+ mouseInside _ false.
+ !
- mouseInside := false.
- self addButtons!
Item was changed:
----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'as yet unclassified') -----
makeButton: aString balloonText: anotherString for: aSymbol
- self flag: #yo.
- "In principle, this method shouldn't call #translated."
-
^ SimpleButtonDelayedMenuMorph new target: self;
borderColor: #raised;
color: self colorForButtons;
+ label: aString font: self fontForButtons;
+ setBalloonText: anotherString;
- label: aString translated font: self fontForButtons;
- setBalloonText: anotherString translated;
actionSelector: aSymbol!
Item was changed:
----- Method: ProjectNavigationMorph>>publishDifferent (in category 'the actions') -----
publishDifferent
self
+ publishStyle: #initialDirectoryListForProjects
- publishStyle: #initialDirectoryList
forgetURL: true
withRename: false
!
Item was changed:
----- Method: ProjectNavigationMorph>>publishStyle:forgetURL:withRename: (in category 'the actions') -----
publishStyle: aSymbol forgetURL: aBoolean withRename: renameBoolean
| w saveOwner primaryServer rename |
+ w _ self world ifNil: [^Beeper beep].
- w := self world ifNil: [^Beeper beep].
w setProperty: #SuperSwikiPublishOptions toValue: aSymbol.
+ primaryServer _ w project primaryServerIfNil: [nil].
+ rename _ ((primaryServer notNil
- primaryServer := w project primaryServerIfNil: [nil].
- rename := ((primaryServer notNil
and: [primaryServer acceptsUploads]) not)
or: [renameBoolean].
+ rename := rename or: [(primaryServer isKindOf: DAVMultiUserServerDirectory)].
w setProperty: #SuperSwikiRename toValue: rename.
+ saveOwner _ owner.
- saveOwner := owner.
self delete.
[w project
storeOnServerShowProgressOn: self
forgetURL: aBoolean | rename]
ensure: [saveOwner addMorphFront: self]!
Item was changed:
+ ----- Method: ProjectSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: ProjectSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
- | b r partsBinButton newButton |
+ | b r partsBinButton newButton aWrapper |
+ newButton _ ImageMorph new image: (World project makeThumbnail scaledToSize: 48@36).
- newButton := ImageMorph new image: (World project makeThumbnail scaledToSize: 24@18).
newButton on: #mouseDown send: #insertNewProject: to: self.
newButton setBalloonText: 'Make a new Project' translated.
+ (partsBinButton _ UpdatingThreePhaseButtonMorph checkBox)
- (partsBinButton := UpdatingThreePhaseButtonMorph checkBox)
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ (r _ AlignmentMorph newRow)
- (r := AlignmentMorph newRow)
color: Color transparent;
borderWidth: 0;
layoutInset: 0;
+ cellInset: 10@0;
wrapCentering: #center;
+ cellPositioning: #leftCenter;
- cellPositioning: #topCenter;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5@5.
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- r addMorphBack: (self wrapperFor: (b label: 'Okay' translated; actionSelector: #acceptSort)).
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete));
- r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated; actionSelector: #delete));
- addMorphBack: (self wrapperFor: (newButton));
addTransparentSpacerOfSize: 8 @ 0;
+ addMorphBack: (self wrapperFor: (newButton));
+ addTransparentSpacerOfSize: 8 @ 0.
+
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
addMorphBack: (self wrapperFor: partsBinButton);
+ addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons) lock).
+ r addMorphBack: aWrapper.
- addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated) lock).
self addMorphFront: r.
!
Item was changed:
----- Method: ProjectSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
super initialize.
- ""
self useRoundedCorners.
pageHolder useRoundedCorners; borderWidth: 0;
color: (self
gridFormOrigin: 0 @ 0
+ grid: ScriptingSystem sorterGridSize
- grid: 16 @ 16
background: Color white
line: Color blue muchLighter)!
Item was changed:
----- Method: ProjectSorterMorph>>sorterMorphForProjectNamed: (in category 'as yet unclassified') -----
sorterMorphForProjectNamed: projName
| pvm proj |
+ (proj _ Project named: projName) ifNil: [^nil].
+ pvm _ (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
- (proj := Project named: projName) ifNil: [^nil].
- pvm := (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
pvm setProperty: #nameOfThisProject toValue: projName.
+ pvm isOpaque: true.
pvm setBalloonText: projName.
pvm on: #mouseDown send: #clickFromSorterEvent:morph: to: self.
pvm on: #mouseUp send: #clickFromSorterEvent:morph: to: self.
^pvm
!
Item was changed:
----- Method: RecordingControlsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.'}
- cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: RecordingControlsMorph>>addButtonRows (in category 'initialization') -----
addButtonRows
+ | r fullWidth |
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- | r |
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Morph' translated action: #makeSoundMorph).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Tile' translated action: #makeTile).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Trim' translated action: #trim).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Show' translated action: #showEditor).
- r addMorphBack: (self buttonName: 'Show' translated action: #show).
self addMorphBack: r.
+ r layoutChanged.
+ fullWidth := r fullBounds width.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Record' translated action: #record).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Stop' translated action: #stop).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Play' translated action: #playback).
+ r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Codec' translated action: #chooseCodec).
r addMorphBack: self makeStatusLight.
self addMorphBack: r.
+ self changeCodec: OggSpeexCodec name: 'Speex'.
+ r layoutChanged.
+ fullWidth := fullWidth max: r fullBounds width.
+ ^ fullWidth@(r fullBounds height).
!
Item was changed:
----- Method: RecordingControlsMorph>>buttonName:action: (in category 'other') -----
buttonName: aString action: aSymbol
^ SimpleButtonMorph new
target: self;
+ label: aString font: Preferences standardButtonFont;
- label: aString;
actionSelector: aSymbol
!
Item was changed:
----- Method: RecordingControlsMorph>>initialize (in category 'initialization') -----
initialize
+ | r full |
- | r |
super initialize.
self hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ borderWidth _ 2.
- borderWidth := 2.
self listDirection: #topToBottom.
+ recorder _ SoundRecorder new.
+ full := self addButtonRows.
+ self addRecordLevelSliderIn: full.
- recorder := SoundRecorder new.
- self addButtonRows.
- self addRecordLevelSlider.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
+ r addMorphBack: (self makeRecordMeterIn: full).
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
- r addMorphBack: self makeRecordMeter.
self addMorphBack: r.
self extent: 10@10. "make minimum size"
!
Item was changed:
----- Method: RectangleMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RectangleMorph, #roundRectPrototype, 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: RectangleMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundRect' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A rectangle with rounded corners' translatedNoop
- formalName: 'RoundRect'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with rounded corners'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #roundRectPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a horizontal gradient' translatedNoop
- formalName: 'Gradient'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a horizontal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #gradientPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient (slanted)' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a diagonal gradient' translatedNoop
- formalName: 'Gradient (slanted)'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a diagonal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #diagonalPrototype}!
Item was changed:
----- Method: ReferenceMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'ref' translatedNoop!
- ^ 'ref'!
Item was changed:
----- Method: ScrollableField class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Info for build parts-bin entries."
+
+ ^ self partName: 'Scrolling Text' translatedNoop
+ categories: #(Basic)
+ documentation: 'A scrollable, editable body of text' translatedNoop!
- ^ self partName: 'Scrolling Text'
- categories: #('Text' )
- documentation: 'A scrollable, editable body of text'!
Item was changed:
----- Method: ScrollableField class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
forFlapNamed: 'Stack Tools'.]!
Item was changed:
----- Method: SelectorBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SelectorBrowser. #prototypicalToolWindow. 'Method Finder' translatedNoop. 'A tool for discovering methods by providing sample values for arguments and results' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results')
forFlapNamed: 'Tools']
!
Item was changed:
----- Method: SimpleSliderMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'Slider' translatedNoop!
- ^ 'Slider'!
Item was changed:
----- Method: SimpleSliderMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Slider' translatedNoop
+ categories: {'Basic' translatedNoop}
+ documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.' translatedNoop!
- ^ self partName: 'Slider'
- categories: #('Scripting')
- documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.'!
Item was changed:
----- Method: SimpleSliderMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: SimpleSliderMorph>>adjustToValue: (in category 'private') -----
adjustToValue: aNumber
"Adjust the position of this slider to correspond to the given value in the range minVal..maxVal."
"Details: Internal values are normalized to the range 0..1."
+ | toUse |
+ toUse := minVal = maxVal
+ ifTrue:
+ [minVal]
+ ifFalse:
+ [(aNumber - minVal) asFloat / (maxVal - minVal)].
+ self value: toUse
- self value:
- (aNumber - minVal) asFloat / (maxVal - minVal).
!
Item was changed:
----- Method: SimpleSliderMorph>>descendingString (in category 'menu') -----
descendingString
^ (self descending
+ ifTrue: ['switch to ascending' translatedNoop]
+ ifFalse: ['switch to descending' translatedNoop]) translated!
- ifTrue: ['switch to ascending']
- ifFalse: ['switch to descending']) translated!
Item was changed:
----- Method: SimpleSliderMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]!
Item was changed:
----- Method: SimpleSliderMorph>>truncateString (in category 'menu') -----
truncateString
^ (truncate
+ ifTrue: ['turn off truncation' translatedNoop]
+ ifFalse: ['turn on truncation' translatedNoop]) translated!
- ifTrue: ['turn off truncation']
- ifFalse: ['turn on truncation']) translated!
Item was changed:
----- Method: SketchEditorMorph>>addRotationScaleHandles (in category 'start & finish') -----
addRotationScaleHandles
"Rotation and scaling handles"
+ rotationButton _ SketchMorph withForm: (palette rotationTabForm).
- rotationButton := SketchMorph withForm: (palette rotationTabForm).
rotationButton position: bounds topCenter - (6@0).
rotationButton on: #mouseDown send: #rotateScalePrep: to: self.
rotationButton on: #mouseMove send: #rotateBy: to: self.
rotationButton on: #mouseUp send: #rotateDone: to: self.
rotationButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
rotationButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: rotationButton].
- self addMorph: rotationButton.
rotationButton setBalloonText: 'Drag me sideways to
rotate your
picture.' translated.
+ scaleButton _ SketchMorph withForm: (palette scaleTabForm).
- scaleButton := SketchMorph withForm: (palette scaleTabForm).
scaleButton position: bounds rightCenter - ((scaleButton width)@6).
scaleButton on: #mouseDown send: #rotateScalePrep: to: self.
scaleButton on: #mouseMove send: #scaleBy: to: self.
scaleButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
scaleButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: scaleButton].
- self addMorph: scaleButton.
scaleButton setBalloonText: 'Drag me up and down to change
the size
of your picture.' translated.
"REMOVED:
+ fwdButton _ PolygonMorph new.
+ pt _ bounds topCenter.
- fwdButton := PolygonMorph new.
- pt := bounds topCenter.
fwdButton borderWidth: 2; makeOpen; makeBackArrow; borderColor:
(Color r: 0 g: 0.8 b: 0).
fwdButton removeHandles; setVertices: (Array with: pt+(0@7) with:
pt+(0@22)).
fwdButton on: #mouseMove send: #forward:direction: to: self.
fwdButton on: #mouseEnter send: #mouseLeave: to: self.
fwdButton on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdButton toValue: fwdButton.
self addMorph: fwdButton.
fwdButton setBalloonText: 'Drag me around to point
in the direction
I go forward.' translated.
+ toggle _ EllipseMorph
- toggle := EllipseMorph
newBounds: (Rectangle center: fwdButton vertices last +
(-4@4) extent: 8@8)
color: Color gray.
toggle on: #mouseUp send: #toggleDirType:in: to: self.
toggle on: #mouseEnter send: #mouseLeave: to: self.
toggle on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdToggle toValue: toggle.
fwdButton addMorph: toggle.
toggle setBalloonText: 'When your object turns,
how should its
picture change?
It can rotate, face left or right,
face up or down, or not
change.' translated.
"
self setProperty: #rotationStyle toValue: hostView rotationStyle.
" self forward: hostView setupAngle direction: fwdButton. "
"Set to its current value"
!
Item was changed:
----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: (in category 'initialization') -----
initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph
+ "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
+
| aPaintBox newPaintBoxBounds worldBounds requiredWidth newOrigin aPosition aPal aTab paintBoxFullBounds |
+ (aTab _ self world paintingFlapTab) ifNotNil:
- (aTab := self world paintingFlapTab) ifNotNil:
[aTab showFlap.
^ self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: nil].
+ self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
+ aPaintBox _ self world paintBox.
+ worldBounds _ self world bounds.
+ requiredWidth _ aPaintBox width.
- aPaintBox := self world paintBox.
- worldBounds := self world bounds.
- requiredWidth := aPaintBox width.
+ aPosition _ (aPal _ aPasteUpMorph standardPalette)
- aPosition := (aPal := aPasteUpMorph standardPalette)
ifNotNil:
[aPal showNoPalette.
aPal topRight + (aPaintBox width negated @ 0 "aPal tabsMorph height")]
ifNil:
[boundsToUse topRight].
+ newOrigin _ ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
- newOrigin := ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
ifTrue: "will fit to right of aPasteUpMorph"
[aPosition]
ifFalse: "won't fit to right, try left"
[boundsToUse topLeft - (requiredWidth @ 0)].
+ paintBoxFullBounds _ aPaintBox maxBounds.
+ paintBoxFullBounds _ (newOrigin - aPaintBox offsetFromMaxBounds) extent:
- paintBoxFullBounds := aPaintBox maxBounds.
- paintBoxFullBounds := (newOrigin - aPaintBox offsetFromMaxBounds) extent:
paintBoxFullBounds extent.
+ newPaintBoxBounds _ paintBoxFullBounds translatedToBeWithin: worldBounds.
- newPaintBoxBounds := paintBoxFullBounds translatedToBeWithin: worldBounds.
self initializeFor: aSketchMorph inBounds: boundsToUse
pasteUpMorph: aPasteUpMorph
+ paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.
+ !
- paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.!
Item was changed:
----- Method: SketchEditorMorph>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "In the middle of drawing a stroke of any kind."
- "In the middle of drawing a stroke. 6/11/97 19:51 tk"
+ | pt priorEvt actionSelector |
- | pt priorEvt |
WorldState canSurrenderToOS: false. "we want maximum responsiveness"
pt := evt cursorPoint.
priorEvt := self get: #lastEvent for: evt.
(priorEvt notNil and: [pt = priorEvt cursorPoint]) ifTrue: [^self].
+ self perform: (actionSelector _ self getActionFor: evt) with: evt.
- self perform: (self getActionFor: evt) with: evt.
"Each action must do invalidRect:"
self
set: #lastEvent
for: evt
to: evt.
+ "If recording painting, mark these events so they will not be condensed. The actual path the brush takes is important."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: actionSelector]].
false
ifTrue:
["So senders will find the things performed here"
self
paint: nil;
fill: nil;
erase: nil;
pickup: nil;
stamp: nil.
self
rect: nil;
ellipse: nil;
polygon: nil;
line: nil;
star: nil]!
Item was changed:
----- Method: SketchEditorMorph>>mouseUp: (in category 'event handling') -----
mouseUp: evt
| myAction |
"Do nothing except those that work on mouseUp."
+ myAction _ self getActionFor: evt.
- myAction := self getActionFor: evt.
myAction == #fill: ifTrue: [
self perform: myAction with: evt.
"Each action must do invalidRect:"
].
myAction == #pickup: ifTrue: [
self pickupMouseUp: evt].
myAction == #polygon: ifTrue: [self polyEdit: evt]. "a mode lets you drag vertices"
self set: #lastEvent for: evt to: nil.
+ "If recording painting, note that we stopped a stroke. OK to condense points."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: #mouseUp:]].
!
Item was changed:
----- Method: SketchEditorMorph>>paint: (in category 'actions & preps') -----
paint: evt
"While the mouse is down, lay down paint, but only within window bounds.
11/28/96 sw: no longer stop painting when pen strays out of window; once it comes back in, resume painting rather than waiting for a mouse up"
+ | mousePoint startToEnd pfPen newPoint |
+ pfPen _ self get: #paintingFormPen for: evt.
+ mousePoint _ evt cursorPoint.
+ newPoint _ mousePoint - bounds origin.
+ startToEnd _ pfPen regionFor: newPoint.
+ evt shiftPressed
+ ifTrue: [pfPen gotoBack: newPoint]
+ ifFalse: [pfPen goto: newPoint].
- | mousePoint startRect endRect startToEnd pfPen myBrush |
-
- pfPen := self get: #paintingFormPen for: evt.
- myBrush := self getBrushFor: evt.
- mousePoint := evt cursorPoint.
- startRect := pfPen location + myBrush offset extent: myBrush extent.
- pfPen goto: mousePoint - bounds origin.
- endRect := pfPen location + myBrush offset extent: myBrush extent.
- "self render: (startRect merge: endRect). Show the user what happened"
- startToEnd := startRect merge: endRect.
self invalidRect: (startToEnd translateBy: bounds origin).
!
Item was changed:
----- Method: SoundEventMorph>>releaseCachedState (in category 'caching') -----
releaseCachedState
super releaseCachedState.
+ sound isCompressed
+ ifFalse: [sound _ sound compressWith: GSMCodec].
- sound := sound compressWith: GSMCodec.
!
Item was changed:
----- Method: SquishedNameMorph>>fontForName (in category 'as yet unclassified') -----
fontForName
+ ^(TextStyle default fontOfSize: 15) emphasized: 1
- | pickem |
- pickem := 3.
-
- pickem = 1 ifTrue: [
- ^(((TextStyle named: #Helvetica) ifNil: [TextStyle default]) fontOfSize: 13) emphasized: 1.
- ].
- pickem = 2 ifTrue: [
- ^(((TextStyle named: #Palatino) ifNil: [TextStyle default]) fontOfSize: 12) emphasized: 1.
- ].
- ^((TextStyle default) fontAt: 1) emphasized: 1
!
Item was changed:
----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}
- cl registerQuad: #(ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop}
- cl registerQuad: #(ScriptingSystem holderWithAlphabet 'Alphabet' 'A source for single-letter objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: StarMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Star' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'A symmetrical polygon in the shape of a star' translatedNoop!
- ^ self partName: 'Star'
- categories: #('Graphics')
- documentation: 'A symmetrical polygon in the shape of a star'!
Item was changed:
----- Method: StarMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: StickyPadMorph class>>defaultNameStemForInstances (in category 'parts bin') -----
defaultNameStemForInstances
"Answer the default name stem to use"
+ ^ 'tear off' translatedNoop
+ !
- ^ 'tear off'!
Item was changed:
----- Method: StickyPadMorph class>>descriptionForPartsBin (in category 'parts bin') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StickyPadMorph class>>launchPartVia:label: (in category 'parts bin') -----
launchPartVia: aSelector label: aString
"Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins. Overridden here so that all instances will be given the name, unlike the prevailing convention for other object types"
| aMorph |
+ aMorph _ self perform: aSelector.
- aMorph := self perform: aSelector.
aMorph setNameTo: self defaultNameStemForInstances. "i.e., circumvent uniqueness in this case"
aMorph setProperty: #beFullyVisibleAfterDrop toValue: true.
+ aMorph openInHand.
+ ^ aMorph!
- aMorph openInHand!
Item was changed:
----- Method: StickyPadMorph class>>registerInFlapsRegistry (in category 'as yet unclassified') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: StoryboardBookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Storyboard' translatedNoop
+ categories: #()
+ documentation: 'A storyboard authoring tool' translatedNoop!
- ^ self partName: 'Storyboard'
- categories: #('Presentation')
- documentation: 'A storyboard authoring tool'!
Item was changed:
----- Method: StringButtonMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'SButton' translatedNoop!
- ^ 'SButton'!
Item was changed:
----- Method: StringButtonMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]
ifFalse: [nil]!
Item was changed:
----- Method: TabMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tab' translatedNoop!
- ^ 'tab'!
Item was changed:
+ ----- Method: TabSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: TabSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
| b r |
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r _ AlignmentMorph newRow.
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r := AlignmentMorph newRow.
r color: b color; borderWidth: 0; layoutInset: 0.
r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
r wrapCentering: #topLeft.
+ r addMorphBack: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort).
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #cancelSort).
- r addMorphBack: (b label: 'Okay'; actionSelector: #acceptSort).
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (b label: 'Cancel'; actionSelector: #cancelSort).
self addMorphFront: r.
!
Item was changed:
----- Method: TabSorterMorph>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
self removeAllMorphs.
self extent: 300@100.
+ pageHolder _ PasteUpMorph new.
- pageHolder := PasteUpMorph new.
pageHolder vResizeToFit: true; autoLineLayout: true.
pageHolder extent: self extent - borderWidth.
pageHolder padding: 8.
pageHolder cursor: 0.
+ pageHolder wantsMouseOverHalos: false.
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: TabbedPalette class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tabbedPalette' translatedNoop!
- ^ 'tabbedPalette'!
Item was changed:
----- Method: TextMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {
DescriptionForPartsBin
+ formalName: 'Text (border)' translatedNoop
+ categoryList: #()
+ documentation: 'A text field with border' translatedNoop
- formalName: 'Text (border)'
- categoryList: #('Text')
- documentation: 'A text field with border'
globalReceiverSymbol: #TextMorph
nativitySelector: #borderedPrototype.
" DescriptionForPartsBin
+ formalName: 'Text (fancy)' translatedNoop
+ categoryList: {'Text' translatedNoop}
+ documentation: 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop
- formalName: 'Text (fancy)'
- categoryList: #('Text')
- documentation: 'A text field with a rounded shadowed border, with a fancy font.'
globalReceiverSymbol: #TextMorph
nativitySelector: #fancyPrototype."
DescriptionForPartsBin
+ formalName: 'Text' translatedNoop
+ categoryList: {'Basic' translatedNoop}
+ documentation:
+ 'A raw piece of text which you can edit into anything you want' translatedNoop
- formalName: 'Text'
- categoryList: #('Basic' 'Text')
- documentation: 'A raw piece of text which you can edit into anything you want'
globalReceiverSymbol: #TextMorph
+ nativitySelector: #nonwrappingPrototype.
- nativitySelector: #boldAuthoringPrototype.
}
!
Item was changed:
----- Method: Thumbnail>>makeThumbnailFromForm: (in category 'thumnail creation') -----
makeThumbnailFromForm: aForm
"Make a thumbnail from the form provided, obeying my min and max width and height preferences"
+ | scaleX scaleY margin opaque nominalWidth minimumWidth |
+ minimumWidth := self minimumWidth.
+ scaleY _ minimumHeight / aForm height. "keep height invariant"
+
+ scaleX _ ((nominalWidth := aForm width * scaleY) <= maximumWidth)
+ ifTrue:
+ [(nominalWidth < minimumWidth)
+ ifFalse:
+ [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
+ ifTrue:
+ [minimumWidth / aForm width]]
+ ifFalse:
+ [scaleY _ maximumWidth / aForm width].
- | scaleX scaleY margin opaque |
- scaleY := minimumHeight / aForm height. "keep height invariant"
- scaleX := ((aForm width * scaleY) <= maximumWidth)
- ifTrue: [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
- ifFalse: [scaleY := maximumWidth / aForm width].
"self form: (aForm magnify: aForm boundingBox by: (scaleX @ scaleY) smoothing: 2)."
"Note: A problem with magnify:by: fails to reproduce borders properly.
The following code does a better job..."
+ margin _ 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
+ opaque _ (Form extent: aForm extent + margin depth: 32) "fillWhite".
+ aForm displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
+ self form: ((opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2) fixAlpha).
- margin := 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
- opaque := (Form extent: aForm extent + margin depth: 32) "fillWhite".
- aForm fixAlpha displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
- opaque fixAlpha.
- self form: (opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2).
self extent: originalForm extent!
Item was changed:
----- Method: Thumbnail>>setStandardDefaultMetrics (in category 'initialization') -----
setStandardDefaultMetrics
"Provide the current choices for min.max width/height for thumbnails"
+ self maxWidth: 60 minHeight: 32.
+ self setProperty: #minimumWidth toValue: 16!
- self maxWidth: 60 minHeight: 24!
Item was changed:
----- Method: ThumbnailMorph>>step (in category 'stepping and presenter') -----
step
"Optimization: Don't redraw if we're viewing some kind of SketchMorph and its rotated Form hasn't changed."
| viewee f |
+ viewee _ self actualViewee.
+ viewee ifNil: [self stopStepping. ^ self].
+ viewee isSketchMorph
+ ifTrue:
+ [f := viewee rotatedForm.
+ f == lastSketchForm ifTrue: [^ self]. "The optimization"
+ lastSketchForm _ f]
+ ifFalse:
+ [lastSketchForm := nil]. "Avoids subtle bug if sketchMorph removed and then put back in"
+ self changed
- viewee := self actualViewee.
- viewee ifNil: [ self stopStepping. ^self ].
- (viewee isSketchMorph) ifTrue: [
- f := viewee rotatedForm.
- f == lastSketchForm ifTrue: [^ self].
- lastSketchForm := f].
- self changed.
!
Item was changed:
----- Method: TickIndicatorMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ self extent: 30 @ 30.
+ index _ 0!
- self extent: 20 @ 20.
- index := 0!
Item was changed:
----- Method: TransitionMorph class>>allEffects (in category 'available effects') -----
allEffects
+ #('none' 'slide over' 'slide both' 'slide away' 'slide border'
+ 'page forward' 'page back'
+ 'french door' 'zoom frame' 'zoom' 'dissolve') translatedNoop.
^ #(none
slideOver slideBoth slideAway slideBorder
pageForward pageBack
frenchDoor
zoomFrame zoom
dissolve)!
Item was changed:
----- Method: TransitionMorph class>>directionsForEffect: (in category 'available effects') -----
directionsForEffect: eff
"All these arrays are ordered so inverse is atWrap: size//2."
+ #('right' 'down right' 'down' 'down left' 'left' 'up left' 'up' 'up right'
+ 'in' 'in h' 'out' 'out h') translatedNoop.
+
(#(slideOver slideBoth slideAway slideBorder) includes: eff)
ifTrue: [^ #(right downRight down downLeft left upLeft up upRight)].
(#(pageForward pageBack) includes: eff)
ifTrue: [^ #(right down left up)].
(#(frenchDoor) includes: eff)
ifTrue: [^ #(in inH out outH)].
(#(zoomFrame zoom) includes: eff)
ifTrue: [^ #(in out)].
^ Array new!
Item was changed:
----- Method: TrashCanMorph class>>descriptionForPartsBin (in category 'miscellaneous') -----
descriptionForPartsBin
+ ^ self partName: 'Trash' translatedNoop
+ categories: { 'Basic' translatedNoop}
+ documentation: 'a tool for discarding objects' translatedNoop
+ sampleImageForm: (Form extent: 42@54 depth: 8 fromArray: #( 0 0 0 2555943 992034 555814414 587202599 654311424 0 0 0 0 0 654320418 550751400 2829625512 2829625512 2829625357 556007424 0 0 0 0 36 3553874600 2829155709 2105376125 2711726248 2829625512 2728926240 587212583 0 0 0 639882194 3433594237 1400339837 2107746472 2812848296 2829634764 2829623677 2820612864 640090112 0 0 3553809064 2097828727 2108216018 3537030348 3436367016 2829625548 3537021096 2105452577 603989760 0 9427 3537019218 22259922 4141011666 3536637138 4160212129 2712183208 2832398034 2709355944 539103014 0 2413266 3531411713 2110979575 3537031884 3435975671 4157384573 2812846461 2108216055 3430776189 488645135 654311424 651416310 2823946621 4160606930 3537030348 3539466451 2829559720 2829625506 2105398007 3534257533 2718769186 0 601019090 2097238994 4258452178 3537031891 4160213671 2812782760 2829559976 2105387218 4154948989 2099055886 254214144 4174566098 1392595922 4258452178 3537041442 3551045799 2829625512 2829625505 2105396471 3534257533 2098863648 606470144 4275229394 2097238696 4260811474 3536977959 3550980264 2829625512 2829558141 2108225271 2826796413 1998134560 589758464 584241874 3427991891 3438727890 3537031970 3433614504 2829625512 2829164961 3436377804 2709355901 1394154783 589692928 617861842 3534246674 1403572946 3537031890 3536627880 2829625512 2812848338 4157778045 2105376083 1394154527 587202560 265540306 3537030269 1397980584 2831994060 3435964584 2829625512 2831995602 3433594237 2105365330 1394154783 589758464 13871314 3537041106 2826796413 2105385640 2829559976 2829625548 3436367016 2709355901 1397902346 1394220320 606535680 639674536 2831995602 3537030312 2829625256 2829625512 2829634728 2829625469 2105365331 1280463699 186260768 606535680 1037224 2829625512 3436368594 3537030348 3433605288 2829625512 2709355895 1397967954 1376389715 404364814 254214144 9164 2829625512 2829166760 2829625512 2829625505 2709355901 1397951058 1280463370 173167480 421203235 637534208 35 2829625511 2711715197 2105376125 2105376119 1397969747 1397903954 168430156 1397954174 421339392 654311424 0 4174162088 2728492413 2105376125 2105374547 1397969747 1397969490 1280070483 2105350169 438182694 0 0 267898023 2829155709 2105376125 2104981331 1397969747 1397902346 1397979005 2105376282 455025703 0 0 16241320 2832387239 2105376125 2004318035 1397969747 1397980541 2104982910 2105350427 471928576 0 0 653775528 2832388812 2712119464 2829221245 2728960381 2105387170 2104982910 2105350683 488701990 0 0 16700071 2832388818 2829625548 3433603489 2829625469 2105387170 2104982909 2105350683 504233984 0 0 2413224 2815218380 2829559976 3433594237 2829625469 2105387176 2104982910 2105416476 220266496 0 0 2413516 2815218386 2812782760 2829614461 2829625469 2105387176 2104982909 2105416476 220341760 0 0 2413516 2815218386 2829166796 2829623677 2829625469 2105387176 2104982909 2105416733 522397440 0 0 54226 2829636306 2810030284 3433605245 2829625469 2105385640 2104982910 2105416733 522397440 0 0 2619346 2829636306 2829166760 2829625469 2829625505 2105385634 2104982945 2097945629 522462976 0 0 65234 2812859090 2829166760 3433604989 2829625469 2105387176 2104982945 2097945629 539240192 0 0 8914 2829636306 2829166760 3433605245 2829625505 2105387176 2104982945 2098797853 537863936 0 0 9427 2829634770 3433539752 3433604989 2829625505 2105387176 2104982946 2098797597 554641152 0 0 211 3433549010 3433146536 3433605245 2728962209 2105387176 2104983208 2098863389 553658112 0 0 9975 3433539794 3433144744 2829625213 2728962209 2105387176 2104983208 2098863134 234881024 0 0 10238 3433539794 3534201256 3435964321 2712184993 2105387176 2104983202 2115640350 234891008 0 0 35 3534203090 3534266792 3435964577 2108205217 2105387176 2104982946 2115705886 234881024 0 0 36 3550980306 3534268328 2831984801 2108205223 2105385640 2104982946 2115706142 570425344 0 0 0 3551045836 3534266792 2831984801 2108205224 2105385640 2105376161 2115705869 572915712 0 0 38 4155025356 3534266792 2831984801 2108205224 2105385640 2105376161 2115706125 572915712 0 0 39 4174162088 3536626088 2831984801 2108205224 2105385640 2105376126 2115771661 589758464 0 0 0 583837608 3536626087 2831984801 2108205224 2105387176 2105376161 2115771679 589692928 0 0 0 601006503 3537020839 2831984807 2108205224 2102623656 2105385342 2719751456 254214144 0 0 0 617850792 3537020833 2831984808 2108214440 2097238952 2105387170 438111502 0 0 0 0 668191948 3537021095 2829634727 2108205224 2097238952 2726142590 471736591 654311424 0 0 0 2282194 3537020833 2829634728 2711726248 2097238690 2826796314 220275750 0 0 0 0 63442 3537021095 2832387240 2107746472 2709355937 2105350686 539168550 640090112 0 0 0 211 3537030312 3536627879 2712194216 2815677352 2820414989 555885347 588195584 0 0 0 39 584307410 3433605288 2812848295 2714576126 3542093084 504176397 521015079 0 0 0 0 8992 3553414312 2829625512 2820673060 3553470632 2829589020 488579879 0 0 0 0 39 991758 235807524 2564819 3433605288 2829614621 220270375 0 0 0 0 0 0 0 2140364 3536627880 2709356064 571418112 0 0 0 0 0 0 0 581478568 3433605246 2719813120 640090112 0 0 0 0 0 0 0 13880488 2829589793 603989798 0 0 0 0 0 0 0 0 991758 570435111 654311424 0 0) offset: 0@0)!
- ^ self partName: 'Trash'
- categories: #('Useful' 'Basic')
- documentation: 'a tool for discarding objects'!
Item was changed:
----- Method: TrashCanMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'viewerFlapTab' translatedNoop!
- ^ 'viewerFlapTab'!
Item was changed:
----- Method: ViewerFlapTab>>initializeFor:topAt: (in category 'transition') -----
initializeFor: aPlayer topAt: aTop
+ "The assumption is that this is only called at the same time of creation of this instance."
+ beingOpened _ true.
+ scriptedPlayer _ aPlayer.
- scriptedPlayer := aPlayer.
self useGraphicalTab.
self top: aTop!
Item was changed:
----- Method: WaveEditor class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'WaveEditor' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A workbench for seing and editing wave forms' translatedNoop!
- ^ self partName: 'WaveEditor'
- categories: #('Multimedia')
- documentation: 'A workbench for seing and editing wave forms'!
Item was changed:
----- Method: WaveEditor>>addControls (in category 'initialization') -----
addControls
+ | slider aWrapper m aButton |
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: Color transparent;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ extent: 5 @ 5.
+ aWrapper wrapCentering: #topLeft.
+ aButton := self buttonName: 'X' action: #delete.
+ aButton setBalloonText: 'Close WaveEditor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Menu' translated action: #invokeMenu.
+ aButton setBalloonText: 'Open a menu' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play' translated action: #play.
+ aButton setBalloonText: 'Play sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor.
+ aButton setBalloonText: 'Play before cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play After' translated action: #playAfterCursor.
+ aButton setBalloonText: 'Play after cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Loop' translated action: #playLoop.
+ aButton setBalloonText: 'Play the loop' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Test' translated action: #playTestNote.
+ aButton setBalloonText: 'Test the note' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Save' translated action: #saveInstrument.
+ aButton setBalloonText: 'Save the sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd.
+ aButton setBalloonText: 'Set loop end at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle.
+ aButton setBalloonText: 'Set one cycle' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart.
+ aButton setBalloonText: 'Set the loop start at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ self addMorphBack: aWrapper.
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: self color;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #spaceFill;
+ vResizing: #rigid;
+ extent: 5 @ 20;
+ wrapCentering: #center;
+ cellPositioning: #leftCenter.
+ m := StringMorph new contents: 'Index: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #cursor;
+ putSelector: #cursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 71;
+ step.
+ aWrapper addMorphBack: m.
+ m := StringMorph new contents: 'Value: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #valueAtCursor;
+ putSelector: #valueAtCursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 50;
+ step.
+ aWrapper addMorphBack: m.
+ slider := SimpleSliderMorph new color: color;
+ extent: 200 @ 10;
+ target: self;
+ actionSelector: #scrollTime:.
+ aWrapper addMorphBack: slider.
+ m := Morph new color: aWrapper color;
+ extent: 10 @ 5.
+ "spacer"
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #startIndex;
+ putSelector: #startIndex:;
+ font: Preferences standardEToysButtonFont;
+ width: 40;
+ step.
+ aWrapper addMorphBack: m.
+ self addMorphBack: aWrapper!
- | slider bb r m |
- r := AlignmentMorph newRow.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r color: bb color; borderWidth: 0; layoutInset: 0.
- r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
- r wrapCentering: #topLeft.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'X'; actionSelector: #delete).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: '<>'; actWhen: #buttonDown;
- actionSelector: #invokeMenu).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play' translated; actionSelector: #play).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Before' translated; actionSelector: #playBeforeCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play After' translated; actionSelector: #playAfterCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Loop' translated; actionSelector: #playLoop).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Test' translated; actionSelector: #playTestNote).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Save' translated; actionSelector: #saveInstrument).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop End' translated; actionSelector: #setLoopEnd).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'One Cycle' translated; actionSelector: #setOneCycle).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop Start' translated; actionSelector: #setLoopStart).
- self addMorphBack: r.
-
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
-
- m := StringMorph new contents: 'Index: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #cursor; putSelector: #cursor:;
- growable: false; width: 71; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Value: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:;
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- slider := SimpleSliderMorph new
- color: color;
- extent: 200@2;
- target: self;
- actionSelector: #scrollTime:.
- r addMorphBack: slider.
-
- m := Morph new color: r color; extent: 10@5. "spacer"
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #startIndex; putSelector: #startIndex:;
- width: 40; step.
- r addMorphBack: m.
-
- self addMorphBack: r.
-
- !
Item was changed:
----- Method: WaveEditor>>addLoopPointControls (in category 'initialization') -----
addLoopPointControls
+ | m aWrapper |
+ aWrapper _ AlignmentMorph newRow.
+ aWrapper color: self color; borderWidth: 0; layoutInset: 0.
+ aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
- | r m |
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
+ m _ StringMorph new contents: 'Loop end: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- m := StringMorph new contents: 'Loop end: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopEnd; putSelector: #loopEnd:;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop length: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopLength; putSelector: #loopLength:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop cycles: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopCycles; putSelector: #loopCycles:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Frequency: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Frequency: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
- growable: false; width: 50; step.
- r addMorphBack: m.
+ self addMorphBack: aWrapper
- self addMorphBack: r.
!
Item was changed:
----- Method: WaveEditor>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ samplingRate _ SoundPlayer samplingRate.
+ loopEnd _ loopLength _ 0.
+ loopCycles _ 1.
+ perceivedFrequency _ 0.
- samplingRate := SoundPlayer samplingRate.
- loopEnd := loopLength := 0.
- loopCycles := 1.
- perceivedFrequency := 0.
"zero means unknown"
self extent: 5 @ 5;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ graph _ GraphMorph new extent: 450 @ 100.
- graph := GraphMorph new extent: 450 @ 100.
graph cursor: 0.
graph cursorColorAtZeroCrossings: Color blue.
self addControls.
self addLoopPointControls.
self addMorphBack: graph.
self
addMorphBack: (Morph
newBounds: (0 @ 0 extent: 0 @ 3)
color: Color transparent).
+ self addMorphBack: (keyboard _ PianoKeyboardMorph new).
+ "self sound: (SampledSound soundNamed: 'croak')."
- self addMorphBack: (keyboard := PianoKeyboardMorph new).
- self sound: (SampledSound soundNamed: 'croak').
!
Item was changed:
----- Method: Workspace class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#Workspace. #prototypicalToolWindow. 'Workspace' translatedNoop. 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.' translatedNoop} forFlapNamed: 'Tools'.]!
- ifPresent: [:cl | cl registerQuad: #(Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')
- forFlapNamed: 'Tools'.]!
1
0
Tim Felgentreff uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-tfel.182.mcz
==================== Summary ====================
Name: MorphicExtras-tfel.182
Author: tfel
Time: 3 August 2016, 1:30:16.122917 pm
UUID: 8a27ff73-4a8d-4b46-b5a8-169fcbd70495
Ancestors: MorphicExtras-tfel.181
use new sugar navigator preference if etoys is loaded
=============== Diff against MorphicExtras-tfel.178 ===============
Item was changed:
----- Method: AlignmentMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Extra items for parts bins"
^ {DescriptionForPartsBin
+ formalName: 'Column' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a column' translatedNoop
- formalName: 'Column'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a column'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #columnPrototype.
DescriptionForPartsBin
+ formalName: 'Row' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a row' translatedNoop
- formalName: 'Row'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a row'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #rowPrototype}!
Item was changed:
+ ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'olpc support') -----
+ fancyText: aString font: aFont color: aColor
+ "Answer a morph containing a TextMorph containing the given string in the given font with the given color."
+
+ | answer tm |
+ answer _ self inAColumn: {
+ tm _ TextMorph new
+ textColor: aColor;
+ contents: aString;
+ beAllFont: aFont;
+ yourself
+ }.
+
- ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'as yet unclassified') -----
- fancyText: aString font: aFont color: aColor
- | answer tm col |
- col := ColorTheme current dialog3DTitles
- ifTrue: [aColor]
- ifFalse: [aColor negated].
- tm := TextMorph new.
- tm beAllFont: aFont;
- color: col;
- contents: aString.
- answer := self inAColumn: {tm}.
- ColorTheme current dialog3DTitles
- ifTrue: [""
- tm addDropShadow.
- tm shadowPoint: 5 @ 5 + tm bounds center].
tm lock.
+ ^ answer
+ !
- ^ answer!
Item was changed:
----- Method: AlignmentMorphBob1>>inARow: (in category 'as yet unclassified') -----
inARow: aCollectionOfMorphs
| row |
row := AlignmentMorph newRow color: Color transparent;
vResizing: #shrinkWrap;
layoutInset: 2;
wrapCentering: #center;
cellPositioning: #leftCenter.
aCollectionOfMorphs
+ do: [:each | each ifNotNil: [row addMorphBack: each]].
- do: [:each | row addMorphBack: each].
^ row!
Item was changed:
----- Method: BOBTransformationMorph>>recomputeExtent (in category 'as yet unclassified') -----
recomputeExtent
| scalePt newScale theGreenThingie greenIBE myNewExtent |
submorphs isEmpty ifTrue: [^self extent].
+ worldBoundsToShow ifNil: [worldBoundsToShow _ self firstSubmorph bounds].
- worldBoundsToShow ifNil: [worldBoundsToShow := self firstSubmorph bounds].
worldBoundsToShow area = 0 ifTrue: [^self extent].
+ scalePt _ owner innerBounds extent / worldBoundsToShow extent.
+ newScale _ scalePt x min: scalePt y.
+ theGreenThingie _ owner.
+ greenIBE _ theGreenThingie innerBounds extent.
+ myNewExtent _ (greenIBE min: worldBoundsToShow extent * newScale) truncated.
- scalePt := owner innerBounds extent / worldBoundsToShow extent.
- newScale := scalePt x min: scalePt y.
- theGreenThingie := owner.
- greenIBE := theGreenThingie innerBounds extent.
- myNewExtent := (greenIBE min: worldBoundsToShow extent * newScale) truncated.
self
scale: newScale;
offset: worldBoundsToShow origin * newScale.
+ smoothing _ (newScale < 1.0) ifTrue: [1] ifFalse: [1].
- smoothing := (newScale < 1.0) ifTrue: [2] ifFalse: [1].
^myNewExtent!
Item was changed:
----- Method: BasicButton class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'button' translatedNoop!
- ^ 'button'!
Item was changed:
+ ----- Method: BasicButton>>label:font: (in category 'initialization') -----
- ----- Method: BasicButton>>label:font: (in category 'as yet unclassified') -----
label: aString font: aFontOrNil
+ "Set the receiver's label and font as indicated."
| oldLabel m aFont |
+ (oldLabel _ self findA: StringMorph)
- (oldLabel := self findA: StringMorph)
ifNotNil: [oldLabel delete].
+ aFont _ aFontOrNil ifNil: [Preferences standardEToysButtonFont].
+ m _ StringMorph contents: aString font: aFont.
- aFont := aFontOrNil ifNil: [Preferences standardButtonFont].
- m := StringMorph contents: aString font: aFont.
self extent: (m width + 6) @ (m height + 6).
m position: self center - (m extent // 2).
self addMorph: m.
m lock
!
Item was changed:
----- Method: BookMorph class>>alreadyInFromUrl: (in category 'url') -----
alreadyInFromUrl: aUrl
"Does a bookMorph living in some world in this image represent the same set of server pages? If so, don't create another one. It will steal pages from the existing one. Go delete the first one."
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world ifNotNil: [
+ self inform: 'This book is already open in some project' translated.
- self inform: 'This book is already open in some project'.
^ true]]]].
^ false!
Item was changed:
----- Method: BookMorph class>>authoringPrototype (in category 'scripting') -----
authoringPrototype
"Answer an instance of the receiver suitable for placing in a parts bin for authors"
| book |
+ book := self new initializeToStandAlone.
+ book markAsPartsDonor.
- book := self new markAsPartsDonor.
- book removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
- book borderWidth: 1; borderColor: Color black.
- book beSticky.
- book showPageControls; insertPage.
^ book!
Item was changed:
----- Method: BookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Book' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'Multi-page structures' translatedNoop
+ sampleImageForm: (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAAMgAAACgCAYAAABJ/yOpAAAABHNCSVQFBQUBSsjp7wAABMtJ
+ REFUeF7l3S2S4kAAgFEkEonkCEiOgEQikUgkEolEcgSOgEQiOcYcAZfdniqmpnaBkE43JHni
+ 7dZuzWR7m3z5ISHT6/X6hc/ne+TvL9fr1efz/cMPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5OhLI
+ 19eXz9dZfiA+nx+Iz+cH4vN1K5Dz+fxUEyaoCWP0xwAF8ntSy94l+NQL0IQx+mMAA3llop+9
+ AO+K49Nj9MeABfLqVujVrVTOvcYnx+iPAQwkxWTn3kI1YYz+GMBAckx4kw4lUo3RH4MfiB9I
+ hTHU/ZSbH0gLAsk54akmvuoYY+5LKxvjvTGkDCR2DKnnoq2RZAkkNo4cK2DKOGJv3Hw0xkdj
+ SB1IzBhyzEedSC6XS7Hf74vFYlGMx+Nit9uVfs9yufz++jrLaFwg75r0KmMsW/nkQKrMSexr
+ dTgc/vs/rlar0u/r9/vfkdRZRiMDecekvzrGV1Y+PZBX5yX2tTqdTsVmsymOx+PPir5er0uj
+ CoGE74ldRpZA6px7xK6Mud7OrLtSPhvjszHkCKTqGHLMQYpzkdvKXbb1D3uO0WhUaxmNDyTX
+ pKdeMXIFkvoQNXcgMfMQG0jZ1n84HP4cXsUuoxWB5Jj0sjGm3GprgZSN+x17kHA4Fb4mfG3n
+ 9yA5Jj3H4Y1/iBU3hhx7kHCuMRgMau+F/ED8QFobyLOt/2QyKebzee3zGP8Qyz/Eau0h1qOt
+ f7jWEd69Ctc7iD2If5Lun6RX2fqHi3/PDq86tQfx3+b13+atuvUPh1az2SzJO2H+hUL/QmEr
+ LhTermuELX5Y+cO/F84zwp/D34d3rX5fPd9ut7WW4d9q0pJbTVLOX5tvNbmdeIf7p+79frta
+ ftszhPOQ2GX4Nyu26GbFNgTSpDt6w02I0+nUv93dv93dv9390Qn6o4uD/gem/A9M+R+Y8j9R
+ 6H/k1v/Irf/QBv+hDf5DG/zH/viP/fHH4AfiPzjOH4MfiP/oUf/Ro/6jR/2HV/sPr/YfXu3/
+ +AOfzw/E5/MD8fn8QHy+pgfi8/k/BtqfDJ/PD8Tn8wPx+fxAfD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fzw/E5/MD8fn8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8QPx+fxAfD4/EJ/PD8Tn8wPx+fxAfL47ro3i
+ B+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8wPx+fxAfD4/EJ/PD8QPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5/EB8Pj8Qn88PxOfz
+ A/H5fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiB+Iz+cH4vP5gfg+o6P8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHw+PxCfz+cH4vP5gfh8fiA+nx+Iz+cH
+ 4vP5gfh8fiA+nx+Iz+cH4vP5gfiB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+
+ ID6fzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHy+jgXi8/nu+wM79mpMjbRBXAAAAABJRU5E
+ rkJggg==' readStream) readStream) nextImage!
- ^ self partName: 'Book'
- categories: #('Presentation')
- documentation: 'Multi-page structures'!
Item was changed:
----- Method: BookMorph class>>initialize (in category 'class initialization') -----
initialize
- FileList registerFileReader: self.
-
self registerInFlapsRegistry. !
Item was changed:
----- Method: BookMorph class>>isInWorld:withUrl: (in category 'url') -----
isInWorld: aWorld withUrl: aUrl
| urls bks short |
"If a book with this url is in the that (current) world, return it. Say if it is out or in another world."
+ urls _ OrderedCollection new.
+ bks _ OrderedCollection new.
- urls := OrderedCollection new.
- bks := OrderedCollection new.
aWorld allMorphsDo: [:aBook | (aBook isKindOf: BookMorph) ifTrue: [
bks add: aBook.
(urls add: (aBook valueOfProperty: #url)) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]]]]. "shortcut"
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]
ifFalse: [
+ self inform: 'Book may be open in some other project' translated.
- self inform: 'Book may be open in some other project'.
^ aBook]]]].
"if same book name, use it"
+ short _ (aUrl findTokens: '/') last.
- short := (aUrl findTokens: '/') last.
urls withIndexDo: [:kk :ind | (kk findTokens: '/') last = short ifTrue: [
^ bks at: ind]].
^ #out!
Item was changed:
----- Method: BookMorph class>>nextPageButton (in category 'scripting') -----
nextPageButton
+ "Answer a button that will take the user to the next page of its
+ enclosing book"
- "Answer a button that will take the user to the next page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #NextPage.
+ aButton target: aButton.
+ aButton actionSelector: #nextOwnerPage.
+ aButton arguments: #().
+ aButton setNameTo: 'previous'.
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #nextOwnerPage; label: '->'; color: Color yellow.
- aButton setNameTo: 'next'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>openFromFile: (in category 'fileIn/Out') -----
openFromFile: fullName
"Reconstitute a Morph from the selected file, presumed to be represent
a Morph saved via the SmartRefStream mechanism, and open it in an
appropriate Morphic world"
| book aFileStream |
Smalltalk verifyMorphicAvailability ifFalse: [^ self].
+ aFileStream _ FileStream readOnlyFileNamed: fullName.
+ book _ BookMorph new.
- aFileStream := FileStream oldFileNamed: fullName.
- book := BookMorph new.
book setProperty: #url toValue: aFileStream url.
book fromRemoteStream: aFileStream.
aFileStream close.
Smalltalk isMorphic
ifTrue: [ActiveWorld addMorphsAndModel: book]
ifFalse:
[book isMorph ifFalse: [^self inform: 'Can only load a single morph
+ into an mvc project via this mechanism.' translated].
- into an mvc project via this mechanism.'].
book openInWorld].
book goToPage: 1!
Item was changed:
----- Method: BookMorph class>>previousPageButton (in category 'scripting') -----
previousPageButton
+ "Answer a button that will take the user to the previous page of its
+ enclosing book"
- "Answer a button that will take the user to the previous page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #PrevPage.
+ aButton target: aButton.
+ aButton actionSelector: #previousOwnerPage.
+ aButton arguments: #().
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #previousOwnerPage; color: Color yellow; label: '<-'.
aButton setNameTo: 'previous'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BookMorph . #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'Supplies']!
Item was changed:
----- Method: BookMorph class>>serviceLoadAsBook (in category 'fileIn/Out') -----
serviceLoadAsBook
^ SimpleServiceEntry
provider: self
+ label: 'load as book' translatedNoop
- label: 'load as book'
selector: #openFromFile:
+ description: 'open as bookmorph' translatedNoop!
- description: 'open as bookmorph'!
Item was changed:
----- Method: BookMorph>>goToPageMorph:transitionSpec: (in category 'navigation') -----
goToPageMorph: newPage transitionSpec: transitionSpec
+ "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided."
+
| pageIndex aWorld oldPageIndex ascending tSpec readIn |
pages isEmpty ifTrue: [^self].
self setProperty: #searchContainer toValue: nil. "forget previous search"
self setProperty: #searchOffset toValue: nil.
self setProperty: #searchKey toValue: nil.
pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"].
readIn := newPage isInMemory not.
oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil].
ascending := (oldPageIndex isNil or: [newPage == currentPage])
ifTrue: [nil]
ifFalse: [oldPageIndex < pageIndex].
tSpec := transitionSpec ifNil:
["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec
ifAbsent:
[" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]].
self flag: #arNote. "Probably unnecessary"
(aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus].
currentPage ifNotNil: [currentPage updateCachedThumbnail].
self currentPage notNil
ifTrue:
[(((pages at: pageIndex) owner isKindOf: TransitionMorph)
and: [(pages at: pageIndex) isInWorld])
ifTrue: [^self "In the process of a prior pageTurn"].
self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts].
+ self removeViewersOnSubsIn: ActiveWorld presenter.
ascending ifNotNil:
["Show appropriate page transition and start new page when done"
currentPage stopStepping.
(pages at: pageIndex) position: currentPage position.
^(TransitionMorph
effect: tSpec second
direction: tSpec third
inverse: (ascending or: [transitionSpec notNil]) not)
showTransitionFrom: currentPage
to: (pages at: pageIndex)
in: self
whenStart: [self playPageFlipSound: tSpec first]
whenDone:
[currentPage
delete;
fullReleaseCachedState.
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrlInBook: self url.
currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page"
currentPage
delete;
fullReleaseCachedState].
+ self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage"
- self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
-
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrl.
+ currentPage sqkPage computeThumbnail "just store it"].
+ ActiveWorld ifNotNil: [ActiveWorld presenter flushPlayerListCache]!
- currentPage sqkPage computeThumbnail "just store it"]!
Item was changed:
----- Method: BookMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
+ super initializeToStandAlone.
+ self removeEverything; pageSize: 360@228; color: Color white.
- self initialize.
- self removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
self borderWidth: 1; borderColor: Color black.
self beSticky.
self showPageControls; insertPage.
^ self!
Item was changed:
----- Method: BookMorph>>pasteBookPage (in category 'menu') -----
pasteBookPage
+ "If the paste buffer has something to paste, paste it as a book page."
+
| aPage |
+ aPage _ self primaryHand objectToPaste.
+ aPage removeProperty: #revertKey.
- aPage := self primaryHand objectToPaste.
self insertPage: aPage pageSize: aPage extent atIndex: ((pages indexOf: currentPage) - 1).
"self goToPageMorph: aPage"!
Item was changed:
----- Method: BookMorph>>setNewPagePrototype (in category 'menu') -----
setNewPagePrototype
"Record the current page as the prototype to be copied when inserting new pages."
currentPage ifNotNil:
+ [newPagePrototype _ currentPage veryDeepCopy.
+ newPagePrototype removeProperty: #revertKey].
+ "When a new page is inserted, it will not have any original page to revert to. After author improves the new page, he can save it for later revert."
- [newPagePrototype := currentPage veryDeepCopy].
!
Item was changed:
+ ----- Method: BookPageSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: BookPageSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
+ | bb r str aCheckbox aWrapper |
+ r _ AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
+ r wrapCentering: #center; cellPositioning: #leftCenter;
- | bb r aButton str |
- r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
- r wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated.
+ r addTransparentSpacerOfSize: 12.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete)).
+ bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated; actionSelector: #acceptSort)).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated; actionSelector: #delete)).
+ "eliminate the parts-bin button on the book-page sorters...
+ r addTransparentSpacerOfSize: 24 @ 0.
+
+ aCheckbox := UpdatingThreePhaseButtonMorph checkBox.
+ aCheckbox
- r addTransparentSpacerOfSize: 8 @ 0.
- r addMorphBack: (self wrapperFor: (aButton := UpdatingThreePhaseButtonMorph checkBox)).
- aButton
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ str _ StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons.
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
+ addMorphBack: (self wrapperFor: aCheckbox);
+ addMorphBack: (self wrapperFor: str lock).
+ r addMorphBack: aWrapper."
- str := StringMorph contents: 'Parts bin' translated.
- r addMorphBack: (self wrapperFor: str lock).
+ self addMorphFront: r
- self addMorphFront: r.
!
Item was changed:
----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'as yet unclassified') -----
book: aBookMorph morphsToSort: morphList
+ | innerBounds scrollPane newHeight |
+ book _ aBookMorph.
+ newHeight _ self currentWorld height.
- | innerBounds |
- book := aBookMorph.
pageHolder removeAllMorphs.
pageHolder addAllMorphs: morphList.
pageHolder extent: pageHolder width@pageHolder fullBounds height.
+ innerBounds _ Rectangle merging: (morphList collect: [:m | m bounds]).
+ pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.
+ (pageHolder height > newHeight) ifTrue: [
+ scrollPane _ ScrollPane new.
+
+ self height: newHeight.
+ scrollPane model: pageHolder.
+ scrollPane extent: pageHolder width@(newHeight - aBookMorph submorphs first height - 28).
+ self addMorph: scrollPane inFrontOf: pageHolder.
+ scrollPane scroller addMorph: pageHolder.
+ scrollPane scrollBarOnLeft: false.
+ scrollPane retractable: false.
+ scrollPane hideHScrollBarIndefinitely: true.
+ scrollPane borderWidth: 1; borderColor: Color gray.
+ ].
+ !
- innerBounds := Rectangle merging: (morphList collect: [:m | m bounds]).
- pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.!
Item was changed:
----- Method: BookPageSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: Display extent - 100;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ pageHolder _ PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
- pageHolder := PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
pageHolder hResizing: #shrinkWrap.
+ pageHolder wantsMouseOverHalos: false.
"pageHolder cursor: 0."
"causes a walkback as of 5/25/2000"
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: BookPageThumbnailMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
| f |
super initialize.
+ flipOnClick _ false.
- ""
- flipOnClick := false.
+ f _ Form extent: 160@120 depth: Display depth.
- f := Form extent: 60 @ 80 depth: Display depth.
f fill: f boundingBox fillColor: color.
self form: f!
Item was changed:
----- Method: BooklikeMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
"This factoring allows subclasses to have different menu yet still use the super call for the rest of the metamenu."
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ aCustomMenu add: 'book...' translated target: self action: #invokeBookMenu.
+
+ "self addBookMenuItemsTo: aCustomMenu hand: aHandMorph"!
- self addBookMenuItemsTo: aCustomMenu hand: aHandMorph!
Item was changed:
----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') -----
currentPlayerDo: aBlock
| aPlayer aPage |
(aPage := self currentPage) ifNil: [^ self].
+ aPage allMorphsDo:[ :m|
+ (aPlayer := m player) ifNotNil:
+ [aBlock value: aPlayer]]!
- (aPlayer := aPage player) ifNotNil:
- [aBlock value: aPlayer]!
Item was changed:
----- Method: BooklikeMorph>>makePageControlsFrom: (in category 'page controls') -----
makePageControlsFrom: controlSpecs
"From the controlSpecs, create a set of page control and return them -- this method does *not* add the controls to the receiver."
| c col row |
c := (color saturation > 0.1) ifTrue: [color slightlyLighter] ifFalse: [color slightlyDarker].
col := AlignmentMorph newColumn.
col color: c; borderWidth: 0; layoutInset: 0.
col hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5.
row := AlignmentMorph newRow.
row color: c; borderWidth: 0; layoutInset: 0.
row hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5.
controlSpecs do: [:spec | | lastGuy b |
+ spec == #showDescription ifTrue: [row addMorphBack: self makeDescriptionViewer].
+ spec == #pageNumber ifTrue: [row addMorphBack: self makePageNumberItem].
+ spec == #spacer ifTrue: [row addTransparentSpacerOfSize: (10 @ 0)].
+ spec == #variableSpacer ifTrue: [
+ row addMorphBack: AlignmentMorph newVariableTransparentSpacer].
+ spec class == Array ifTrue: [
+ spec first isSymbol
+ ifTrue: [b := ThreePhaseButtonMorph labelSymbol: spec first]
+ ifFalse: [b := SimpleButtonMorph new borderWidth: 2;
+ borderColor: Color black; color: Color veryLightGray.
+ b label: spec first font: Preferences standardMenuFont].
+ b target: self; actionSelector: spec second; setBalloonText: spec third.
+ (spec atPin: 4) = #border
+ ifTrue: [b actWhen: #buttonDown]
+ ifFalse: [b borderWidth: 0]. "default is none"
+ row addMorphBack: b.
+ (((lastGuy _ spec last asLowercase) includesSubString: 'menu') or:
+ [lastGuy includesSubString: 'designations'])
+ ifTrue: [b actWhen: #buttonDown]]]. "pop up menu on mouseDown"
- spec == #spacer
- ifTrue:
- [row addTransparentSpacerOfSize: (10 @ 0)]
- ifFalse:
- [spec == #variableSpacer
- ifTrue:
- [row addMorphBack: AlignmentMorph newVariableTransparentSpacer]
- ifFalse:
- [b := SimpleButtonMorph new target: self; borderWidth: 1;
- borderColor: Color veryLightGray; color: c.
- b label: spec first;
- actionSelector: spec second;
- borderWidth: 0;
- setBalloonText: spec third.
- row addMorphBack: b.
- (((lastGuy := spec last asLowercase) includesSubstring: 'menu') or:
- [lastGuy includesSubstring: 'designations'])
- ifTrue: [b actWhen: #buttonDown]]]]. "pop up menu on mouseDown"
col addMorphBack: row.
^ col!
Item was changed:
----- Method: BooklikeMorph>>shortControlSpecs (in category 'page controls') -----
shortControlSpecs
+ "Answer specs defining the widgets in the short form of the control panel."
+
^ {
#spacer.
#variableSpacer.
{'<'. #previousPage. 'Previous page' translated}.
#spacer.
+ {#MenuIcon. #invokeShortBookMenu. 'Click here to get a menu of options for this book.' translated}.
- {'·'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}.
#spacer.
{'>'. #nextPage. 'Next page' translated}.
#spacer.
#variableSpacer.
+ {#RightCaret. #showMoreControls. 'More controls' translated}
- {'³'. #showMoreControls. 'More controls' translated}
}
!
Item was changed:
----- Method: BooklikeMorph>>showingFullScreenString (in category 'misc') -----
showingFullScreenString
+ "Answer a string characterizing whether the receiver is operating in full-screen mode."
+
+ ^ (self isInFullScreenMode ifTrue: ['<yes>'] ifFalse: ['<no>']), 'view pages full-screen' translated!
- ^ (self isInFullScreenMode
- ifTrue: ['exit full screen']
- ifFalse: ['show full screen']) translated!
Item was changed:
----- Method: BooklikeMorph>>showingPageControlsString (in category 'misc') -----
showingPageControlsString
+ "Answer a string characterizing whether page controls are currently showing."
+
+ ^ (self pageControlsVisible ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'page controls visible' translated!
- ^ (self pageControlsVisible
- ifTrue: ['hide page controls']
- ifFalse: ['show page controls']) translated!
Item was changed:
----- Method: BouncingAtomsMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'BouncingAtoms' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney' translatedNoop!
- ^ self partName: 'BouncingAtoms'
- categories: #('Demo')
- documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney'!
Item was changed:
----- Method: BouncingAtomsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BouncingAtomsMorph, #new. 'Bouncing Atoms' translatedNoop. 'Atoms, mate' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BouncingAtomsMorph new 'Bouncing Atoms' 'Atoms, mate')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: ClockMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Answer a description for use in parts bins."
+
+ ^ self partName: 'Digital Clock' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A digital clock' translatedNoop!
- ^ self partName: 'Clock'
- categories: #('Useful')
- documentation: 'A digital clock'!
Item was changed:
----- Method: ClockMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ClockMorph, #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: ClockMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
+ "Add toggles for showing-seconds and display-24-hrs to the halo menu"
+
+ "NB: intentionallyi no super call here!!"
+
+ aCustomMenu add: 'change font' translated action: #changeFont.
+
+ aCustomMenu addUpdating: #showingSecondsString action: #toggleShowingSeconds.
+ aCustomMenu addUpdating: #displaying24HourString action: #toggleShowing24hr!
- "Note minor loose end here -- if the menu is persistent, then the wording will be wrong half the time"
- | item |
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- item := showSeconds == true
- ifTrue: ['stop showing seconds']
- ifFalse: ['start showing seconds'].
- aCustomMenu add: item translated target: self action: #toggleShowingSeconds.
- item := show24hr == true
- ifTrue: ['display Am/Pm']
- ifFalse: ['display 24 hour'].
- aCustomMenu add: item translated target: self action: #toggleShowing24hr.
-
- !
Item was changed:
----- Method: ClockMorph>>initialize (in category 'initialization') -----
initialize
+ "initialize the state of the receiver"
+
- "initialize the state of the receiver"
super initialize.
+
+ showSeconds _ true.
+ show24hr _ false.
+ self font: Preferences standardMenuFont emphasis: 1.
- ""
- showSeconds := true.
- show24hr := false.
self step!
Item was changed:
----- Method: ClockMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
super initializeToStandAlone.
+ showSeconds _ false.
+ self font: (Preferences standardMenuFont emphasized: 1).
- showSeconds := true.
self step!
Item was changed:
----- Method: CurveMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#CurveMorph, #authoringPrototype. 'Curve' translatedNoop, 'A curve' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#CurveMorph. #authoringPrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}
- cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: CurveMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Curvy Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.' translatedNoop
- formalName: 'Curvy Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.'
globalReceiverSymbol: #CurveMorph
nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: EllipseMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: EnvelopeEditorMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: menu hand: aHandMorph
super addCustomMenuItems: menu hand: aHandMorph.
menu addLine.
envelope updateSelector = #ratio: ifTrue:
[menu add: 'choose denominator...' translated action: #chooseDenominator:].
menu add: 'adjust scale...' translated action: #adjustScale:.
- SoundPlayer isReverbOn
- ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb]
- ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb].
menu addLine.
menu add: 'get sound from lib' translated action: #chooseSound:.
menu add: 'put sound in lib' translated action: #saveSound:.
menu add: 'read sound from disk...' translated action: #readFromDisk:.
menu add: 'save sound on disk...' translated action: #saveToDisk:.
menu add: 'save library on disk...' translated action: #saveLibToDisk:.
!
Item was changed:
----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'editing') -----
buildScalesIn: frame
+ | env |
+ env _ envelope.
+ pixPerTick _ graphArea width // (self maxTime//10) max: 1.
+ "hminortick _ ( 1 + ( self maxTime // 800 ) ) * 10.
+ hmajortick _ ( 1 + ( self maxTime // 800 ) ) * 100."
+ hScale _ (Morph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) color: Color lightGreen.
+ " hScale _ (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
- | env hmajortick hminortick |
- env := envelope.
- pixPerTick := graphArea width // (self maxTime//10) max: 1.
- hminortick := ( 1 + ( self maxTime // 800 ) ) * 10.
- hmajortick := ( 1 + ( self maxTime // 800 ) ) * 100.
- hScale := (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
start: 0 stop: self maxTime
minorTick: hminortick minorTickLength: 3
majorTick: hmajortick majorTickLength: 10
caption: 'milliseconds' tickPrintBlock: [:v | v printString].
+ "
self addMorph: hScale.
+ vScale _ (Morph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))) color: Color lightGreen.
+ "vScale _ ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))."
- vScale := ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left)).
env name = 'pitch'
ifTrue:
[env scale >= 2.0
ifTrue:
[vScale start: 0 stop: env scale
minorTick: env scale / 24 minorTickLength: 3
majorTick: env scale / 2.0 majorTickLength: 10
caption: 'pitch (octaves)'
tickPrintBlock: [:v | (v-(env scale/2)) asInteger printString]]
ifFalse:
[vScale start: 0 stop: env scale
minorTick: 1.0/48.0 minorTickLength: 3
majorTick: 1.0/12.0 majorTickLength: 10
caption: 'pitch (half-steps)'
tickPrintBlock: [:v | (v-(env scale/2)*12) rounded printString]]]
ifFalse: [
env name = 'random pitch:'
ifTrue: [
vScale start: 0.9 stop: 1.1
minorTick: 0.2 / 50.0 minorTickLength: 3
majorTick: 0.2 / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]]
ifFalse: [
vScale start: 0 stop: env scale
minorTick: env scale / 50.0 minorTickLength: 3
majorTick: env scale / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]].
].
+ vScale _ TransformationMorph new asFlexOf: vScale.
- vScale := TransformationMorph new asFlexOf: vScale.
vScale angle: Float pi / 2.0.
self addMorph: vScale.
vScale position: (frame left)@(graphArea top-1) - (3@1).
!
Item was changed:
----- Method: EventRecorderMorph>>addButtons (in category 'initialization') -----
addButtons
+ | r b w |
- | r b |
caption ifNotNil: ["Special setup for play-only interface"
+ (r _ self makeARowForButtons)
- (r := self makeARowForButtons)
addMorphBack: (SimpleButtonMorph new target: self;
+ label: caption font: Preferences standardButtonFont; actionSelector: #play);
- label: caption; actionSelector: #play);
- addMorphBack: self makeASpacer;
- addMorphBack: self makeStatusLight;
addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
+ addMorphBack: self makeASpacer.
^ self addMorphBack: r
].
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#record. nil. 'Begin recording'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#record. nil. 'Begin recording'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#stop. b width. 'Stop recording - you can also use the ESC key to stop it'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#play. b width. 'Play current recording'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#readTape. b width. 'Get a new recording from disk'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
+ addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
addMorphBack: self makeASpacer;
+ addMorphBack: (self buttonFor: {#createPlayButton. b width. 'Make a simple button to play this recording'}).
- addMorphBack: self makeStatusLight;
- addMorphBack: self makeASpacer;
- addMorphBack: (self buttonFor: {#button. b width. 'Make a simple button to play this recording'}).
self addMorph: r.
self setStatusLight: #ready.!
Item was changed:
----- Method: EventRecorderMorph>>handleListenEvent: (in category 'events-processing') -----
handleListenEvent: anEvent
"Record the given event"
+ anEvent hand == recHand ifFalse: [^ self]. "not for me"
+ state == #record ifFalse: [
+ "If user got an error while recording and deleted recorder, will still be listening"
+ recHand ifNotNil: [recHand removeEventListener: self].
+ ^self].
- (state == #record and:[anEvent hand == recHand])
- ifFalse:[^self].
anEvent = lastEvent ifTrue: [^ self].
(anEvent isKeyboard and:[anEvent keyValue = 27 "esc"])
ifTrue: [^ self stop].
+ time _ anEvent timeStamp.
- time := anEvent timeStamp.
tapeStream nextPut: (anEvent copy setHand: nil).
journalFile ifNotNil:
[journalFile store: anEvent; cr; flush].
+ lastEvent _ anEvent.!
- lastEvent := anEvent.!
Item was changed:
----- Method: EventRecorderMorph>>pauseIn: (in category 'pause/resume') -----
pauseIn: aWorld
"Suspend playing or recording, either as part of a stop command,
or as part of a project switch, after which it will be resumed."
self setStatusLight: #ready.
state = #play ifTrue:
+ [state _ #suspendedPlay.
+ playHand halo ifNotNil: [playHand halo delete].
- [state := #suspendedPlay.
playHand delete.
aWorld removeHand: playHand.
+ playHand _ nil].
- playHand := nil].
state = #record ifTrue:
+ [state _ #suspendedRecord.
- [state := #suspendedRecord.
recHand removeEventListener: self.
+ recHand _ nil].
- recHand := nil].
voiceRecorder ifNotNil:
[voiceRecorder pause.
startSoundEvent ifNotNil:
[startSoundEvent argument: voiceRecorder recordedSound.
voiceRecorder clearRecordedSound.
+ startSoundEvent _ nil]].
- startSoundEvent := nil]].
!
Item was changed:
----- Method: EventRecorderMorph>>resumeIn: (in category 'pause/resume') -----
resumeIn: aWorld
"Resume playing or recording after a project switch."
+ self state = #suspendedPlay ifTrue:
- state = #suspendedPlay ifTrue:
[self resumePlayIn: aWorld].
+ self state = #suspendedRecord ifTrue:
- state = #suspendedRecord ifTrue:
[self resumeRecordIn: aWorld].
!
Item was changed:
----- Method: EventRecorderMorph>>resumePlayIn: (in category 'pause/resume') -----
resumePlayIn: aWorld
+ playHand _ HandMorphForReplay new recorder: self.
- playHand := HandMorphForReplay new recorder: self.
playHand position: tapeStream peek position.
aWorld addHand: playHand.
playHand newKeyboardFocus: aWorld.
playHand userInitials: 'play' andPicture: nil.
+ lastEvent _ nil.
+ lastDelta _ 0@0.
+ self findPlayOffset.
+ state _ #play.
- lastEvent := nil.
- lastDelta := 0@0.
- state := #play.
self synchronize.
!
Item was changed:
----- Method: EventRecorderMorph>>synchronize (in category 'event handling') -----
synchronize
+ time _ lastInterpolation _ Time millisecondClockValue.
+ deltaTime _ nil.!
- time := Time millisecondClockValue.
- deltaTime := nil.!
Item was changed:
----- Method: EventRecorderMorph>>writeTape: (in category 'fileIn/Out') -----
writeTape: fileName
+ | name bb |
+ name _ self writeFileNamed: fileName.
+ bb _ self findDeepSubmorphThat: [:mm | (mm isKindOf: SimpleButtonMorph)
+ and: [mm label = 'writeTape']]
+ ifAbsent: [^ self].
+ bb actionSelector: #writeTape:.
+ bb arguments: (Array with: name).
- | b name |
- name := self writeFileNamed: fileName.
- (b := self button: 'writeTape') ifNotNil: [
- b actionSelector: #writeTape:.
- b arguments: (Array with: name)].
!
Item was changed:
----- Method: FlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'flap tab' translatedNoop!
- ^ 'flap tab'!
Item was changed:
----- Method: FlapTab>>adaptToWorld (in category 'initialization') -----
adaptToWorld
| wasShowing new |
+ (wasShowing _ self flapShowing) ifTrue:
- (wasShowing := self flapShowing) ifTrue:
[self hideFlap].
(self respondsTo: #unhibernate) ifTrue: [
+ (new _ self unhibernate) == self ifFalse: [
- (new := self unhibernate) == self ifFalse: [
^ new adaptToWorld]].
- self spanWorld.
- self positionObject: self.
wasShowing ifTrue:
+ [self spanWorld.
+ self positionObject: self.
+ self showFlap]!
- [self showFlap]!
Item was changed:
----- Method: FlapTab>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aMenu hand: aHandMorph
"Add further items to the menu as appropriate"
aMenu add: 'tab color...' translated target: self action: #changeColor.
aMenu add: 'flap color...' translated target: self action: #changeFlapColor.
aMenu addLine.
aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo.
aMenu addLine.
aMenu addUpdating: #textualTabString action: #textualTab.
aMenu addUpdating: #graphicalTabString action: #graphicalTab.
aMenu addUpdating: #solidTabString enablement: #notSolid action: #solidTab.
aMenu addLine.
(referent isKindOf: PasteUpMorph) ifTrue:
[aMenu addUpdating: #partsBinString action: #togglePartsBinMode].
aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior.
aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior.
aMenu addLine.
aMenu addUpdating: #isGlobalFlapString enablement: #sharedFlapsAllowed action: #toggleIsGlobalFlap.
+ aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.' translated.
- aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.,' translated.
aMenu addLine.
+ aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap.
aMenu add: 'destroy this flap' translated action: #destroyFlap.
"aMenu addUpdating: #slideString action: #toggleSlideBehavior.
aMenu addUpdating: #inboardString action: #toggleInboardness.
aMenu addUpdating: #thicknessString ('thickness... (current: ', self thickness printString, ')') action: #setThickness."
!
Item was changed:
----- Method: FlapTab>>balloonTextForFlapsMenu (in category 'miscellaneous') -----
balloonTextForFlapsMenu
"Answer the balloon text to show on a menu item in the flaps menu that governs the visibility of the receiver in the current project"
| id |
+ id _ self flapID.
- id := self flapID.
#(
+ ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects' translatedNoop)
+ ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.' translatedNoop)
+ ('Widgets' 'A variety of controls and media tools' translatedNoop)
+ ('Supplies' 'Supplies' translatedNoop)
+ ('Help' 'A flap providing documentation, tutorials, and other help' translatedNoop)
+ ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented' translatedNoop)
+ ('Scripting' 'Tools useful when doing tile scripting' translatedNoop)
+ ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment' translatedNoop)
+ ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting' translatedNoop)) do:
- ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects')
- ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.')
- ('Widgets' 'A variety of controls and media tools')
- ('Supplies' 'A source for many basic types of objects')
- ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented')
- ('Scripting' 'Tools useful when doing tile scripting')
- ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment')
- ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting')) do:
[:pair | (FlapTab givenID: id matches: pair first translated) ifTrue: [^ pair second translated]].
^ self balloonText!
Item was changed:
----- Method: FlapTab>>computeEdgeFraction (in category 'edge') -----
computeEdgeFraction
"Compute and remember the edge fraction"
| aBox aFraction |
self isCurrentlySolid ifTrue: [^ edgeFraction ifNil: [self edgeFraction: 0.5]].
+ aBox := ((self pasteUpMorph ifNil: [self currentWorld]) bounds) insetBy: (self extent // 2).
- aBox := ((owner ifNil: [ActiveWorld]) bounds) insetBy: (self extent // 2).
aFraction := self
ifVertical:
[(self center y - aBox top) / (aBox height max: 1)]
ifHorizontal:
[(self center x - aBox left) / (aBox width max: 1)].
^ self edgeFraction: aFraction!
Item was changed:
----- Method: FlapTab>>destroyFlap (in category 'menu') -----
destroyFlap
"Destroy the receiver"
| reply request |
+ request _ self isGlobalFlap
- request := self isGlobalFlap
ifTrue:
['Caution -- this would permanently
remove this flap, so it would no longer be
available in this or any other project.
+ Do you really want to this? ' translated]
- Do you really want to this? ']
ifFalse:
['Caution -- this is permanent!! Do
+ you really want to do this? ' translated].
+ reply _ self confirm: request translated orCancel: [^ self].
- you really want to do this? '].
- reply := self confirm: request translated orCancel: [^ self].
reply ifTrue:
[self isGlobalFlap
ifTrue:
[Flaps removeFlapTab: self keepInList: false.
self currentWorld reformulateUpdatingMenus]
ifFalse:
[referent isInWorld ifTrue: [referent delete].
self delete]]!
Item was changed:
----- Method: FlapTab>>flapMenuTitle (in category 'menu') -----
flapMenuTitle
+ ^ 'flap: ' translated , self wording!
- ^ 'flap: ', self wording!
Item was changed:
----- Method: FlapTab>>graphicalTabString (in category 'graphical tabs') -----
graphicalTabString
^ (self isCurrentlyGraphical
+ ifTrue: ['choose new graphic...' translated]
+ ifFalse: ['use graphical tab' translated]) !
- ifTrue: ['choose new graphic...']
- ifFalse: ['use graphical tab']) translated!
Item was changed:
----- Method: FlapTab>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "Handle a mouse-move event. The event, a MorphicEvent, is passed in."
+
| aPosition newReferentThickness adjustedPosition thick |
dragged ifFalse: [(thick := self referentThickness) > 0
ifTrue: [lastReferentThickness := thick]].
((self containsPoint: (aPosition := evt cursorPoint)) and: [dragged not])
ifFalse:
[flapShowing ifFalse: [self showFlap].
adjustedPosition := aPosition - evt hand targetOffset.
(edgeToAdhereTo == #bottom)
ifTrue:
[newReferentThickness := inboard
ifTrue:
[self world height - adjustedPosition y]
ifFalse:
[self world height - adjustedPosition y - self height]].
(edgeToAdhereTo == #left)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition x + self width]
ifFalse:
[adjustedPosition x]].
(edgeToAdhereTo == #right)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[self world width - adjustedPosition x]
ifFalse:
[self world width - adjustedPosition x - self width]].
(edgeToAdhereTo == #top)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition y + self height]
ifFalse:
[adjustedPosition y]].
self isCurrentlySolid ifFalse:
[(#(left right) includes: edgeToAdhereTo)
ifFalse:
[self left: adjustedPosition x]
ifTrue:
[self top: adjustedPosition y]].
+ ((edgeToAdhereTo == #left) and: [(self valueOfProperty: #rigidThickness) notNil]) ifTrue:
+ [newReferentThickness := referent width].
+
self applyThickness: newReferentThickness.
dragged := true.
self fitOnScreen.
self computeEdgeFraction]!
Item was changed:
----- Method: FlapTab>>solidTabString (in category 'solid tabs') -----
solidTabString
^ (self isCurrentlySolid
+ ifTrue: ['currently using solid tab' translated]
+ ifFalse: ['use solid tab' translated]) !
- ifTrue: ['currently using solid tab']
- ifFalse: ['use solid tab']) translated!
Item was changed:
----- Method: FlapTab>>textualTabString (in category 'textual tabs') -----
textualTabString
^ (self isCurrentlyTextual
+ ifTrue: ['change tab wording...' translated]
+ ifFalse: ['use textual tab' translated]) !
- ifTrue: ['change tab wording...']
- ifFalse: ['use textual tab']) translated!
Item was changed:
----- Method: Flaps class>>addAndEnableEToyFlaps (in category 'predefined flaps') -----
addAndEnableEToyFlaps
"Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed."
| aSuppliesFlap |
SharedFlapTabs
ifNotNil: [^ self].
SharedFlapTabs := OrderedCollection new.
aSuppliesFlap := self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right.
aSuppliesFlap referent setNameTo: 'Supplies Flap' translated. "Per request from Kim Rose, 7/19/02"
SharedFlapTabs add: aSuppliesFlap. "The #center designation doesn't quite work at the moment"
+ (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false])
+ ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap]
+ ifFalse: [Preferences showProjectNavigator
+ ifTrue:[ SharedFlapTabs add: self newNavigatorFlap]].
- Preferences showProjectNavigator
- ifTrue:[ SharedFlapTabs add: self newNavigatorFlap ].
self enableGlobalFlapWithID: 'Supplies' translated.
+ (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false])
+ ifTrue:
+ [self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated.
+ "(self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNilDo:
+ [:navTab | aSuppliesFlap sugarNavTab: navTab]"]
+ ifFalse: [
+ Preferences showProjectNavigator
+ ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated]].
- Preferences showProjectNavigator
- ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated ].
SharedFlapsAllowed := true.
Project current flapsSuppressed: false.
^ SharedFlapTabs
"Flaps addAndEnableEToyFlaps"!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category 'flaps registry') -----
defaultsQuadsDefiningScriptingFlap
"Answer a structure defining the default items in the Scripting flap.
previously in quadsDeiningScriptingFlap"
+ ^ {
+ {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
+ {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}.
- ^ #(
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
- (ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#FunctionTile. #randomNumberTile. 'Random' translatedNoop. 'A tile that will produce a random number in a given range' translatedNoop}.
+ {#ScriptingSystem. #anyButtonPressedTiles. 'ButtonDown?' translatedNoop. 'Tiles for querying whether the mouse button is down' translatedNoop}.
+ {#ScriptingSystem. #noButtonPressedTiles. 'ButtonUp?' translatedNoop. 'Tiles for querying whether the mouse button is up' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (RandomNumberTile new 'Random' 'A tile that will produce a random number in a given range')
- (ScriptingSystem anyButtonPressedTiles 'ButtonDown?' 'Tiles for querying whether the mouse button is down')
- (ScriptingSystem noButtonPressedTiles 'ButtonUp?' 'Tiles for querying whether the mouse button is up')
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}.
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (TextFieldMorph exampleBackgroundField 'Scrolling Field' 'A scrolling data field which will have a different value on every card of the background')
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#TextMorph. #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}.
+ {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop}
+ } asOrderedCollection!
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (TextMorph exampleBackgroundLabel 'Background Label' 'A piece of text that will occur on every card of the background')
- (TextMorph exampleBackgroundField 'Background Field' 'A data field which will have a different value on every card of the background')
-
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningStackToolsFlap (in category 'flaps registry') -----
defaultsQuadsDefiningStackToolsFlap
"Answer a structure defining the items on the default system Stack Tools flap.
previously in quadsDefiningStackToolsFlap"
+ ^ {
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}.
+ {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}.
+ {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Scriptable Button' translatedNoop. 'A button whose script will be a method of the background Player' translatedNoop}.
+ {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}.
+ {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection
- ^ #(
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (StackMorph stackHelpWindow 'Stack Help' 'Some hints about how to use Stacks')
- (TextMorph authoringPrototype 'Simple Text' 'Text that you can edit into anything you wish')
- (TextMorph fancyPrototype 'Fancy Text' 'A text field with a rounded shadowed border, with a fancy font.')
- (ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
- (ScriptableButton authoringPrototype 'Scriptable Button' 'A button whose script will be a method of the background Player')
- (StackMorph previousCardButton 'Previous Card' 'A button that takes the user to the previous card in the stack')
- (StackMorph nextCardButton 'Next Card' 'A button that takes the user to the next card in the stack')) asOrderedCollection
!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningSuppliesFlap (in category 'flaps registry') -----
defaultsQuadsDefiningSuppliesFlap
"Answer a list of quads which define the objects to appear in the default Supplies flap.
previously in quadsDefiningSuppliesFlap"
+ ^ {
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}.
+ {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
+ } asOrderedCollection!
- ^ #(
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'TabbedPalette' 'A structure with tabs')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>disableGlobalFlaps: (in category 'menu commands') -----
disableGlobalFlaps: interactive
"Clobber all the shared flaps structures. First read the user her Miranda rights."
interactive
ifTrue: [(self confirm:
'CAUTION!! This will destroy all the shared
flaps, so that they will not be present in
*any* project. If, later, you want them
back, you will have to reenable them, from
this same menu, whereupon the standard
default set of shared flaps will be created.
Do you really want to go ahead and clobber
all shared flaps at this time?' translated) ifFalse: [^ self]].
self globalFlapTabsIfAny do:
[:aFlapTab | self removeFlapTab: aFlapTab keepInList: false.
aFlapTab isInWorld ifTrue: [self error: 'Flap problem' translated]].
self clobberFlapTabList.
+ self initializeFlapsQuads.
+ SharedFlapsAllowed _ false.
- SharedFlapsAllowed := false.
Smalltalk isMorphic ifTrue:
[ActiveWorld restoreMorphicDisplay.
ActiveWorld reformulateUpdatingMenus].
"The following reduces the risk that flaps will be created with variant IDs
such as 'Stack Tools2', potentially causing some shared flap logic to fail."
"Smalltalk garbageCollect." "-- see if we are OK without this"
!
Item was changed:
----- Method: Flaps class>>explainFlapsText (in category 'menu commands') -----
explainFlapsText
"Answer the text, in English, to show in a help-window about Flaps."
^'Flaps are like drawers on the edge of the screen, which can be opened so that you can use what is inside them, and closed when you do not need them. They have many possible uses, a few of which are illustrated by the default set of flaps you can get as described below.
+ ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
- ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
+ To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
- To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
+ ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
- ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
+ If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
- If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
+ If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
- If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
+ Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
- Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
+ You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
- You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
+ You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
- You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
+ Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
- Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
+ If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
- If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
+ The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
- The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
+ tab color... Lets you change the color of the flap''s tab.
+ flap color... Lets you change the color of the flap itself.
- tab color... Lets you change the color of the flap''s tab.
- flap color... Lets you change the color of the flap itself.
+ use textual tab... If the tab is not textual, makes it become textual.
+ change tab wording... If the tab is already textual, allows you to edit
- use textual tab... If the tab is not textual, makes it become textual.
- change tab wording... If the tab is already textual, allows you to edit
its wording.
+ use graphical tab... If the tab is not graphical, makes it become
- use graphical tab... If the tab is not graphical, makes it become
graphical.
+ choose tab graphic... If the tab is already graphical, allows you
- choose tab graphic... If the tab is already graphical, allows you
to change the picture.
+ use solid tab... If the tab is not solid, makes it become solid, i.e.
- use solid tab... If the tab is not solid, makes it become solid, i.e.
appear as a solid band of color along the
entire length or width of the screen.
+ parts-bin behavior If set, then dragging an object from the flap
- parts-bin behavior If set, then dragging an object from the flap
tears off a new copy of the object.
+ dragover If set, the flap opens on dragover and closes
- dragover If set, the flap opens on dragover and closes
again on drag-leave.
+
+ mouseover If set, the flap opens on mouseover and closes
- mouseover If set, the flap opens on mouseover and closes
again on mouse-leave.
+ cling to edge... Governs which edge (left, right, top, bottom)
- cling to edge... Governs which edge (left, right, top, bottom)
the flap adheres to.
+ shared If set, the same flap will be available in all projects; if not, the
- shared If set, the same flap will be available in all projects; if not, the
flap will will occur only in one project.
+ destroy this flap Deletes the flap.
- destroy this flap Deletes the flap.
+ To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
- To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
+ To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
- To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
+ To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
- To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
+ Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.' translated!
- Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.'!
Item was changed:
----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') -----
newLoneSuppliesFlap
+ "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch. We're still evidently nurturing this method along, but it is a disused branch, whose lone sender has no senders..."
- "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch"
| aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly"
+ aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: {
- aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: #(
+ {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph . #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#SimpleSliderMorph . #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ " {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}."
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'Tabs' translatedNoop. 'A structure with tabs' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle' )
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph authoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, ec.')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'Tabs' 'A structure with tabs')
+ {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}.
+ {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}.
- (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
- (MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ClockMorph. #authoringPrototype, 'Clock' translatedNoop, 'A simple digital clock' translatedNoop}.
+ {#BookMorph, #previousPageButton, 'Previous' translatedNoop, 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph, #nextPageButton, 'Next' translatedNoop, 'A button that takes you to the next page' translatedNoop}.
+ }.
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'Previous' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'Next' 'A button that takes you to the next page')
- ).
+ aFlapTab _ FlapTab new referent: aStrip beSticky.
- aFlapTab := FlapTab new referent: aStrip beSticky.
aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter.
aStrip extent: self currentWorld width @ 78.
+ leftEdge _ ((Display width - (16 + aFlapTab width)) + 556) // 2.
- leftEdge := ((Display width - (16 + aFlapTab width)) + 556) // 2.
aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)).
aStrip beFlap: true.
aStrip autoLineLayout: true.
^ aFlapTab!
Item was changed:
----- Method: Flaps class>>newNavigatorFlap (in category 'predefined flaps') -----
newNavigatorFlap
"Answer a newly-created flap which adheres to the bottom edge of the screen and which holds the project navigator controls. "
| aFlapTab navBar aFlap |
+ navBar _ ProjectNavigationMorph preferredNavigator new addButtons.
+ aFlap _ PasteUpMorph newSticky borderWidth: 0;
- navBar := ProjectNavigationMorph preferredNavigator new.
- aFlap := PasteUpMorph newSticky borderWidth: 0;
extent: navBar extent + (0@20);
color: (Color orange alpha: 0.8);
beFlap: true;
addMorph: navBar beSticky.
aFlap hResizing: #shrinkWrap; vResizing: #shrinkWrap.
aFlap useRoundedCorners.
aFlap setNameTo: 'Navigator Flap' translated.
navBar fullBounds. "to establish width"
+ aFlapTab _ FlapTab new referent: aFlap.
- aFlapTab := FlapTab new referent: aFlap.
aFlapTab setName: 'Navigator' translated edge: #bottom color: Color orange.
aFlapTab position: ((navBar width // 2) - (aFlapTab width // 2))
@ (self currentWorld height - aFlapTab height).
aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Navigator' translated "
!
Item was changed:
----- Method: Flasher class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver for use in a parts bin"
+ ^ self partName: 'Flasher' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A circle that flashes' translatedNoop!
- ^ self partName: 'Flasher'
- categories: #('Demo')
- documentation: 'A circle that flashes'!
Item was changed:
----- Method: FrameRateMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'FrameRate' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A readout that allows you to monitor the frame rate of your system' translatedNoop!
- ^ self partName: 'FrameRate'
- categories: #('Useful')
- documentation: 'A readout that allows you to monitor the frame rate of your system'!
Item was changed:
----- Method: FrameRateMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#FrameRateMorph. #authoringPrototype. 'Frame Rate' translatedNoop. 'An indicator of how fast your system is running' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(FrameRateMorph authoringPrototype 'Frame Rate' 'An indicator of how fast your system is running')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: FrameRateMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ lastDisplayTime _ 0.
+ framesSinceLastDisplay _ 0.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ !
- lastDisplayTime := 0.
- framesSinceLastDisplay := 0!
Item was changed:
----- Method: FrameRateMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
"Initialize the receiver as a stand-alone entity"
super initializeToStandAlone.
self color: Color blue.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ self step.
+ !
- self step!
Item was changed:
----- Method: GrabPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver's instances for a parts bin"
+ ^ self partName: 'Grab Patch' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Use this to grab a rectangular patch from the screen' translatedNoop!
- ^ self partName: 'Grab Patch'
- categories: #('Graphics')
- documentation: 'Use this to grab a rectangular patch from the screen'!
Item was changed:
----- Method: GrabPatchMorph>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initialize.
+ self image: (ScriptingSystem formAtKey: 'GrabPatch').
+ self setProperty: #ignorePartsBinDrop toValue: true!
- self image: (ScriptingSystem formAtKey: 'GrabPatch')!
Item was changed:
----- Method: GraphMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Graph' translatedNoop
+ categories: #()
+ documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.' translatedNoop!
- ^ self partName: 'Graph'
- categories: #('Useful')
- documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.'!
Item was changed:
----- Method: GraphMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: 365 @ 80.
+ dataColor _ Color darkGray.
+ cursor _ 1.0.
+ samplingRate := 11025.
- dataColor := Color darkGray.
- cursor := 1.0.
"may be fractional"
+ cursorColor _ Color red.
+ cursorColorAtZeroCrossings _ Color red.
+ startIndex _ 1.
+ hasChanged _ false.
- cursorColor := Color red.
- cursorColorAtZeroCrossings := Color red.
- startIndex := 1.
- hasChanged := false.
self
data: ((0 to: 360 - 1)
collect: [:x | (100.0 * x degreesToRadians sin) asInteger])!
Item was changed:
----- Method: GraphicalDictionaryMenu class>>openOn:withLabel: (in category 'instance creation') -----
openOn: aFormDictionary withLabel: aLabel
"open a graphical dictionary in a window having the label aLabel.
aFormDictionary should be a dictionary containing as value a form."
| inst aWindow |
+ aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!' translated].
- aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!'].
inst := self new initializeFor: nil fromDictionary: aFormDictionary.
+ aWindow _ (SystemWindow labelled: aLabel) model: inst.
- aWindow := (SystemWindow labelled: aLabel) model: inst.
aWindow addMorph: inst frame: (0@0 extent: 1@1).
aWindow extent: inst fullBounds extent + (3 @ aWindow labelHeight + 3);
minimumExtent: inst minimumExtent + (3 @ aWindow labelHeight + 3).
HandMorph attach: aWindow.
^ inst!
Item was changed:
----- Method: GraphicalDictionaryMenu>>renameGraphicTo: (in category 'menu commands') -----
renameGraphicTo: newName
| curr |
+ curr _ entryNames at: currentIndex.
- curr := entryNames at: currentIndex.
(newName isEmptyOrNil or: [newName = curr]) ifTrue: [^ Beeper beep].
(baseDictionary includesKey: newName) ifTrue:
[^ self inform: 'sorry that conflicts with
the name of another
+ entry in this dictionary' translated].
- entry in this dictionary'].
baseDictionary at: newName put: (baseDictionary at: curr).
baseDictionary removeKey: curr.
self baseDictionary: baseDictionary.
+ currentIndex _ entryNames indexOf: newName.
- currentIndex := entryNames indexOf: newName.
self updateThumbnail!
Item was changed:
----- Method: GraphicalMenu>>initializeFor:withForms:coexist: (in category 'initialization') -----
initializeFor: aTarget withForms: formList coexist: aBoolean
"World primaryHand attachMorph:
(GraphicalMenu new initializeFor: nil
withForms: Form allInstances coexist: true)"
| buttons bb anIndex buttonCage |
target := aTarget.
coexistWithOriginal := aBoolean.
formChoices := formList.
currentIndex := 1.
self borderWidth: 1;
cellPositioning: #center;
color: Color white;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap.
buttons := AlignmentMorph newRow.
buttons borderWidth: 0;
layoutInset: 0.
buttons hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5 @ 5.
buttons wrapCentering: #topLeft.
buttonCage := AlignmentMorph newColumn.
buttonCage hResizing: #shrinkWrap;
vResizing: #spaceFill.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Prev' translated;
- buttons addMorphBack: (bb label: 'Prev';
actionSelector: #downArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 9 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Next' translated;
- buttons addMorphBack: (bb label: 'Next';
actionSelector: #upArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 5 @ 0.
buttons submorphs last color: Color white.
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 12.
buttons := AlignmentMorph newRow.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'OK' translated;
- buttons addMorphBack: (bb label: 'OK';
actionSelector: #okay).
buttons addTransparentSpacerOfSize: 5 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Cancel' translated;
- buttons addMorphBack: (bb label: 'Cancel';
actionSelector: #cancel).
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
self addMorphFront: buttonCage.
formDisplayMorph := Thumbnail new extent: 100 @ 100;
maxWidth: 100 minHeight: 30;
yourself.
self addMorphBack: (Morph new color: Color white;
layoutPolicy: TableLayout new;
layoutInset: 4 @ 4;
hResizing: #spaceFill;
vResizing: #spaceFill;
listCentering: #center;
addMorphBack: formDisplayMorph;
yourself).
target
ifNotNil: [(anIndex := formList
indexOf: target form
ifAbsent: [])
ifNotNil: [currentIndex := anIndex]].
self updateThumbnail!
Item was changed:
----- Method: HandMorphForReplay>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
+ suspended := false.
+ self showTemporaryCursor: Cursor normal
- self showTemporaryCursor: Cursor normal.
!
Item was changed:
----- Method: HandMorphForReplay>>processEvents (in category 'event handling') -----
processEvents
"Play back the next event"
+ | evt hadMouse hadAny tracker |
+ suspended == true ifTrue: [^ self].
- | evt hadMouse hadAny |
hadMouse := hadAny := false.
+ tracker := recorder objectTrackingEvents.
[(evt := recorder nextEventToPlay) isNil] whileFalse:
+ [
+ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self].
+ tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp].
+ evt type == #EOF
- [evt type == #EOF
ifTrue:
+ [recorder pauseIn: ActiveWorld.
+ ^ self].
- [recorder pauseIn: self world.
- ^self].
evt type == #startSound
ifTrue:
+ [recorder perhapsPlaySound: evt argument.
- [evt argument play.
recorder synchronize.
+ ^ self].
+ evt type == #startEventPlayback
+ ifTrue:
+ [evt argument launchPlayback.
+ recorder synchronize.
+ ^ self].
+
+ evt type == #noteTheatreBounds
+ ifTrue:
+ ["The argument holds the content rect --for now we don't make any use of that info in this form."
+ ^ self].
+
- ^self].
evt isMouse ifTrue: [hadMouse := true].
(evt isMouse or: [evt isKeyboard])
ifTrue:
[self handleEvent: (evt setHand: self) resetHandlerFields.
hadAny := true]].
(mouseClickState notNil and: [hadMouse not])
ifTrue:
["No mouse events during this cycle. Make sure click states time out accordingly"
mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
hadAny
ifFalse:
["No pending events. Make sure z-order is up to date"
self mouseOverHandler processMouseOver: lastMouseEvent]!
Item was changed:
----- Method: HandMorphForReplay>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
+ "Handmorph blocks deep copy. Go up to Morph"
+
+ ^ self perform: #veryDeepCopyWith: withArguments: {deepCopier} inSuperclass: Morph!
- ^ self copy!
Item was changed:
----- Method: IndexTabs class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'tabs' translatedNoop!
- ^ 'tabs'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>cacheThumbnailFor: (in category 'thumbnails') -----
cacheThumbnailFor: aProject
+ "Save a thumbnail of the given project in my thumbnail cache."
| form |
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
-
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
CachedThumbnails
at: aProject name
+ put: (form _ self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter).
+ ^ form
- put: (form := self sorterFormForProject: aProject sized: nil).
- ^form
!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'ThreadNavigator' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A tool that lets you navigate through a thread of projects.' translatedNoop!
- ^ self partName: 'ThreadNavigator'
- categories: #('Navigation')
- documentation: 'A tool that lets you navigate through a thread of projects.'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>getThumbnailFor: (in category 'thumbnails') -----
getThumbnailFor: aProject
+ "Answer a thumbnail for the given project, retrieving it from a cache of such objects if possible, else creating a fresh thumbnail, storing it in the cache, and answering it."
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
^CachedThumbnails
at: aProject name
+ ifAbsentPut: [self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter]!
- ifAbsentPut: [self sorterFormForProject: aProject sized: nil]!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>sorterFormForProject:sized: (in category 'sorter') -----
+ sorterFormForProject: aProject sized: aSize
+ "Answer a form to use in a project-sorter to represent the project."
- sorterFormForProject: aProject sized: ignored
+ ^ (ProjectViewMorph on: aProject) imageForm scaledToSize: aSize
- ^(ProjectViewMorph on: aProject) imageForm scaledToSize: 80@60.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>buttonForMenu (in category 'navigation') -----
buttonForMenu
+ ^self makeButton: '?' balloonText: 'More commands' translated for: #moreCommands.
- ^self makeButton: '?' balloonText: 'More commands' for: #moreCommands.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>editThisThread (in category 'navigation') -----
editThisThread
| sorter |
+ sorter _ ProjectSorterMorph new.
- sorter := ProjectSorterMorph new.
sorter navigator: self listOfPages: listOfPages.
self currentWorld addMorphFront: sorter.
+ sorter align: sorter topCenter with: self currentWorld topCenter.
- sorter align: sorter center with: self currentWorld center.
self delete.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>positionAppropriately (in category 'navigation') -----
positionAppropriately
+ | others otherRects overlaps bottomRight |
- | others otherRects overlaps |
-
(self ownerThatIsA: HandMorph) ifNotNil: [^self].
+ others _ ActiveWorld submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
+ otherRects _ others collect: [ :each | each bounds].
+ bottomRight _ (ActiveWorld hasProperty: #threadNavigatorPosition) ifTrue: [
+ ActiveWorld valueOfProperty: #threadNavigatorPosition.
+ ] ifFalse: [
+ ActiveWorld bottomRight.
+ ].
+ self align: self fullBounds bottomRight with: bottomRight.
- others := self world submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
- otherRects := others collect: [ :each | each bounds].
- self align: self fullBounds bottomRight with: self world bottomRight.
self setProperty: #previousWorldBounds toValue: self world bounds.
[
+ overlaps _ false.
- overlaps := false.
otherRects do: [ :r |
+ (r intersects: bounds) ifTrue: [overlaps _ true. self bottom: r top].
- (r intersects: bounds) ifTrue: [overlaps := true. self bottom: r top].
].
self top < self world top ifTrue: [
+ self bottom: bottomRight y.
- self bottom: self world bottom.
self right: self left - 1.
].
overlaps
] whileTrue.!
Item was changed:
----- Method: InternalThreadNavigationMorph>>sizeRatio (in category 'accessing') -----
sizeRatio
"answer the size ratio for the receiver"
+ ^ 1.0
+
+ "^ Preferences standardMenuFont height / 12" "Good grief!!"!
- ^ Preferences standardMenuFont height / 12!
Item was changed:
----- Method: LassoPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver to be used in a parts bin"
+ ^ self partName: 'Lasso' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Drop this icon to grab a patch from the screen with a lasso.' translatedNoop!
- ^ self partName: 'Lasso'
- categories: #('Graphics')
- documentation: 'Drop this icon to grab a patch from the screen with a lasso.'!
Item was changed:
----- Method: LassoPatchMorph>>wantsToBeDroppedInto: (in category 'dropping') -----
wantsToBeDroppedInto: aMorph
+ "Only wanted by the world"
- "Only into PasteUps that are not part bins"
+ ^ aMorph isWorldMorph!
- ^ aMorph isPlayfieldLike!
Item was changed:
----- Method: MagnifierMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Magnifier' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A magnifying glass' translatedNoop!
- ^ self partName: 'Magnifier'
- categories: #('Useful')
- documentation: 'A magnifying glass'!
Item was changed:
----- Method: MagnifierMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MagnifierMorph. #newRound. 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: MagnifierMorph class>>supplementaryPartsDescriptions (in category 'parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundGlass' translatedNoop
+ categoryList: {'Just for Fun' translatedNoop}
+ documentation: 'A round magnifying glass' translatedNoop
- formalName: 'RoundGlass'
- categoryList: #(Useful)
- documentation: 'A round magnifying glass'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newRound.
DescriptionForPartsBin
+ formalName: 'Hand Magnifier' translatedNoop
+ categoryList: #()
+ documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.' translatedNoop
- formalName: 'Hand Magnifier'
- categoryList: #(Useful)
- documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newShowingPointer }!
Item was changed:
----- Method: MagnifierMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
+ | stencil newForm bb |
+
- super drawOn: aCanvas. "border and fill"
aCanvas isShadowDrawing ifFalse: [
"Optimize because #magnifiedForm is expensive"
+ self isRound
+ ifTrue:[stencil := (EllipseMorph new extent: self extent; color: Color white) imageForm.
+ bb := BitBlt toForm: stencil.
+ newForm := (bb copyForm: self magnifiedForm to: 0@0 rule: Form and) destForm.
+ aCanvas paintImage: newForm at: self innerBounds origin ]
+ ifFalse:[super drawOn: aCanvas. "border and fill"
+ aCanvas paintImage: self magnifiedForm at: self innerBounds origin]]
+
+ !
- aCanvas paintImage: self magnifiedForm at: self innerBounds origin]!
Item was changed:
----- Method: MagnifierMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
+ trackPointer _ true.
+ showPointer _ false.
+ magnification _ 2.
+ roundness := false.
- trackPointer := true.
- showPointer := false.
- magnification := 2.
-
self extent: 128 @ 128!
Item was changed:
----- Method: MagnifierMorph>>isRound (in category 'round view') -----
isRound
+ ^ roundness == true!
- ^ owner isMemberOf: ScreeningMorph!
Item was changed:
----- Method: MagnifierMorph>>showingPointerString (in category 'menu') -----
showingPointerString
+ "Answer a string characterizing whether or not I'm showing the pointer."
+
+ ^ (self showPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'show pointer' translated!
- ^ (self showPointer
- ifTrue: ['stop showing pointer']
- ifFalse: ['start showing pointer']) translated!
Item was changed:
----- Method: MagnifierMorph>>sourcePoint (in category 'magnifying') -----
sourcePoint
"If we are being dragged use our center, otherwise use pointer position"
^(trackPointer not or: [owner notNil and: [owner isHandMorph]])
+ ifTrue: [self isFlexed ifTrue:[owner center] ifFalse:[self center]]
- ifTrue: [self center]
ifFalse: [self currentHand position]!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundString (in category 'round view') -----
toggleRoundString
+ "Answer a string describing whether the receiver is currently round."
+
+ ^ (self isRound ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'round' translated!
- ^ (self isRound
- ifTrue: ['be square']
- ifFalse: ['be round']) translated!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundness (in category 'round view') -----
toggleRoundness
+ roundness := roundness not.
+ self fullBounds changed
+ !
- | sm w |
- w := self world.
- self isRound
- ifTrue: [owner delete.
- w addMorph: self]
- ifFalse: [sm := ScreeningMorph new position: self position.
- sm addMorph: self.
- sm addMorph: (EllipseMorph newBounds: self bounds).
- w addMorph: sm]!
Item was changed:
----- Method: MagnifierMorph>>trackingPointerString (in category 'menu') -----
trackingPointerString
+ "Answer a string describing whether or not I'm currently tracking the pointer."
+
^ (trackPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'track pointer' translated!
- ifTrue: ['stop tracking pointer']
- ifFalse: ['start tracking pointer']) translated!
Item was changed:
----- Method: MessageNames class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MessageNames. #prototypicalToolWindow. 'Message Names' translatedNoop. 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: Morph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
^ { DescriptionForPartsBin
+ formalName: 'Status' translatedNoop
+ categoryList: #()
+ documentation: 'Buttons to run, stop, or single-step scripts' translatedNoop
- formalName: 'Status'
- categoryList: #(Scripting)
- documentation: 'Buttons to run, stop, or single-step scripts'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #scriptControlButtons.
DescriptionForPartsBin
+ formalName: 'Scripting' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop
- formalName: 'Scripting'
- categoryList: #(Scripting)
- documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #newScriptingSpace.
DescriptionForPartsBin
+ formalName: 'Random' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A tile that will produce a random number in a given range' translatedNoop
+ globalReceiverSymbol: #FunctionTile
+ nativitySelector: #randomNumberTile.
- formalName: 'Random'
- categoryList: #(Scripting)
- documentation: 'A tile that will produce a random number in a given range'
- globalReceiverSymbol: #RandomNumberTile
- nativitySelector: #new.
DescriptionForPartsBin
+ formalName: 'ButtonDown?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is down' translatedNoop
- formalName: 'ButtonDown?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is down'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #anyButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'ButtonUp?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is up' translatedNoop
- formalName: 'ButtonUp?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is up'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #noButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'NextPage' translatedNoop
+ categoryList: {'Multimedia' translatedNoop}
+ documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop
- formalName: 'NextPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #nextPageButton.
DescriptionForPartsBin
+ formalName: 'PreviousPage' translatedNoop
+ categoryList: {'Multimedia'}
+ documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop
- formalName: 'PreviousPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #previousPageButton.},
+ self partsDescriptionsFromToolsFlap!
- (Flaps quadsDefiningToolsFlap collect:
- [:aQuad | DescriptionForPartsBin fromQuad: aQuad categoryList: #(Tools)])!
Item was changed:
----- Method: ObjectsTool class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Objects' translatedNoop
+ categories: #()
+ documentation: 'A place to obtain many kinds of objects' translatedNoop!
- ^ self partName: 'Objects'
- categories: #('Useful')
- documentation: 'A place to obtain many kinds of objects'!
Item was changed:
----- Method: ObjectsTool class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ObjectsTool. #newStandAlone. 'Object Catalog' translatedNoop. 'A tool that lets you browse the catalog of objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ObjectsTool . #newStandAlone. 'Object Catalog' translatedNoop.'A tool that lets you browse the catalog of objects' translatedNoop}
- cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: ObjectsTool>>minimumWidth (in category 'layout') -----
minimumWidth
+ "Answer a width that assures that the alphabet fits in two rows. For olpc, this is increased in order to make the Connectors category not too absurdly tall."
- "Answer a width that assures that the alphabet fits in two rows"
+ ^ 400!
- ^ 300!
Item was changed:
----- Method: PackagePaneBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PackagePaneBrowser. #prototypicalToolWindow . 'Packages' translatedNoop. 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: PaintBoxMorph class>>localeChanged (in category 'notification') -----
localeChanged
| caption |
caption := ColorPickerMorph noColorCaption.
+ ColorChart ifNotNil: [
+ caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)].!
- caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)!
Item was changed:
----- Method: PaintBoxMorph>>offsetFromMaxBounds (in category 'other') -----
offsetFromMaxBounds
"location of normal PaintBox within maxBounds."
+ | left |
+ left _ self left.
+ Preferences useBiggerPaintingBox ifTrue: [left _ left - (( self width * 1.5)- self width)].
+ ^ left - colorMemory left @ 0!
-
- ^ self left - colorMemory left @ 0!
Item was changed:
----- Method: PaintBoxMorph>>recentColor: (in category 'recent colors') -----
recentColor: aColor
"Remember the color as one of our recent colors"
+ Prototype currentColor: aColor.
+ (recentColors anySatisfy: [:any | any color = aColor])
+ ifTrue: [^self]. "already remembered"
+ RecentColors := {aColor}, RecentColors allButLast.
+ RecentColors keysAndValuesDo: [:i :each |
+ (recentColors at: i) color: each]!
-
- (recentColors anySatisfy: [:any | any color = aColor]) ifTrue: [^self]. "already remembered"
- recentColors size to: 2
- by: -1
- do:
- [:i |
- (recentColors at: i) color: (recentColors at: i - 1) color.
- RecentColors at: i put: (RecentColors at: i - 1)].
- (recentColors first) color: aColor.
- RecentColors at: 1 put: aColor!
Item was changed:
----- Method: PaintBoxMorph>>showColorPalette: (in category 'actions') -----
showColorPalette: evt
| w box |
self comeToFront.
colorMemory align: colorMemory bounds topRight
with: colorMemoryThin bounds topRight.
"make sure color memory fits or else align with left"
+ w _ self world.
+ box _ self bounds: colorMemory fullBounds in: w.
- w := self world.
- box := self bounds: colorMemory fullBounds in: w.
box left < 0 ifTrue:[
colorMemory align: colorMemory bounds topLeft
with: colorMemoryThin bounds topLeft].
+ self addMorphFront: colorMemory.
+ self changed!
- self addMorphFront: colorMemory.!
Item was changed:
----- Method: PaintBoxMorph>>toggleShapes (in category 'actions') -----
toggleShapes
| tab sh stamps |
"The sub panel that has the shape tools on it. Rect, line..."
+ stamps _ self submorphNamed: 'stamps'.
+ tab _ self submorphNamed: 'shapeTab'.
+ (sh _ self submorphNamed: 'shapes') visible
- stamps := self submorphNamed: 'stamps'.
- tab := self submorphNamed: 'shapeTab'.
- (sh := self submorphNamed: 'shapes') visible
ifTrue: [sh hide. tab top: stamps bottom-1]
ifFalse: [sh comeToFront. sh top: stamps bottom-9.
sh show. tab top: sh bottom - tab height + 10].
self layoutChanged.
+ self changed
!
Item was changed:
----- Method: PaintBoxMorph>>toggleStamps (in category 'actions') -----
toggleStamps
| tab otherTab st shapes |
"The sub panel that has the stamps in it. For saving and moving parts of an image."
+ shapes _ self submorphNamed: 'shapes'.
+ otherTab _ self submorphNamed: 'shapeTab'.
+ tab _ self submorphNamed: 'stampTab'.
+ (st _ self submorphNamed: 'stamps') visible
- shapes := self submorphNamed: 'shapes'.
- otherTab := self submorphNamed: 'shapeTab'.
- tab := self submorphNamed: 'stampTab'.
- (st := self submorphNamed: 'stamps') visible
ifTrue: [st hide. st bottom: self bottom. tab top: self bottom-1.
shapes top: self bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [self bottom-1])]
ifFalse: [st top: self bottom-10. st show. tab top: st bottom-0.
shapes top: st bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [st bottom-0])].
+ self layoutChanged.
+ self changed!
- self layoutChanged.!
Item was changed:
----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Paint' translatedNoop
+ categories: #()
+ documentation: 'Drop this icon to start painting a new object.' translatedNoop!
- ^ self partName: 'Paint'
- categories: #('Basic' 'Graphics')
- documentation: 'Drop this icon to start painting a new object.'!
Item was changed:
----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PartsBin>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
wantsDroppedMorph: aMorph event: evt
"Answer whether the receiver would like to accept the given morph. For a Parts bin, we accept just about anything except something that just originated from ourselves"
(aMorph hasProperty: #beFullyVisibleAfterDrop) ifTrue:
+ [^ true].
- ["Sign that this was launched from a parts bun, probably indeed this very parts bin"
- ^ false].
^ super wantsDroppedMorph: aMorph event: evt!
Item was changed:
----- Method: PasteUpMorph class>>initialize (in category '*MorphicExtras-class initialization') -----
initialize
"Initialize the class"
+ #('keyStroke') translatedNoop.
+
self registerInFlapsRegistry.
+ ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' translatedNoop targetMorphClass: PasteUpMorph.!
- ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' targetMorphClass: PasteUpMorph.!
Item was changed:
----- Method: PasteUpMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Holder' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop
- formalName: 'Holder'
- categoryList: #(Scripting)
- documentation: 'A place for storing alternative pictures in an animation, ec.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #prototypicalHolder}!
Item was changed:
----- Method: PianoKeyboardMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'PianoKeyboard' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A piano keyboard' translatedNoop!
- ^ self partName: 'PianoKeyboard'
- categories: #('Multimedia')
- documentation: 'A piano keyboard'!
Item was changed:
----- Method: PianoKeyboardMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+
+ whiteKeyColor _ Color gray: 0.95.
+ blackKeyColor _ Color black.
+ playingKeyColor _ Color red.
+ nOctaves _ 6.
-
- whiteKeyColor := Color gray: 0.95.
- blackKeyColor := Color black.
- playingKeyColor := Color red.
- nOctaves := 6.
self buildKeyboard.
+ soundPrototype _ FMSound brass1 duration: 9.9.
+ frequency _ 0.
+ soundPrototype _ FMSound new.
+ allowingChord _ false. "Sorry!!"
+ soundPlayingList _ Array new: self submorphs size.
+ !
- soundPrototype := FMSound brass1 duration: 9.9!
Item was changed:
----- Method: PolygonMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: PolygonMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-instance creation') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {DescriptionForPartsBin
+ formalName: 'Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.' translatedNoop
- formalName: 'Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.'
globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #arrowPrototype.
+ DescriptionForPartsBin
+ formalName: 'Triangle' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A three-sided polygon.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #trianglePrototype.
+
+ DescriptionForPartsBin
+ formalName: 'Curve' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A smooth wiggly curve, or a curved solid. Shift-click to get handles and move the points. Using the halo menu, can be coverted into a polygon, and can be made "open" rather than closed.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #curvePrototype.
+ }
+
+
- nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFlaps (in category 'the buttons') -----
buttonFlaps
^self inFlapsSuppressedMode ifTrue: [
+ self makeButton: 'Show tabs' translated balloonText: 'Show tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Show tabs' balloonText: 'Show tabs' for: #toggleFlapsSuppressed
] ifFalse: [
+ self makeButton: 'Hide tabs' translated balloonText: 'Hide tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Hide tabs' balloonText: 'Hide tabs' for: #toggleFlapsSuppressed
].
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFullScreen (in category 'the buttons') -----
buttonFullScreen
^self inFullScreenMode ifTrue: [
+ self makeButton: 'Browser Reentry' translated balloonText: 'Re-enter the browser' translated for: #fullScreenOff
- self makeButton: 'Browser Reentry' balloonText: 'Re-enter the browser' for: #fullScreenOff
] ifFalse: [
+ self makeButton: 'Escape Browser' translated balloonText: 'Use the full screen' translated for: #fullScreenOn
- self makeButton: 'Escape Browser' balloonText: 'Use the full screen' for: #fullScreenOn
]
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonGoTo (in category 'the buttons') -----
buttonGoTo
+ ^self makeButton: 'GO TO' translated balloonText: 'Go to another project' translated for: #gotoAnother
- ^self makeButton: 'GO TO' balloonText: 'Go to another project' for: #gotoAnother
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewProject (in category 'the buttons') -----
buttonNewProject
+ ^self makeButton: 'NEW' translated balloonText: 'Start a new project' translated for: #newProject
- ^self makeButton: 'NEW' balloonText: 'Start a new project' for: #newProject
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewer (in category 'the buttons') -----
buttonNewer
+ ^self makeButton: 'Newer?' translated balloonText: 'Is there a newer version of this project ?' translated for: #getNewerVersionIfAvailable!
- ^self makeButton: 'Newer?' balloonText: 'Is there a newer version of this project ?' for: #getNewerVersionIfAvailable!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNext (in category 'the buttons') -----
buttonNext
+ ^self makeButton: 'NEXT >' translated balloonText: 'Next project' translated for: #nextProject!
- ^self makeButton: 'NEXT >' balloonText: 'Next project' for: #nextProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPaint (in category 'the buttons') -----
buttonPaint
| pb oldArgs brush myButton m |
+ myButton _ self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting.
+ pb _ PaintBoxMorph new submorphNamed: #paint:.
- myButton := self makeButton: '' balloonText: 'Make a painting' for: #doNewPainting.
- pb := PaintBoxMorph new submorphNamed: #paint:.
pb ifNil: [
+ (brush _ Form extent: 16@16 depth: 16) fillColor: Color red
- (brush := Form extent: 16@16 depth: 16) fillColor: Color red
] ifNotNil: [
+ oldArgs _ pb arguments.
+ brush _ oldArgs third.
+ brush _ brush copy: (2@0 extent: 42@38).
+ brush _ brush scaledToSize: brush extent // 2.
- oldArgs := pb arguments.
- brush := oldArgs third.
- brush := brush copy: (2@0 extent: 42@38).
- brush := brush scaledToSize: brush extent // 2.
].
+ myButton addMorph: (m _ brush asMorph lock).
- myButton addMorph: (m := brush asMorph lock).
myButton extent: m extent + (myButton borderWidth + 6).
m position: myButton center - (m extent // 2).
^myButton
+ "brush _ (ScriptingSystem formAtKey: 'Painting')."
- "brush := (ScriptingSystem formAtKey: 'Painting')."
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPrev (in category 'the buttons') -----
buttonPrev
+ ^self makeButton: '< PREV' translated balloonText: 'Previous project' translated for: #previousProject!
- ^self makeButton: '< PREV' balloonText: 'Previous project' for: #previousProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonQuit (in category 'the buttons') -----
buttonQuit
+ "Make and answer a button whose pressing will result in quitting out of Squeak."
+ ^self makeButton: 'QUIT' translated balloonText: 'Quit Etoys (without saving)' translated for: #quitSqueak
- ^self makeButton: 'QUIT' balloonText: 'Quit Squeak altogether' for: #quitSqueak
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonTell (in category 'the buttons') -----
buttonTell
+ ^self makeButton: 'Tell!!' translated balloonText: 'Tell a friend about this project' translated for: #tellAFriend
- ^self makeButton: 'Tell!!' balloonText: 'Tell a friend about this project' for: #tellAFriend
!
Item was changed:
----- Method: ProjectNavigationMorph>>fontForButtons (in category 'as yet unclassified') -----
fontForButtons
+ ^ Preferences standardButtonFont!
-
- ^TextStyle defaultFont!
Item was changed:
----- Method: ProjectNavigationMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self layoutInset: 6;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
useRoundedCorners.
+ mouseInside _ false.
+ !
- mouseInside := false.
- self addButtons!
Item was changed:
----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'as yet unclassified') -----
makeButton: aString balloonText: anotherString for: aSymbol
- self flag: #yo.
- "In principle, this method shouldn't call #translated."
-
^ SimpleButtonDelayedMenuMorph new target: self;
borderColor: #raised;
color: self colorForButtons;
+ label: aString font: self fontForButtons;
+ setBalloonText: anotherString;
- label: aString translated font: self fontForButtons;
- setBalloonText: anotherString translated;
actionSelector: aSymbol!
Item was changed:
----- Method: ProjectNavigationMorph>>publishDifferent (in category 'the actions') -----
publishDifferent
self
+ publishStyle: #initialDirectoryListForProjects
- publishStyle: #initialDirectoryList
forgetURL: true
withRename: false
!
Item was changed:
----- Method: ProjectNavigationMorph>>publishStyle:forgetURL:withRename: (in category 'the actions') -----
publishStyle: aSymbol forgetURL: aBoolean withRename: renameBoolean
| w saveOwner primaryServer rename |
+ w _ self world ifNil: [^Beeper beep].
- w := self world ifNil: [^Beeper beep].
w setProperty: #SuperSwikiPublishOptions toValue: aSymbol.
+ primaryServer _ w project primaryServerIfNil: [nil].
+ rename _ ((primaryServer notNil
- primaryServer := w project primaryServerIfNil: [nil].
- rename := ((primaryServer notNil
and: [primaryServer acceptsUploads]) not)
or: [renameBoolean].
+ rename := rename or: [(primaryServer isKindOf: DAVMultiUserServerDirectory)].
w setProperty: #SuperSwikiRename toValue: rename.
+ saveOwner _ owner.
- saveOwner := owner.
self delete.
[w project
storeOnServerShowProgressOn: self
forgetURL: aBoolean | rename]
ensure: [saveOwner addMorphFront: self]!
Item was changed:
+ ----- Method: ProjectSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: ProjectSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
- | b r partsBinButton newButton |
+ | b r partsBinButton newButton aWrapper |
+ newButton _ ImageMorph new image: (World project makeThumbnail scaledToSize: 48@36).
- newButton := ImageMorph new image: (World project makeThumbnail scaledToSize: 24@18).
newButton on: #mouseDown send: #insertNewProject: to: self.
newButton setBalloonText: 'Make a new Project' translated.
+ (partsBinButton _ UpdatingThreePhaseButtonMorph checkBox)
- (partsBinButton := UpdatingThreePhaseButtonMorph checkBox)
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ (r _ AlignmentMorph newRow)
- (r := AlignmentMorph newRow)
color: Color transparent;
borderWidth: 0;
layoutInset: 0;
+ cellInset: 10@0;
wrapCentering: #center;
+ cellPositioning: #leftCenter;
- cellPositioning: #topCenter;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5@5.
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- r addMorphBack: (self wrapperFor: (b label: 'Okay' translated; actionSelector: #acceptSort)).
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete));
- r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated; actionSelector: #delete));
- addMorphBack: (self wrapperFor: (newButton));
addTransparentSpacerOfSize: 8 @ 0;
+ addMorphBack: (self wrapperFor: (newButton));
+ addTransparentSpacerOfSize: 8 @ 0.
+
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
addMorphBack: (self wrapperFor: partsBinButton);
+ addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons) lock).
+ r addMorphBack: aWrapper.
- addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated) lock).
self addMorphFront: r.
!
Item was changed:
----- Method: ProjectSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
super initialize.
- ""
self useRoundedCorners.
pageHolder useRoundedCorners; borderWidth: 0;
color: (self
gridFormOrigin: 0 @ 0
+ grid: ScriptingSystem sorterGridSize
- grid: 16 @ 16
background: Color white
line: Color blue muchLighter)!
Item was changed:
----- Method: ProjectSorterMorph>>sorterMorphForProjectNamed: (in category 'as yet unclassified') -----
sorterMorphForProjectNamed: projName
| pvm proj |
+ (proj _ Project named: projName) ifNil: [^nil].
+ pvm _ (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
- (proj := Project named: projName) ifNil: [^nil].
- pvm := (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
pvm setProperty: #nameOfThisProject toValue: projName.
+ pvm isOpaque: true.
pvm setBalloonText: projName.
pvm on: #mouseDown send: #clickFromSorterEvent:morph: to: self.
pvm on: #mouseUp send: #clickFromSorterEvent:morph: to: self.
^pvm
!
Item was changed:
----- Method: RealEstateAgent class>>reduceByFlaps: (in category '*MorphicExtras-utilities') -----
reduceByFlaps: aScreenRect
"Return a rectangle that won't interfere with default shared flaps"
Flaps sharedFlapsAllowed ifFalse: [^ aScreenRect copy].
(Flaps globalFlapTabsIfAny allSatisfy:
[:ft | ft flapID = 'Painting' translated or: [ft edgeToAdhereTo == #bottom]])
ifTrue: [^ aScreenRect withHeight: aScreenRect height - 18]
+ ifFalse: [^ aScreenRect insetBy: 64]!
- ifFalse: [^ aScreenRect insetBy: 18]!
Item was changed:
----- Method: RecordingControlsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.'}
- cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: RecordingControlsMorph>>addButtonRows (in category 'initialization') -----
addButtonRows
+ | r fullWidth |
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- | r |
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Morph' translated action: #makeSoundMorph).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Tile' translated action: #makeTile).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Trim' translated action: #trim).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Show' translated action: #showEditor).
- r addMorphBack: (self buttonName: 'Show' translated action: #show).
self addMorphBack: r.
+ r layoutChanged.
+ fullWidth := r fullBounds width.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Record' translated action: #record).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Stop' translated action: #stop).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Play' translated action: #playback).
+ r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Codec' translated action: #chooseCodec).
r addMorphBack: self makeStatusLight.
self addMorphBack: r.
+ self changeCodec: OggSpeexCodec name: 'Speex'.
+ r layoutChanged.
+ fullWidth := fullWidth max: r fullBounds width.
+ ^ fullWidth@(r fullBounds height).
!
Item was changed:
----- Method: RecordingControlsMorph>>buttonName:action: (in category 'other') -----
buttonName: aString action: aSymbol
^ SimpleButtonMorph new
target: self;
+ label: aString font: Preferences standardButtonFont;
- label: aString;
actionSelector: aSymbol
!
Item was changed:
----- Method: RecordingControlsMorph>>initialize (in category 'initialization') -----
initialize
+ | r full |
- | r |
super initialize.
self hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ borderWidth _ 2.
- borderWidth := 2.
self listDirection: #topToBottom.
+ recorder _ SoundRecorder new.
+ full := self addButtonRows.
+ self addRecordLevelSliderIn: full.
- recorder := SoundRecorder new.
- self addButtonRows.
- self addRecordLevelSlider.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
+ r addMorphBack: (self makeRecordMeterIn: full).
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
- r addMorphBack: self makeRecordMeter.
self addMorphBack: r.
self extent: 10@10. "make minimum size"
!
Item was changed:
----- Method: RectangleMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RectangleMorph, #roundRectPrototype, 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: RectangleMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundRect' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A rectangle with rounded corners' translatedNoop
- formalName: 'RoundRect'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with rounded corners'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #roundRectPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a horizontal gradient' translatedNoop
- formalName: 'Gradient'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a horizontal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #gradientPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient (slanted)' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a diagonal gradient' translatedNoop
- formalName: 'Gradient (slanted)'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a diagonal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #diagonalPrototype}!
Item was changed:
----- Method: ReferenceMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'ref' translatedNoop!
- ^ 'ref'!
Item was changed:
----- Method: ScrollableField class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Info for build parts-bin entries."
+
+ ^ self partName: 'Scrolling Text' translatedNoop
+ categories: #(Basic)
+ documentation: 'A scrollable, editable body of text' translatedNoop!
- ^ self partName: 'Scrolling Text'
- categories: #('Text' )
- documentation: 'A scrollable, editable body of text'!
Item was changed:
----- Method: ScrollableField class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
forFlapNamed: 'Stack Tools'.]!
Item was changed:
----- Method: SelectorBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SelectorBrowser. #prototypicalToolWindow. 'Method Finder' translatedNoop. 'A tool for discovering methods by providing sample values for arguments and results' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results')
forFlapNamed: 'Tools']
!
Item was changed:
----- Method: SimpleSliderMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'Slider' translatedNoop!
- ^ 'Slider'!
Item was changed:
----- Method: SimpleSliderMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Slider' translatedNoop
+ categories: {'Basic' translatedNoop}
+ documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.' translatedNoop!
- ^ self partName: 'Slider'
- categories: #('Scripting')
- documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.'!
Item was changed:
----- Method: SimpleSliderMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: SimpleSliderMorph>>adjustToValue: (in category 'private') -----
adjustToValue: aNumber
"Adjust the position of this slider to correspond to the given value in the range minVal..maxVal."
"Details: Internal values are normalized to the range 0..1."
+ | toUse |
+ toUse := minVal = maxVal
+ ifTrue:
+ [minVal]
+ ifFalse:
+ [(aNumber - minVal) asFloat / (maxVal - minVal)].
+ self value: toUse
- self value:
- (aNumber - minVal) asFloat / (maxVal - minVal).
!
Item was changed:
----- Method: SimpleSliderMorph>>descendingString (in category 'menu') -----
descendingString
^ (self descending
+ ifTrue: ['switch to ascending' translatedNoop]
+ ifFalse: ['switch to descending' translatedNoop]) translated!
- ifTrue: ['switch to ascending']
- ifFalse: ['switch to descending']) translated!
Item was changed:
----- Method: SimpleSliderMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]!
Item was changed:
----- Method: SimpleSliderMorph>>truncateString (in category 'menu') -----
truncateString
^ (truncate
+ ifTrue: ['turn off truncation' translatedNoop]
+ ifFalse: ['turn on truncation' translatedNoop]) translated!
- ifTrue: ['turn off truncation']
- ifFalse: ['turn on truncation']) translated!
Item was changed:
----- Method: SketchEditorMorph>>addRotationScaleHandles (in category 'start & finish') -----
addRotationScaleHandles
"Rotation and scaling handles"
+ rotationButton _ SketchMorph withForm: (palette rotationTabForm).
- rotationButton := SketchMorph withForm: (palette rotationTabForm).
rotationButton position: bounds topCenter - (6@0).
rotationButton on: #mouseDown send: #rotateScalePrep: to: self.
rotationButton on: #mouseMove send: #rotateBy: to: self.
rotationButton on: #mouseUp send: #rotateDone: to: self.
rotationButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
rotationButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: rotationButton].
- self addMorph: rotationButton.
rotationButton setBalloonText: 'Drag me sideways to
rotate your
picture.' translated.
+ scaleButton _ SketchMorph withForm: (palette scaleTabForm).
- scaleButton := SketchMorph withForm: (palette scaleTabForm).
scaleButton position: bounds rightCenter - ((scaleButton width)@6).
scaleButton on: #mouseDown send: #rotateScalePrep: to: self.
scaleButton on: #mouseMove send: #scaleBy: to: self.
scaleButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
scaleButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: scaleButton].
- self addMorph: scaleButton.
scaleButton setBalloonText: 'Drag me up and down to change
the size
of your picture.' translated.
"REMOVED:
+ fwdButton _ PolygonMorph new.
+ pt _ bounds topCenter.
- fwdButton := PolygonMorph new.
- pt := bounds topCenter.
fwdButton borderWidth: 2; makeOpen; makeBackArrow; borderColor:
(Color r: 0 g: 0.8 b: 0).
fwdButton removeHandles; setVertices: (Array with: pt+(0@7) with:
pt+(0@22)).
fwdButton on: #mouseMove send: #forward:direction: to: self.
fwdButton on: #mouseEnter send: #mouseLeave: to: self.
fwdButton on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdButton toValue: fwdButton.
self addMorph: fwdButton.
fwdButton setBalloonText: 'Drag me around to point
in the direction
I go forward.' translated.
+ toggle _ EllipseMorph
- toggle := EllipseMorph
newBounds: (Rectangle center: fwdButton vertices last +
(-4@4) extent: 8@8)
color: Color gray.
toggle on: #mouseUp send: #toggleDirType:in: to: self.
toggle on: #mouseEnter send: #mouseLeave: to: self.
toggle on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdToggle toValue: toggle.
fwdButton addMorph: toggle.
toggle setBalloonText: 'When your object turns,
how should its
picture change?
It can rotate, face left or right,
face up or down, or not
change.' translated.
"
self setProperty: #rotationStyle toValue: hostView rotationStyle.
" self forward: hostView setupAngle direction: fwdButton. "
"Set to its current value"
!
Item was changed:
----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: (in category 'initialization') -----
initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph
+ "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
+
| aPaintBox newPaintBoxBounds worldBounds requiredWidth newOrigin aPosition aPal aTab paintBoxFullBounds |
+ (aTab _ self world paintingFlapTab) ifNotNil:
- (aTab := self world paintingFlapTab) ifNotNil:
[aTab showFlap.
^ self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: nil].
+ self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
+ aPaintBox _ self world paintBox.
+ worldBounds _ self world bounds.
+ requiredWidth _ aPaintBox width.
- aPaintBox := self world paintBox.
- worldBounds := self world bounds.
- requiredWidth := aPaintBox width.
+ aPosition _ (aPal _ aPasteUpMorph standardPalette)
- aPosition := (aPal := aPasteUpMorph standardPalette)
ifNotNil:
[aPal showNoPalette.
aPal topRight + (aPaintBox width negated @ 0 "aPal tabsMorph height")]
ifNil:
[boundsToUse topRight].
+ newOrigin _ ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
- newOrigin := ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
ifTrue: "will fit to right of aPasteUpMorph"
[aPosition]
ifFalse: "won't fit to right, try left"
[boundsToUse topLeft - (requiredWidth @ 0)].
+ paintBoxFullBounds _ aPaintBox maxBounds.
+ paintBoxFullBounds _ (newOrigin - aPaintBox offsetFromMaxBounds) extent:
- paintBoxFullBounds := aPaintBox maxBounds.
- paintBoxFullBounds := (newOrigin - aPaintBox offsetFromMaxBounds) extent:
paintBoxFullBounds extent.
+ newPaintBoxBounds _ paintBoxFullBounds translatedToBeWithin: worldBounds.
- newPaintBoxBounds := paintBoxFullBounds translatedToBeWithin: worldBounds.
self initializeFor: aSketchMorph inBounds: boundsToUse
pasteUpMorph: aPasteUpMorph
+ paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.
+ !
- paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.!
Item was changed:
----- Method: SketchEditorMorph>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "In the middle of drawing a stroke of any kind."
- "In the middle of drawing a stroke. 6/11/97 19:51 tk"
+ | pt priorEvt actionSelector |
- | pt priorEvt |
WorldState canSurrenderToOS: false. "we want maximum responsiveness"
pt := evt cursorPoint.
priorEvt := self get: #lastEvent for: evt.
(priorEvt notNil and: [pt = priorEvt cursorPoint]) ifTrue: [^self].
+ self perform: (actionSelector _ self getActionFor: evt) with: evt.
- self perform: (self getActionFor: evt) with: evt.
"Each action must do invalidRect:"
self
set: #lastEvent
for: evt
to: evt.
+ "If recording painting, mark these events so they will not be condensed. The actual path the brush takes is important."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: actionSelector]].
false
ifTrue:
["So senders will find the things performed here"
self
paint: nil;
fill: nil;
erase: nil;
pickup: nil;
stamp: nil.
self
rect: nil;
ellipse: nil;
polygon: nil;
line: nil;
star: nil]!
Item was changed:
----- Method: SketchEditorMorph>>mouseUp: (in category 'event handling') -----
mouseUp: evt
| myAction |
"Do nothing except those that work on mouseUp."
+ myAction _ self getActionFor: evt.
- myAction := self getActionFor: evt.
myAction == #fill: ifTrue: [
self perform: myAction with: evt.
"Each action must do invalidRect:"
].
myAction == #pickup: ifTrue: [
self pickupMouseUp: evt].
myAction == #polygon: ifTrue: [self polyEdit: evt]. "a mode lets you drag vertices"
self set: #lastEvent for: evt to: nil.
+ "If recording painting, note that we stopped a stroke. OK to condense points."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: #mouseUp:]].
!
Item was changed:
----- Method: SketchEditorMorph>>paint: (in category 'actions & preps') -----
paint: evt
"While the mouse is down, lay down paint, but only within window bounds.
11/28/96 sw: no longer stop painting when pen strays out of window; once it comes back in, resume painting rather than waiting for a mouse up"
+ | mousePoint startToEnd pfPen newPoint |
+ pfPen _ self get: #paintingFormPen for: evt.
+ mousePoint _ evt cursorPoint.
+ newPoint _ mousePoint - bounds origin.
+ startToEnd _ pfPen regionFor: newPoint.
+ evt shiftPressed
+ ifTrue: [pfPen gotoBack: newPoint]
+ ifFalse: [pfPen goto: newPoint].
- | mousePoint startRect endRect startToEnd pfPen myBrush |
-
- pfPen := self get: #paintingFormPen for: evt.
- myBrush := self getBrushFor: evt.
- mousePoint := evt cursorPoint.
- startRect := pfPen location + myBrush offset extent: myBrush extent.
- pfPen goto: mousePoint - bounds origin.
- endRect := pfPen location + myBrush offset extent: myBrush extent.
- "self render: (startRect merge: endRect). Show the user what happened"
- startToEnd := startRect merge: endRect.
self invalidRect: (startToEnd translateBy: bounds origin).
!
Item was changed:
----- Method: SoundEventMorph>>releaseCachedState (in category 'caching') -----
releaseCachedState
super releaseCachedState.
+ sound isCompressed
+ ifFalse: [sound _ sound compressWith: GSMCodec].
- sound := sound compressWith: GSMCodec.
!
Item was changed:
----- Method: SquishedNameMorph>>fontForName (in category 'as yet unclassified') -----
fontForName
+ ^(TextStyle default fontOfSize: 15) emphasized: 1
- | pickem |
- pickem := 3.
-
- pickem = 1 ifTrue: [
- ^(((TextStyle named: #Helvetica) ifNil: [TextStyle default]) fontOfSize: 13) emphasized: 1.
- ].
- pickem = 2 ifTrue: [
- ^(((TextStyle named: #Palatino) ifNil: [TextStyle default]) fontOfSize: 12) emphasized: 1.
- ].
- ^((TextStyle default) fontAt: 1) emphasized: 1
!
Item was changed:
----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}
- cl registerQuad: #(ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop}
- cl registerQuad: #(ScriptingSystem holderWithAlphabet 'Alphabet' 'A source for single-letter objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: StarMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Star' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'A symmetrical polygon in the shape of a star' translatedNoop!
- ^ self partName: 'Star'
- categories: #('Graphics')
- documentation: 'A symmetrical polygon in the shape of a star'!
Item was changed:
----- Method: StarMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: StickyPadMorph class>>defaultNameStemForInstances (in category 'parts bin') -----
defaultNameStemForInstances
"Answer the default name stem to use"
+ ^ 'tear off' translatedNoop
+ !
- ^ 'tear off'!
Item was changed:
----- Method: StickyPadMorph class>>descriptionForPartsBin (in category 'parts bin') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StickyPadMorph class>>launchPartVia:label: (in category 'parts bin') -----
launchPartVia: aSelector label: aString
"Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins. Overridden here so that all instances will be given the name, unlike the prevailing convention for other object types"
| aMorph |
+ aMorph _ self perform: aSelector.
- aMorph := self perform: aSelector.
aMorph setNameTo: self defaultNameStemForInstances. "i.e., circumvent uniqueness in this case"
aMorph setProperty: #beFullyVisibleAfterDrop toValue: true.
+ aMorph openInHand.
+ ^ aMorph!
- aMorph openInHand!
Item was changed:
----- Method: StickyPadMorph class>>registerInFlapsRegistry (in category 'as yet unclassified') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: StoryboardBookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Storyboard' translatedNoop
+ categories: #()
+ documentation: 'A storyboard authoring tool' translatedNoop!
- ^ self partName: 'Storyboard'
- categories: #('Presentation')
- documentation: 'A storyboard authoring tool'!
Item was changed:
----- Method: StringButtonMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'SButton' translatedNoop!
- ^ 'SButton'!
Item was changed:
----- Method: StringButtonMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]
ifFalse: [nil]!
Item was changed:
----- Method: TabMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tab' translatedNoop!
- ^ 'tab'!
Item was changed:
+ ----- Method: TabSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: TabSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
| b r |
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r _ AlignmentMorph newRow.
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r := AlignmentMorph newRow.
r color: b color; borderWidth: 0; layoutInset: 0.
r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
r wrapCentering: #topLeft.
+ r addMorphBack: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort).
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #cancelSort).
- r addMorphBack: (b label: 'Okay'; actionSelector: #acceptSort).
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (b label: 'Cancel'; actionSelector: #cancelSort).
self addMorphFront: r.
!
Item was changed:
----- Method: TabSorterMorph>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
self removeAllMorphs.
self extent: 300@100.
+ pageHolder _ PasteUpMorph new.
- pageHolder := PasteUpMorph new.
pageHolder vResizeToFit: true; autoLineLayout: true.
pageHolder extent: self extent - borderWidth.
pageHolder padding: 8.
pageHolder cursor: 0.
+ pageHolder wantsMouseOverHalos: false.
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: TabbedPalette class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tabbedPalette' translatedNoop!
- ^ 'tabbedPalette'!
Item was changed:
----- Method: TextMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {
DescriptionForPartsBin
+ formalName: 'Text (border)' translatedNoop
+ categoryList: #()
+ documentation: 'A text field with border' translatedNoop
- formalName: 'Text (border)'
- categoryList: #('Text')
- documentation: 'A text field with border'
globalReceiverSymbol: #TextMorph
nativitySelector: #borderedPrototype.
" DescriptionForPartsBin
+ formalName: 'Text (fancy)' translatedNoop
+ categoryList: {'Text' translatedNoop}
+ documentation: 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop
- formalName: 'Text (fancy)'
- categoryList: #('Text')
- documentation: 'A text field with a rounded shadowed border, with a fancy font.'
globalReceiverSymbol: #TextMorph
nativitySelector: #fancyPrototype."
DescriptionForPartsBin
+ formalName: 'Text' translatedNoop
+ categoryList: {'Basic' translatedNoop}
+ documentation:
+ 'A raw piece of text which you can edit into anything you want' translatedNoop
- formalName: 'Text'
- categoryList: #('Basic' 'Text')
- documentation: 'A raw piece of text which you can edit into anything you want'
globalReceiverSymbol: #TextMorph
+ nativitySelector: #nonwrappingPrototype.
- nativitySelector: #boldAuthoringPrototype.
}
!
Item was changed:
----- Method: Thumbnail>>makeThumbnailFromForm: (in category 'thumnail creation') -----
makeThumbnailFromForm: aForm
"Make a thumbnail from the form provided, obeying my min and max width and height preferences"
+ | scaleX scaleY margin opaque nominalWidth minimumWidth |
+ minimumWidth := self minimumWidth.
+ scaleY _ minimumHeight / aForm height. "keep height invariant"
+
+ scaleX _ ((nominalWidth := aForm width * scaleY) <= maximumWidth)
+ ifTrue:
+ [(nominalWidth < minimumWidth)
+ ifFalse:
+ [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
+ ifTrue:
+ [minimumWidth / aForm width]]
+ ifFalse:
+ [scaleY _ maximumWidth / aForm width].
- | scaleX scaleY margin opaque |
- scaleY := minimumHeight / aForm height. "keep height invariant"
- scaleX := ((aForm width * scaleY) <= maximumWidth)
- ifTrue: [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
- ifFalse: [scaleY := maximumWidth / aForm width].
"self form: (aForm magnify: aForm boundingBox by: (scaleX @ scaleY) smoothing: 2)."
"Note: A problem with magnify:by: fails to reproduce borders properly.
The following code does a better job..."
+ margin _ 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
+ opaque _ (Form extent: aForm extent + margin depth: 32) "fillWhite".
+ aForm displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
+ self form: ((opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2) fixAlpha).
- margin := 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
- opaque := (Form extent: aForm extent + margin depth: 32) "fillWhite".
- aForm fixAlpha displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
- opaque fixAlpha.
- self form: (opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2).
self extent: originalForm extent!
Item was changed:
----- Method: Thumbnail>>setStandardDefaultMetrics (in category 'initialization') -----
setStandardDefaultMetrics
"Provide the current choices for min.max width/height for thumbnails"
+ self maxWidth: 60 minHeight: 32.
+ self setProperty: #minimumWidth toValue: 16!
- self maxWidth: 60 minHeight: 24!
Item was changed:
----- Method: ThumbnailMorph>>step (in category 'stepping and presenter') -----
step
"Optimization: Don't redraw if we're viewing some kind of SketchMorph and its rotated Form hasn't changed."
| viewee f |
+ viewee _ self actualViewee.
+ viewee ifNil: [self stopStepping. ^ self].
+ viewee isSketchMorph
+ ifTrue:
+ [f := viewee rotatedForm.
+ f == lastSketchForm ifTrue: [^ self]. "The optimization"
+ lastSketchForm _ f]
+ ifFalse:
+ [lastSketchForm := nil]. "Avoids subtle bug if sketchMorph removed and then put back in"
+ self changed
- viewee := self actualViewee.
- viewee ifNil: [ self stopStepping. ^self ].
- (viewee isSketchMorph) ifTrue: [
- f := viewee rotatedForm.
- f == lastSketchForm ifTrue: [^ self].
- lastSketchForm := f].
- self changed.
!
Item was changed:
----- Method: TickIndicatorMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ self extent: 30 @ 30.
+ index _ 0!
- self extent: 20 @ 20.
- index := 0!
Item was changed:
----- Method: TransitionMorph class>>allEffects (in category 'available effects') -----
allEffects
+ #('none' 'slide over' 'slide both' 'slide away' 'slide border'
+ 'page forward' 'page back'
+ 'french door' 'zoom frame' 'zoom' 'dissolve') translatedNoop.
^ #(none
slideOver slideBoth slideAway slideBorder
pageForward pageBack
frenchDoor
zoomFrame zoom
dissolve)!
Item was changed:
----- Method: TransitionMorph class>>directionsForEffect: (in category 'available effects') -----
directionsForEffect: eff
"All these arrays are ordered so inverse is atWrap: size//2."
+ #('right' 'down right' 'down' 'down left' 'left' 'up left' 'up' 'up right'
+ 'in' 'in h' 'out' 'out h') translatedNoop.
+
(#(slideOver slideBoth slideAway slideBorder) includes: eff)
ifTrue: [^ #(right downRight down downLeft left upLeft up upRight)].
(#(pageForward pageBack) includes: eff)
ifTrue: [^ #(right down left up)].
(#(frenchDoor) includes: eff)
ifTrue: [^ #(in inH out outH)].
(#(zoomFrame zoom) includes: eff)
ifTrue: [^ #(in out)].
^ Array new!
Item was changed:
----- Method: TrashCanMorph class>>descriptionForPartsBin (in category 'miscellaneous') -----
descriptionForPartsBin
+ ^ self partName: 'Trash' translatedNoop
+ categories: { 'Basic' translatedNoop}
+ documentation: 'a tool for discarding objects' translatedNoop
+ sampleImageForm: (Form extent: 42@54 depth: 8 fromArray: #( 0 0 0 2555943 992034 555814414 587202599 654311424 0 0 0 0 0 654320418 550751400 2829625512 2829625512 2829625357 556007424 0 0 0 0 36 3553874600 2829155709 2105376125 2711726248 2829625512 2728926240 587212583 0 0 0 639882194 3433594237 1400339837 2107746472 2812848296 2829634764 2829623677 2820612864 640090112 0 0 3553809064 2097828727 2108216018 3537030348 3436367016 2829625548 3537021096 2105452577 603989760 0 9427 3537019218 22259922 4141011666 3536637138 4160212129 2712183208 2832398034 2709355944 539103014 0 2413266 3531411713 2110979575 3537031884 3435975671 4157384573 2812846461 2108216055 3430776189 488645135 654311424 651416310 2823946621 4160606930 3537030348 3539466451 2829559720 2829625506 2105398007 3534257533 2718769186 0 601019090 2097238994 4258452178 3537031891 4160213671 2812782760 2829559976 2105387218 4154948989 2099055886 254214144 4174566098 1392595922 4258452178 3537041442 3551045799 2829625512 2829625505 2105396471 3534257533 2098863648 606470144 4275229394 2097238696 4260811474 3536977959 3550980264 2829625512 2829558141 2108225271 2826796413 1998134560 589758464 584241874 3427991891 3438727890 3537031970 3433614504 2829625512 2829164961 3436377804 2709355901 1394154783 589692928 617861842 3534246674 1403572946 3537031890 3536627880 2829625512 2812848338 4157778045 2105376083 1394154527 587202560 265540306 3537030269 1397980584 2831994060 3435964584 2829625512 2831995602 3433594237 2105365330 1394154783 589758464 13871314 3537041106 2826796413 2105385640 2829559976 2829625548 3436367016 2709355901 1397902346 1394220320 606535680 639674536 2831995602 3537030312 2829625256 2829625512 2829634728 2829625469 2105365331 1280463699 186260768 606535680 1037224 2829625512 3436368594 3537030348 3433605288 2829625512 2709355895 1397967954 1376389715 404364814 254214144 9164 2829625512 2829166760 2829625512 2829625505 2709355901 1397951058 1280463370 173167480 421203235 637534208 35 2829625511 2711715197 2105376125 2105376119 1397969747 1397903954 168430156 1397954174 421339392 654311424 0 4174162088 2728492413 2105376125 2105374547 1397969747 1397969490 1280070483 2105350169 438182694 0 0 267898023 2829155709 2105376125 2104981331 1397969747 1397902346 1397979005 2105376282 455025703 0 0 16241320 2832387239 2105376125 2004318035 1397969747 1397980541 2104982910 2105350427 471928576 0 0 653775528 2832388812 2712119464 2829221245 2728960381 2105387170 2104982910 2105350683 488701990 0 0 16700071 2832388818 2829625548 3433603489 2829625469 2105387170 2104982909 2105350683 504233984 0 0 2413224 2815218380 2829559976 3433594237 2829625469 2105387176 2104982910 2105416476 220266496 0 0 2413516 2815218386 2812782760 2829614461 2829625469 2105387176 2104982909 2105416476 220341760 0 0 2413516 2815218386 2829166796 2829623677 2829625469 2105387176 2104982909 2105416733 522397440 0 0 54226 2829636306 2810030284 3433605245 2829625469 2105385640 2104982910 2105416733 522397440 0 0 2619346 2829636306 2829166760 2829625469 2829625505 2105385634 2104982945 2097945629 522462976 0 0 65234 2812859090 2829166760 3433604989 2829625469 2105387176 2104982945 2097945629 539240192 0 0 8914 2829636306 2829166760 3433605245 2829625505 2105387176 2104982945 2098797853 537863936 0 0 9427 2829634770 3433539752 3433604989 2829625505 2105387176 2104982946 2098797597 554641152 0 0 211 3433549010 3433146536 3433605245 2728962209 2105387176 2104983208 2098863389 553658112 0 0 9975 3433539794 3433144744 2829625213 2728962209 2105387176 2104983208 2098863134 234881024 0 0 10238 3433539794 3534201256 3435964321 2712184993 2105387176 2104983202 2115640350 234891008 0 0 35 3534203090 3534266792 3435964577 2108205217 2105387176 2104982946 2115705886 234881024 0 0 36 3550980306 3534268328 2831984801 2108205223 2105385640 2104982946 2115706142 570425344 0 0 0 3551045836 3534266792 2831984801 2108205224 2105385640 2105376161 2115705869 572915712 0 0 38 4155025356 3534266792 2831984801 2108205224 2105385640 2105376161 2115706125 572915712 0 0 39 4174162088 3536626088 2831984801 2108205224 2105385640 2105376126 2115771661 589758464 0 0 0 583837608 3536626087 2831984801 2108205224 2105387176 2105376161 2115771679 589692928 0 0 0 601006503 3537020839 2831984807 2108205224 2102623656 2105385342 2719751456 254214144 0 0 0 617850792 3537020833 2831984808 2108214440 2097238952 2105387170 438111502 0 0 0 0 668191948 3537021095 2829634727 2108205224 2097238952 2726142590 471736591 654311424 0 0 0 2282194 3537020833 2829634728 2711726248 2097238690 2826796314 220275750 0 0 0 0 63442 3537021095 2832387240 2107746472 2709355937 2105350686 539168550 640090112 0 0 0 211 3537030312 3536627879 2712194216 2815677352 2820414989 555885347 588195584 0 0 0 39 584307410 3433605288 2812848295 2714576126 3542093084 504176397 521015079 0 0 0 0 8992 3553414312 2829625512 2820673060 3553470632 2829589020 488579879 0 0 0 0 39 991758 235807524 2564819 3433605288 2829614621 220270375 0 0 0 0 0 0 0 2140364 3536627880 2709356064 571418112 0 0 0 0 0 0 0 581478568 3433605246 2719813120 640090112 0 0 0 0 0 0 0 13880488 2829589793 603989798 0 0 0 0 0 0 0 0 991758 570435111 654311424 0 0) offset: 0@0)!
- ^ self partName: 'Trash'
- categories: #('Useful' 'Basic')
- documentation: 'a tool for discarding objects'!
Item was changed:
----- Method: TrashCanMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'viewerFlapTab' translatedNoop!
- ^ 'viewerFlapTab'!
Item was changed:
----- Method: ViewerFlapTab>>initializeFor:topAt: (in category 'transition') -----
initializeFor: aPlayer topAt: aTop
+ "The assumption is that this is only called at the same time of creation of this instance."
+ beingOpened _ true.
+ scriptedPlayer _ aPlayer.
- scriptedPlayer := aPlayer.
self useGraphicalTab.
self top: aTop!
Item was changed:
----- Method: WaveEditor class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'WaveEditor' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A workbench for seing and editing wave forms' translatedNoop!
- ^ self partName: 'WaveEditor'
- categories: #('Multimedia')
- documentation: 'A workbench for seing and editing wave forms'!
Item was changed:
----- Method: WaveEditor>>addControls (in category 'initialization') -----
addControls
+ | slider aWrapper m aButton |
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: Color transparent;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ extent: 5 @ 5.
+ aWrapper wrapCentering: #topLeft.
+ aButton := self buttonName: 'X' action: #delete.
+ aButton setBalloonText: 'Close WaveEditor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Menu' translated action: #invokeMenu.
+ aButton setBalloonText: 'Open a menu' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play' translated action: #play.
+ aButton setBalloonText: 'Play sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor.
+ aButton setBalloonText: 'Play before cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play After' translated action: #playAfterCursor.
+ aButton setBalloonText: 'Play after cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Loop' translated action: #playLoop.
+ aButton setBalloonText: 'Play the loop' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Test' translated action: #playTestNote.
+ aButton setBalloonText: 'Test the note' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Save' translated action: #saveInstrument.
+ aButton setBalloonText: 'Save the sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd.
+ aButton setBalloonText: 'Set loop end at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle.
+ aButton setBalloonText: 'Set one cycle' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart.
+ aButton setBalloonText: 'Set the loop start at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ self addMorphBack: aWrapper.
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: self color;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #spaceFill;
+ vResizing: #rigid;
+ extent: 5 @ 20;
+ wrapCentering: #center;
+ cellPositioning: #leftCenter.
+ m := StringMorph new contents: 'Index: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #cursor;
+ putSelector: #cursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 71;
+ step.
+ aWrapper addMorphBack: m.
+ m := StringMorph new contents: 'Value: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #valueAtCursor;
+ putSelector: #valueAtCursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 50;
+ step.
+ aWrapper addMorphBack: m.
+ slider := SimpleSliderMorph new color: color;
+ extent: 200 @ 10;
+ target: self;
+ actionSelector: #scrollTime:.
+ aWrapper addMorphBack: slider.
+ m := Morph new color: aWrapper color;
+ extent: 10 @ 5.
+ "spacer"
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #startIndex;
+ putSelector: #startIndex:;
+ font: Preferences standardEToysButtonFont;
+ width: 40;
+ step.
+ aWrapper addMorphBack: m.
+ self addMorphBack: aWrapper!
- | slider bb r m |
- r := AlignmentMorph newRow.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r color: bb color; borderWidth: 0; layoutInset: 0.
- r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
- r wrapCentering: #topLeft.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'X'; actionSelector: #delete).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: '<>'; actWhen: #buttonDown;
- actionSelector: #invokeMenu).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play' translated; actionSelector: #play).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Before' translated; actionSelector: #playBeforeCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play After' translated; actionSelector: #playAfterCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Loop' translated; actionSelector: #playLoop).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Test' translated; actionSelector: #playTestNote).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Save' translated; actionSelector: #saveInstrument).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop End' translated; actionSelector: #setLoopEnd).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'One Cycle' translated; actionSelector: #setOneCycle).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop Start' translated; actionSelector: #setLoopStart).
- self addMorphBack: r.
-
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
-
- m := StringMorph new contents: 'Index: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #cursor; putSelector: #cursor:;
- growable: false; width: 71; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Value: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:;
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- slider := SimpleSliderMorph new
- color: color;
- extent: 200@2;
- target: self;
- actionSelector: #scrollTime:.
- r addMorphBack: slider.
-
- m := Morph new color: r color; extent: 10@5. "spacer"
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #startIndex; putSelector: #startIndex:;
- width: 40; step.
- r addMorphBack: m.
-
- self addMorphBack: r.
-
- !
Item was changed:
----- Method: WaveEditor>>addLoopPointControls (in category 'initialization') -----
addLoopPointControls
+ | m aWrapper |
+ aWrapper _ AlignmentMorph newRow.
+ aWrapper color: self color; borderWidth: 0; layoutInset: 0.
+ aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
- | r m |
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
+ m _ StringMorph new contents: 'Loop end: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- m := StringMorph new contents: 'Loop end: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopEnd; putSelector: #loopEnd:;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop length: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopLength; putSelector: #loopLength:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop cycles: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopCycles; putSelector: #loopCycles:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Frequency: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Frequency: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
- growable: false; width: 50; step.
- r addMorphBack: m.
+ self addMorphBack: aWrapper
- self addMorphBack: r.
!
Item was changed:
----- Method: WaveEditor>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ samplingRate _ SoundPlayer samplingRate.
+ loopEnd _ loopLength _ 0.
+ loopCycles _ 1.
+ perceivedFrequency _ 0.
- samplingRate := SoundPlayer samplingRate.
- loopEnd := loopLength := 0.
- loopCycles := 1.
- perceivedFrequency := 0.
"zero means unknown"
self extent: 5 @ 5;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ graph _ GraphMorph new extent: 450 @ 100.
- graph := GraphMorph new extent: 450 @ 100.
graph cursor: 0.
graph cursorColorAtZeroCrossings: Color blue.
self addControls.
self addLoopPointControls.
self addMorphBack: graph.
self
addMorphBack: (Morph
newBounds: (0 @ 0 extent: 0 @ 3)
color: Color transparent).
+ self addMorphBack: (keyboard _ PianoKeyboardMorph new).
+ "self sound: (SampledSound soundNamed: 'croak')."
- self addMorphBack: (keyboard := PianoKeyboardMorph new).
- self sound: (SampledSound soundNamed: 'croak').
!
Item was changed:
----- Method: Workspace class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#Workspace. #prototypicalToolWindow. 'Workspace' translatedNoop. 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.' translatedNoop} forFlapNamed: 'Tools'.]!
- ifPresent: [:cl | cl registerQuad: #(Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')
- forFlapNamed: 'Tools'.]!
1
0
Tim Felgentreff uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-tfel.183.mcz
==================== Summary ====================
Name: MorphicExtras-tfel.183
Author: tfel
Time: 4 August 2016, 2:34:46.670859 pm
UUID: 4c71396d-7ed8-a64d-b977-7461c7e9cc77
Ancestors: MorphicExtras-tfel.182
- if etoys is loaded and the sugar bar is enabled, defer to its sepcial methods to build flaps.
- use a table layout in the flaps
=============== Diff against MorphicExtras-tfel.178 ===============
Item was changed:
----- Method: AlignmentMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Extra items for parts bins"
^ {DescriptionForPartsBin
+ formalName: 'Column' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a column' translatedNoop
- formalName: 'Column'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a column'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #columnPrototype.
DescriptionForPartsBin
+ formalName: 'Row' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a row' translatedNoop
- formalName: 'Row'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a row'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #rowPrototype}!
Item was changed:
+ ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'olpc support') -----
+ fancyText: aString font: aFont color: aColor
+ "Answer a morph containing a TextMorph containing the given string in the given font with the given color."
+
+ | answer tm |
+ answer _ self inAColumn: {
+ tm _ TextMorph new
+ textColor: aColor;
+ contents: aString;
+ beAllFont: aFont;
+ yourself
+ }.
+
- ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'as yet unclassified') -----
- fancyText: aString font: aFont color: aColor
- | answer tm col |
- col := ColorTheme current dialog3DTitles
- ifTrue: [aColor]
- ifFalse: [aColor negated].
- tm := TextMorph new.
- tm beAllFont: aFont;
- color: col;
- contents: aString.
- answer := self inAColumn: {tm}.
- ColorTheme current dialog3DTitles
- ifTrue: [""
- tm addDropShadow.
- tm shadowPoint: 5 @ 5 + tm bounds center].
tm lock.
+ ^ answer
+ !
- ^ answer!
Item was changed:
----- Method: AlignmentMorphBob1>>inARow: (in category 'as yet unclassified') -----
inARow: aCollectionOfMorphs
| row |
row := AlignmentMorph newRow color: Color transparent;
vResizing: #shrinkWrap;
layoutInset: 2;
wrapCentering: #center;
cellPositioning: #leftCenter.
aCollectionOfMorphs
+ do: [:each | each ifNotNil: [row addMorphBack: each]].
- do: [:each | row addMorphBack: each].
^ row!
Item was changed:
----- Method: BOBTransformationMorph>>recomputeExtent (in category 'as yet unclassified') -----
recomputeExtent
| scalePt newScale theGreenThingie greenIBE myNewExtent |
submorphs isEmpty ifTrue: [^self extent].
+ worldBoundsToShow ifNil: [worldBoundsToShow _ self firstSubmorph bounds].
- worldBoundsToShow ifNil: [worldBoundsToShow := self firstSubmorph bounds].
worldBoundsToShow area = 0 ifTrue: [^self extent].
+ scalePt _ owner innerBounds extent / worldBoundsToShow extent.
+ newScale _ scalePt x min: scalePt y.
+ theGreenThingie _ owner.
+ greenIBE _ theGreenThingie innerBounds extent.
+ myNewExtent _ (greenIBE min: worldBoundsToShow extent * newScale) truncated.
- scalePt := owner innerBounds extent / worldBoundsToShow extent.
- newScale := scalePt x min: scalePt y.
- theGreenThingie := owner.
- greenIBE := theGreenThingie innerBounds extent.
- myNewExtent := (greenIBE min: worldBoundsToShow extent * newScale) truncated.
self
scale: newScale;
offset: worldBoundsToShow origin * newScale.
+ smoothing _ (newScale < 1.0) ifTrue: [1] ifFalse: [1].
- smoothing := (newScale < 1.0) ifTrue: [2] ifFalse: [1].
^myNewExtent!
Item was changed:
----- Method: BasicButton class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'button' translatedNoop!
- ^ 'button'!
Item was changed:
+ ----- Method: BasicButton>>label:font: (in category 'initialization') -----
- ----- Method: BasicButton>>label:font: (in category 'as yet unclassified') -----
label: aString font: aFontOrNil
+ "Set the receiver's label and font as indicated."
| oldLabel m aFont |
+ (oldLabel _ self findA: StringMorph)
- (oldLabel := self findA: StringMorph)
ifNotNil: [oldLabel delete].
+ aFont _ aFontOrNil ifNil: [Preferences standardEToysButtonFont].
+ m _ StringMorph contents: aString font: aFont.
- aFont := aFontOrNil ifNil: [Preferences standardButtonFont].
- m := StringMorph contents: aString font: aFont.
self extent: (m width + 6) @ (m height + 6).
m position: self center - (m extent // 2).
self addMorph: m.
m lock
!
Item was changed:
----- Method: BookMorph class>>alreadyInFromUrl: (in category 'url') -----
alreadyInFromUrl: aUrl
"Does a bookMorph living in some world in this image represent the same set of server pages? If so, don't create another one. It will steal pages from the existing one. Go delete the first one."
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world ifNotNil: [
+ self inform: 'This book is already open in some project' translated.
- self inform: 'This book is already open in some project'.
^ true]]]].
^ false!
Item was changed:
----- Method: BookMorph class>>authoringPrototype (in category 'scripting') -----
authoringPrototype
"Answer an instance of the receiver suitable for placing in a parts bin for authors"
| book |
+ book := self new initializeToStandAlone.
+ book markAsPartsDonor.
- book := self new markAsPartsDonor.
- book removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
- book borderWidth: 1; borderColor: Color black.
- book beSticky.
- book showPageControls; insertPage.
^ book!
Item was changed:
----- Method: BookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Book' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'Multi-page structures' translatedNoop
+ sampleImageForm: (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAAMgAAACgCAYAAABJ/yOpAAAABHNCSVQFBQUBSsjp7wAABMtJ
+ REFUeF7l3S2S4kAAgFEkEonkCEiOgEQikUgkEolEcgSOgEQiOcYcAZfdniqmpnaBkE43JHni
+ 7dZuzWR7m3z5ISHT6/X6hc/ne+TvL9fr1efz/cMPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5OhLI
+ 19eXz9dZfiA+nx+Iz+cH4vN1K5Dz+fxUEyaoCWP0xwAF8ntSy94l+NQL0IQx+mMAA3llop+9
+ AO+K49Nj9MeABfLqVujVrVTOvcYnx+iPAQwkxWTn3kI1YYz+GMBAckx4kw4lUo3RH4MfiB9I
+ hTHU/ZSbH0gLAsk54akmvuoYY+5LKxvjvTGkDCR2DKnnoq2RZAkkNo4cK2DKOGJv3Hw0xkdj
+ SB1IzBhyzEedSC6XS7Hf74vFYlGMx+Nit9uVfs9yufz++jrLaFwg75r0KmMsW/nkQKrMSexr
+ dTgc/vs/rlar0u/r9/vfkdRZRiMDecekvzrGV1Y+PZBX5yX2tTqdTsVmsymOx+PPir5er0uj
+ CoGE74ldRpZA6px7xK6Mud7OrLtSPhvjszHkCKTqGHLMQYpzkdvKXbb1D3uO0WhUaxmNDyTX
+ pKdeMXIFkvoQNXcgMfMQG0jZ1n84HP4cXsUuoxWB5Jj0sjGm3GprgZSN+x17kHA4Fb4mfG3n
+ 9yA5Jj3H4Y1/iBU3hhx7kHCuMRgMau+F/ED8QFobyLOt/2QyKebzee3zGP8Qyz/Eau0h1qOt
+ f7jWEd69Ctc7iD2If5Lun6RX2fqHi3/PDq86tQfx3+b13+atuvUPh1az2SzJO2H+hUL/QmEr
+ LhTermuELX5Y+cO/F84zwp/D34d3rX5fPd9ut7WW4d9q0pJbTVLOX5tvNbmdeIf7p+79frta
+ ftszhPOQ2GX4Nyu26GbFNgTSpDt6w02I0+nUv93dv93dv9390Qn6o4uD/gem/A9M+R+Y8j9R
+ 6H/k1v/Irf/QBv+hDf5DG/zH/viP/fHH4AfiPzjOH4MfiP/oUf/Ro/6jR/2HV/sPr/YfXu3/
+ +AOfzw/E5/MD8fn8QHy+pgfi8/k/BtqfDJ/PD8Tn8wPx+fxAfD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fzw/E5/MD8fn8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8QPx+fxAfD4/EJ/PD8Tn8wPx+fxAfL47ro3i
+ B+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8wPx+fxAfD4/EJ/PD8QPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5/EB8Pj8Qn88PxOfz
+ A/H5fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiB+Iz+cH4vP5gfg+o6P8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHw+PxCfz+cH4vP5gfh8fiA+nx+Iz+cH
+ 4vP5gfh8fiA+nx+Iz+cH4vP5gfiB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+
+ ID6fzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHy+jgXi8/nu+wM79mpMjbRBXAAAAABJRU5E
+ rkJggg==' readStream) readStream) nextImage!
- ^ self partName: 'Book'
- categories: #('Presentation')
- documentation: 'Multi-page structures'!
Item was changed:
----- Method: BookMorph class>>initialize (in category 'class initialization') -----
initialize
- FileList registerFileReader: self.
-
self registerInFlapsRegistry. !
Item was changed:
----- Method: BookMorph class>>isInWorld:withUrl: (in category 'url') -----
isInWorld: aWorld withUrl: aUrl
| urls bks short |
"If a book with this url is in the that (current) world, return it. Say if it is out or in another world."
+ urls _ OrderedCollection new.
+ bks _ OrderedCollection new.
- urls := OrderedCollection new.
- bks := OrderedCollection new.
aWorld allMorphsDo: [:aBook | (aBook isKindOf: BookMorph) ifTrue: [
bks add: aBook.
(urls add: (aBook valueOfProperty: #url)) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]]]]. "shortcut"
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]
ifFalse: [
+ self inform: 'Book may be open in some other project' translated.
- self inform: 'Book may be open in some other project'.
^ aBook]]]].
"if same book name, use it"
+ short _ (aUrl findTokens: '/') last.
- short := (aUrl findTokens: '/') last.
urls withIndexDo: [:kk :ind | (kk findTokens: '/') last = short ifTrue: [
^ bks at: ind]].
^ #out!
Item was changed:
----- Method: BookMorph class>>nextPageButton (in category 'scripting') -----
nextPageButton
+ "Answer a button that will take the user to the next page of its
+ enclosing book"
- "Answer a button that will take the user to the next page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #NextPage.
+ aButton target: aButton.
+ aButton actionSelector: #nextOwnerPage.
+ aButton arguments: #().
+ aButton setNameTo: 'previous'.
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #nextOwnerPage; label: '->'; color: Color yellow.
- aButton setNameTo: 'next'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>openFromFile: (in category 'fileIn/Out') -----
openFromFile: fullName
"Reconstitute a Morph from the selected file, presumed to be represent
a Morph saved via the SmartRefStream mechanism, and open it in an
appropriate Morphic world"
| book aFileStream |
Smalltalk verifyMorphicAvailability ifFalse: [^ self].
+ aFileStream _ FileStream readOnlyFileNamed: fullName.
+ book _ BookMorph new.
- aFileStream := FileStream oldFileNamed: fullName.
- book := BookMorph new.
book setProperty: #url toValue: aFileStream url.
book fromRemoteStream: aFileStream.
aFileStream close.
Smalltalk isMorphic
ifTrue: [ActiveWorld addMorphsAndModel: book]
ifFalse:
[book isMorph ifFalse: [^self inform: 'Can only load a single morph
+ into an mvc project via this mechanism.' translated].
- into an mvc project via this mechanism.'].
book openInWorld].
book goToPage: 1!
Item was changed:
----- Method: BookMorph class>>previousPageButton (in category 'scripting') -----
previousPageButton
+ "Answer a button that will take the user to the previous page of its
+ enclosing book"
- "Answer a button that will take the user to the previous page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #PrevPage.
+ aButton target: aButton.
+ aButton actionSelector: #previousOwnerPage.
+ aButton arguments: #().
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #previousOwnerPage; color: Color yellow; label: '<-'.
aButton setNameTo: 'previous'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BookMorph . #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'Supplies']!
Item was changed:
----- Method: BookMorph class>>serviceLoadAsBook (in category 'fileIn/Out') -----
serviceLoadAsBook
^ SimpleServiceEntry
provider: self
+ label: 'load as book' translatedNoop
- label: 'load as book'
selector: #openFromFile:
+ description: 'open as bookmorph' translatedNoop!
- description: 'open as bookmorph'!
Item was changed:
----- Method: BookMorph>>goToPageMorph:transitionSpec: (in category 'navigation') -----
goToPageMorph: newPage transitionSpec: transitionSpec
+ "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided."
+
| pageIndex aWorld oldPageIndex ascending tSpec readIn |
pages isEmpty ifTrue: [^self].
self setProperty: #searchContainer toValue: nil. "forget previous search"
self setProperty: #searchOffset toValue: nil.
self setProperty: #searchKey toValue: nil.
pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"].
readIn := newPage isInMemory not.
oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil].
ascending := (oldPageIndex isNil or: [newPage == currentPage])
ifTrue: [nil]
ifFalse: [oldPageIndex < pageIndex].
tSpec := transitionSpec ifNil:
["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec
ifAbsent:
[" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]].
self flag: #arNote. "Probably unnecessary"
(aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus].
currentPage ifNotNil: [currentPage updateCachedThumbnail].
self currentPage notNil
ifTrue:
[(((pages at: pageIndex) owner isKindOf: TransitionMorph)
and: [(pages at: pageIndex) isInWorld])
ifTrue: [^self "In the process of a prior pageTurn"].
self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts].
+ self removeViewersOnSubsIn: ActiveWorld presenter.
ascending ifNotNil:
["Show appropriate page transition and start new page when done"
currentPage stopStepping.
(pages at: pageIndex) position: currentPage position.
^(TransitionMorph
effect: tSpec second
direction: tSpec third
inverse: (ascending or: [transitionSpec notNil]) not)
showTransitionFrom: currentPage
to: (pages at: pageIndex)
in: self
whenStart: [self playPageFlipSound: tSpec first]
whenDone:
[currentPage
delete;
fullReleaseCachedState.
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrlInBook: self url.
currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page"
currentPage
delete;
fullReleaseCachedState].
+ self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage"
- self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
-
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrl.
+ currentPage sqkPage computeThumbnail "just store it"].
+ ActiveWorld ifNotNil: [ActiveWorld presenter flushPlayerListCache]!
- currentPage sqkPage computeThumbnail "just store it"]!
Item was changed:
----- Method: BookMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
+ super initializeToStandAlone.
+ self removeEverything; pageSize: 360@228; color: Color white.
- self initialize.
- self removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
self borderWidth: 1; borderColor: Color black.
self beSticky.
self showPageControls; insertPage.
^ self!
Item was changed:
----- Method: BookMorph>>pasteBookPage (in category 'menu') -----
pasteBookPage
+ "If the paste buffer has something to paste, paste it as a book page."
+
| aPage |
+ aPage _ self primaryHand objectToPaste.
+ aPage removeProperty: #revertKey.
- aPage := self primaryHand objectToPaste.
self insertPage: aPage pageSize: aPage extent atIndex: ((pages indexOf: currentPage) - 1).
"self goToPageMorph: aPage"!
Item was changed:
----- Method: BookMorph>>setNewPagePrototype (in category 'menu') -----
setNewPagePrototype
"Record the current page as the prototype to be copied when inserting new pages."
currentPage ifNotNil:
+ [newPagePrototype _ currentPage veryDeepCopy.
+ newPagePrototype removeProperty: #revertKey].
+ "When a new page is inserted, it will not have any original page to revert to. After author improves the new page, he can save it for later revert."
- [newPagePrototype := currentPage veryDeepCopy].
!
Item was changed:
+ ----- Method: BookPageSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: BookPageSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
+ | bb r str aCheckbox aWrapper |
+ r _ AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
+ r wrapCentering: #center; cellPositioning: #leftCenter;
- | bb r aButton str |
- r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
- r wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated.
+ r addTransparentSpacerOfSize: 12.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete)).
+ bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated; actionSelector: #acceptSort)).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated; actionSelector: #delete)).
+ "eliminate the parts-bin button on the book-page sorters...
+ r addTransparentSpacerOfSize: 24 @ 0.
+
+ aCheckbox := UpdatingThreePhaseButtonMorph checkBox.
+ aCheckbox
- r addTransparentSpacerOfSize: 8 @ 0.
- r addMorphBack: (self wrapperFor: (aButton := UpdatingThreePhaseButtonMorph checkBox)).
- aButton
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ str _ StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons.
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
+ addMorphBack: (self wrapperFor: aCheckbox);
+ addMorphBack: (self wrapperFor: str lock).
+ r addMorphBack: aWrapper."
- str := StringMorph contents: 'Parts bin' translated.
- r addMorphBack: (self wrapperFor: str lock).
+ self addMorphFront: r
- self addMorphFront: r.
!
Item was changed:
----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'as yet unclassified') -----
book: aBookMorph morphsToSort: morphList
+ | innerBounds scrollPane newHeight |
+ book _ aBookMorph.
+ newHeight _ self currentWorld height.
- | innerBounds |
- book := aBookMorph.
pageHolder removeAllMorphs.
pageHolder addAllMorphs: morphList.
pageHolder extent: pageHolder width@pageHolder fullBounds height.
+ innerBounds _ Rectangle merging: (morphList collect: [:m | m bounds]).
+ pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.
+ (pageHolder height > newHeight) ifTrue: [
+ scrollPane _ ScrollPane new.
+
+ self height: newHeight.
+ scrollPane model: pageHolder.
+ scrollPane extent: pageHolder width@(newHeight - aBookMorph submorphs first height - 28).
+ self addMorph: scrollPane inFrontOf: pageHolder.
+ scrollPane scroller addMorph: pageHolder.
+ scrollPane scrollBarOnLeft: false.
+ scrollPane retractable: false.
+ scrollPane hideHScrollBarIndefinitely: true.
+ scrollPane borderWidth: 1; borderColor: Color gray.
+ ].
+ !
- innerBounds := Rectangle merging: (morphList collect: [:m | m bounds]).
- pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.!
Item was changed:
----- Method: BookPageSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: Display extent - 100;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ pageHolder _ PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
- pageHolder := PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
pageHolder hResizing: #shrinkWrap.
+ pageHolder wantsMouseOverHalos: false.
"pageHolder cursor: 0."
"causes a walkback as of 5/25/2000"
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: BookPageThumbnailMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
| f |
super initialize.
+ flipOnClick _ false.
- ""
- flipOnClick := false.
+ f _ Form extent: 160@120 depth: Display depth.
- f := Form extent: 60 @ 80 depth: Display depth.
f fill: f boundingBox fillColor: color.
self form: f!
Item was changed:
----- Method: BooklikeMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
"This factoring allows subclasses to have different menu yet still use the super call for the rest of the metamenu."
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ aCustomMenu add: 'book...' translated target: self action: #invokeBookMenu.
+
+ "self addBookMenuItemsTo: aCustomMenu hand: aHandMorph"!
- self addBookMenuItemsTo: aCustomMenu hand: aHandMorph!
Item was changed:
----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') -----
currentPlayerDo: aBlock
| aPlayer aPage |
(aPage := self currentPage) ifNil: [^ self].
+ aPage allMorphsDo:[ :m|
+ (aPlayer := m player) ifNotNil:
+ [aBlock value: aPlayer]]!
- (aPlayer := aPage player) ifNotNil:
- [aBlock value: aPlayer]!
Item was changed:
----- Method: BooklikeMorph>>makePageControlsFrom: (in category 'page controls') -----
makePageControlsFrom: controlSpecs
"From the controlSpecs, create a set of page control and return them -- this method does *not* add the controls to the receiver."
| c col row |
c := (color saturation > 0.1) ifTrue: [color slightlyLighter] ifFalse: [color slightlyDarker].
col := AlignmentMorph newColumn.
col color: c; borderWidth: 0; layoutInset: 0.
col hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5.
row := AlignmentMorph newRow.
row color: c; borderWidth: 0; layoutInset: 0.
row hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5.
controlSpecs do: [:spec | | lastGuy b |
+ spec == #showDescription ifTrue: [row addMorphBack: self makeDescriptionViewer].
+ spec == #pageNumber ifTrue: [row addMorphBack: self makePageNumberItem].
+ spec == #spacer ifTrue: [row addTransparentSpacerOfSize: (10 @ 0)].
+ spec == #variableSpacer ifTrue: [
+ row addMorphBack: AlignmentMorph newVariableTransparentSpacer].
+ spec class == Array ifTrue: [
+ spec first isSymbol
+ ifTrue: [b := ThreePhaseButtonMorph labelSymbol: spec first]
+ ifFalse: [b := SimpleButtonMorph new borderWidth: 2;
+ borderColor: Color black; color: Color veryLightGray.
+ b label: spec first font: Preferences standardMenuFont].
+ b target: self; actionSelector: spec second; setBalloonText: spec third.
+ (spec atPin: 4) = #border
+ ifTrue: [b actWhen: #buttonDown]
+ ifFalse: [b borderWidth: 0]. "default is none"
+ row addMorphBack: b.
+ (((lastGuy _ spec last asLowercase) includesSubString: 'menu') or:
+ [lastGuy includesSubString: 'designations'])
+ ifTrue: [b actWhen: #buttonDown]]]. "pop up menu on mouseDown"
- spec == #spacer
- ifTrue:
- [row addTransparentSpacerOfSize: (10 @ 0)]
- ifFalse:
- [spec == #variableSpacer
- ifTrue:
- [row addMorphBack: AlignmentMorph newVariableTransparentSpacer]
- ifFalse:
- [b := SimpleButtonMorph new target: self; borderWidth: 1;
- borderColor: Color veryLightGray; color: c.
- b label: spec first;
- actionSelector: spec second;
- borderWidth: 0;
- setBalloonText: spec third.
- row addMorphBack: b.
- (((lastGuy := spec last asLowercase) includesSubstring: 'menu') or:
- [lastGuy includesSubstring: 'designations'])
- ifTrue: [b actWhen: #buttonDown]]]]. "pop up menu on mouseDown"
col addMorphBack: row.
^ col!
Item was changed:
----- Method: BooklikeMorph>>shortControlSpecs (in category 'page controls') -----
shortControlSpecs
+ "Answer specs defining the widgets in the short form of the control panel."
+
^ {
#spacer.
#variableSpacer.
{'<'. #previousPage. 'Previous page' translated}.
#spacer.
+ {#MenuIcon. #invokeShortBookMenu. 'Click here to get a menu of options for this book.' translated}.
- {'·'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}.
#spacer.
{'>'. #nextPage. 'Next page' translated}.
#spacer.
#variableSpacer.
+ {#RightCaret. #showMoreControls. 'More controls' translated}
- {'³'. #showMoreControls. 'More controls' translated}
}
!
Item was changed:
----- Method: BooklikeMorph>>showingFullScreenString (in category 'misc') -----
showingFullScreenString
+ "Answer a string characterizing whether the receiver is operating in full-screen mode."
+
+ ^ (self isInFullScreenMode ifTrue: ['<yes>'] ifFalse: ['<no>']), 'view pages full-screen' translated!
- ^ (self isInFullScreenMode
- ifTrue: ['exit full screen']
- ifFalse: ['show full screen']) translated!
Item was changed:
----- Method: BooklikeMorph>>showingPageControlsString (in category 'misc') -----
showingPageControlsString
+ "Answer a string characterizing whether page controls are currently showing."
+
+ ^ (self pageControlsVisible ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'page controls visible' translated!
- ^ (self pageControlsVisible
- ifTrue: ['hide page controls']
- ifFalse: ['show page controls']) translated!
Item was changed:
----- Method: BouncingAtomsMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'BouncingAtoms' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney' translatedNoop!
- ^ self partName: 'BouncingAtoms'
- categories: #('Demo')
- documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney'!
Item was changed:
----- Method: BouncingAtomsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BouncingAtomsMorph, #new. 'Bouncing Atoms' translatedNoop. 'Atoms, mate' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BouncingAtomsMorph new 'Bouncing Atoms' 'Atoms, mate')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: ClockMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Answer a description for use in parts bins."
+
+ ^ self partName: 'Digital Clock' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A digital clock' translatedNoop!
- ^ self partName: 'Clock'
- categories: #('Useful')
- documentation: 'A digital clock'!
Item was changed:
----- Method: ClockMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ClockMorph, #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: ClockMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
+ "Add toggles for showing-seconds and display-24-hrs to the halo menu"
+
+ "NB: intentionallyi no super call here!!"
+
+ aCustomMenu add: 'change font' translated action: #changeFont.
+
+ aCustomMenu addUpdating: #showingSecondsString action: #toggleShowingSeconds.
+ aCustomMenu addUpdating: #displaying24HourString action: #toggleShowing24hr!
- "Note minor loose end here -- if the menu is persistent, then the wording will be wrong half the time"
- | item |
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- item := showSeconds == true
- ifTrue: ['stop showing seconds']
- ifFalse: ['start showing seconds'].
- aCustomMenu add: item translated target: self action: #toggleShowingSeconds.
- item := show24hr == true
- ifTrue: ['display Am/Pm']
- ifFalse: ['display 24 hour'].
- aCustomMenu add: item translated target: self action: #toggleShowing24hr.
-
- !
Item was changed:
----- Method: ClockMorph>>initialize (in category 'initialization') -----
initialize
+ "initialize the state of the receiver"
+
- "initialize the state of the receiver"
super initialize.
+
+ showSeconds _ true.
+ show24hr _ false.
+ self font: Preferences standardMenuFont emphasis: 1.
- ""
- showSeconds := true.
- show24hr := false.
self step!
Item was changed:
----- Method: ClockMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
super initializeToStandAlone.
+ showSeconds _ false.
+ self font: (Preferences standardMenuFont emphasized: 1).
- showSeconds := true.
self step!
Item was changed:
----- Method: CurveMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#CurveMorph, #authoringPrototype. 'Curve' translatedNoop, 'A curve' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#CurveMorph. #authoringPrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}
- cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: CurveMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Curvy Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.' translatedNoop
- formalName: 'Curvy Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.'
globalReceiverSymbol: #CurveMorph
nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: EllipseMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: EnvelopeEditorMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: menu hand: aHandMorph
super addCustomMenuItems: menu hand: aHandMorph.
menu addLine.
envelope updateSelector = #ratio: ifTrue:
[menu add: 'choose denominator...' translated action: #chooseDenominator:].
menu add: 'adjust scale...' translated action: #adjustScale:.
- SoundPlayer isReverbOn
- ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb]
- ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb].
menu addLine.
menu add: 'get sound from lib' translated action: #chooseSound:.
menu add: 'put sound in lib' translated action: #saveSound:.
menu add: 'read sound from disk...' translated action: #readFromDisk:.
menu add: 'save sound on disk...' translated action: #saveToDisk:.
menu add: 'save library on disk...' translated action: #saveLibToDisk:.
!
Item was changed:
----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'editing') -----
buildScalesIn: frame
+ | env |
+ env _ envelope.
+ pixPerTick _ graphArea width // (self maxTime//10) max: 1.
+ "hminortick _ ( 1 + ( self maxTime // 800 ) ) * 10.
+ hmajortick _ ( 1 + ( self maxTime // 800 ) ) * 100."
+ hScale _ (Morph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) color: Color lightGreen.
+ " hScale _ (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
- | env hmajortick hminortick |
- env := envelope.
- pixPerTick := graphArea width // (self maxTime//10) max: 1.
- hminortick := ( 1 + ( self maxTime // 800 ) ) * 10.
- hmajortick := ( 1 + ( self maxTime // 800 ) ) * 100.
- hScale := (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
start: 0 stop: self maxTime
minorTick: hminortick minorTickLength: 3
majorTick: hmajortick majorTickLength: 10
caption: 'milliseconds' tickPrintBlock: [:v | v printString].
+ "
self addMorph: hScale.
+ vScale _ (Morph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))) color: Color lightGreen.
+ "vScale _ ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))."
- vScale := ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left)).
env name = 'pitch'
ifTrue:
[env scale >= 2.0
ifTrue:
[vScale start: 0 stop: env scale
minorTick: env scale / 24 minorTickLength: 3
majorTick: env scale / 2.0 majorTickLength: 10
caption: 'pitch (octaves)'
tickPrintBlock: [:v | (v-(env scale/2)) asInteger printString]]
ifFalse:
[vScale start: 0 stop: env scale
minorTick: 1.0/48.0 minorTickLength: 3
majorTick: 1.0/12.0 majorTickLength: 10
caption: 'pitch (half-steps)'
tickPrintBlock: [:v | (v-(env scale/2)*12) rounded printString]]]
ifFalse: [
env name = 'random pitch:'
ifTrue: [
vScale start: 0.9 stop: 1.1
minorTick: 0.2 / 50.0 minorTickLength: 3
majorTick: 0.2 / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]]
ifFalse: [
vScale start: 0 stop: env scale
minorTick: env scale / 50.0 minorTickLength: 3
majorTick: env scale / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]].
].
+ vScale _ TransformationMorph new asFlexOf: vScale.
- vScale := TransformationMorph new asFlexOf: vScale.
vScale angle: Float pi / 2.0.
self addMorph: vScale.
vScale position: (frame left)@(graphArea top-1) - (3@1).
!
Item was changed:
----- Method: EventRecorderMorph>>addButtons (in category 'initialization') -----
addButtons
+ | r b w |
- | r b |
caption ifNotNil: ["Special setup for play-only interface"
+ (r _ self makeARowForButtons)
- (r := self makeARowForButtons)
addMorphBack: (SimpleButtonMorph new target: self;
+ label: caption font: Preferences standardButtonFont; actionSelector: #play);
- label: caption; actionSelector: #play);
- addMorphBack: self makeASpacer;
- addMorphBack: self makeStatusLight;
addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
+ addMorphBack: self makeASpacer.
^ self addMorphBack: r
].
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#record. nil. 'Begin recording'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#record. nil. 'Begin recording'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#stop. b width. 'Stop recording - you can also use the ESC key to stop it'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#play. b width. 'Play current recording'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#readTape. b width. 'Get a new recording from disk'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
+ addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
addMorphBack: self makeASpacer;
+ addMorphBack: (self buttonFor: {#createPlayButton. b width. 'Make a simple button to play this recording'}).
- addMorphBack: self makeStatusLight;
- addMorphBack: self makeASpacer;
- addMorphBack: (self buttonFor: {#button. b width. 'Make a simple button to play this recording'}).
self addMorph: r.
self setStatusLight: #ready.!
Item was changed:
----- Method: EventRecorderMorph>>handleListenEvent: (in category 'events-processing') -----
handleListenEvent: anEvent
"Record the given event"
+ anEvent hand == recHand ifFalse: [^ self]. "not for me"
+ state == #record ifFalse: [
+ "If user got an error while recording and deleted recorder, will still be listening"
+ recHand ifNotNil: [recHand removeEventListener: self].
+ ^self].
- (state == #record and:[anEvent hand == recHand])
- ifFalse:[^self].
anEvent = lastEvent ifTrue: [^ self].
(anEvent isKeyboard and:[anEvent keyValue = 27 "esc"])
ifTrue: [^ self stop].
+ time _ anEvent timeStamp.
- time := anEvent timeStamp.
tapeStream nextPut: (anEvent copy setHand: nil).
journalFile ifNotNil:
[journalFile store: anEvent; cr; flush].
+ lastEvent _ anEvent.!
- lastEvent := anEvent.!
Item was changed:
----- Method: EventRecorderMorph>>pauseIn: (in category 'pause/resume') -----
pauseIn: aWorld
"Suspend playing or recording, either as part of a stop command,
or as part of a project switch, after which it will be resumed."
self setStatusLight: #ready.
state = #play ifTrue:
+ [state _ #suspendedPlay.
+ playHand halo ifNotNil: [playHand halo delete].
- [state := #suspendedPlay.
playHand delete.
aWorld removeHand: playHand.
+ playHand _ nil].
- playHand := nil].
state = #record ifTrue:
+ [state _ #suspendedRecord.
- [state := #suspendedRecord.
recHand removeEventListener: self.
+ recHand _ nil].
- recHand := nil].
voiceRecorder ifNotNil:
[voiceRecorder pause.
startSoundEvent ifNotNil:
[startSoundEvent argument: voiceRecorder recordedSound.
voiceRecorder clearRecordedSound.
+ startSoundEvent _ nil]].
- startSoundEvent := nil]].
!
Item was changed:
----- Method: EventRecorderMorph>>resumeIn: (in category 'pause/resume') -----
resumeIn: aWorld
"Resume playing or recording after a project switch."
+ self state = #suspendedPlay ifTrue:
- state = #suspendedPlay ifTrue:
[self resumePlayIn: aWorld].
+ self state = #suspendedRecord ifTrue:
- state = #suspendedRecord ifTrue:
[self resumeRecordIn: aWorld].
!
Item was changed:
----- Method: EventRecorderMorph>>resumePlayIn: (in category 'pause/resume') -----
resumePlayIn: aWorld
+ playHand _ HandMorphForReplay new recorder: self.
- playHand := HandMorphForReplay new recorder: self.
playHand position: tapeStream peek position.
aWorld addHand: playHand.
playHand newKeyboardFocus: aWorld.
playHand userInitials: 'play' andPicture: nil.
+ lastEvent _ nil.
+ lastDelta _ 0@0.
+ self findPlayOffset.
+ state _ #play.
- lastEvent := nil.
- lastDelta := 0@0.
- state := #play.
self synchronize.
!
Item was changed:
----- Method: EventRecorderMorph>>synchronize (in category 'event handling') -----
synchronize
+ time _ lastInterpolation _ Time millisecondClockValue.
+ deltaTime _ nil.!
- time := Time millisecondClockValue.
- deltaTime := nil.!
Item was changed:
----- Method: EventRecorderMorph>>writeTape: (in category 'fileIn/Out') -----
writeTape: fileName
+ | name bb |
+ name _ self writeFileNamed: fileName.
+ bb _ self findDeepSubmorphThat: [:mm | (mm isKindOf: SimpleButtonMorph)
+ and: [mm label = 'writeTape']]
+ ifAbsent: [^ self].
+ bb actionSelector: #writeTape:.
+ bb arguments: (Array with: name).
- | b name |
- name := self writeFileNamed: fileName.
- (b := self button: 'writeTape') ifNotNil: [
- b actionSelector: #writeTape:.
- b arguments: (Array with: name)].
!
Item was changed:
----- Method: FlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'flap tab' translatedNoop!
- ^ 'flap tab'!
Item was changed:
----- Method: FlapTab>>adaptToWorld (in category 'initialization') -----
adaptToWorld
| wasShowing new |
+ (wasShowing _ self flapShowing) ifTrue:
- (wasShowing := self flapShowing) ifTrue:
[self hideFlap].
(self respondsTo: #unhibernate) ifTrue: [
+ (new _ self unhibernate) == self ifFalse: [
- (new := self unhibernate) == self ifFalse: [
^ new adaptToWorld]].
- self spanWorld.
- self positionObject: self.
wasShowing ifTrue:
+ [self spanWorld.
+ self positionObject: self.
+ self showFlap]!
- [self showFlap]!
Item was changed:
----- Method: FlapTab>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aMenu hand: aHandMorph
"Add further items to the menu as appropriate"
aMenu add: 'tab color...' translated target: self action: #changeColor.
aMenu add: 'flap color...' translated target: self action: #changeFlapColor.
aMenu addLine.
aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo.
aMenu addLine.
aMenu addUpdating: #textualTabString action: #textualTab.
aMenu addUpdating: #graphicalTabString action: #graphicalTab.
aMenu addUpdating: #solidTabString enablement: #notSolid action: #solidTab.
aMenu addLine.
(referent isKindOf: PasteUpMorph) ifTrue:
[aMenu addUpdating: #partsBinString action: #togglePartsBinMode].
aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior.
aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior.
aMenu addLine.
aMenu addUpdating: #isGlobalFlapString enablement: #sharedFlapsAllowed action: #toggleIsGlobalFlap.
+ aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.' translated.
- aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.,' translated.
aMenu addLine.
+ aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap.
aMenu add: 'destroy this flap' translated action: #destroyFlap.
"aMenu addUpdating: #slideString action: #toggleSlideBehavior.
aMenu addUpdating: #inboardString action: #toggleInboardness.
aMenu addUpdating: #thicknessString ('thickness... (current: ', self thickness printString, ')') action: #setThickness."
!
Item was changed:
----- Method: FlapTab>>balloonTextForFlapsMenu (in category 'miscellaneous') -----
balloonTextForFlapsMenu
"Answer the balloon text to show on a menu item in the flaps menu that governs the visibility of the receiver in the current project"
| id |
+ id _ self flapID.
- id := self flapID.
#(
+ ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects' translatedNoop)
+ ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.' translatedNoop)
+ ('Widgets' 'A variety of controls and media tools' translatedNoop)
+ ('Supplies' 'Supplies' translatedNoop)
+ ('Help' 'A flap providing documentation, tutorials, and other help' translatedNoop)
+ ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented' translatedNoop)
+ ('Scripting' 'Tools useful when doing tile scripting' translatedNoop)
+ ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment' translatedNoop)
+ ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting' translatedNoop)) do:
- ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects')
- ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.')
- ('Widgets' 'A variety of controls and media tools')
- ('Supplies' 'A source for many basic types of objects')
- ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented')
- ('Scripting' 'Tools useful when doing tile scripting')
- ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment')
- ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting')) do:
[:pair | (FlapTab givenID: id matches: pair first translated) ifTrue: [^ pair second translated]].
^ self balloonText!
Item was changed:
----- Method: FlapTab>>computeEdgeFraction (in category 'edge') -----
computeEdgeFraction
"Compute and remember the edge fraction"
| aBox aFraction |
self isCurrentlySolid ifTrue: [^ edgeFraction ifNil: [self edgeFraction: 0.5]].
+ aBox := ((self pasteUpMorph ifNil: [self currentWorld]) bounds) insetBy: (self extent // 2).
- aBox := ((owner ifNil: [ActiveWorld]) bounds) insetBy: (self extent // 2).
aFraction := self
ifVertical:
[(self center y - aBox top) / (aBox height max: 1)]
ifHorizontal:
[(self center x - aBox left) / (aBox width max: 1)].
^ self edgeFraction: aFraction!
Item was changed:
----- Method: FlapTab>>destroyFlap (in category 'menu') -----
destroyFlap
"Destroy the receiver"
| reply request |
+ request _ self isGlobalFlap
- request := self isGlobalFlap
ifTrue:
['Caution -- this would permanently
remove this flap, so it would no longer be
available in this or any other project.
+ Do you really want to this? ' translated]
- Do you really want to this? ']
ifFalse:
['Caution -- this is permanent!! Do
+ you really want to do this? ' translated].
+ reply _ self confirm: request translated orCancel: [^ self].
- you really want to do this? '].
- reply := self confirm: request translated orCancel: [^ self].
reply ifTrue:
[self isGlobalFlap
ifTrue:
[Flaps removeFlapTab: self keepInList: false.
self currentWorld reformulateUpdatingMenus]
ifFalse:
[referent isInWorld ifTrue: [referent delete].
self delete]]!
Item was changed:
----- Method: FlapTab>>flapMenuTitle (in category 'menu') -----
flapMenuTitle
+ ^ 'flap: ' translated , self wording!
- ^ 'flap: ', self wording!
Item was changed:
----- Method: FlapTab>>graphicalTabString (in category 'graphical tabs') -----
graphicalTabString
^ (self isCurrentlyGraphical
+ ifTrue: ['choose new graphic...' translated]
+ ifFalse: ['use graphical tab' translated]) !
- ifTrue: ['choose new graphic...']
- ifFalse: ['use graphical tab']) translated!
Item was changed:
----- Method: FlapTab>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "Handle a mouse-move event. The event, a MorphicEvent, is passed in."
+
| aPosition newReferentThickness adjustedPosition thick |
dragged ifFalse: [(thick := self referentThickness) > 0
ifTrue: [lastReferentThickness := thick]].
((self containsPoint: (aPosition := evt cursorPoint)) and: [dragged not])
ifFalse:
[flapShowing ifFalse: [self showFlap].
adjustedPosition := aPosition - evt hand targetOffset.
(edgeToAdhereTo == #bottom)
ifTrue:
[newReferentThickness := inboard
ifTrue:
[self world height - adjustedPosition y]
ifFalse:
[self world height - adjustedPosition y - self height]].
(edgeToAdhereTo == #left)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition x + self width]
ifFalse:
[adjustedPosition x]].
(edgeToAdhereTo == #right)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[self world width - adjustedPosition x]
ifFalse:
[self world width - adjustedPosition x - self width]].
(edgeToAdhereTo == #top)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition y + self height]
ifFalse:
[adjustedPosition y]].
self isCurrentlySolid ifFalse:
[(#(left right) includes: edgeToAdhereTo)
ifFalse:
[self left: adjustedPosition x]
ifTrue:
[self top: adjustedPosition y]].
+ ((edgeToAdhereTo == #left) and: [(self valueOfProperty: #rigidThickness) notNil]) ifTrue:
+ [newReferentThickness := referent width].
+
self applyThickness: newReferentThickness.
dragged := true.
self fitOnScreen.
self computeEdgeFraction]!
Item was changed:
----- Method: FlapTab>>solidTabString (in category 'solid tabs') -----
solidTabString
^ (self isCurrentlySolid
+ ifTrue: ['currently using solid tab' translated]
+ ifFalse: ['use solid tab' translated]) !
- ifTrue: ['currently using solid tab']
- ifFalse: ['use solid tab']) translated!
Item was changed:
----- Method: FlapTab>>textualTabString (in category 'textual tabs') -----
textualTabString
^ (self isCurrentlyTextual
+ ifTrue: ['change tab wording...' translated]
+ ifFalse: ['use textual tab' translated]) !
- ifTrue: ['change tab wording...']
- ifFalse: ['use textual tab']) translated!
Item was changed:
----- Method: Flaps class>>addAndEnableEToyFlaps (in category 'predefined flaps') -----
addAndEnableEToyFlaps
"Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed."
| aSuppliesFlap |
SharedFlapTabs
ifNotNil: [^ self].
SharedFlapTabs := OrderedCollection new.
aSuppliesFlap := self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right.
aSuppliesFlap referent setNameTo: 'Supplies Flap' translated. "Per request from Kim Rose, 7/19/02"
SharedFlapTabs add: aSuppliesFlap. "The #center designation doesn't quite work at the moment"
+ (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false])
+ ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap]
+ ifFalse: [Preferences showProjectNavigator
+ ifTrue:[ SharedFlapTabs add: self newNavigatorFlap]].
- Preferences showProjectNavigator
- ifTrue:[ SharedFlapTabs add: self newNavigatorFlap ].
self enableGlobalFlapWithID: 'Supplies' translated.
+ (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false])
+ ifTrue:
+ [self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated.
+ (self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNilDo:
+ [:navTab | aSuppliesFlap sugarNavTab: navTab]]
+ ifFalse: [
+ Preferences showProjectNavigator
+ ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated]].
- Preferences showProjectNavigator
- ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated ].
SharedFlapsAllowed := true.
Project current flapsSuppressed: false.
^ SharedFlapTabs
"Flaps addAndEnableEToyFlaps"!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category 'flaps registry') -----
defaultsQuadsDefiningScriptingFlap
"Answer a structure defining the default items in the Scripting flap.
previously in quadsDeiningScriptingFlap"
+ ^ {
+ {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
+ {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}.
- ^ #(
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
- (ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#FunctionTile. #randomNumberTile. 'Random' translatedNoop. 'A tile that will produce a random number in a given range' translatedNoop}.
+ {#ScriptingSystem. #anyButtonPressedTiles. 'ButtonDown?' translatedNoop. 'Tiles for querying whether the mouse button is down' translatedNoop}.
+ {#ScriptingSystem. #noButtonPressedTiles. 'ButtonUp?' translatedNoop. 'Tiles for querying whether the mouse button is up' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (RandomNumberTile new 'Random' 'A tile that will produce a random number in a given range')
- (ScriptingSystem anyButtonPressedTiles 'ButtonDown?' 'Tiles for querying whether the mouse button is down')
- (ScriptingSystem noButtonPressedTiles 'ButtonUp?' 'Tiles for querying whether the mouse button is up')
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}.
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (TextFieldMorph exampleBackgroundField 'Scrolling Field' 'A scrolling data field which will have a different value on every card of the background')
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#TextMorph. #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}.
+ {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop}
+ } asOrderedCollection!
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (TextMorph exampleBackgroundLabel 'Background Label' 'A piece of text that will occur on every card of the background')
- (TextMorph exampleBackgroundField 'Background Field' 'A data field which will have a different value on every card of the background')
-
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningStackToolsFlap (in category 'flaps registry') -----
defaultsQuadsDefiningStackToolsFlap
"Answer a structure defining the items on the default system Stack Tools flap.
previously in quadsDefiningStackToolsFlap"
+ ^ {
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}.
+ {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}.
+ {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Scriptable Button' translatedNoop. 'A button whose script will be a method of the background Player' translatedNoop}.
+ {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}.
+ {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection
- ^ #(
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (StackMorph stackHelpWindow 'Stack Help' 'Some hints about how to use Stacks')
- (TextMorph authoringPrototype 'Simple Text' 'Text that you can edit into anything you wish')
- (TextMorph fancyPrototype 'Fancy Text' 'A text field with a rounded shadowed border, with a fancy font.')
- (ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
- (ScriptableButton authoringPrototype 'Scriptable Button' 'A button whose script will be a method of the background Player')
- (StackMorph previousCardButton 'Previous Card' 'A button that takes the user to the previous card in the stack')
- (StackMorph nextCardButton 'Next Card' 'A button that takes the user to the next card in the stack')) asOrderedCollection
!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningSuppliesFlap (in category 'flaps registry') -----
defaultsQuadsDefiningSuppliesFlap
"Answer a list of quads which define the objects to appear in the default Supplies flap.
previously in quadsDefiningSuppliesFlap"
+ ^ {
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}.
+ {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
+ } asOrderedCollection!
- ^ #(
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'TabbedPalette' 'A structure with tabs')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>disableGlobalFlaps: (in category 'menu commands') -----
disableGlobalFlaps: interactive
"Clobber all the shared flaps structures. First read the user her Miranda rights."
interactive
ifTrue: [(self confirm:
'CAUTION!! This will destroy all the shared
flaps, so that they will not be present in
*any* project. If, later, you want them
back, you will have to reenable them, from
this same menu, whereupon the standard
default set of shared flaps will be created.
Do you really want to go ahead and clobber
all shared flaps at this time?' translated) ifFalse: [^ self]].
self globalFlapTabsIfAny do:
[:aFlapTab | self removeFlapTab: aFlapTab keepInList: false.
aFlapTab isInWorld ifTrue: [self error: 'Flap problem' translated]].
self clobberFlapTabList.
+ self initializeFlapsQuads.
+ SharedFlapsAllowed _ false.
- SharedFlapsAllowed := false.
Smalltalk isMorphic ifTrue:
[ActiveWorld restoreMorphicDisplay.
ActiveWorld reformulateUpdatingMenus].
"The following reduces the risk that flaps will be created with variant IDs
such as 'Stack Tools2', potentially causing some shared flap logic to fail."
"Smalltalk garbageCollect." "-- see if we are OK without this"
!
Item was changed:
----- Method: Flaps class>>explainFlapsText (in category 'menu commands') -----
explainFlapsText
"Answer the text, in English, to show in a help-window about Flaps."
^'Flaps are like drawers on the edge of the screen, which can be opened so that you can use what is inside them, and closed when you do not need them. They have many possible uses, a few of which are illustrated by the default set of flaps you can get as described below.
+ ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
- ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
+ To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
- To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
+ ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
- ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
+ If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
- If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
+ If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
- If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
+ Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
- Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
+ You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
- You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
+ You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
- You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
+ Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
- Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
+ If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
- If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
+ The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
- The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
+ tab color... Lets you change the color of the flap''s tab.
+ flap color... Lets you change the color of the flap itself.
- tab color... Lets you change the color of the flap''s tab.
- flap color... Lets you change the color of the flap itself.
+ use textual tab... If the tab is not textual, makes it become textual.
+ change tab wording... If the tab is already textual, allows you to edit
- use textual tab... If the tab is not textual, makes it become textual.
- change tab wording... If the tab is already textual, allows you to edit
its wording.
+ use graphical tab... If the tab is not graphical, makes it become
- use graphical tab... If the tab is not graphical, makes it become
graphical.
+ choose tab graphic... If the tab is already graphical, allows you
- choose tab graphic... If the tab is already graphical, allows you
to change the picture.
+ use solid tab... If the tab is not solid, makes it become solid, i.e.
- use solid tab... If the tab is not solid, makes it become solid, i.e.
appear as a solid band of color along the
entire length or width of the screen.
+ parts-bin behavior If set, then dragging an object from the flap
- parts-bin behavior If set, then dragging an object from the flap
tears off a new copy of the object.
+ dragover If set, the flap opens on dragover and closes
- dragover If set, the flap opens on dragover and closes
again on drag-leave.
+
+ mouseover If set, the flap opens on mouseover and closes
- mouseover If set, the flap opens on mouseover and closes
again on mouse-leave.
+ cling to edge... Governs which edge (left, right, top, bottom)
- cling to edge... Governs which edge (left, right, top, bottom)
the flap adheres to.
+ shared If set, the same flap will be available in all projects; if not, the
- shared If set, the same flap will be available in all projects; if not, the
flap will will occur only in one project.
+ destroy this flap Deletes the flap.
- destroy this flap Deletes the flap.
+ To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
- To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
+ To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
- To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
+ To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
- To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
+ Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.' translated!
- Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.'!
Item was changed:
----- Method: Flaps class>>newFlapTitled:onEdge:inPasteUp: (in category 'new flap') -----
newFlapTitled: aString onEdge: anEdge inPasteUp: aPasteUpMorph
"Add a flap with the given title, placing it on the given edge, in the given pasteup"
| aFlapBody aFlapTab |
aFlapBody := PasteUpMorph newSticky.
aFlapTab := FlapTab new referent: aFlapBody.
aFlapTab setName: aString edge: anEdge color: (Color r: 0.516 g: 0.452 b: 1.0).
anEdge == #left ifTrue:
[aFlapTab position: (aPasteUpMorph left @ aPasteUpMorph top).
aFlapBody extent: (200 @ aPasteUpMorph height)].
anEdge == #right ifTrue:
[aFlapTab position: ((aPasteUpMorph right - aFlapTab width) @ aPasteUpMorph top).
aFlapBody extent: (200 @ aPasteUpMorph height)].
anEdge == #top ifTrue:
[aFlapTab position: ((aPasteUpMorph left + 50) @ aPasteUpMorph top).
aFlapBody extent: (aPasteUpMorph width @ 200)].
anEdge == #bottom ifTrue:
[aFlapTab position: ((aPasteUpMorph left + 50) @ (aPasteUpMorph bottom - aFlapTab height)).
aFlapBody extent: (aPasteUpMorph width @ 200)].
+ aFlapBody
+ beFlap: true;
+ color: self defaultColorForFlapBackgrounds;
+ changeTableLayout.
- aFlapBody beFlap: true.
- aFlapBody color: self defaultColorForFlapBackgrounds.
-
^ aFlapTab!
Item was changed:
----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') -----
newLoneSuppliesFlap
+ "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch. We're still evidently nurturing this method along, but it is a disused branch, whose lone sender has no senders..."
- "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch"
| aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly"
+ aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: {
- aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: #(
+ {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph . #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#SimpleSliderMorph . #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ " {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}."
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'Tabs' translatedNoop. 'A structure with tabs' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle' )
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph authoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, ec.')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'Tabs' 'A structure with tabs')
+ {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}.
+ {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}.
- (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
- (MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ClockMorph. #authoringPrototype, 'Clock' translatedNoop, 'A simple digital clock' translatedNoop}.
+ {#BookMorph, #previousPageButton, 'Previous' translatedNoop, 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph, #nextPageButton, 'Next' translatedNoop, 'A button that takes you to the next page' translatedNoop}.
+ }.
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'Previous' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'Next' 'A button that takes you to the next page')
- ).
+ aFlapTab _ FlapTab new referent: aStrip beSticky.
- aFlapTab := FlapTab new referent: aStrip beSticky.
aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter.
aStrip extent: self currentWorld width @ 78.
+ leftEdge _ ((Display width - (16 + aFlapTab width)) + 556) // 2.
- leftEdge := ((Display width - (16 + aFlapTab width)) + 556) // 2.
aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)).
aStrip beFlap: true.
aStrip autoLineLayout: true.
^ aFlapTab!
Item was changed:
----- Method: Flaps class>>newNavigatorFlap (in category 'predefined flaps') -----
newNavigatorFlap
"Answer a newly-created flap which adheres to the bottom edge of the screen and which holds the project navigator controls. "
| aFlapTab navBar aFlap |
+ navBar _ ProjectNavigationMorph preferredNavigator new addButtons.
+ aFlap _ PasteUpMorph newSticky borderWidth: 0;
- navBar := ProjectNavigationMorph preferredNavigator new.
- aFlap := PasteUpMorph newSticky borderWidth: 0;
extent: navBar extent + (0@20);
color: (Color orange alpha: 0.8);
beFlap: true;
addMorph: navBar beSticky.
aFlap hResizing: #shrinkWrap; vResizing: #shrinkWrap.
aFlap useRoundedCorners.
aFlap setNameTo: 'Navigator Flap' translated.
navBar fullBounds. "to establish width"
+ aFlapTab _ FlapTab new referent: aFlap.
- aFlapTab := FlapTab new referent: aFlap.
aFlapTab setName: 'Navigator' translated edge: #bottom color: Color orange.
aFlapTab position: ((navBar width // 2) - (aFlapTab width // 2))
@ (self currentWorld height - aFlapTab height).
aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Navigator' translated "
!
Item was changed:
----- Method: Flaps class>>newSuppliesFlapFromQuads:positioning: (in category 'predefined flaps') -----
newSuppliesFlapFromQuads: quads positioning: positionSymbol
"Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge."
| aFlapTab aStrip hPosition |
+ Smalltalk at: #SugarNavigatorBar ifPresent: [:c |
+ c showSugarNavigator ifTrue: [
+ ^ self newSuppliesFlapFromQuads: quads positioning: positionSymbol withPreviousEntries: nil]].
aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads.
"self twiddleSuppliesButtonsIn: aStrip."
aFlapTab := FlapTab new referent: aStrip beSticky.
aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter.
hPosition := positionSymbol == #center
ifTrue:
[(Display width // 2) - (aFlapTab width // 2)]
ifFalse:
[Display width - (aFlapTab width + 22)].
aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)).
aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
aStrip extent: self currentWorld width @ 136.
aStrip beFlap: true.
aStrip autoLineLayout: true.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Supplies' translated"!
Item was changed:
----- Method: Flasher class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver for use in a parts bin"
+ ^ self partName: 'Flasher' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A circle that flashes' translatedNoop!
- ^ self partName: 'Flasher'
- categories: #('Demo')
- documentation: 'A circle that flashes'!
Item was changed:
----- Method: FrameRateMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'FrameRate' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A readout that allows you to monitor the frame rate of your system' translatedNoop!
- ^ self partName: 'FrameRate'
- categories: #('Useful')
- documentation: 'A readout that allows you to monitor the frame rate of your system'!
Item was changed:
----- Method: FrameRateMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#FrameRateMorph. #authoringPrototype. 'Frame Rate' translatedNoop. 'An indicator of how fast your system is running' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(FrameRateMorph authoringPrototype 'Frame Rate' 'An indicator of how fast your system is running')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: FrameRateMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ lastDisplayTime _ 0.
+ framesSinceLastDisplay _ 0.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ !
- lastDisplayTime := 0.
- framesSinceLastDisplay := 0!
Item was changed:
----- Method: FrameRateMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
"Initialize the receiver as a stand-alone entity"
super initializeToStandAlone.
self color: Color blue.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ self step.
+ !
- self step!
Item was changed:
----- Method: GrabPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver's instances for a parts bin"
+ ^ self partName: 'Grab Patch' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Use this to grab a rectangular patch from the screen' translatedNoop!
- ^ self partName: 'Grab Patch'
- categories: #('Graphics')
- documentation: 'Use this to grab a rectangular patch from the screen'!
Item was changed:
----- Method: GrabPatchMorph>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initialize.
+ self image: (ScriptingSystem formAtKey: 'GrabPatch').
+ self setProperty: #ignorePartsBinDrop toValue: true!
- self image: (ScriptingSystem formAtKey: 'GrabPatch')!
Item was changed:
----- Method: GraphMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Graph' translatedNoop
+ categories: #()
+ documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.' translatedNoop!
- ^ self partName: 'Graph'
- categories: #('Useful')
- documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.'!
Item was changed:
----- Method: GraphMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: 365 @ 80.
+ dataColor _ Color darkGray.
+ cursor _ 1.0.
+ samplingRate := 11025.
- dataColor := Color darkGray.
- cursor := 1.0.
"may be fractional"
+ cursorColor _ Color red.
+ cursorColorAtZeroCrossings _ Color red.
+ startIndex _ 1.
+ hasChanged _ false.
- cursorColor := Color red.
- cursorColorAtZeroCrossings := Color red.
- startIndex := 1.
- hasChanged := false.
self
data: ((0 to: 360 - 1)
collect: [:x | (100.0 * x degreesToRadians sin) asInteger])!
Item was changed:
----- Method: GraphicalDictionaryMenu class>>openOn:withLabel: (in category 'instance creation') -----
openOn: aFormDictionary withLabel: aLabel
"open a graphical dictionary in a window having the label aLabel.
aFormDictionary should be a dictionary containing as value a form."
| inst aWindow |
+ aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!' translated].
- aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!'].
inst := self new initializeFor: nil fromDictionary: aFormDictionary.
+ aWindow _ (SystemWindow labelled: aLabel) model: inst.
- aWindow := (SystemWindow labelled: aLabel) model: inst.
aWindow addMorph: inst frame: (0@0 extent: 1@1).
aWindow extent: inst fullBounds extent + (3 @ aWindow labelHeight + 3);
minimumExtent: inst minimumExtent + (3 @ aWindow labelHeight + 3).
HandMorph attach: aWindow.
^ inst!
Item was changed:
----- Method: GraphicalDictionaryMenu>>renameGraphicTo: (in category 'menu commands') -----
renameGraphicTo: newName
| curr |
+ curr _ entryNames at: currentIndex.
- curr := entryNames at: currentIndex.
(newName isEmptyOrNil or: [newName = curr]) ifTrue: [^ Beeper beep].
(baseDictionary includesKey: newName) ifTrue:
[^ self inform: 'sorry that conflicts with
the name of another
+ entry in this dictionary' translated].
- entry in this dictionary'].
baseDictionary at: newName put: (baseDictionary at: curr).
baseDictionary removeKey: curr.
self baseDictionary: baseDictionary.
+ currentIndex _ entryNames indexOf: newName.
- currentIndex := entryNames indexOf: newName.
self updateThumbnail!
Item was changed:
----- Method: GraphicalMenu>>initializeFor:withForms:coexist: (in category 'initialization') -----
initializeFor: aTarget withForms: formList coexist: aBoolean
"World primaryHand attachMorph:
(GraphicalMenu new initializeFor: nil
withForms: Form allInstances coexist: true)"
| buttons bb anIndex buttonCage |
target := aTarget.
coexistWithOriginal := aBoolean.
formChoices := formList.
currentIndex := 1.
self borderWidth: 1;
cellPositioning: #center;
color: Color white;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap.
buttons := AlignmentMorph newRow.
buttons borderWidth: 0;
layoutInset: 0.
buttons hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5 @ 5.
buttons wrapCentering: #topLeft.
buttonCage := AlignmentMorph newColumn.
buttonCage hResizing: #shrinkWrap;
vResizing: #spaceFill.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Prev' translated;
- buttons addMorphBack: (bb label: 'Prev';
actionSelector: #downArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 9 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Next' translated;
- buttons addMorphBack: (bb label: 'Next';
actionSelector: #upArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 5 @ 0.
buttons submorphs last color: Color white.
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 12.
buttons := AlignmentMorph newRow.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'OK' translated;
- buttons addMorphBack: (bb label: 'OK';
actionSelector: #okay).
buttons addTransparentSpacerOfSize: 5 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Cancel' translated;
- buttons addMorphBack: (bb label: 'Cancel';
actionSelector: #cancel).
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
self addMorphFront: buttonCage.
formDisplayMorph := Thumbnail new extent: 100 @ 100;
maxWidth: 100 minHeight: 30;
yourself.
self addMorphBack: (Morph new color: Color white;
layoutPolicy: TableLayout new;
layoutInset: 4 @ 4;
hResizing: #spaceFill;
vResizing: #spaceFill;
listCentering: #center;
addMorphBack: formDisplayMorph;
yourself).
target
ifNotNil: [(anIndex := formList
indexOf: target form
ifAbsent: [])
ifNotNil: [currentIndex := anIndex]].
self updateThumbnail!
Item was changed:
----- Method: HandMorphForReplay>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
+ suspended := false.
+ self showTemporaryCursor: Cursor normal
- self showTemporaryCursor: Cursor normal.
!
Item was changed:
----- Method: HandMorphForReplay>>processEvents (in category 'event handling') -----
processEvents
"Play back the next event"
+ | evt hadMouse hadAny tracker |
+ suspended == true ifTrue: [^ self].
- | evt hadMouse hadAny |
hadMouse := hadAny := false.
+ tracker := recorder objectTrackingEvents.
[(evt := recorder nextEventToPlay) isNil] whileFalse:
+ [
+ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self].
+ tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp].
+ evt type == #EOF
- [evt type == #EOF
ifTrue:
+ [recorder pauseIn: ActiveWorld.
+ ^ self].
- [recorder pauseIn: self world.
- ^self].
evt type == #startSound
ifTrue:
+ [recorder perhapsPlaySound: evt argument.
- [evt argument play.
recorder synchronize.
+ ^ self].
+ evt type == #startEventPlayback
+ ifTrue:
+ [evt argument launchPlayback.
+ recorder synchronize.
+ ^ self].
+
+ evt type == #noteTheatreBounds
+ ifTrue:
+ ["The argument holds the content rect --for now we don't make any use of that info in this form."
+ ^ self].
+
- ^self].
evt isMouse ifTrue: [hadMouse := true].
(evt isMouse or: [evt isKeyboard])
ifTrue:
[self handleEvent: (evt setHand: self) resetHandlerFields.
hadAny := true]].
(mouseClickState notNil and: [hadMouse not])
ifTrue:
["No mouse events during this cycle. Make sure click states time out accordingly"
mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
hadAny
ifFalse:
["No pending events. Make sure z-order is up to date"
self mouseOverHandler processMouseOver: lastMouseEvent]!
Item was changed:
----- Method: HandMorphForReplay>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
+ "Handmorph blocks deep copy. Go up to Morph"
+
+ ^ self perform: #veryDeepCopyWith: withArguments: {deepCopier} inSuperclass: Morph!
- ^ self copy!
Item was changed:
----- Method: IndexTabs class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'tabs' translatedNoop!
- ^ 'tabs'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>cacheThumbnailFor: (in category 'thumbnails') -----
cacheThumbnailFor: aProject
+ "Save a thumbnail of the given project in my thumbnail cache."
| form |
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
-
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
CachedThumbnails
at: aProject name
+ put: (form _ self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter).
+ ^ form
- put: (form := self sorterFormForProject: aProject sized: nil).
- ^form
!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'ThreadNavigator' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A tool that lets you navigate through a thread of projects.' translatedNoop!
- ^ self partName: 'ThreadNavigator'
- categories: #('Navigation')
- documentation: 'A tool that lets you navigate through a thread of projects.'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>getThumbnailFor: (in category 'thumbnails') -----
getThumbnailFor: aProject
+ "Answer a thumbnail for the given project, retrieving it from a cache of such objects if possible, else creating a fresh thumbnail, storing it in the cache, and answering it."
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
^CachedThumbnails
at: aProject name
+ ifAbsentPut: [self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter]!
- ifAbsentPut: [self sorterFormForProject: aProject sized: nil]!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>sorterFormForProject:sized: (in category 'sorter') -----
+ sorterFormForProject: aProject sized: aSize
+ "Answer a form to use in a project-sorter to represent the project."
- sorterFormForProject: aProject sized: ignored
+ ^ (ProjectViewMorph on: aProject) imageForm scaledToSize: aSize
- ^(ProjectViewMorph on: aProject) imageForm scaledToSize: 80@60.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>buttonForMenu (in category 'navigation') -----
buttonForMenu
+ ^self makeButton: '?' balloonText: 'More commands' translated for: #moreCommands.
- ^self makeButton: '?' balloonText: 'More commands' for: #moreCommands.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>editThisThread (in category 'navigation') -----
editThisThread
| sorter |
+ sorter _ ProjectSorterMorph new.
- sorter := ProjectSorterMorph new.
sorter navigator: self listOfPages: listOfPages.
self currentWorld addMorphFront: sorter.
+ sorter align: sorter topCenter with: self currentWorld topCenter.
- sorter align: sorter center with: self currentWorld center.
self delete.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>positionAppropriately (in category 'navigation') -----
positionAppropriately
+ | others otherRects overlaps bottomRight |
- | others otherRects overlaps |
-
(self ownerThatIsA: HandMorph) ifNotNil: [^self].
+ others _ ActiveWorld submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
+ otherRects _ others collect: [ :each | each bounds].
+ bottomRight _ (ActiveWorld hasProperty: #threadNavigatorPosition) ifTrue: [
+ ActiveWorld valueOfProperty: #threadNavigatorPosition.
+ ] ifFalse: [
+ ActiveWorld bottomRight.
+ ].
+ self align: self fullBounds bottomRight with: bottomRight.
- others := self world submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
- otherRects := others collect: [ :each | each bounds].
- self align: self fullBounds bottomRight with: self world bottomRight.
self setProperty: #previousWorldBounds toValue: self world bounds.
[
+ overlaps _ false.
- overlaps := false.
otherRects do: [ :r |
+ (r intersects: bounds) ifTrue: [overlaps _ true. self bottom: r top].
- (r intersects: bounds) ifTrue: [overlaps := true. self bottom: r top].
].
self top < self world top ifTrue: [
+ self bottom: bottomRight y.
- self bottom: self world bottom.
self right: self left - 1.
].
overlaps
] whileTrue.!
Item was changed:
----- Method: InternalThreadNavigationMorph>>sizeRatio (in category 'accessing') -----
sizeRatio
"answer the size ratio for the receiver"
+ ^ 1.0
+
+ "^ Preferences standardMenuFont height / 12" "Good grief!!"!
- ^ Preferences standardMenuFont height / 12!
Item was changed:
----- Method: LassoPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver to be used in a parts bin"
+ ^ self partName: 'Lasso' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Drop this icon to grab a patch from the screen with a lasso.' translatedNoop!
- ^ self partName: 'Lasso'
- categories: #('Graphics')
- documentation: 'Drop this icon to grab a patch from the screen with a lasso.'!
Item was changed:
----- Method: LassoPatchMorph>>wantsToBeDroppedInto: (in category 'dropping') -----
wantsToBeDroppedInto: aMorph
+ "Only wanted by the world"
- "Only into PasteUps that are not part bins"
+ ^ aMorph isWorldMorph!
- ^ aMorph isPlayfieldLike!
Item was changed:
----- Method: MagnifierMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Magnifier' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A magnifying glass' translatedNoop!
- ^ self partName: 'Magnifier'
- categories: #('Useful')
- documentation: 'A magnifying glass'!
Item was changed:
----- Method: MagnifierMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MagnifierMorph. #newRound. 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: MagnifierMorph class>>supplementaryPartsDescriptions (in category 'parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundGlass' translatedNoop
+ categoryList: {'Just for Fun' translatedNoop}
+ documentation: 'A round magnifying glass' translatedNoop
- formalName: 'RoundGlass'
- categoryList: #(Useful)
- documentation: 'A round magnifying glass'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newRound.
DescriptionForPartsBin
+ formalName: 'Hand Magnifier' translatedNoop
+ categoryList: #()
+ documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.' translatedNoop
- formalName: 'Hand Magnifier'
- categoryList: #(Useful)
- documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newShowingPointer }!
Item was changed:
----- Method: MagnifierMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
+ | stencil newForm bb |
+
- super drawOn: aCanvas. "border and fill"
aCanvas isShadowDrawing ifFalse: [
"Optimize because #magnifiedForm is expensive"
+ self isRound
+ ifTrue:[stencil := (EllipseMorph new extent: self extent; color: Color white) imageForm.
+ bb := BitBlt toForm: stencil.
+ newForm := (bb copyForm: self magnifiedForm to: 0@0 rule: Form and) destForm.
+ aCanvas paintImage: newForm at: self innerBounds origin ]
+ ifFalse:[super drawOn: aCanvas. "border and fill"
+ aCanvas paintImage: self magnifiedForm at: self innerBounds origin]]
+
+ !
- aCanvas paintImage: self magnifiedForm at: self innerBounds origin]!
Item was changed:
----- Method: MagnifierMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
+ trackPointer _ true.
+ showPointer _ false.
+ magnification _ 2.
+ roundness := false.
- trackPointer := true.
- showPointer := false.
- magnification := 2.
-
self extent: 128 @ 128!
Item was changed:
----- Method: MagnifierMorph>>isRound (in category 'round view') -----
isRound
+ ^ roundness == true!
- ^ owner isMemberOf: ScreeningMorph!
Item was changed:
----- Method: MagnifierMorph>>showingPointerString (in category 'menu') -----
showingPointerString
+ "Answer a string characterizing whether or not I'm showing the pointer."
+
+ ^ (self showPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'show pointer' translated!
- ^ (self showPointer
- ifTrue: ['stop showing pointer']
- ifFalse: ['start showing pointer']) translated!
Item was changed:
----- Method: MagnifierMorph>>sourcePoint (in category 'magnifying') -----
sourcePoint
"If we are being dragged use our center, otherwise use pointer position"
^(trackPointer not or: [owner notNil and: [owner isHandMorph]])
+ ifTrue: [self isFlexed ifTrue:[owner center] ifFalse:[self center]]
- ifTrue: [self center]
ifFalse: [self currentHand position]!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundString (in category 'round view') -----
toggleRoundString
+ "Answer a string describing whether the receiver is currently round."
+
+ ^ (self isRound ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'round' translated!
- ^ (self isRound
- ifTrue: ['be square']
- ifFalse: ['be round']) translated!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundness (in category 'round view') -----
toggleRoundness
+ roundness := roundness not.
+ self fullBounds changed
+ !
- | sm w |
- w := self world.
- self isRound
- ifTrue: [owner delete.
- w addMorph: self]
- ifFalse: [sm := ScreeningMorph new position: self position.
- sm addMorph: self.
- sm addMorph: (EllipseMorph newBounds: self bounds).
- w addMorph: sm]!
Item was changed:
----- Method: MagnifierMorph>>trackingPointerString (in category 'menu') -----
trackingPointerString
+ "Answer a string describing whether or not I'm currently tracking the pointer."
+
^ (trackPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'track pointer' translated!
- ifTrue: ['stop tracking pointer']
- ifFalse: ['start tracking pointer']) translated!
Item was changed:
----- Method: MessageNames class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MessageNames. #prototypicalToolWindow. 'Message Names' translatedNoop. 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: Morph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
^ { DescriptionForPartsBin
+ formalName: 'Status' translatedNoop
+ categoryList: #()
+ documentation: 'Buttons to run, stop, or single-step scripts' translatedNoop
- formalName: 'Status'
- categoryList: #(Scripting)
- documentation: 'Buttons to run, stop, or single-step scripts'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #scriptControlButtons.
DescriptionForPartsBin
+ formalName: 'Scripting' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop
- formalName: 'Scripting'
- categoryList: #(Scripting)
- documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #newScriptingSpace.
DescriptionForPartsBin
+ formalName: 'Random' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A tile that will produce a random number in a given range' translatedNoop
+ globalReceiverSymbol: #FunctionTile
+ nativitySelector: #randomNumberTile.
- formalName: 'Random'
- categoryList: #(Scripting)
- documentation: 'A tile that will produce a random number in a given range'
- globalReceiverSymbol: #RandomNumberTile
- nativitySelector: #new.
DescriptionForPartsBin
+ formalName: 'ButtonDown?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is down' translatedNoop
- formalName: 'ButtonDown?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is down'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #anyButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'ButtonUp?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is up' translatedNoop
- formalName: 'ButtonUp?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is up'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #noButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'NextPage' translatedNoop
+ categoryList: {'Multimedia' translatedNoop}
+ documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop
- formalName: 'NextPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #nextPageButton.
DescriptionForPartsBin
+ formalName: 'PreviousPage' translatedNoop
+ categoryList: {'Multimedia'}
+ documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop
- formalName: 'PreviousPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #previousPageButton.},
+ self partsDescriptionsFromToolsFlap!
- (Flaps quadsDefiningToolsFlap collect:
- [:aQuad | DescriptionForPartsBin fromQuad: aQuad categoryList: #(Tools)])!
Item was changed:
----- Method: ObjectsTool class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Objects' translatedNoop
+ categories: #()
+ documentation: 'A place to obtain many kinds of objects' translatedNoop!
- ^ self partName: 'Objects'
- categories: #('Useful')
- documentation: 'A place to obtain many kinds of objects'!
Item was changed:
----- Method: ObjectsTool class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ObjectsTool. #newStandAlone. 'Object Catalog' translatedNoop. 'A tool that lets you browse the catalog of objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ObjectsTool . #newStandAlone. 'Object Catalog' translatedNoop.'A tool that lets you browse the catalog of objects' translatedNoop}
- cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: ObjectsTool>>minimumWidth (in category 'layout') -----
minimumWidth
+ "Answer a width that assures that the alphabet fits in two rows. For olpc, this is increased in order to make the Connectors category not too absurdly tall."
- "Answer a width that assures that the alphabet fits in two rows"
+ ^ 400!
- ^ 300!
Item was changed:
----- Method: PackagePaneBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PackagePaneBrowser. #prototypicalToolWindow . 'Packages' translatedNoop. 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: PaintBoxMorph class>>localeChanged (in category 'notification') -----
localeChanged
| caption |
caption := ColorPickerMorph noColorCaption.
+ ColorChart ifNotNil: [
+ caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)].!
- caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)!
Item was changed:
----- Method: PaintBoxMorph>>offsetFromMaxBounds (in category 'other') -----
offsetFromMaxBounds
"location of normal PaintBox within maxBounds."
+ | left |
+ left _ self left.
+ Preferences useBiggerPaintingBox ifTrue: [left _ left - (( self width * 1.5)- self width)].
+ ^ left - colorMemory left @ 0!
-
- ^ self left - colorMemory left @ 0!
Item was changed:
----- Method: PaintBoxMorph>>recentColor: (in category 'recent colors') -----
recentColor: aColor
"Remember the color as one of our recent colors"
+ Prototype currentColor: aColor.
+ (recentColors anySatisfy: [:any | any color = aColor])
+ ifTrue: [^self]. "already remembered"
+ RecentColors := {aColor}, RecentColors allButLast.
+ RecentColors keysAndValuesDo: [:i :each |
+ (recentColors at: i) color: each]!
-
- (recentColors anySatisfy: [:any | any color = aColor]) ifTrue: [^self]. "already remembered"
- recentColors size to: 2
- by: -1
- do:
- [:i |
- (recentColors at: i) color: (recentColors at: i - 1) color.
- RecentColors at: i put: (RecentColors at: i - 1)].
- (recentColors first) color: aColor.
- RecentColors at: 1 put: aColor!
Item was changed:
----- Method: PaintBoxMorph>>showColorPalette: (in category 'actions') -----
showColorPalette: evt
| w box |
self comeToFront.
colorMemory align: colorMemory bounds topRight
with: colorMemoryThin bounds topRight.
"make sure color memory fits or else align with left"
+ w _ self world.
+ box _ self bounds: colorMemory fullBounds in: w.
- w := self world.
- box := self bounds: colorMemory fullBounds in: w.
box left < 0 ifTrue:[
colorMemory align: colorMemory bounds topLeft
with: colorMemoryThin bounds topLeft].
+ self addMorphFront: colorMemory.
+ self changed!
- self addMorphFront: colorMemory.!
Item was changed:
----- Method: PaintBoxMorph>>toggleShapes (in category 'actions') -----
toggleShapes
| tab sh stamps |
"The sub panel that has the shape tools on it. Rect, line..."
+ stamps _ self submorphNamed: 'stamps'.
+ tab _ self submorphNamed: 'shapeTab'.
+ (sh _ self submorphNamed: 'shapes') visible
- stamps := self submorphNamed: 'stamps'.
- tab := self submorphNamed: 'shapeTab'.
- (sh := self submorphNamed: 'shapes') visible
ifTrue: [sh hide. tab top: stamps bottom-1]
ifFalse: [sh comeToFront. sh top: stamps bottom-9.
sh show. tab top: sh bottom - tab height + 10].
self layoutChanged.
+ self changed
!
Item was changed:
----- Method: PaintBoxMorph>>toggleStamps (in category 'actions') -----
toggleStamps
| tab otherTab st shapes |
"The sub panel that has the stamps in it. For saving and moving parts of an image."
+ shapes _ self submorphNamed: 'shapes'.
+ otherTab _ self submorphNamed: 'shapeTab'.
+ tab _ self submorphNamed: 'stampTab'.
+ (st _ self submorphNamed: 'stamps') visible
- shapes := self submorphNamed: 'shapes'.
- otherTab := self submorphNamed: 'shapeTab'.
- tab := self submorphNamed: 'stampTab'.
- (st := self submorphNamed: 'stamps') visible
ifTrue: [st hide. st bottom: self bottom. tab top: self bottom-1.
shapes top: self bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [self bottom-1])]
ifFalse: [st top: self bottom-10. st show. tab top: st bottom-0.
shapes top: st bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [st bottom-0])].
+ self layoutChanged.
+ self changed!
- self layoutChanged.!
Item was changed:
----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Paint' translatedNoop
+ categories: #()
+ documentation: 'Drop this icon to start painting a new object.' translatedNoop!
- ^ self partName: 'Paint'
- categories: #('Basic' 'Graphics')
- documentation: 'Drop this icon to start painting a new object.'!
Item was changed:
----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PartsBin>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
wantsDroppedMorph: aMorph event: evt
"Answer whether the receiver would like to accept the given morph. For a Parts bin, we accept just about anything except something that just originated from ourselves"
(aMorph hasProperty: #beFullyVisibleAfterDrop) ifTrue:
+ [^ true].
- ["Sign that this was launched from a parts bun, probably indeed this very parts bin"
- ^ false].
^ super wantsDroppedMorph: aMorph event: evt!
Item was changed:
----- Method: PasteUpMorph class>>initialize (in category '*MorphicExtras-class initialization') -----
initialize
"Initialize the class"
+ #('keyStroke') translatedNoop.
+
self registerInFlapsRegistry.
+ ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' translatedNoop targetMorphClass: PasteUpMorph.!
- ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' targetMorphClass: PasteUpMorph.!
Item was changed:
----- Method: PasteUpMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Holder' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop
- formalName: 'Holder'
- categoryList: #(Scripting)
- documentation: 'A place for storing alternative pictures in an animation, ec.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #prototypicalHolder}!
Item was changed:
----- Method: PianoKeyboardMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'PianoKeyboard' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A piano keyboard' translatedNoop!
- ^ self partName: 'PianoKeyboard'
- categories: #('Multimedia')
- documentation: 'A piano keyboard'!
Item was changed:
----- Method: PianoKeyboardMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+
+ whiteKeyColor _ Color gray: 0.95.
+ blackKeyColor _ Color black.
+ playingKeyColor _ Color red.
+ nOctaves _ 6.
-
- whiteKeyColor := Color gray: 0.95.
- blackKeyColor := Color black.
- playingKeyColor := Color red.
- nOctaves := 6.
self buildKeyboard.
+ soundPrototype _ FMSound brass1 duration: 9.9.
+ frequency _ 0.
+ soundPrototype _ FMSound new.
+ allowingChord _ false. "Sorry!!"
+ soundPlayingList _ Array new: self submorphs size.
+ !
- soundPrototype := FMSound brass1 duration: 9.9!
Item was changed:
----- Method: PolygonMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: PolygonMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-instance creation') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {DescriptionForPartsBin
+ formalName: 'Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.' translatedNoop
- formalName: 'Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.'
globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #arrowPrototype.
+ DescriptionForPartsBin
+ formalName: 'Triangle' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A three-sided polygon.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #trianglePrototype.
+
+ DescriptionForPartsBin
+ formalName: 'Curve' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A smooth wiggly curve, or a curved solid. Shift-click to get handles and move the points. Using the halo menu, can be coverted into a polygon, and can be made "open" rather than closed.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #curvePrototype.
+ }
+
+
- nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFlaps (in category 'the buttons') -----
buttonFlaps
^self inFlapsSuppressedMode ifTrue: [
+ self makeButton: 'Show tabs' translated balloonText: 'Show tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Show tabs' balloonText: 'Show tabs' for: #toggleFlapsSuppressed
] ifFalse: [
+ self makeButton: 'Hide tabs' translated balloonText: 'Hide tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Hide tabs' balloonText: 'Hide tabs' for: #toggleFlapsSuppressed
].
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFullScreen (in category 'the buttons') -----
buttonFullScreen
^self inFullScreenMode ifTrue: [
+ self makeButton: 'Browser Reentry' translated balloonText: 'Re-enter the browser' translated for: #fullScreenOff
- self makeButton: 'Browser Reentry' balloonText: 'Re-enter the browser' for: #fullScreenOff
] ifFalse: [
+ self makeButton: 'Escape Browser' translated balloonText: 'Use the full screen' translated for: #fullScreenOn
- self makeButton: 'Escape Browser' balloonText: 'Use the full screen' for: #fullScreenOn
]
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonGoTo (in category 'the buttons') -----
buttonGoTo
+ ^self makeButton: 'GO TO' translated balloonText: 'Go to another project' translated for: #gotoAnother
- ^self makeButton: 'GO TO' balloonText: 'Go to another project' for: #gotoAnother
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewProject (in category 'the buttons') -----
buttonNewProject
+ ^self makeButton: 'NEW' translated balloonText: 'Start a new project' translated for: #newProject
- ^self makeButton: 'NEW' balloonText: 'Start a new project' for: #newProject
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewer (in category 'the buttons') -----
buttonNewer
+ ^self makeButton: 'Newer?' translated balloonText: 'Is there a newer version of this project ?' translated for: #getNewerVersionIfAvailable!
- ^self makeButton: 'Newer?' balloonText: 'Is there a newer version of this project ?' for: #getNewerVersionIfAvailable!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNext (in category 'the buttons') -----
buttonNext
+ ^self makeButton: 'NEXT >' translated balloonText: 'Next project' translated for: #nextProject!
- ^self makeButton: 'NEXT >' balloonText: 'Next project' for: #nextProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPaint (in category 'the buttons') -----
buttonPaint
| pb oldArgs brush myButton m |
+ myButton _ self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting.
+ pb _ PaintBoxMorph new submorphNamed: #paint:.
- myButton := self makeButton: '' balloonText: 'Make a painting' for: #doNewPainting.
- pb := PaintBoxMorph new submorphNamed: #paint:.
pb ifNil: [
+ (brush _ Form extent: 16@16 depth: 16) fillColor: Color red
- (brush := Form extent: 16@16 depth: 16) fillColor: Color red
] ifNotNil: [
+ oldArgs _ pb arguments.
+ brush _ oldArgs third.
+ brush _ brush copy: (2@0 extent: 42@38).
+ brush _ brush scaledToSize: brush extent // 2.
- oldArgs := pb arguments.
- brush := oldArgs third.
- brush := brush copy: (2@0 extent: 42@38).
- brush := brush scaledToSize: brush extent // 2.
].
+ myButton addMorph: (m _ brush asMorph lock).
- myButton addMorph: (m := brush asMorph lock).
myButton extent: m extent + (myButton borderWidth + 6).
m position: myButton center - (m extent // 2).
^myButton
+ "brush _ (ScriptingSystem formAtKey: 'Painting')."
- "brush := (ScriptingSystem formAtKey: 'Painting')."
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPrev (in category 'the buttons') -----
buttonPrev
+ ^self makeButton: '< PREV' translated balloonText: 'Previous project' translated for: #previousProject!
- ^self makeButton: '< PREV' balloonText: 'Previous project' for: #previousProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonQuit (in category 'the buttons') -----
buttonQuit
+ "Make and answer a button whose pressing will result in quitting out of Squeak."
+ ^self makeButton: 'QUIT' translated balloonText: 'Quit Etoys (without saving)' translated for: #quitSqueak
- ^self makeButton: 'QUIT' balloonText: 'Quit Squeak altogether' for: #quitSqueak
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonTell (in category 'the buttons') -----
buttonTell
+ ^self makeButton: 'Tell!!' translated balloonText: 'Tell a friend about this project' translated for: #tellAFriend
- ^self makeButton: 'Tell!!' balloonText: 'Tell a friend about this project' for: #tellAFriend
!
Item was changed:
----- Method: ProjectNavigationMorph>>fontForButtons (in category 'as yet unclassified') -----
fontForButtons
+ ^ Preferences standardButtonFont!
-
- ^TextStyle defaultFont!
Item was changed:
----- Method: ProjectNavigationMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self layoutInset: 6;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
useRoundedCorners.
+ mouseInside _ false.
+ !
- mouseInside := false.
- self addButtons!
Item was changed:
----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'as yet unclassified') -----
makeButton: aString balloonText: anotherString for: aSymbol
- self flag: #yo.
- "In principle, this method shouldn't call #translated."
-
^ SimpleButtonDelayedMenuMorph new target: self;
borderColor: #raised;
color: self colorForButtons;
+ label: aString font: self fontForButtons;
+ setBalloonText: anotherString;
- label: aString translated font: self fontForButtons;
- setBalloonText: anotherString translated;
actionSelector: aSymbol!
Item was changed:
----- Method: ProjectNavigationMorph>>publishDifferent (in category 'the actions') -----
publishDifferent
self
+ publishStyle: #initialDirectoryListForProjects
- publishStyle: #initialDirectoryList
forgetURL: true
withRename: false
!
Item was changed:
----- Method: ProjectNavigationMorph>>publishStyle:forgetURL:withRename: (in category 'the actions') -----
publishStyle: aSymbol forgetURL: aBoolean withRename: renameBoolean
| w saveOwner primaryServer rename |
+ w _ self world ifNil: [^Beeper beep].
- w := self world ifNil: [^Beeper beep].
w setProperty: #SuperSwikiPublishOptions toValue: aSymbol.
+ primaryServer _ w project primaryServerIfNil: [nil].
+ rename _ ((primaryServer notNil
- primaryServer := w project primaryServerIfNil: [nil].
- rename := ((primaryServer notNil
and: [primaryServer acceptsUploads]) not)
or: [renameBoolean].
+ rename := rename or: [(primaryServer isKindOf: DAVMultiUserServerDirectory)].
w setProperty: #SuperSwikiRename toValue: rename.
+ saveOwner _ owner.
- saveOwner := owner.
self delete.
[w project
storeOnServerShowProgressOn: self
forgetURL: aBoolean | rename]
ensure: [saveOwner addMorphFront: self]!
Item was changed:
+ ----- Method: ProjectSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: ProjectSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
- | b r partsBinButton newButton |
+ | b r partsBinButton newButton aWrapper |
+ newButton _ ImageMorph new image: (World project makeThumbnail scaledToSize: 48@36).
- newButton := ImageMorph new image: (World project makeThumbnail scaledToSize: 24@18).
newButton on: #mouseDown send: #insertNewProject: to: self.
newButton setBalloonText: 'Make a new Project' translated.
+ (partsBinButton _ UpdatingThreePhaseButtonMorph checkBox)
- (partsBinButton := UpdatingThreePhaseButtonMorph checkBox)
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ (r _ AlignmentMorph newRow)
- (r := AlignmentMorph newRow)
color: Color transparent;
borderWidth: 0;
layoutInset: 0;
+ cellInset: 10@0;
wrapCentering: #center;
+ cellPositioning: #leftCenter;
- cellPositioning: #topCenter;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5@5.
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- r addMorphBack: (self wrapperFor: (b label: 'Okay' translated; actionSelector: #acceptSort)).
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete));
- r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated; actionSelector: #delete));
- addMorphBack: (self wrapperFor: (newButton));
addTransparentSpacerOfSize: 8 @ 0;
+ addMorphBack: (self wrapperFor: (newButton));
+ addTransparentSpacerOfSize: 8 @ 0.
+
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
addMorphBack: (self wrapperFor: partsBinButton);
+ addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons) lock).
+ r addMorphBack: aWrapper.
- addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated) lock).
self addMorphFront: r.
!
Item was changed:
----- Method: ProjectSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
super initialize.
- ""
self useRoundedCorners.
pageHolder useRoundedCorners; borderWidth: 0;
color: (self
gridFormOrigin: 0 @ 0
+ grid: ScriptingSystem sorterGridSize
- grid: 16 @ 16
background: Color white
line: Color blue muchLighter)!
Item was changed:
----- Method: ProjectSorterMorph>>sorterMorphForProjectNamed: (in category 'as yet unclassified') -----
sorterMorphForProjectNamed: projName
| pvm proj |
+ (proj _ Project named: projName) ifNil: [^nil].
+ pvm _ (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
- (proj := Project named: projName) ifNil: [^nil].
- pvm := (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
pvm setProperty: #nameOfThisProject toValue: projName.
+ pvm isOpaque: true.
pvm setBalloonText: projName.
pvm on: #mouseDown send: #clickFromSorterEvent:morph: to: self.
pvm on: #mouseUp send: #clickFromSorterEvent:morph: to: self.
^pvm
!
Item was changed:
----- Method: RealEstateAgent class>>reduceByFlaps: (in category '*MorphicExtras-utilities') -----
reduceByFlaps: aScreenRect
"Return a rectangle that won't interfere with default shared flaps"
Flaps sharedFlapsAllowed ifFalse: [^ aScreenRect copy].
(Flaps globalFlapTabsIfAny allSatisfy:
[:ft | ft flapID = 'Painting' translated or: [ft edgeToAdhereTo == #bottom]])
ifTrue: [^ aScreenRect withHeight: aScreenRect height - 18]
+ ifFalse: [^ aScreenRect insetBy: 64]!
- ifFalse: [^ aScreenRect insetBy: 18]!
Item was changed:
----- Method: RecordingControlsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.'}
- cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: RecordingControlsMorph>>addButtonRows (in category 'initialization') -----
addButtonRows
+ | r fullWidth |
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- | r |
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Morph' translated action: #makeSoundMorph).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Tile' translated action: #makeTile).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Trim' translated action: #trim).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Show' translated action: #showEditor).
- r addMorphBack: (self buttonName: 'Show' translated action: #show).
self addMorphBack: r.
+ r layoutChanged.
+ fullWidth := r fullBounds width.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Record' translated action: #record).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Stop' translated action: #stop).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Play' translated action: #playback).
+ r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Codec' translated action: #chooseCodec).
r addMorphBack: self makeStatusLight.
self addMorphBack: r.
+ self changeCodec: OggSpeexCodec name: 'Speex'.
+ r layoutChanged.
+ fullWidth := fullWidth max: r fullBounds width.
+ ^ fullWidth@(r fullBounds height).
!
Item was changed:
----- Method: RecordingControlsMorph>>buttonName:action: (in category 'other') -----
buttonName: aString action: aSymbol
^ SimpleButtonMorph new
target: self;
+ label: aString font: Preferences standardButtonFont;
- label: aString;
actionSelector: aSymbol
!
Item was changed:
----- Method: RecordingControlsMorph>>initialize (in category 'initialization') -----
initialize
+ | r full |
- | r |
super initialize.
self hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ borderWidth _ 2.
- borderWidth := 2.
self listDirection: #topToBottom.
+ recorder _ SoundRecorder new.
+ full := self addButtonRows.
+ self addRecordLevelSliderIn: full.
- recorder := SoundRecorder new.
- self addButtonRows.
- self addRecordLevelSlider.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
+ r addMorphBack: (self makeRecordMeterIn: full).
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
- r addMorphBack: self makeRecordMeter.
self addMorphBack: r.
self extent: 10@10. "make minimum size"
!
Item was changed:
----- Method: RectangleMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RectangleMorph, #roundRectPrototype, 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: RectangleMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundRect' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A rectangle with rounded corners' translatedNoop
- formalName: 'RoundRect'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with rounded corners'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #roundRectPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a horizontal gradient' translatedNoop
- formalName: 'Gradient'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a horizontal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #gradientPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient (slanted)' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a diagonal gradient' translatedNoop
- formalName: 'Gradient (slanted)'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a diagonal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #diagonalPrototype}!
Item was changed:
----- Method: ReferenceMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'ref' translatedNoop!
- ^ 'ref'!
Item was changed:
----- Method: ScrollableField class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Info for build parts-bin entries."
+
+ ^ self partName: 'Scrolling Text' translatedNoop
+ categories: #(Basic)
+ documentation: 'A scrollable, editable body of text' translatedNoop!
- ^ self partName: 'Scrolling Text'
- categories: #('Text' )
- documentation: 'A scrollable, editable body of text'!
Item was changed:
----- Method: ScrollableField class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
forFlapNamed: 'Stack Tools'.]!
Item was changed:
----- Method: SelectorBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SelectorBrowser. #prototypicalToolWindow. 'Method Finder' translatedNoop. 'A tool for discovering methods by providing sample values for arguments and results' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results')
forFlapNamed: 'Tools']
!
Item was changed:
----- Method: SimpleSliderMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'Slider' translatedNoop!
- ^ 'Slider'!
Item was changed:
----- Method: SimpleSliderMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Slider' translatedNoop
+ categories: {'Basic' translatedNoop}
+ documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.' translatedNoop!
- ^ self partName: 'Slider'
- categories: #('Scripting')
- documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.'!
Item was changed:
----- Method: SimpleSliderMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: SimpleSliderMorph>>adjustToValue: (in category 'private') -----
adjustToValue: aNumber
"Adjust the position of this slider to correspond to the given value in the range minVal..maxVal."
"Details: Internal values are normalized to the range 0..1."
+ | toUse |
+ toUse := minVal = maxVal
+ ifTrue:
+ [minVal]
+ ifFalse:
+ [(aNumber - minVal) asFloat / (maxVal - minVal)].
+ self value: toUse
- self value:
- (aNumber - minVal) asFloat / (maxVal - minVal).
!
Item was changed:
----- Method: SimpleSliderMorph>>descendingString (in category 'menu') -----
descendingString
^ (self descending
+ ifTrue: ['switch to ascending' translatedNoop]
+ ifFalse: ['switch to descending' translatedNoop]) translated!
- ifTrue: ['switch to ascending']
- ifFalse: ['switch to descending']) translated!
Item was changed:
----- Method: SimpleSliderMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]!
Item was changed:
----- Method: SimpleSliderMorph>>truncateString (in category 'menu') -----
truncateString
^ (truncate
+ ifTrue: ['turn off truncation' translatedNoop]
+ ifFalse: ['turn on truncation' translatedNoop]) translated!
- ifTrue: ['turn off truncation']
- ifFalse: ['turn on truncation']) translated!
Item was changed:
----- Method: SketchEditorMorph>>addRotationScaleHandles (in category 'start & finish') -----
addRotationScaleHandles
"Rotation and scaling handles"
+ rotationButton _ SketchMorph withForm: (palette rotationTabForm).
- rotationButton := SketchMorph withForm: (palette rotationTabForm).
rotationButton position: bounds topCenter - (6@0).
rotationButton on: #mouseDown send: #rotateScalePrep: to: self.
rotationButton on: #mouseMove send: #rotateBy: to: self.
rotationButton on: #mouseUp send: #rotateDone: to: self.
rotationButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
rotationButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: rotationButton].
- self addMorph: rotationButton.
rotationButton setBalloonText: 'Drag me sideways to
rotate your
picture.' translated.
+ scaleButton _ SketchMorph withForm: (palette scaleTabForm).
- scaleButton := SketchMorph withForm: (palette scaleTabForm).
scaleButton position: bounds rightCenter - ((scaleButton width)@6).
scaleButton on: #mouseDown send: #rotateScalePrep: to: self.
scaleButton on: #mouseMove send: #scaleBy: to: self.
scaleButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
scaleButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: scaleButton].
- self addMorph: scaleButton.
scaleButton setBalloonText: 'Drag me up and down to change
the size
of your picture.' translated.
"REMOVED:
+ fwdButton _ PolygonMorph new.
+ pt _ bounds topCenter.
- fwdButton := PolygonMorph new.
- pt := bounds topCenter.
fwdButton borderWidth: 2; makeOpen; makeBackArrow; borderColor:
(Color r: 0 g: 0.8 b: 0).
fwdButton removeHandles; setVertices: (Array with: pt+(0@7) with:
pt+(0@22)).
fwdButton on: #mouseMove send: #forward:direction: to: self.
fwdButton on: #mouseEnter send: #mouseLeave: to: self.
fwdButton on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdButton toValue: fwdButton.
self addMorph: fwdButton.
fwdButton setBalloonText: 'Drag me around to point
in the direction
I go forward.' translated.
+ toggle _ EllipseMorph
- toggle := EllipseMorph
newBounds: (Rectangle center: fwdButton vertices last +
(-4@4) extent: 8@8)
color: Color gray.
toggle on: #mouseUp send: #toggleDirType:in: to: self.
toggle on: #mouseEnter send: #mouseLeave: to: self.
toggle on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdToggle toValue: toggle.
fwdButton addMorph: toggle.
toggle setBalloonText: 'When your object turns,
how should its
picture change?
It can rotate, face left or right,
face up or down, or not
change.' translated.
"
self setProperty: #rotationStyle toValue: hostView rotationStyle.
" self forward: hostView setupAngle direction: fwdButton. "
"Set to its current value"
!
Item was changed:
----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: (in category 'initialization') -----
initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph
+ "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
+
| aPaintBox newPaintBoxBounds worldBounds requiredWidth newOrigin aPosition aPal aTab paintBoxFullBounds |
+ (aTab _ self world paintingFlapTab) ifNotNil:
- (aTab := self world paintingFlapTab) ifNotNil:
[aTab showFlap.
^ self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: nil].
+ self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
+ aPaintBox _ self world paintBox.
+ worldBounds _ self world bounds.
+ requiredWidth _ aPaintBox width.
- aPaintBox := self world paintBox.
- worldBounds := self world bounds.
- requiredWidth := aPaintBox width.
+ aPosition _ (aPal _ aPasteUpMorph standardPalette)
- aPosition := (aPal := aPasteUpMorph standardPalette)
ifNotNil:
[aPal showNoPalette.
aPal topRight + (aPaintBox width negated @ 0 "aPal tabsMorph height")]
ifNil:
[boundsToUse topRight].
+ newOrigin _ ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
- newOrigin := ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
ifTrue: "will fit to right of aPasteUpMorph"
[aPosition]
ifFalse: "won't fit to right, try left"
[boundsToUse topLeft - (requiredWidth @ 0)].
+ paintBoxFullBounds _ aPaintBox maxBounds.
+ paintBoxFullBounds _ (newOrigin - aPaintBox offsetFromMaxBounds) extent:
- paintBoxFullBounds := aPaintBox maxBounds.
- paintBoxFullBounds := (newOrigin - aPaintBox offsetFromMaxBounds) extent:
paintBoxFullBounds extent.
+ newPaintBoxBounds _ paintBoxFullBounds translatedToBeWithin: worldBounds.
- newPaintBoxBounds := paintBoxFullBounds translatedToBeWithin: worldBounds.
self initializeFor: aSketchMorph inBounds: boundsToUse
pasteUpMorph: aPasteUpMorph
+ paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.
+ !
- paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.!
Item was changed:
----- Method: SketchEditorMorph>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "In the middle of drawing a stroke of any kind."
- "In the middle of drawing a stroke. 6/11/97 19:51 tk"
+ | pt priorEvt actionSelector |
- | pt priorEvt |
WorldState canSurrenderToOS: false. "we want maximum responsiveness"
pt := evt cursorPoint.
priorEvt := self get: #lastEvent for: evt.
(priorEvt notNil and: [pt = priorEvt cursorPoint]) ifTrue: [^self].
+ self perform: (actionSelector _ self getActionFor: evt) with: evt.
- self perform: (self getActionFor: evt) with: evt.
"Each action must do invalidRect:"
self
set: #lastEvent
for: evt
to: evt.
+ "If recording painting, mark these events so they will not be condensed. The actual path the brush takes is important."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: actionSelector]].
false
ifTrue:
["So senders will find the things performed here"
self
paint: nil;
fill: nil;
erase: nil;
pickup: nil;
stamp: nil.
self
rect: nil;
ellipse: nil;
polygon: nil;
line: nil;
star: nil]!
Item was changed:
----- Method: SketchEditorMorph>>mouseUp: (in category 'event handling') -----
mouseUp: evt
| myAction |
"Do nothing except those that work on mouseUp."
+ myAction _ self getActionFor: evt.
- myAction := self getActionFor: evt.
myAction == #fill: ifTrue: [
self perform: myAction with: evt.
"Each action must do invalidRect:"
].
myAction == #pickup: ifTrue: [
self pickupMouseUp: evt].
myAction == #polygon: ifTrue: [self polyEdit: evt]. "a mode lets you drag vertices"
self set: #lastEvent for: evt to: nil.
+ "If recording painting, note that we stopped a stroke. OK to condense points."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: #mouseUp:]].
!
Item was changed:
----- Method: SketchEditorMorph>>paint: (in category 'actions & preps') -----
paint: evt
"While the mouse is down, lay down paint, but only within window bounds.
11/28/96 sw: no longer stop painting when pen strays out of window; once it comes back in, resume painting rather than waiting for a mouse up"
+ | mousePoint startToEnd pfPen newPoint |
+ pfPen _ self get: #paintingFormPen for: evt.
+ mousePoint _ evt cursorPoint.
+ newPoint _ mousePoint - bounds origin.
+ startToEnd _ pfPen regionFor: newPoint.
+ evt shiftPressed
+ ifTrue: [pfPen gotoBack: newPoint]
+ ifFalse: [pfPen goto: newPoint].
- | mousePoint startRect endRect startToEnd pfPen myBrush |
-
- pfPen := self get: #paintingFormPen for: evt.
- myBrush := self getBrushFor: evt.
- mousePoint := evt cursorPoint.
- startRect := pfPen location + myBrush offset extent: myBrush extent.
- pfPen goto: mousePoint - bounds origin.
- endRect := pfPen location + myBrush offset extent: myBrush extent.
- "self render: (startRect merge: endRect). Show the user what happened"
- startToEnd := startRect merge: endRect.
self invalidRect: (startToEnd translateBy: bounds origin).
!
Item was changed:
----- Method: SoundEventMorph>>releaseCachedState (in category 'caching') -----
releaseCachedState
super releaseCachedState.
+ sound isCompressed
+ ifFalse: [sound _ sound compressWith: GSMCodec].
- sound := sound compressWith: GSMCodec.
!
Item was changed:
----- Method: SquishedNameMorph>>fontForName (in category 'as yet unclassified') -----
fontForName
+ ^(TextStyle default fontOfSize: 15) emphasized: 1
- | pickem |
- pickem := 3.
-
- pickem = 1 ifTrue: [
- ^(((TextStyle named: #Helvetica) ifNil: [TextStyle default]) fontOfSize: 13) emphasized: 1.
- ].
- pickem = 2 ifTrue: [
- ^(((TextStyle named: #Palatino) ifNil: [TextStyle default]) fontOfSize: 12) emphasized: 1.
- ].
- ^((TextStyle default) fontAt: 1) emphasized: 1
!
Item was changed:
----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}
- cl registerQuad: #(ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop}
- cl registerQuad: #(ScriptingSystem holderWithAlphabet 'Alphabet' 'A source for single-letter objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: StarMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Star' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'A symmetrical polygon in the shape of a star' translatedNoop!
- ^ self partName: 'Star'
- categories: #('Graphics')
- documentation: 'A symmetrical polygon in the shape of a star'!
Item was changed:
----- Method: StarMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: StickyPadMorph class>>defaultNameStemForInstances (in category 'parts bin') -----
defaultNameStemForInstances
"Answer the default name stem to use"
+ ^ 'tear off' translatedNoop
+ !
- ^ 'tear off'!
Item was changed:
----- Method: StickyPadMorph class>>descriptionForPartsBin (in category 'parts bin') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StickyPadMorph class>>launchPartVia:label: (in category 'parts bin') -----
launchPartVia: aSelector label: aString
"Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins. Overridden here so that all instances will be given the name, unlike the prevailing convention for other object types"
| aMorph |
+ aMorph _ self perform: aSelector.
- aMorph := self perform: aSelector.
aMorph setNameTo: self defaultNameStemForInstances. "i.e., circumvent uniqueness in this case"
aMorph setProperty: #beFullyVisibleAfterDrop toValue: true.
+ aMorph openInHand.
+ ^ aMorph!
- aMorph openInHand!
Item was changed:
----- Method: StickyPadMorph class>>registerInFlapsRegistry (in category 'as yet unclassified') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: StoryboardBookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Storyboard' translatedNoop
+ categories: #()
+ documentation: 'A storyboard authoring tool' translatedNoop!
- ^ self partName: 'Storyboard'
- categories: #('Presentation')
- documentation: 'A storyboard authoring tool'!
Item was changed:
----- Method: StringButtonMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'SButton' translatedNoop!
- ^ 'SButton'!
Item was changed:
----- Method: StringButtonMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]
ifFalse: [nil]!
Item was changed:
----- Method: TabMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tab' translatedNoop!
- ^ 'tab'!
Item was changed:
+ ----- Method: TabSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: TabSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
| b r |
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r _ AlignmentMorph newRow.
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r := AlignmentMorph newRow.
r color: b color; borderWidth: 0; layoutInset: 0.
r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
r wrapCentering: #topLeft.
+ r addMorphBack: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort).
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #cancelSort).
- r addMorphBack: (b label: 'Okay'; actionSelector: #acceptSort).
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (b label: 'Cancel'; actionSelector: #cancelSort).
self addMorphFront: r.
!
Item was changed:
----- Method: TabSorterMorph>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
self removeAllMorphs.
self extent: 300@100.
+ pageHolder _ PasteUpMorph new.
- pageHolder := PasteUpMorph new.
pageHolder vResizeToFit: true; autoLineLayout: true.
pageHolder extent: self extent - borderWidth.
pageHolder padding: 8.
pageHolder cursor: 0.
+ pageHolder wantsMouseOverHalos: false.
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: TabbedPalette class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tabbedPalette' translatedNoop!
- ^ 'tabbedPalette'!
Item was changed:
----- Method: TextMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {
DescriptionForPartsBin
+ formalName: 'Text (border)' translatedNoop
+ categoryList: #()
+ documentation: 'A text field with border' translatedNoop
- formalName: 'Text (border)'
- categoryList: #('Text')
- documentation: 'A text field with border'
globalReceiverSymbol: #TextMorph
nativitySelector: #borderedPrototype.
" DescriptionForPartsBin
+ formalName: 'Text (fancy)' translatedNoop
+ categoryList: {'Text' translatedNoop}
+ documentation: 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop
- formalName: 'Text (fancy)'
- categoryList: #('Text')
- documentation: 'A text field with a rounded shadowed border, with a fancy font.'
globalReceiverSymbol: #TextMorph
nativitySelector: #fancyPrototype."
DescriptionForPartsBin
+ formalName: 'Text' translatedNoop
+ categoryList: {'Basic' translatedNoop}
+ documentation:
+ 'A raw piece of text which you can edit into anything you want' translatedNoop
- formalName: 'Text'
- categoryList: #('Basic' 'Text')
- documentation: 'A raw piece of text which you can edit into anything you want'
globalReceiverSymbol: #TextMorph
+ nativitySelector: #nonwrappingPrototype.
- nativitySelector: #boldAuthoringPrototype.
}
!
Item was changed:
----- Method: Thumbnail>>makeThumbnailFromForm: (in category 'thumnail creation') -----
makeThumbnailFromForm: aForm
"Make a thumbnail from the form provided, obeying my min and max width and height preferences"
+ | scaleX scaleY margin opaque nominalWidth minimumWidth |
+ minimumWidth := self minimumWidth.
+ scaleY _ minimumHeight / aForm height. "keep height invariant"
+
+ scaleX _ ((nominalWidth := aForm width * scaleY) <= maximumWidth)
+ ifTrue:
+ [(nominalWidth < minimumWidth)
+ ifFalse:
+ [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
+ ifTrue:
+ [minimumWidth / aForm width]]
+ ifFalse:
+ [scaleY _ maximumWidth / aForm width].
- | scaleX scaleY margin opaque |
- scaleY := minimumHeight / aForm height. "keep height invariant"
- scaleX := ((aForm width * scaleY) <= maximumWidth)
- ifTrue: [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
- ifFalse: [scaleY := maximumWidth / aForm width].
"self form: (aForm magnify: aForm boundingBox by: (scaleX @ scaleY) smoothing: 2)."
"Note: A problem with magnify:by: fails to reproduce borders properly.
The following code does a better job..."
+ margin _ 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
+ opaque _ (Form extent: aForm extent + margin depth: 32) "fillWhite".
+ aForm displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
+ self form: ((opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2) fixAlpha).
- margin := 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
- opaque := (Form extent: aForm extent + margin depth: 32) "fillWhite".
- aForm fixAlpha displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
- opaque fixAlpha.
- self form: (opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2).
self extent: originalForm extent!
Item was changed:
----- Method: Thumbnail>>setStandardDefaultMetrics (in category 'initialization') -----
setStandardDefaultMetrics
"Provide the current choices for min.max width/height for thumbnails"
+ self maxWidth: 60 minHeight: 32.
+ self setProperty: #minimumWidth toValue: 16!
- self maxWidth: 60 minHeight: 24!
Item was changed:
----- Method: ThumbnailMorph>>step (in category 'stepping and presenter') -----
step
"Optimization: Don't redraw if we're viewing some kind of SketchMorph and its rotated Form hasn't changed."
| viewee f |
+ viewee _ self actualViewee.
+ viewee ifNil: [self stopStepping. ^ self].
+ viewee isSketchMorph
+ ifTrue:
+ [f := viewee rotatedForm.
+ f == lastSketchForm ifTrue: [^ self]. "The optimization"
+ lastSketchForm _ f]
+ ifFalse:
+ [lastSketchForm := nil]. "Avoids subtle bug if sketchMorph removed and then put back in"
+ self changed
- viewee := self actualViewee.
- viewee ifNil: [ self stopStepping. ^self ].
- (viewee isSketchMorph) ifTrue: [
- f := viewee rotatedForm.
- f == lastSketchForm ifTrue: [^ self].
- lastSketchForm := f].
- self changed.
!
Item was changed:
----- Method: TickIndicatorMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ self extent: 30 @ 30.
+ index _ 0!
- self extent: 20 @ 20.
- index := 0!
Item was changed:
----- Method: TransitionMorph class>>allEffects (in category 'available effects') -----
allEffects
+ #('none' 'slide over' 'slide both' 'slide away' 'slide border'
+ 'page forward' 'page back'
+ 'french door' 'zoom frame' 'zoom' 'dissolve') translatedNoop.
^ #(none
slideOver slideBoth slideAway slideBorder
pageForward pageBack
frenchDoor
zoomFrame zoom
dissolve)!
Item was changed:
----- Method: TransitionMorph class>>directionsForEffect: (in category 'available effects') -----
directionsForEffect: eff
"All these arrays are ordered so inverse is atWrap: size//2."
+ #('right' 'down right' 'down' 'down left' 'left' 'up left' 'up' 'up right'
+ 'in' 'in h' 'out' 'out h') translatedNoop.
+
(#(slideOver slideBoth slideAway slideBorder) includes: eff)
ifTrue: [^ #(right downRight down downLeft left upLeft up upRight)].
(#(pageForward pageBack) includes: eff)
ifTrue: [^ #(right down left up)].
(#(frenchDoor) includes: eff)
ifTrue: [^ #(in inH out outH)].
(#(zoomFrame zoom) includes: eff)
ifTrue: [^ #(in out)].
^ Array new!
Item was changed:
----- Method: TrashCanMorph class>>descriptionForPartsBin (in category 'miscellaneous') -----
descriptionForPartsBin
+ ^ self partName: 'Trash' translatedNoop
+ categories: { 'Basic' translatedNoop}
+ documentation: 'a tool for discarding objects' translatedNoop
+ sampleImageForm: (Form extent: 42@54 depth: 8 fromArray: #( 0 0 0 2555943 992034 555814414 587202599 654311424 0 0 0 0 0 654320418 550751400 2829625512 2829625512 2829625357 556007424 0 0 0 0 36 3553874600 2829155709 2105376125 2711726248 2829625512 2728926240 587212583 0 0 0 639882194 3433594237 1400339837 2107746472 2812848296 2829634764 2829623677 2820612864 640090112 0 0 3553809064 2097828727 2108216018 3537030348 3436367016 2829625548 3537021096 2105452577 603989760 0 9427 3537019218 22259922 4141011666 3536637138 4160212129 2712183208 2832398034 2709355944 539103014 0 2413266 3531411713 2110979575 3537031884 3435975671 4157384573 2812846461 2108216055 3430776189 488645135 654311424 651416310 2823946621 4160606930 3537030348 3539466451 2829559720 2829625506 2105398007 3534257533 2718769186 0 601019090 2097238994 4258452178 3537031891 4160213671 2812782760 2829559976 2105387218 4154948989 2099055886 254214144 4174566098 1392595922 4258452178 3537041442 3551045799 2829625512 2829625505 2105396471 3534257533 2098863648 606470144 4275229394 2097238696 4260811474 3536977959 3550980264 2829625512 2829558141 2108225271 2826796413 1998134560 589758464 584241874 3427991891 3438727890 3537031970 3433614504 2829625512 2829164961 3436377804 2709355901 1394154783 589692928 617861842 3534246674 1403572946 3537031890 3536627880 2829625512 2812848338 4157778045 2105376083 1394154527 587202560 265540306 3537030269 1397980584 2831994060 3435964584 2829625512 2831995602 3433594237 2105365330 1394154783 589758464 13871314 3537041106 2826796413 2105385640 2829559976 2829625548 3436367016 2709355901 1397902346 1394220320 606535680 639674536 2831995602 3537030312 2829625256 2829625512 2829634728 2829625469 2105365331 1280463699 186260768 606535680 1037224 2829625512 3436368594 3537030348 3433605288 2829625512 2709355895 1397967954 1376389715 404364814 254214144 9164 2829625512 2829166760 2829625512 2829625505 2709355901 1397951058 1280463370 173167480 421203235 637534208 35 2829625511 2711715197 2105376125 2105376119 1397969747 1397903954 168430156 1397954174 421339392 654311424 0 4174162088 2728492413 2105376125 2105374547 1397969747 1397969490 1280070483 2105350169 438182694 0 0 267898023 2829155709 2105376125 2104981331 1397969747 1397902346 1397979005 2105376282 455025703 0 0 16241320 2832387239 2105376125 2004318035 1397969747 1397980541 2104982910 2105350427 471928576 0 0 653775528 2832388812 2712119464 2829221245 2728960381 2105387170 2104982910 2105350683 488701990 0 0 16700071 2832388818 2829625548 3433603489 2829625469 2105387170 2104982909 2105350683 504233984 0 0 2413224 2815218380 2829559976 3433594237 2829625469 2105387176 2104982910 2105416476 220266496 0 0 2413516 2815218386 2812782760 2829614461 2829625469 2105387176 2104982909 2105416476 220341760 0 0 2413516 2815218386 2829166796 2829623677 2829625469 2105387176 2104982909 2105416733 522397440 0 0 54226 2829636306 2810030284 3433605245 2829625469 2105385640 2104982910 2105416733 522397440 0 0 2619346 2829636306 2829166760 2829625469 2829625505 2105385634 2104982945 2097945629 522462976 0 0 65234 2812859090 2829166760 3433604989 2829625469 2105387176 2104982945 2097945629 539240192 0 0 8914 2829636306 2829166760 3433605245 2829625505 2105387176 2104982945 2098797853 537863936 0 0 9427 2829634770 3433539752 3433604989 2829625505 2105387176 2104982946 2098797597 554641152 0 0 211 3433549010 3433146536 3433605245 2728962209 2105387176 2104983208 2098863389 553658112 0 0 9975 3433539794 3433144744 2829625213 2728962209 2105387176 2104983208 2098863134 234881024 0 0 10238 3433539794 3534201256 3435964321 2712184993 2105387176 2104983202 2115640350 234891008 0 0 35 3534203090 3534266792 3435964577 2108205217 2105387176 2104982946 2115705886 234881024 0 0 36 3550980306 3534268328 2831984801 2108205223 2105385640 2104982946 2115706142 570425344 0 0 0 3551045836 3534266792 2831984801 2108205224 2105385640 2105376161 2115705869 572915712 0 0 38 4155025356 3534266792 2831984801 2108205224 2105385640 2105376161 2115706125 572915712 0 0 39 4174162088 3536626088 2831984801 2108205224 2105385640 2105376126 2115771661 589758464 0 0 0 583837608 3536626087 2831984801 2108205224 2105387176 2105376161 2115771679 589692928 0 0 0 601006503 3537020839 2831984807 2108205224 2102623656 2105385342 2719751456 254214144 0 0 0 617850792 3537020833 2831984808 2108214440 2097238952 2105387170 438111502 0 0 0 0 668191948 3537021095 2829634727 2108205224 2097238952 2726142590 471736591 654311424 0 0 0 2282194 3537020833 2829634728 2711726248 2097238690 2826796314 220275750 0 0 0 0 63442 3537021095 2832387240 2107746472 2709355937 2105350686 539168550 640090112 0 0 0 211 3537030312 3536627879 2712194216 2815677352 2820414989 555885347 588195584 0 0 0 39 584307410 3433605288 2812848295 2714576126 3542093084 504176397 521015079 0 0 0 0 8992 3553414312 2829625512 2820673060 3553470632 2829589020 488579879 0 0 0 0 39 991758 235807524 2564819 3433605288 2829614621 220270375 0 0 0 0 0 0 0 2140364 3536627880 2709356064 571418112 0 0 0 0 0 0 0 581478568 3433605246 2719813120 640090112 0 0 0 0 0 0 0 13880488 2829589793 603989798 0 0 0 0 0 0 0 0 991758 570435111 654311424 0 0) offset: 0@0)!
- ^ self partName: 'Trash'
- categories: #('Useful' 'Basic')
- documentation: 'a tool for discarding objects'!
Item was changed:
----- Method: TrashCanMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'viewerFlapTab' translatedNoop!
- ^ 'viewerFlapTab'!
Item was changed:
----- Method: WaveEditor class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'WaveEditor' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A workbench for seing and editing wave forms' translatedNoop!
- ^ self partName: 'WaveEditor'
- categories: #('Multimedia')
- documentation: 'A workbench for seing and editing wave forms'!
Item was changed:
----- Method: WaveEditor>>addControls (in category 'initialization') -----
addControls
+ | slider aWrapper m aButton |
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: Color transparent;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ extent: 5 @ 5.
+ aWrapper wrapCentering: #topLeft.
+ aButton := self buttonName: 'X' action: #delete.
+ aButton setBalloonText: 'Close WaveEditor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Menu' translated action: #invokeMenu.
+ aButton setBalloonText: 'Open a menu' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play' translated action: #play.
+ aButton setBalloonText: 'Play sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor.
+ aButton setBalloonText: 'Play before cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play After' translated action: #playAfterCursor.
+ aButton setBalloonText: 'Play after cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Loop' translated action: #playLoop.
+ aButton setBalloonText: 'Play the loop' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Test' translated action: #playTestNote.
+ aButton setBalloonText: 'Test the note' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Save' translated action: #saveInstrument.
+ aButton setBalloonText: 'Save the sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd.
+ aButton setBalloonText: 'Set loop end at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle.
+ aButton setBalloonText: 'Set one cycle' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart.
+ aButton setBalloonText: 'Set the loop start at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ self addMorphBack: aWrapper.
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: self color;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #spaceFill;
+ vResizing: #rigid;
+ extent: 5 @ 20;
+ wrapCentering: #center;
+ cellPositioning: #leftCenter.
+ m := StringMorph new contents: 'Index: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #cursor;
+ putSelector: #cursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 71;
+ step.
+ aWrapper addMorphBack: m.
+ m := StringMorph new contents: 'Value: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #valueAtCursor;
+ putSelector: #valueAtCursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 50;
+ step.
+ aWrapper addMorphBack: m.
+ slider := SimpleSliderMorph new color: color;
+ extent: 200 @ 10;
+ target: self;
+ actionSelector: #scrollTime:.
+ aWrapper addMorphBack: slider.
+ m := Morph new color: aWrapper color;
+ extent: 10 @ 5.
+ "spacer"
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #startIndex;
+ putSelector: #startIndex:;
+ font: Preferences standardEToysButtonFont;
+ width: 40;
+ step.
+ aWrapper addMorphBack: m.
+ self addMorphBack: aWrapper!
- | slider bb r m |
- r := AlignmentMorph newRow.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r color: bb color; borderWidth: 0; layoutInset: 0.
- r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
- r wrapCentering: #topLeft.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'X'; actionSelector: #delete).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: '<>'; actWhen: #buttonDown;
- actionSelector: #invokeMenu).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play' translated; actionSelector: #play).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Before' translated; actionSelector: #playBeforeCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play After' translated; actionSelector: #playAfterCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Loop' translated; actionSelector: #playLoop).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Test' translated; actionSelector: #playTestNote).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Save' translated; actionSelector: #saveInstrument).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop End' translated; actionSelector: #setLoopEnd).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'One Cycle' translated; actionSelector: #setOneCycle).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop Start' translated; actionSelector: #setLoopStart).
- self addMorphBack: r.
-
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
-
- m := StringMorph new contents: 'Index: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #cursor; putSelector: #cursor:;
- growable: false; width: 71; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Value: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:;
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- slider := SimpleSliderMorph new
- color: color;
- extent: 200@2;
- target: self;
- actionSelector: #scrollTime:.
- r addMorphBack: slider.
-
- m := Morph new color: r color; extent: 10@5. "spacer"
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #startIndex; putSelector: #startIndex:;
- width: 40; step.
- r addMorphBack: m.
-
- self addMorphBack: r.
-
- !
Item was changed:
----- Method: WaveEditor>>addLoopPointControls (in category 'initialization') -----
addLoopPointControls
+ | m aWrapper |
+ aWrapper _ AlignmentMorph newRow.
+ aWrapper color: self color; borderWidth: 0; layoutInset: 0.
+ aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
- | r m |
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
+ m _ StringMorph new contents: 'Loop end: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- m := StringMorph new contents: 'Loop end: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopEnd; putSelector: #loopEnd:;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop length: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopLength; putSelector: #loopLength:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop cycles: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopCycles; putSelector: #loopCycles:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Frequency: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Frequency: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
- growable: false; width: 50; step.
- r addMorphBack: m.
+ self addMorphBack: aWrapper
- self addMorphBack: r.
!
Item was changed:
----- Method: WaveEditor>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ samplingRate _ SoundPlayer samplingRate.
+ loopEnd _ loopLength _ 0.
+ loopCycles _ 1.
+ perceivedFrequency _ 0.
- samplingRate := SoundPlayer samplingRate.
- loopEnd := loopLength := 0.
- loopCycles := 1.
- perceivedFrequency := 0.
"zero means unknown"
self extent: 5 @ 5;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ graph _ GraphMorph new extent: 450 @ 100.
- graph := GraphMorph new extent: 450 @ 100.
graph cursor: 0.
graph cursorColorAtZeroCrossings: Color blue.
self addControls.
self addLoopPointControls.
self addMorphBack: graph.
self
addMorphBack: (Morph
newBounds: (0 @ 0 extent: 0 @ 3)
color: Color transparent).
+ self addMorphBack: (keyboard _ PianoKeyboardMorph new).
+ "self sound: (SampledSound soundNamed: 'croak')."
- self addMorphBack: (keyboard := PianoKeyboardMorph new).
- self sound: (SampledSound soundNamed: 'croak').
!
Item was changed:
----- Method: Workspace class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#Workspace. #prototypicalToolWindow. 'Workspace' translatedNoop. 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.' translatedNoop} forFlapNamed: 'Tools'.]!
- ifPresent: [:cl | cl registerQuad: #(Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')
- forFlapNamed: 'Tools'.]!
1
0
Tim Felgentreff uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-tfel.184.mcz
==================== Summary ====================
Name: MorphicExtras-tfel.184
Author: tfel
Time: 5 August 2016, 3:54:33.670259 pm
UUID: 86b16c11-f6d6-2f47-9d66-7728dcea9cf1
Ancestors: MorphicExtras-tfel.183
translation
=============== Diff against MorphicExtras-tfel.178 ===============
Item was changed:
----- Method: AlignmentMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Extra items for parts bins"
^ {DescriptionForPartsBin
+ formalName: 'Column' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a column' translatedNoop
- formalName: 'Column'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a column'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #columnPrototype.
DescriptionForPartsBin
+ formalName: 'Row' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a row' translatedNoop
- formalName: 'Row'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a row'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #rowPrototype}!
Item was changed:
+ ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'olpc support') -----
+ fancyText: aString font: aFont color: aColor
+ "Answer a morph containing a TextMorph containing the given string in the given font with the given color."
+
+ | answer tm |
+ answer _ self inAColumn: {
+ tm _ TextMorph new
+ textColor: aColor;
+ contents: aString;
+ beAllFont: aFont;
+ yourself
+ }.
+
- ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'as yet unclassified') -----
- fancyText: aString font: aFont color: aColor
- | answer tm col |
- col := ColorTheme current dialog3DTitles
- ifTrue: [aColor]
- ifFalse: [aColor negated].
- tm := TextMorph new.
- tm beAllFont: aFont;
- color: col;
- contents: aString.
- answer := self inAColumn: {tm}.
- ColorTheme current dialog3DTitles
- ifTrue: [""
- tm addDropShadow.
- tm shadowPoint: 5 @ 5 + tm bounds center].
tm lock.
+ ^ answer
+ !
- ^ answer!
Item was changed:
----- Method: AlignmentMorphBob1>>inARow: (in category 'as yet unclassified') -----
inARow: aCollectionOfMorphs
| row |
row := AlignmentMorph newRow color: Color transparent;
vResizing: #shrinkWrap;
layoutInset: 2;
wrapCentering: #center;
cellPositioning: #leftCenter.
aCollectionOfMorphs
+ do: [:each | each ifNotNil: [row addMorphBack: each]].
- do: [:each | row addMorphBack: each].
^ row!
Item was changed:
----- Method: BOBTransformationMorph>>recomputeExtent (in category 'as yet unclassified') -----
recomputeExtent
| scalePt newScale theGreenThingie greenIBE myNewExtent |
submorphs isEmpty ifTrue: [^self extent].
+ worldBoundsToShow ifNil: [worldBoundsToShow _ self firstSubmorph bounds].
- worldBoundsToShow ifNil: [worldBoundsToShow := self firstSubmorph bounds].
worldBoundsToShow area = 0 ifTrue: [^self extent].
+ scalePt _ owner innerBounds extent / worldBoundsToShow extent.
+ newScale _ scalePt x min: scalePt y.
+ theGreenThingie _ owner.
+ greenIBE _ theGreenThingie innerBounds extent.
+ myNewExtent _ (greenIBE min: worldBoundsToShow extent * newScale) truncated.
- scalePt := owner innerBounds extent / worldBoundsToShow extent.
- newScale := scalePt x min: scalePt y.
- theGreenThingie := owner.
- greenIBE := theGreenThingie innerBounds extent.
- myNewExtent := (greenIBE min: worldBoundsToShow extent * newScale) truncated.
self
scale: newScale;
offset: worldBoundsToShow origin * newScale.
+ smoothing _ (newScale < 1.0) ifTrue: [1] ifFalse: [1].
- smoothing := (newScale < 1.0) ifTrue: [2] ifFalse: [1].
^myNewExtent!
Item was changed:
----- Method: BasicButton class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'button' translatedNoop!
- ^ 'button'!
Item was changed:
+ ----- Method: BasicButton>>label:font: (in category 'initialization') -----
- ----- Method: BasicButton>>label:font: (in category 'as yet unclassified') -----
label: aString font: aFontOrNil
+ "Set the receiver's label and font as indicated."
| oldLabel m aFont |
+ (oldLabel _ self findA: StringMorph)
- (oldLabel := self findA: StringMorph)
ifNotNil: [oldLabel delete].
+ aFont _ aFontOrNil ifNil: [Preferences standardEToysButtonFont].
+ m _ StringMorph contents: aString font: aFont.
- aFont := aFontOrNil ifNil: [Preferences standardButtonFont].
- m := StringMorph contents: aString font: aFont.
self extent: (m width + 6) @ (m height + 6).
m position: self center - (m extent // 2).
self addMorph: m.
m lock
!
Item was changed:
----- Method: BookMorph class>>alreadyInFromUrl: (in category 'url') -----
alreadyInFromUrl: aUrl
"Does a bookMorph living in some world in this image represent the same set of server pages? If so, don't create another one. It will steal pages from the existing one. Go delete the first one."
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world ifNotNil: [
+ self inform: 'This book is already open in some project' translated.
- self inform: 'This book is already open in some project'.
^ true]]]].
^ false!
Item was changed:
----- Method: BookMorph class>>authoringPrototype (in category 'scripting') -----
authoringPrototype
"Answer an instance of the receiver suitable for placing in a parts bin for authors"
| book |
+ book := self new initializeToStandAlone.
+ book markAsPartsDonor.
- book := self new markAsPartsDonor.
- book removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
- book borderWidth: 1; borderColor: Color black.
- book beSticky.
- book showPageControls; insertPage.
^ book!
Item was changed:
----- Method: BookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Book' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'Multi-page structures' translatedNoop
+ sampleImageForm: (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAAMgAAACgCAYAAABJ/yOpAAAABHNCSVQFBQUBSsjp7wAABMtJ
+ REFUeF7l3S2S4kAAgFEkEonkCEiOgEQikUgkEolEcgSOgEQiOcYcAZfdniqmpnaBkE43JHni
+ 7dZuzWR7m3z5ISHT6/X6hc/ne+TvL9fr1efz/cMPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5OhLI
+ 19eXz9dZfiA+nx+Iz+cH4vN1K5Dz+fxUEyaoCWP0xwAF8ntSy94l+NQL0IQx+mMAA3llop+9
+ AO+K49Nj9MeABfLqVujVrVTOvcYnx+iPAQwkxWTn3kI1YYz+GMBAckx4kw4lUo3RH4MfiB9I
+ hTHU/ZSbH0gLAsk54akmvuoYY+5LKxvjvTGkDCR2DKnnoq2RZAkkNo4cK2DKOGJv3Hw0xkdj
+ SB1IzBhyzEedSC6XS7Hf74vFYlGMx+Nit9uVfs9yufz++jrLaFwg75r0KmMsW/nkQKrMSexr
+ dTgc/vs/rlar0u/r9/vfkdRZRiMDecekvzrGV1Y+PZBX5yX2tTqdTsVmsymOx+PPir5er0uj
+ CoGE74ldRpZA6px7xK6Mud7OrLtSPhvjszHkCKTqGHLMQYpzkdvKXbb1D3uO0WhUaxmNDyTX
+ pKdeMXIFkvoQNXcgMfMQG0jZ1n84HP4cXsUuoxWB5Jj0sjGm3GprgZSN+x17kHA4Fb4mfG3n
+ 9yA5Jj3H4Y1/iBU3hhx7kHCuMRgMau+F/ED8QFobyLOt/2QyKebzee3zGP8Qyz/Eau0h1qOt
+ f7jWEd69Ctc7iD2If5Lun6RX2fqHi3/PDq86tQfx3+b13+atuvUPh1az2SzJO2H+hUL/QmEr
+ LhTermuELX5Y+cO/F84zwp/D34d3rX5fPd9ut7WW4d9q0pJbTVLOX5tvNbmdeIf7p+79frta
+ ftszhPOQ2GX4Nyu26GbFNgTSpDt6w02I0+nUv93dv93dv9390Qn6o4uD/gem/A9M+R+Y8j9R
+ 6H/k1v/Irf/QBv+hDf5DG/zH/viP/fHH4AfiPzjOH4MfiP/oUf/Ro/6jR/2HV/sPr/YfXu3/
+ +AOfzw/E5/MD8fn8QHy+pgfi8/k/BtqfDJ/PD8Tn8wPx+fxAfD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fzw/E5/MD8fn8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8QPx+fxAfD4/EJ/PD8Tn8wPx+fxAfL47ro3i
+ B+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8wPx+fxAfD4/EJ/PD8QPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5/EB8Pj8Qn88PxOfz
+ A/H5fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiB+Iz+cH4vP5gfg+o6P8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHw+PxCfz+cH4vP5gfh8fiA+nx+Iz+cH
+ 4vP5gfh8fiA+nx+Iz+cH4vP5gfiB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+
+ ID6fzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHy+jgXi8/nu+wM79mpMjbRBXAAAAABJRU5E
+ rkJggg==' readStream) readStream) nextImage!
- ^ self partName: 'Book'
- categories: #('Presentation')
- documentation: 'Multi-page structures'!
Item was changed:
----- Method: BookMorph class>>initialize (in category 'class initialization') -----
initialize
- FileList registerFileReader: self.
-
self registerInFlapsRegistry. !
Item was changed:
----- Method: BookMorph class>>isInWorld:withUrl: (in category 'url') -----
isInWorld: aWorld withUrl: aUrl
| urls bks short |
"If a book with this url is in the that (current) world, return it. Say if it is out or in another world."
+ urls _ OrderedCollection new.
+ bks _ OrderedCollection new.
- urls := OrderedCollection new.
- bks := OrderedCollection new.
aWorld allMorphsDo: [:aBook | (aBook isKindOf: BookMorph) ifTrue: [
bks add: aBook.
(urls add: (aBook valueOfProperty: #url)) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]]]]. "shortcut"
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]
ifFalse: [
+ self inform: 'Book may be open in some other project' translated.
- self inform: 'Book may be open in some other project'.
^ aBook]]]].
"if same book name, use it"
+ short _ (aUrl findTokens: '/') last.
- short := (aUrl findTokens: '/') last.
urls withIndexDo: [:kk :ind | (kk findTokens: '/') last = short ifTrue: [
^ bks at: ind]].
^ #out!
Item was changed:
----- Method: BookMorph class>>nextPageButton (in category 'scripting') -----
nextPageButton
+ "Answer a button that will take the user to the next page of its
+ enclosing book"
- "Answer a button that will take the user to the next page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #NextPage.
+ aButton target: aButton.
+ aButton actionSelector: #nextOwnerPage.
+ aButton arguments: #().
+ aButton setNameTo: 'previous'.
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #nextOwnerPage; label: '->'; color: Color yellow.
- aButton setNameTo: 'next'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>openFromFile: (in category 'fileIn/Out') -----
openFromFile: fullName
"Reconstitute a Morph from the selected file, presumed to be represent
a Morph saved via the SmartRefStream mechanism, and open it in an
appropriate Morphic world"
| book aFileStream |
Smalltalk verifyMorphicAvailability ifFalse: [^ self].
+ aFileStream _ FileStream readOnlyFileNamed: fullName.
+ book _ BookMorph new.
- aFileStream := FileStream oldFileNamed: fullName.
- book := BookMorph new.
book setProperty: #url toValue: aFileStream url.
book fromRemoteStream: aFileStream.
aFileStream close.
Smalltalk isMorphic
ifTrue: [ActiveWorld addMorphsAndModel: book]
ifFalse:
[book isMorph ifFalse: [^self inform: 'Can only load a single morph
+ into an mvc project via this mechanism.' translated].
- into an mvc project via this mechanism.'].
book openInWorld].
book goToPage: 1!
Item was changed:
----- Method: BookMorph class>>previousPageButton (in category 'scripting') -----
previousPageButton
+ "Answer a button that will take the user to the previous page of its
+ enclosing book"
- "Answer a button that will take the user to the previous page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #PrevPage.
+ aButton target: aButton.
+ aButton actionSelector: #previousOwnerPage.
+ aButton arguments: #().
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #previousOwnerPage; color: Color yellow; label: '<-'.
aButton setNameTo: 'previous'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BookMorph . #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'Supplies']!
Item was changed:
----- Method: BookMorph class>>serviceLoadAsBook (in category 'fileIn/Out') -----
serviceLoadAsBook
^ SimpleServiceEntry
provider: self
+ label: 'load as book' translatedNoop
- label: 'load as book'
selector: #openFromFile:
+ description: 'open as bookmorph' translatedNoop!
- description: 'open as bookmorph'!
Item was changed:
----- Method: BookMorph>>goToPageMorph:transitionSpec: (in category 'navigation') -----
goToPageMorph: newPage transitionSpec: transitionSpec
+ "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided."
+
| pageIndex aWorld oldPageIndex ascending tSpec readIn |
pages isEmpty ifTrue: [^self].
self setProperty: #searchContainer toValue: nil. "forget previous search"
self setProperty: #searchOffset toValue: nil.
self setProperty: #searchKey toValue: nil.
pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"].
readIn := newPage isInMemory not.
oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil].
ascending := (oldPageIndex isNil or: [newPage == currentPage])
ifTrue: [nil]
ifFalse: [oldPageIndex < pageIndex].
tSpec := transitionSpec ifNil:
["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec
ifAbsent:
[" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]].
self flag: #arNote. "Probably unnecessary"
(aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus].
currentPage ifNotNil: [currentPage updateCachedThumbnail].
self currentPage notNil
ifTrue:
[(((pages at: pageIndex) owner isKindOf: TransitionMorph)
and: [(pages at: pageIndex) isInWorld])
ifTrue: [^self "In the process of a prior pageTurn"].
self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts].
+ self removeViewersOnSubsIn: ActiveWorld presenter.
ascending ifNotNil:
["Show appropriate page transition and start new page when done"
currentPage stopStepping.
(pages at: pageIndex) position: currentPage position.
^(TransitionMorph
effect: tSpec second
direction: tSpec third
inverse: (ascending or: [transitionSpec notNil]) not)
showTransitionFrom: currentPage
to: (pages at: pageIndex)
in: self
whenStart: [self playPageFlipSound: tSpec first]
whenDone:
[currentPage
delete;
fullReleaseCachedState.
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrlInBook: self url.
currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page"
currentPage
delete;
fullReleaseCachedState].
+ self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage"
- self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
-
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrl.
+ currentPage sqkPage computeThumbnail "just store it"].
+ ActiveWorld ifNotNil: [ActiveWorld presenter flushPlayerListCache]!
- currentPage sqkPage computeThumbnail "just store it"]!
Item was changed:
----- Method: BookMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
+ super initializeToStandAlone.
+ self removeEverything; pageSize: 360@228; color: Color white.
- self initialize.
- self removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
self borderWidth: 1; borderColor: Color black.
self beSticky.
self showPageControls; insertPage.
^ self!
Item was changed:
----- Method: BookMorph>>pasteBookPage (in category 'menu') -----
pasteBookPage
+ "If the paste buffer has something to paste, paste it as a book page."
+
| aPage |
+ aPage _ self primaryHand objectToPaste.
+ aPage removeProperty: #revertKey.
- aPage := self primaryHand objectToPaste.
self insertPage: aPage pageSize: aPage extent atIndex: ((pages indexOf: currentPage) - 1).
"self goToPageMorph: aPage"!
Item was changed:
----- Method: BookMorph>>setNewPagePrototype (in category 'menu') -----
setNewPagePrototype
"Record the current page as the prototype to be copied when inserting new pages."
currentPage ifNotNil:
+ [newPagePrototype _ currentPage veryDeepCopy.
+ newPagePrototype removeProperty: #revertKey].
+ "When a new page is inserted, it will not have any original page to revert to. After author improves the new page, he can save it for later revert."
- [newPagePrototype := currentPage veryDeepCopy].
!
Item was changed:
+ ----- Method: BookPageSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: BookPageSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
+ | bb r str aCheckbox aWrapper |
+ r _ AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
+ r wrapCentering: #center; cellPositioning: #leftCenter;
- | bb r aButton str |
- r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
- r wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated.
+ r addTransparentSpacerOfSize: 12.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete)).
+ bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated; actionSelector: #acceptSort)).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated; actionSelector: #delete)).
+ "eliminate the parts-bin button on the book-page sorters...
+ r addTransparentSpacerOfSize: 24 @ 0.
+
+ aCheckbox := UpdatingThreePhaseButtonMorph checkBox.
+ aCheckbox
- r addTransparentSpacerOfSize: 8 @ 0.
- r addMorphBack: (self wrapperFor: (aButton := UpdatingThreePhaseButtonMorph checkBox)).
- aButton
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ str _ StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons.
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
+ addMorphBack: (self wrapperFor: aCheckbox);
+ addMorphBack: (self wrapperFor: str lock).
+ r addMorphBack: aWrapper."
- str := StringMorph contents: 'Parts bin' translated.
- r addMorphBack: (self wrapperFor: str lock).
+ self addMorphFront: r
- self addMorphFront: r.
!
Item was changed:
----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'as yet unclassified') -----
book: aBookMorph morphsToSort: morphList
+ | innerBounds scrollPane newHeight |
+ book _ aBookMorph.
+ newHeight _ self currentWorld height.
- | innerBounds |
- book := aBookMorph.
pageHolder removeAllMorphs.
pageHolder addAllMorphs: morphList.
pageHolder extent: pageHolder width@pageHolder fullBounds height.
+ innerBounds _ Rectangle merging: (morphList collect: [:m | m bounds]).
+ pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.
+ (pageHolder height > newHeight) ifTrue: [
+ scrollPane _ ScrollPane new.
+
+ self height: newHeight.
+ scrollPane model: pageHolder.
+ scrollPane extent: pageHolder width@(newHeight - aBookMorph submorphs first height - 28).
+ self addMorph: scrollPane inFrontOf: pageHolder.
+ scrollPane scroller addMorph: pageHolder.
+ scrollPane scrollBarOnLeft: false.
+ scrollPane retractable: false.
+ scrollPane hideHScrollBarIndefinitely: true.
+ scrollPane borderWidth: 1; borderColor: Color gray.
+ ].
+ !
- innerBounds := Rectangle merging: (morphList collect: [:m | m bounds]).
- pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.!
Item was changed:
----- Method: BookPageSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: Display extent - 100;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ pageHolder _ PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
- pageHolder := PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
pageHolder hResizing: #shrinkWrap.
+ pageHolder wantsMouseOverHalos: false.
"pageHolder cursor: 0."
"causes a walkback as of 5/25/2000"
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: BookPageThumbnailMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
| f |
super initialize.
+ flipOnClick _ false.
- ""
- flipOnClick := false.
+ f _ Form extent: 160@120 depth: Display depth.
- f := Form extent: 60 @ 80 depth: Display depth.
f fill: f boundingBox fillColor: color.
self form: f!
Item was changed:
----- Method: BooklikeMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
"This factoring allows subclasses to have different menu yet still use the super call for the rest of the metamenu."
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ aCustomMenu add: 'book...' translated target: self action: #invokeBookMenu.
+
+ "self addBookMenuItemsTo: aCustomMenu hand: aHandMorph"!
- self addBookMenuItemsTo: aCustomMenu hand: aHandMorph!
Item was changed:
----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') -----
currentPlayerDo: aBlock
| aPlayer aPage |
(aPage := self currentPage) ifNil: [^ self].
+ aPage allMorphsDo:[ :m|
+ (aPlayer := m player) ifNotNil:
+ [aBlock value: aPlayer]]!
- (aPlayer := aPage player) ifNotNil:
- [aBlock value: aPlayer]!
Item was changed:
----- Method: BooklikeMorph>>makePageControlsFrom: (in category 'page controls') -----
makePageControlsFrom: controlSpecs
"From the controlSpecs, create a set of page control and return them -- this method does *not* add the controls to the receiver."
| c col row |
c := (color saturation > 0.1) ifTrue: [color slightlyLighter] ifFalse: [color slightlyDarker].
col := AlignmentMorph newColumn.
col color: c; borderWidth: 0; layoutInset: 0.
col hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5.
row := AlignmentMorph newRow.
row color: c; borderWidth: 0; layoutInset: 0.
row hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5.
controlSpecs do: [:spec | | lastGuy b |
+ spec == #showDescription ifTrue: [row addMorphBack: self makeDescriptionViewer].
+ spec == #pageNumber ifTrue: [row addMorphBack: self makePageNumberItem].
+ spec == #spacer ifTrue: [row addTransparentSpacerOfSize: (10 @ 0)].
+ spec == #variableSpacer ifTrue: [
+ row addMorphBack: AlignmentMorph newVariableTransparentSpacer].
+ spec class == Array ifTrue: [
+ spec first isSymbol
+ ifTrue: [b := ThreePhaseButtonMorph labelSymbol: spec first]
+ ifFalse: [b := SimpleButtonMorph new borderWidth: 2;
+ borderColor: Color black; color: Color veryLightGray.
+ b label: spec first font: Preferences standardMenuFont].
+ b target: self; actionSelector: spec second; setBalloonText: spec third.
+ (spec atPin: 4) = #border
+ ifTrue: [b actWhen: #buttonDown]
+ ifFalse: [b borderWidth: 0]. "default is none"
+ row addMorphBack: b.
+ (((lastGuy _ spec last asLowercase) includesSubString: 'menu') or:
+ [lastGuy includesSubString: 'designations'])
+ ifTrue: [b actWhen: #buttonDown]]]. "pop up menu on mouseDown"
- spec == #spacer
- ifTrue:
- [row addTransparentSpacerOfSize: (10 @ 0)]
- ifFalse:
- [spec == #variableSpacer
- ifTrue:
- [row addMorphBack: AlignmentMorph newVariableTransparentSpacer]
- ifFalse:
- [b := SimpleButtonMorph new target: self; borderWidth: 1;
- borderColor: Color veryLightGray; color: c.
- b label: spec first;
- actionSelector: spec second;
- borderWidth: 0;
- setBalloonText: spec third.
- row addMorphBack: b.
- (((lastGuy := spec last asLowercase) includesSubstring: 'menu') or:
- [lastGuy includesSubstring: 'designations'])
- ifTrue: [b actWhen: #buttonDown]]]]. "pop up menu on mouseDown"
col addMorphBack: row.
^ col!
Item was changed:
----- Method: BooklikeMorph>>shortControlSpecs (in category 'page controls') -----
shortControlSpecs
+ "Answer specs defining the widgets in the short form of the control panel."
+
^ {
#spacer.
#variableSpacer.
{'<'. #previousPage. 'Previous page' translated}.
#spacer.
+ {#MenuIcon. #invokeShortBookMenu. 'Click here to get a menu of options for this book.' translated}.
- {'·'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}.
#spacer.
{'>'. #nextPage. 'Next page' translated}.
#spacer.
#variableSpacer.
+ {#RightCaret. #showMoreControls. 'More controls' translated}
- {'³'. #showMoreControls. 'More controls' translated}
}
!
Item was changed:
----- Method: BooklikeMorph>>showingFullScreenString (in category 'misc') -----
showingFullScreenString
+ "Answer a string characterizing whether the receiver is operating in full-screen mode."
+
+ ^ (self isInFullScreenMode ifTrue: ['<yes>'] ifFalse: ['<no>']), 'view pages full-screen' translated!
- ^ (self isInFullScreenMode
- ifTrue: ['exit full screen']
- ifFalse: ['show full screen']) translated!
Item was changed:
----- Method: BooklikeMorph>>showingPageControlsString (in category 'misc') -----
showingPageControlsString
+ "Answer a string characterizing whether page controls are currently showing."
+
+ ^ (self pageControlsVisible ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'page controls visible' translated!
- ^ (self pageControlsVisible
- ifTrue: ['hide page controls']
- ifFalse: ['show page controls']) translated!
Item was changed:
----- Method: BouncingAtomsMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'BouncingAtoms' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney' translatedNoop!
- ^ self partName: 'BouncingAtoms'
- categories: #('Demo')
- documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney'!
Item was changed:
----- Method: BouncingAtomsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BouncingAtomsMorph, #new. 'Bouncing Atoms' translatedNoop. 'Atoms, mate' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BouncingAtomsMorph new 'Bouncing Atoms' 'Atoms, mate')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: ClockMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Answer a description for use in parts bins."
+
+ ^ self partName: 'Digital Clock' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A digital clock' translatedNoop!
- ^ self partName: 'Clock'
- categories: #('Useful')
- documentation: 'A digital clock'!
Item was changed:
----- Method: ClockMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ClockMorph, #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: ClockMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
+ "Add toggles for showing-seconds and display-24-hrs to the halo menu"
+
+ "NB: intentionallyi no super call here!!"
+
+ aCustomMenu add: 'change font' translated action: #changeFont.
+
+ aCustomMenu addUpdating: #showingSecondsString action: #toggleShowingSeconds.
+ aCustomMenu addUpdating: #displaying24HourString action: #toggleShowing24hr!
- "Note minor loose end here -- if the menu is persistent, then the wording will be wrong half the time"
- | item |
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- item := showSeconds == true
- ifTrue: ['stop showing seconds']
- ifFalse: ['start showing seconds'].
- aCustomMenu add: item translated target: self action: #toggleShowingSeconds.
- item := show24hr == true
- ifTrue: ['display Am/Pm']
- ifFalse: ['display 24 hour'].
- aCustomMenu add: item translated target: self action: #toggleShowing24hr.
-
- !
Item was changed:
----- Method: ClockMorph>>initialize (in category 'initialization') -----
initialize
+ "initialize the state of the receiver"
+
- "initialize the state of the receiver"
super initialize.
+
+ showSeconds _ true.
+ show24hr _ false.
+ self font: Preferences standardMenuFont emphasis: 1.
- ""
- showSeconds := true.
- show24hr := false.
self step!
Item was changed:
----- Method: ClockMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
super initializeToStandAlone.
+ showSeconds _ false.
+ self font: (Preferences standardMenuFont emphasized: 1).
- showSeconds := true.
self step!
Item was changed:
----- Method: CurveMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#CurveMorph, #authoringPrototype. 'Curve' translatedNoop, 'A curve' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#CurveMorph. #authoringPrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}
- cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: CurveMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Curvy Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.' translatedNoop
- formalName: 'Curvy Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.'
globalReceiverSymbol: #CurveMorph
nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: EllipseMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: EnvelopeEditorMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: menu hand: aHandMorph
super addCustomMenuItems: menu hand: aHandMorph.
menu addLine.
envelope updateSelector = #ratio: ifTrue:
[menu add: 'choose denominator...' translated action: #chooseDenominator:].
menu add: 'adjust scale...' translated action: #adjustScale:.
- SoundPlayer isReverbOn
- ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb]
- ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb].
menu addLine.
menu add: 'get sound from lib' translated action: #chooseSound:.
menu add: 'put sound in lib' translated action: #saveSound:.
menu add: 'read sound from disk...' translated action: #readFromDisk:.
menu add: 'save sound on disk...' translated action: #saveToDisk:.
menu add: 'save library on disk...' translated action: #saveLibToDisk:.
!
Item was changed:
----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'editing') -----
buildScalesIn: frame
+ | env |
+ env _ envelope.
+ pixPerTick _ graphArea width // (self maxTime//10) max: 1.
+ "hminortick _ ( 1 + ( self maxTime // 800 ) ) * 10.
+ hmajortick _ ( 1 + ( self maxTime // 800 ) ) * 100."
+ hScale _ (Morph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) color: Color lightGreen.
+ " hScale _ (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
- | env hmajortick hminortick |
- env := envelope.
- pixPerTick := graphArea width // (self maxTime//10) max: 1.
- hminortick := ( 1 + ( self maxTime // 800 ) ) * 10.
- hmajortick := ( 1 + ( self maxTime // 800 ) ) * 100.
- hScale := (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
start: 0 stop: self maxTime
minorTick: hminortick minorTickLength: 3
majorTick: hmajortick majorTickLength: 10
caption: 'milliseconds' tickPrintBlock: [:v | v printString].
+ "
self addMorph: hScale.
+ vScale _ (Morph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))) color: Color lightGreen.
+ "vScale _ ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))."
- vScale := ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left)).
env name = 'pitch'
ifTrue:
[env scale >= 2.0
ifTrue:
[vScale start: 0 stop: env scale
minorTick: env scale / 24 minorTickLength: 3
majorTick: env scale / 2.0 majorTickLength: 10
caption: 'pitch (octaves)'
tickPrintBlock: [:v | (v-(env scale/2)) asInteger printString]]
ifFalse:
[vScale start: 0 stop: env scale
minorTick: 1.0/48.0 minorTickLength: 3
majorTick: 1.0/12.0 majorTickLength: 10
caption: 'pitch (half-steps)'
tickPrintBlock: [:v | (v-(env scale/2)*12) rounded printString]]]
ifFalse: [
env name = 'random pitch:'
ifTrue: [
vScale start: 0.9 stop: 1.1
minorTick: 0.2 / 50.0 minorTickLength: 3
majorTick: 0.2 / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]]
ifFalse: [
vScale start: 0 stop: env scale
minorTick: env scale / 50.0 minorTickLength: 3
majorTick: env scale / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]].
].
+ vScale _ TransformationMorph new asFlexOf: vScale.
- vScale := TransformationMorph new asFlexOf: vScale.
vScale angle: Float pi / 2.0.
self addMorph: vScale.
vScale position: (frame left)@(graphArea top-1) - (3@1).
!
Item was changed:
----- Method: EventRecorderMorph>>addButtons (in category 'initialization') -----
addButtons
+ | r b w |
- | r b |
caption ifNotNil: ["Special setup for play-only interface"
+ (r _ self makeARowForButtons)
- (r := self makeARowForButtons)
addMorphBack: (SimpleButtonMorph new target: self;
+ label: caption font: Preferences standardButtonFont; actionSelector: #play);
- label: caption; actionSelector: #play);
- addMorphBack: self makeASpacer;
- addMorphBack: self makeStatusLight;
addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
+ addMorphBack: self makeASpacer.
^ self addMorphBack: r
].
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#record. nil. 'Begin recording'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#record. nil. 'Begin recording'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#stop. b width. 'Stop recording - you can also use the ESC key to stop it'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#play. b width. 'Play current recording'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#readTape. b width. 'Get a new recording from disk'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
+ addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
addMorphBack: self makeASpacer;
+ addMorphBack: (self buttonFor: {#createPlayButton. b width. 'Make a simple button to play this recording'}).
- addMorphBack: self makeStatusLight;
- addMorphBack: self makeASpacer;
- addMorphBack: (self buttonFor: {#button. b width. 'Make a simple button to play this recording'}).
self addMorph: r.
self setStatusLight: #ready.!
Item was changed:
----- Method: EventRecorderMorph>>handleListenEvent: (in category 'events-processing') -----
handleListenEvent: anEvent
"Record the given event"
+ anEvent hand == recHand ifFalse: [^ self]. "not for me"
+ state == #record ifFalse: [
+ "If user got an error while recording and deleted recorder, will still be listening"
+ recHand ifNotNil: [recHand removeEventListener: self].
+ ^self].
- (state == #record and:[anEvent hand == recHand])
- ifFalse:[^self].
anEvent = lastEvent ifTrue: [^ self].
(anEvent isKeyboard and:[anEvent keyValue = 27 "esc"])
ifTrue: [^ self stop].
+ time _ anEvent timeStamp.
- time := anEvent timeStamp.
tapeStream nextPut: (anEvent copy setHand: nil).
journalFile ifNotNil:
[journalFile store: anEvent; cr; flush].
+ lastEvent _ anEvent.!
- lastEvent := anEvent.!
Item was changed:
----- Method: EventRecorderMorph>>pauseIn: (in category 'pause/resume') -----
pauseIn: aWorld
"Suspend playing or recording, either as part of a stop command,
or as part of a project switch, after which it will be resumed."
self setStatusLight: #ready.
state = #play ifTrue:
+ [state _ #suspendedPlay.
+ playHand halo ifNotNil: [playHand halo delete].
- [state := #suspendedPlay.
playHand delete.
aWorld removeHand: playHand.
+ playHand _ nil].
- playHand := nil].
state = #record ifTrue:
+ [state _ #suspendedRecord.
- [state := #suspendedRecord.
recHand removeEventListener: self.
+ recHand _ nil].
- recHand := nil].
voiceRecorder ifNotNil:
[voiceRecorder pause.
startSoundEvent ifNotNil:
[startSoundEvent argument: voiceRecorder recordedSound.
voiceRecorder clearRecordedSound.
+ startSoundEvent _ nil]].
- startSoundEvent := nil]].
!
Item was changed:
----- Method: EventRecorderMorph>>readTape (in category 'fileIn/Out') -----
readTape
^ self readTape: (UIManager default
+ request: 'Tape to read' translated
- request: 'Tape to read'
initialAnswer: 'tapeName.tape').!
Item was changed:
----- Method: EventRecorderMorph>>resumeIn: (in category 'pause/resume') -----
resumeIn: aWorld
"Resume playing or recording after a project switch."
+ self state = #suspendedPlay ifTrue:
- state = #suspendedPlay ifTrue:
[self resumePlayIn: aWorld].
+ self state = #suspendedRecord ifTrue:
- state = #suspendedRecord ifTrue:
[self resumeRecordIn: aWorld].
!
Item was changed:
----- Method: EventRecorderMorph>>resumePlayIn: (in category 'pause/resume') -----
resumePlayIn: aWorld
+ playHand _ HandMorphForReplay new recorder: self.
- playHand := HandMorphForReplay new recorder: self.
playHand position: tapeStream peek position.
aWorld addHand: playHand.
playHand newKeyboardFocus: aWorld.
playHand userInitials: 'play' andPicture: nil.
+ lastEvent _ nil.
+ lastDelta _ 0@0.
+ self findPlayOffset.
+ state _ #play.
- lastEvent := nil.
- lastDelta := 0@0.
- state := #play.
self synchronize.
!
Item was changed:
----- Method: EventRecorderMorph>>synchronize (in category 'event handling') -----
synchronize
+ time _ lastInterpolation _ Time millisecondClockValue.
+ deltaTime _ nil.!
- time := Time millisecondClockValue.
- deltaTime := nil.!
Item was changed:
----- Method: EventRecorderMorph>>writeTape: (in category 'fileIn/Out') -----
writeTape: fileName
+ | name bb |
+ name _ self writeFileNamed: fileName.
+ bb _ self findDeepSubmorphThat: [:mm | (mm isKindOf: SimpleButtonMorph)
+ and: [mm label = 'writeTape']]
+ ifAbsent: [^ self].
+ bb actionSelector: #writeTape:.
+ bb arguments: (Array with: name).
- | b name |
- name := self writeFileNamed: fileName.
- (b := self button: 'writeTape') ifNotNil: [
- b actionSelector: #writeTape:.
- b arguments: (Array with: name)].
!
Item was changed:
----- Method: FlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'flap tab' translatedNoop!
- ^ 'flap tab'!
Item was changed:
----- Method: FlapTab>>adaptToWorld (in category 'initialization') -----
adaptToWorld
| wasShowing new |
+ (wasShowing _ self flapShowing) ifTrue:
- (wasShowing := self flapShowing) ifTrue:
[self hideFlap].
(self respondsTo: #unhibernate) ifTrue: [
+ (new _ self unhibernate) == self ifFalse: [
- (new := self unhibernate) == self ifFalse: [
^ new adaptToWorld]].
- self spanWorld.
- self positionObject: self.
wasShowing ifTrue:
+ [self spanWorld.
+ self positionObject: self.
+ self showFlap]!
- [self showFlap]!
Item was changed:
----- Method: FlapTab>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aMenu hand: aHandMorph
"Add further items to the menu as appropriate"
aMenu add: 'tab color...' translated target: self action: #changeColor.
aMenu add: 'flap color...' translated target: self action: #changeFlapColor.
aMenu addLine.
aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo.
aMenu addLine.
aMenu addUpdating: #textualTabString action: #textualTab.
aMenu addUpdating: #graphicalTabString action: #graphicalTab.
aMenu addUpdating: #solidTabString enablement: #notSolid action: #solidTab.
aMenu addLine.
(referent isKindOf: PasteUpMorph) ifTrue:
[aMenu addUpdating: #partsBinString action: #togglePartsBinMode].
aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior.
aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior.
aMenu addLine.
aMenu addUpdating: #isGlobalFlapString enablement: #sharedFlapsAllowed action: #toggleIsGlobalFlap.
+ aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.' translated.
- aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.,' translated.
aMenu addLine.
+ aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap.
aMenu add: 'destroy this flap' translated action: #destroyFlap.
"aMenu addUpdating: #slideString action: #toggleSlideBehavior.
aMenu addUpdating: #inboardString action: #toggleInboardness.
aMenu addUpdating: #thicknessString ('thickness... (current: ', self thickness printString, ')') action: #setThickness."
!
Item was changed:
----- Method: FlapTab>>balloonTextForFlapsMenu (in category 'miscellaneous') -----
balloonTextForFlapsMenu
"Answer the balloon text to show on a menu item in the flaps menu that governs the visibility of the receiver in the current project"
| id |
+ id _ self flapID.
- id := self flapID.
#(
+ ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects' translatedNoop)
+ ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.' translatedNoop)
+ ('Widgets' 'A variety of controls and media tools' translatedNoop)
+ ('Supplies' 'Supplies' translatedNoop)
+ ('Help' 'A flap providing documentation, tutorials, and other help' translatedNoop)
+ ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented' translatedNoop)
+ ('Scripting' 'Tools useful when doing tile scripting' translatedNoop)
+ ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment' translatedNoop)
+ ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting' translatedNoop)) do:
- ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects')
- ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.')
- ('Widgets' 'A variety of controls and media tools')
- ('Supplies' 'A source for many basic types of objects')
- ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented')
- ('Scripting' 'Tools useful when doing tile scripting')
- ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment')
- ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting')) do:
[:pair | (FlapTab givenID: id matches: pair first translated) ifTrue: [^ pair second translated]].
^ self balloonText!
Item was changed:
----- Method: FlapTab>>computeEdgeFraction (in category 'edge') -----
computeEdgeFraction
"Compute and remember the edge fraction"
| aBox aFraction |
self isCurrentlySolid ifTrue: [^ edgeFraction ifNil: [self edgeFraction: 0.5]].
+ aBox := ((self pasteUpMorph ifNil: [self currentWorld]) bounds) insetBy: (self extent // 2).
- aBox := ((owner ifNil: [ActiveWorld]) bounds) insetBy: (self extent // 2).
aFraction := self
ifVertical:
[(self center y - aBox top) / (aBox height max: 1)]
ifHorizontal:
[(self center x - aBox left) / (aBox width max: 1)].
^ self edgeFraction: aFraction!
Item was changed:
----- Method: FlapTab>>destroyFlap (in category 'menu') -----
destroyFlap
"Destroy the receiver"
| reply request |
+ request _ self isGlobalFlap
- request := self isGlobalFlap
ifTrue:
['Caution -- this would permanently
remove this flap, so it would no longer be
available in this or any other project.
+ Do you really want to this? ' translated]
- Do you really want to this? ']
ifFalse:
['Caution -- this is permanent!! Do
+ you really want to do this? ' translated].
+ reply _ self confirm: request translated orCancel: [^ self].
- you really want to do this? '].
- reply := self confirm: request translated orCancel: [^ self].
reply ifTrue:
[self isGlobalFlap
ifTrue:
[Flaps removeFlapTab: self keepInList: false.
self currentWorld reformulateUpdatingMenus]
ifFalse:
[referent isInWorld ifTrue: [referent delete].
self delete]]!
Item was changed:
----- Method: FlapTab>>flapMenuTitle (in category 'menu') -----
flapMenuTitle
+ ^ 'flap: ' translated , self wording!
- ^ 'flap: ', self wording!
Item was changed:
----- Method: FlapTab>>graphicalTabString (in category 'graphical tabs') -----
graphicalTabString
^ (self isCurrentlyGraphical
+ ifTrue: ['choose new graphic...' translated]
+ ifFalse: ['use graphical tab' translated]) !
- ifTrue: ['choose new graphic...']
- ifFalse: ['use graphical tab']) translated!
Item was changed:
----- Method: FlapTab>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "Handle a mouse-move event. The event, a MorphicEvent, is passed in."
+
| aPosition newReferentThickness adjustedPosition thick |
dragged ifFalse: [(thick := self referentThickness) > 0
ifTrue: [lastReferentThickness := thick]].
((self containsPoint: (aPosition := evt cursorPoint)) and: [dragged not])
ifFalse:
[flapShowing ifFalse: [self showFlap].
adjustedPosition := aPosition - evt hand targetOffset.
(edgeToAdhereTo == #bottom)
ifTrue:
[newReferentThickness := inboard
ifTrue:
[self world height - adjustedPosition y]
ifFalse:
[self world height - adjustedPosition y - self height]].
(edgeToAdhereTo == #left)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition x + self width]
ifFalse:
[adjustedPosition x]].
(edgeToAdhereTo == #right)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[self world width - adjustedPosition x]
ifFalse:
[self world width - adjustedPosition x - self width]].
(edgeToAdhereTo == #top)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition y + self height]
ifFalse:
[adjustedPosition y]].
self isCurrentlySolid ifFalse:
[(#(left right) includes: edgeToAdhereTo)
ifFalse:
[self left: adjustedPosition x]
ifTrue:
[self top: adjustedPosition y]].
+ ((edgeToAdhereTo == #left) and: [(self valueOfProperty: #rigidThickness) notNil]) ifTrue:
+ [newReferentThickness := referent width].
+
self applyThickness: newReferentThickness.
dragged := true.
self fitOnScreen.
self computeEdgeFraction]!
Item was changed:
----- Method: FlapTab>>solidTabString (in category 'solid tabs') -----
solidTabString
^ (self isCurrentlySolid
+ ifTrue: ['currently using solid tab' translated]
+ ifFalse: ['use solid tab' translated]) !
- ifTrue: ['currently using solid tab']
- ifFalse: ['use solid tab']) translated!
Item was changed:
----- Method: FlapTab>>textualTabString (in category 'textual tabs') -----
textualTabString
^ (self isCurrentlyTextual
+ ifTrue: ['change tab wording...' translated]
+ ifFalse: ['use textual tab' translated]) !
- ifTrue: ['change tab wording...']
- ifFalse: ['use textual tab']) translated!
Item was changed:
----- Method: Flaps class>>addAndEnableEToyFlaps (in category 'predefined flaps') -----
addAndEnableEToyFlaps
"Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed."
| aSuppliesFlap |
SharedFlapTabs
ifNotNil: [^ self].
SharedFlapTabs := OrderedCollection new.
aSuppliesFlap := self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right.
aSuppliesFlap referent setNameTo: 'Supplies Flap' translated. "Per request from Kim Rose, 7/19/02"
SharedFlapTabs add: aSuppliesFlap. "The #center designation doesn't quite work at the moment"
+ (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false])
+ ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap]
+ ifFalse: [Preferences showProjectNavigator
+ ifTrue:[ SharedFlapTabs add: self newNavigatorFlap]].
- Preferences showProjectNavigator
- ifTrue:[ SharedFlapTabs add: self newNavigatorFlap ].
self enableGlobalFlapWithID: 'Supplies' translated.
+ (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false])
+ ifTrue:
+ [self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated.
+ (self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNilDo:
+ [:navTab | aSuppliesFlap sugarNavTab: navTab]]
+ ifFalse: [
+ Preferences showProjectNavigator
+ ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated]].
- Preferences showProjectNavigator
- ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated ].
SharedFlapsAllowed := true.
Project current flapsSuppressed: false.
^ SharedFlapTabs
"Flaps addAndEnableEToyFlaps"!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category 'flaps registry') -----
defaultsQuadsDefiningScriptingFlap
"Answer a structure defining the default items in the Scripting flap.
previously in quadsDeiningScriptingFlap"
+ ^ {
+ {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
+ {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}.
- ^ #(
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
- (ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#FunctionTile. #randomNumberTile. 'Random' translatedNoop. 'A tile that will produce a random number in a given range' translatedNoop}.
+ {#ScriptingSystem. #anyButtonPressedTiles. 'ButtonDown?' translatedNoop. 'Tiles for querying whether the mouse button is down' translatedNoop}.
+ {#ScriptingSystem. #noButtonPressedTiles. 'ButtonUp?' translatedNoop. 'Tiles for querying whether the mouse button is up' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (RandomNumberTile new 'Random' 'A tile that will produce a random number in a given range')
- (ScriptingSystem anyButtonPressedTiles 'ButtonDown?' 'Tiles for querying whether the mouse button is down')
- (ScriptingSystem noButtonPressedTiles 'ButtonUp?' 'Tiles for querying whether the mouse button is up')
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}.
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (TextFieldMorph exampleBackgroundField 'Scrolling Field' 'A scrolling data field which will have a different value on every card of the background')
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#TextMorph. #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}.
+ {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop}
+ } asOrderedCollection!
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (TextMorph exampleBackgroundLabel 'Background Label' 'A piece of text that will occur on every card of the background')
- (TextMorph exampleBackgroundField 'Background Field' 'A data field which will have a different value on every card of the background')
-
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningStackToolsFlap (in category 'flaps registry') -----
defaultsQuadsDefiningStackToolsFlap
"Answer a structure defining the items on the default system Stack Tools flap.
previously in quadsDefiningStackToolsFlap"
+ ^ {
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}.
+ {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}.
+ {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Scriptable Button' translatedNoop. 'A button whose script will be a method of the background Player' translatedNoop}.
+ {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}.
+ {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection
- ^ #(
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (StackMorph stackHelpWindow 'Stack Help' 'Some hints about how to use Stacks')
- (TextMorph authoringPrototype 'Simple Text' 'Text that you can edit into anything you wish')
- (TextMorph fancyPrototype 'Fancy Text' 'A text field with a rounded shadowed border, with a fancy font.')
- (ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
- (ScriptableButton authoringPrototype 'Scriptable Button' 'A button whose script will be a method of the background Player')
- (StackMorph previousCardButton 'Previous Card' 'A button that takes the user to the previous card in the stack')
- (StackMorph nextCardButton 'Next Card' 'A button that takes the user to the next card in the stack')) asOrderedCollection
!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningSuppliesFlap (in category 'flaps registry') -----
defaultsQuadsDefiningSuppliesFlap
"Answer a list of quads which define the objects to appear in the default Supplies flap.
previously in quadsDefiningSuppliesFlap"
+ ^ {
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}.
+ {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
+ } asOrderedCollection!
- ^ #(
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'TabbedPalette' 'A structure with tabs')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>disableGlobalFlaps: (in category 'menu commands') -----
disableGlobalFlaps: interactive
"Clobber all the shared flaps structures. First read the user her Miranda rights."
interactive
ifTrue: [(self confirm:
'CAUTION!! This will destroy all the shared
flaps, so that they will not be present in
*any* project. If, later, you want them
back, you will have to reenable them, from
this same menu, whereupon the standard
default set of shared flaps will be created.
Do you really want to go ahead and clobber
all shared flaps at this time?' translated) ifFalse: [^ self]].
self globalFlapTabsIfAny do:
[:aFlapTab | self removeFlapTab: aFlapTab keepInList: false.
aFlapTab isInWorld ifTrue: [self error: 'Flap problem' translated]].
self clobberFlapTabList.
+ self initializeFlapsQuads.
+ SharedFlapsAllowed _ false.
- SharedFlapsAllowed := false.
Smalltalk isMorphic ifTrue:
[ActiveWorld restoreMorphicDisplay.
ActiveWorld reformulateUpdatingMenus].
"The following reduces the risk that flaps will be created with variant IDs
such as 'Stack Tools2', potentially causing some shared flap logic to fail."
"Smalltalk garbageCollect." "-- see if we are OK without this"
!
Item was changed:
----- Method: Flaps class>>explainFlapsText (in category 'menu commands') -----
explainFlapsText
"Answer the text, in English, to show in a help-window about Flaps."
^'Flaps are like drawers on the edge of the screen, which can be opened so that you can use what is inside them, and closed when you do not need them. They have many possible uses, a few of which are illustrated by the default set of flaps you can get as described below.
+ ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
- ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
+ To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
- To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
+ ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
- ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
+ If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
- If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
+ If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
- If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
+ Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
- Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
+ You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
- You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
+ You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
- You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
+ Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
- Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
+ If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
- If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
+ The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
- The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
+ tab color... Lets you change the color of the flap''s tab.
+ flap color... Lets you change the color of the flap itself.
- tab color... Lets you change the color of the flap''s tab.
- flap color... Lets you change the color of the flap itself.
+ use textual tab... If the tab is not textual, makes it become textual.
+ change tab wording... If the tab is already textual, allows you to edit
- use textual tab... If the tab is not textual, makes it become textual.
- change tab wording... If the tab is already textual, allows you to edit
its wording.
+ use graphical tab... If the tab is not graphical, makes it become
- use graphical tab... If the tab is not graphical, makes it become
graphical.
+ choose tab graphic... If the tab is already graphical, allows you
- choose tab graphic... If the tab is already graphical, allows you
to change the picture.
+ use solid tab... If the tab is not solid, makes it become solid, i.e.
- use solid tab... If the tab is not solid, makes it become solid, i.e.
appear as a solid band of color along the
entire length or width of the screen.
+ parts-bin behavior If set, then dragging an object from the flap
- parts-bin behavior If set, then dragging an object from the flap
tears off a new copy of the object.
+ dragover If set, the flap opens on dragover and closes
- dragover If set, the flap opens on dragover and closes
again on drag-leave.
+
+ mouseover If set, the flap opens on mouseover and closes
- mouseover If set, the flap opens on mouseover and closes
again on mouse-leave.
+ cling to edge... Governs which edge (left, right, top, bottom)
- cling to edge... Governs which edge (left, right, top, bottom)
the flap adheres to.
+ shared If set, the same flap will be available in all projects; if not, the
- shared If set, the same flap will be available in all projects; if not, the
flap will will occur only in one project.
+ destroy this flap Deletes the flap.
- destroy this flap Deletes the flap.
+ To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
- To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
+ To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
- To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
+ To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
- To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
+ Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.' translated!
- Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.'!
Item was changed:
----- Method: Flaps class>>newFlapTitled:onEdge:inPasteUp: (in category 'new flap') -----
newFlapTitled: aString onEdge: anEdge inPasteUp: aPasteUpMorph
"Add a flap with the given title, placing it on the given edge, in the given pasteup"
| aFlapBody aFlapTab |
aFlapBody := PasteUpMorph newSticky.
aFlapTab := FlapTab new referent: aFlapBody.
aFlapTab setName: aString edge: anEdge color: (Color r: 0.516 g: 0.452 b: 1.0).
anEdge == #left ifTrue:
[aFlapTab position: (aPasteUpMorph left @ aPasteUpMorph top).
aFlapBody extent: (200 @ aPasteUpMorph height)].
anEdge == #right ifTrue:
[aFlapTab position: ((aPasteUpMorph right - aFlapTab width) @ aPasteUpMorph top).
aFlapBody extent: (200 @ aPasteUpMorph height)].
anEdge == #top ifTrue:
[aFlapTab position: ((aPasteUpMorph left + 50) @ aPasteUpMorph top).
aFlapBody extent: (aPasteUpMorph width @ 200)].
anEdge == #bottom ifTrue:
[aFlapTab position: ((aPasteUpMorph left + 50) @ (aPasteUpMorph bottom - aFlapTab height)).
aFlapBody extent: (aPasteUpMorph width @ 200)].
+ aFlapBody
+ beFlap: true;
+ color: self defaultColorForFlapBackgrounds;
+ changeTableLayout.
- aFlapBody beFlap: true.
- aFlapBody color: self defaultColorForFlapBackgrounds.
-
^ aFlapTab!
Item was changed:
----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') -----
newLoneSuppliesFlap
+ "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch. We're still evidently nurturing this method along, but it is a disused branch, whose lone sender has no senders..."
- "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch"
| aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly"
+ aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: {
- aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: #(
+ {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph . #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#SimpleSliderMorph . #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ " {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}."
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'Tabs' translatedNoop. 'A structure with tabs' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle' )
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph authoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, ec.')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'Tabs' 'A structure with tabs')
+ {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}.
+ {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}.
- (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
- (MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ClockMorph. #authoringPrototype, 'Clock' translatedNoop, 'A simple digital clock' translatedNoop}.
+ {#BookMorph, #previousPageButton, 'Previous' translatedNoop, 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph, #nextPageButton, 'Next' translatedNoop, 'A button that takes you to the next page' translatedNoop}.
+ }.
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'Previous' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'Next' 'A button that takes you to the next page')
- ).
+ aFlapTab _ FlapTab new referent: aStrip beSticky.
- aFlapTab := FlapTab new referent: aStrip beSticky.
aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter.
aStrip extent: self currentWorld width @ 78.
+ leftEdge _ ((Display width - (16 + aFlapTab width)) + 556) // 2.
- leftEdge := ((Display width - (16 + aFlapTab width)) + 556) // 2.
aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)).
aStrip beFlap: true.
aStrip autoLineLayout: true.
^ aFlapTab!
Item was changed:
----- Method: Flaps class>>newNavigatorFlap (in category 'predefined flaps') -----
newNavigatorFlap
"Answer a newly-created flap which adheres to the bottom edge of the screen and which holds the project navigator controls. "
| aFlapTab navBar aFlap |
+ navBar _ ProjectNavigationMorph preferredNavigator new addButtons.
+ aFlap _ PasteUpMorph newSticky borderWidth: 0;
- navBar := ProjectNavigationMorph preferredNavigator new.
- aFlap := PasteUpMorph newSticky borderWidth: 0;
extent: navBar extent + (0@20);
color: (Color orange alpha: 0.8);
beFlap: true;
addMorph: navBar beSticky.
aFlap hResizing: #shrinkWrap; vResizing: #shrinkWrap.
aFlap useRoundedCorners.
aFlap setNameTo: 'Navigator Flap' translated.
navBar fullBounds. "to establish width"
+ aFlapTab _ FlapTab new referent: aFlap.
- aFlapTab := FlapTab new referent: aFlap.
aFlapTab setName: 'Navigator' translated edge: #bottom color: Color orange.
aFlapTab position: ((navBar width // 2) - (aFlapTab width // 2))
@ (self currentWorld height - aFlapTab height).
aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Navigator' translated "
!
Item was changed:
----- Method: Flaps class>>newSuppliesFlapFromQuads:positioning: (in category 'predefined flaps') -----
newSuppliesFlapFromQuads: quads positioning: positionSymbol
"Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge."
| aFlapTab aStrip hPosition |
+ Smalltalk at: #SugarNavigatorBar ifPresent: [:c |
+ c showSugarNavigator ifTrue: [
+ ^ self newSuppliesFlapFromQuads: quads positioning: positionSymbol withPreviousEntries: nil]].
aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads.
"self twiddleSuppliesButtonsIn: aStrip."
aFlapTab := FlapTab new referent: aStrip beSticky.
aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter.
hPosition := positionSymbol == #center
ifTrue:
[(Display width // 2) - (aFlapTab width // 2)]
ifFalse:
[Display width - (aFlapTab width + 22)].
aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)).
aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
aStrip extent: self currentWorld width @ 136.
aStrip beFlap: true.
aStrip autoLineLayout: true.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Supplies' translated"!
Item was changed:
----- Method: Flasher class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver for use in a parts bin"
+ ^ self partName: 'Flasher' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A circle that flashes' translatedNoop!
- ^ self partName: 'Flasher'
- categories: #('Demo')
- documentation: 'A circle that flashes'!
Item was changed:
----- Method: FrameRateMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'FrameRate' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A readout that allows you to monitor the frame rate of your system' translatedNoop!
- ^ self partName: 'FrameRate'
- categories: #('Useful')
- documentation: 'A readout that allows you to monitor the frame rate of your system'!
Item was changed:
----- Method: FrameRateMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#FrameRateMorph. #authoringPrototype. 'Frame Rate' translatedNoop. 'An indicator of how fast your system is running' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(FrameRateMorph authoringPrototype 'Frame Rate' 'An indicator of how fast your system is running')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: FrameRateMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ lastDisplayTime _ 0.
+ framesSinceLastDisplay _ 0.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ !
- lastDisplayTime := 0.
- framesSinceLastDisplay := 0!
Item was changed:
----- Method: FrameRateMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
"Initialize the receiver as a stand-alone entity"
super initializeToStandAlone.
self color: Color blue.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ self step.
+ !
- self step!
Item was changed:
----- Method: GrabPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver's instances for a parts bin"
+ ^ self partName: 'Grab Patch' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Use this to grab a rectangular patch from the screen' translatedNoop!
- ^ self partName: 'Grab Patch'
- categories: #('Graphics')
- documentation: 'Use this to grab a rectangular patch from the screen'!
Item was changed:
----- Method: GrabPatchMorph>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initialize.
+ self image: (ScriptingSystem formAtKey: 'GrabPatch').
+ self setProperty: #ignorePartsBinDrop toValue: true!
- self image: (ScriptingSystem formAtKey: 'GrabPatch')!
Item was changed:
----- Method: GraphMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Graph' translatedNoop
+ categories: #()
+ documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.' translatedNoop!
- ^ self partName: 'Graph'
- categories: #('Useful')
- documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.'!
Item was changed:
----- Method: GraphMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: 365 @ 80.
+ dataColor _ Color darkGray.
+ cursor _ 1.0.
+ samplingRate := 11025.
- dataColor := Color darkGray.
- cursor := 1.0.
"may be fractional"
+ cursorColor _ Color red.
+ cursorColorAtZeroCrossings _ Color red.
+ startIndex _ 1.
+ hasChanged _ false.
- cursorColor := Color red.
- cursorColorAtZeroCrossings := Color red.
- startIndex := 1.
- hasChanged := false.
self
data: ((0 to: 360 - 1)
collect: [:x | (100.0 * x degreesToRadians sin) asInteger])!
Item was changed:
----- Method: GraphicalDictionaryMenu class>>openOn:withLabel: (in category 'instance creation') -----
openOn: aFormDictionary withLabel: aLabel
"open a graphical dictionary in a window having the label aLabel.
aFormDictionary should be a dictionary containing as value a form."
| inst aWindow |
+ aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!' translated].
- aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!'].
inst := self new initializeFor: nil fromDictionary: aFormDictionary.
+ aWindow _ (SystemWindow labelled: aLabel) model: inst.
- aWindow := (SystemWindow labelled: aLabel) model: inst.
aWindow addMorph: inst frame: (0@0 extent: 1@1).
aWindow extent: inst fullBounds extent + (3 @ aWindow labelHeight + 3);
minimumExtent: inst minimumExtent + (3 @ aWindow labelHeight + 3).
HandMorph attach: aWindow.
^ inst!
Item was changed:
----- Method: GraphicalDictionaryMenu>>renameGraphicTo: (in category 'menu commands') -----
renameGraphicTo: newName
| curr |
+ curr _ entryNames at: currentIndex.
- curr := entryNames at: currentIndex.
(newName isEmptyOrNil or: [newName = curr]) ifTrue: [^ Beeper beep].
(baseDictionary includesKey: newName) ifTrue:
[^ self inform: 'sorry that conflicts with
the name of another
+ entry in this dictionary' translated].
- entry in this dictionary'].
baseDictionary at: newName put: (baseDictionary at: curr).
baseDictionary removeKey: curr.
self baseDictionary: baseDictionary.
+ currentIndex _ entryNames indexOf: newName.
- currentIndex := entryNames indexOf: newName.
self updateThumbnail!
Item was changed:
----- Method: GraphicalMenu>>initializeFor:withForms:coexist: (in category 'initialization') -----
initializeFor: aTarget withForms: formList coexist: aBoolean
"World primaryHand attachMorph:
(GraphicalMenu new initializeFor: nil
withForms: Form allInstances coexist: true)"
| buttons bb anIndex buttonCage |
target := aTarget.
coexistWithOriginal := aBoolean.
formChoices := formList.
currentIndex := 1.
self borderWidth: 1;
cellPositioning: #center;
color: Color white;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap.
buttons := AlignmentMorph newRow.
buttons borderWidth: 0;
layoutInset: 0.
buttons hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5 @ 5.
buttons wrapCentering: #topLeft.
buttonCage := AlignmentMorph newColumn.
buttonCage hResizing: #shrinkWrap;
vResizing: #spaceFill.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Prev' translated;
- buttons addMorphBack: (bb label: 'Prev';
actionSelector: #downArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 9 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Next' translated;
- buttons addMorphBack: (bb label: 'Next';
actionSelector: #upArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 5 @ 0.
buttons submorphs last color: Color white.
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 12.
buttons := AlignmentMorph newRow.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'OK' translated;
- buttons addMorphBack: (bb label: 'OK';
actionSelector: #okay).
buttons addTransparentSpacerOfSize: 5 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Cancel' translated;
- buttons addMorphBack: (bb label: 'Cancel';
actionSelector: #cancel).
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
self addMorphFront: buttonCage.
formDisplayMorph := Thumbnail new extent: 100 @ 100;
maxWidth: 100 minHeight: 30;
yourself.
self addMorphBack: (Morph new color: Color white;
layoutPolicy: TableLayout new;
layoutInset: 4 @ 4;
hResizing: #spaceFill;
vResizing: #spaceFill;
listCentering: #center;
addMorphBack: formDisplayMorph;
yourself).
target
ifNotNil: [(anIndex := formList
indexOf: target form
ifAbsent: [])
ifNotNil: [currentIndex := anIndex]].
self updateThumbnail!
Item was changed:
----- Method: HandMorphForReplay>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
+ suspended := false.
+ self showTemporaryCursor: Cursor normal
- self showTemporaryCursor: Cursor normal.
!
Item was changed:
----- Method: HandMorphForReplay>>processEvents (in category 'event handling') -----
processEvents
"Play back the next event"
+ | evt hadMouse hadAny tracker |
+ suspended == true ifTrue: [^ self].
- | evt hadMouse hadAny |
hadMouse := hadAny := false.
+ tracker := recorder objectTrackingEvents.
[(evt := recorder nextEventToPlay) isNil] whileFalse:
+ [
+ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self].
+ tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp].
+ evt type == #EOF
- [evt type == #EOF
ifTrue:
+ [recorder pauseIn: ActiveWorld.
+ ^ self].
- [recorder pauseIn: self world.
- ^self].
evt type == #startSound
ifTrue:
+ [recorder perhapsPlaySound: evt argument.
- [evt argument play.
recorder synchronize.
+ ^ self].
+ evt type == #startEventPlayback
+ ifTrue:
+ [evt argument launchPlayback.
+ recorder synchronize.
+ ^ self].
+
+ evt type == #noteTheatreBounds
+ ifTrue:
+ ["The argument holds the content rect --for now we don't make any use of that info in this form."
+ ^ self].
+
- ^self].
evt isMouse ifTrue: [hadMouse := true].
(evt isMouse or: [evt isKeyboard])
ifTrue:
[self handleEvent: (evt setHand: self) resetHandlerFields.
hadAny := true]].
(mouseClickState notNil and: [hadMouse not])
ifTrue:
["No mouse events during this cycle. Make sure click states time out accordingly"
mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
hadAny
ifFalse:
["No pending events. Make sure z-order is up to date"
self mouseOverHandler processMouseOver: lastMouseEvent]!
Item was changed:
----- Method: HandMorphForReplay>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
+ "Handmorph blocks deep copy. Go up to Morph"
+
+ ^ self perform: #veryDeepCopyWith: withArguments: {deepCopier} inSuperclass: Morph!
- ^ self copy!
Item was changed:
----- Method: IndexTabs class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'tabs' translatedNoop!
- ^ 'tabs'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>cacheThumbnailFor: (in category 'thumbnails') -----
cacheThumbnailFor: aProject
+ "Save a thumbnail of the given project in my thumbnail cache."
| form |
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
-
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
CachedThumbnails
at: aProject name
+ put: (form _ self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter).
+ ^ form
- put: (form := self sorterFormForProject: aProject sized: nil).
- ^form
!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'ThreadNavigator' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A tool that lets you navigate through a thread of projects.' translatedNoop!
- ^ self partName: 'ThreadNavigator'
- categories: #('Navigation')
- documentation: 'A tool that lets you navigate through a thread of projects.'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>getThumbnailFor: (in category 'thumbnails') -----
getThumbnailFor: aProject
+ "Answer a thumbnail for the given project, retrieving it from a cache of such objects if possible, else creating a fresh thumbnail, storing it in the cache, and answering it."
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
^CachedThumbnails
at: aProject name
+ ifAbsentPut: [self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter]!
- ifAbsentPut: [self sorterFormForProject: aProject sized: nil]!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>sorterFormForProject:sized: (in category 'sorter') -----
+ sorterFormForProject: aProject sized: aSize
+ "Answer a form to use in a project-sorter to represent the project."
- sorterFormForProject: aProject sized: ignored
+ ^ (ProjectViewMorph on: aProject) imageForm scaledToSize: aSize
- ^(ProjectViewMorph on: aProject) imageForm scaledToSize: 80@60.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>buttonForMenu (in category 'navigation') -----
buttonForMenu
+ ^self makeButton: '?' balloonText: 'More commands' translated for: #moreCommands.
- ^self makeButton: '?' balloonText: 'More commands' for: #moreCommands.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>editThisThread (in category 'navigation') -----
editThisThread
| sorter |
+ sorter _ ProjectSorterMorph new.
- sorter := ProjectSorterMorph new.
sorter navigator: self listOfPages: listOfPages.
self currentWorld addMorphFront: sorter.
+ sorter align: sorter topCenter with: self currentWorld topCenter.
- sorter align: sorter center with: self currentWorld center.
self delete.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>positionAppropriately (in category 'navigation') -----
positionAppropriately
+ | others otherRects overlaps bottomRight |
- | others otherRects overlaps |
-
(self ownerThatIsA: HandMorph) ifNotNil: [^self].
+ others _ ActiveWorld submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
+ otherRects _ others collect: [ :each | each bounds].
+ bottomRight _ (ActiveWorld hasProperty: #threadNavigatorPosition) ifTrue: [
+ ActiveWorld valueOfProperty: #threadNavigatorPosition.
+ ] ifFalse: [
+ ActiveWorld bottomRight.
+ ].
+ self align: self fullBounds bottomRight with: bottomRight.
- others := self world submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
- otherRects := others collect: [ :each | each bounds].
- self align: self fullBounds bottomRight with: self world bottomRight.
self setProperty: #previousWorldBounds toValue: self world bounds.
[
+ overlaps _ false.
- overlaps := false.
otherRects do: [ :r |
+ (r intersects: bounds) ifTrue: [overlaps _ true. self bottom: r top].
- (r intersects: bounds) ifTrue: [overlaps := true. self bottom: r top].
].
self top < self world top ifTrue: [
+ self bottom: bottomRight y.
- self bottom: self world bottom.
self right: self left - 1.
].
overlaps
] whileTrue.!
Item was changed:
----- Method: InternalThreadNavigationMorph>>sizeRatio (in category 'accessing') -----
sizeRatio
"answer the size ratio for the receiver"
+ ^ 1.0
+
+ "^ Preferences standardMenuFont height / 12" "Good grief!!"!
- ^ Preferences standardMenuFont height / 12!
Item was changed:
----- Method: LassoPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver to be used in a parts bin"
+ ^ self partName: 'Lasso' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Drop this icon to grab a patch from the screen with a lasso.' translatedNoop!
- ^ self partName: 'Lasso'
- categories: #('Graphics')
- documentation: 'Drop this icon to grab a patch from the screen with a lasso.'!
Item was changed:
----- Method: LassoPatchMorph>>wantsToBeDroppedInto: (in category 'dropping') -----
wantsToBeDroppedInto: aMorph
+ "Only wanted by the world"
- "Only into PasteUps that are not part bins"
+ ^ aMorph isWorldMorph!
- ^ aMorph isPlayfieldLike!
Item was changed:
----- Method: MagnifierMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Magnifier' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A magnifying glass' translatedNoop!
- ^ self partName: 'Magnifier'
- categories: #('Useful')
- documentation: 'A magnifying glass'!
Item was changed:
----- Method: MagnifierMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MagnifierMorph. #newRound. 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: MagnifierMorph class>>supplementaryPartsDescriptions (in category 'parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundGlass' translatedNoop
+ categoryList: {'Just for Fun' translatedNoop}
+ documentation: 'A round magnifying glass' translatedNoop
- formalName: 'RoundGlass'
- categoryList: #(Useful)
- documentation: 'A round magnifying glass'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newRound.
DescriptionForPartsBin
+ formalName: 'Hand Magnifier' translatedNoop
+ categoryList: #()
+ documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.' translatedNoop
- formalName: 'Hand Magnifier'
- categoryList: #(Useful)
- documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newShowingPointer }!
Item was changed:
----- Method: MagnifierMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
+ | stencil newForm bb |
+
- super drawOn: aCanvas. "border and fill"
aCanvas isShadowDrawing ifFalse: [
"Optimize because #magnifiedForm is expensive"
+ self isRound
+ ifTrue:[stencil := (EllipseMorph new extent: self extent; color: Color white) imageForm.
+ bb := BitBlt toForm: stencil.
+ newForm := (bb copyForm: self magnifiedForm to: 0@0 rule: Form and) destForm.
+ aCanvas paintImage: newForm at: self innerBounds origin ]
+ ifFalse:[super drawOn: aCanvas. "border and fill"
+ aCanvas paintImage: self magnifiedForm at: self innerBounds origin]]
+
+ !
- aCanvas paintImage: self magnifiedForm at: self innerBounds origin]!
Item was changed:
----- Method: MagnifierMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
+ trackPointer _ true.
+ showPointer _ false.
+ magnification _ 2.
+ roundness := false.
- trackPointer := true.
- showPointer := false.
- magnification := 2.
-
self extent: 128 @ 128!
Item was changed:
----- Method: MagnifierMorph>>isRound (in category 'round view') -----
isRound
+ ^ roundness == true!
- ^ owner isMemberOf: ScreeningMorph!
Item was changed:
----- Method: MagnifierMorph>>showingPointerString (in category 'menu') -----
showingPointerString
+ "Answer a string characterizing whether or not I'm showing the pointer."
+
+ ^ (self showPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'show pointer' translated!
- ^ (self showPointer
- ifTrue: ['stop showing pointer']
- ifFalse: ['start showing pointer']) translated!
Item was changed:
----- Method: MagnifierMorph>>sourcePoint (in category 'magnifying') -----
sourcePoint
"If we are being dragged use our center, otherwise use pointer position"
^(trackPointer not or: [owner notNil and: [owner isHandMorph]])
+ ifTrue: [self isFlexed ifTrue:[owner center] ifFalse:[self center]]
- ifTrue: [self center]
ifFalse: [self currentHand position]!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundString (in category 'round view') -----
toggleRoundString
+ "Answer a string describing whether the receiver is currently round."
+
+ ^ (self isRound ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'round' translated!
- ^ (self isRound
- ifTrue: ['be square']
- ifFalse: ['be round']) translated!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundness (in category 'round view') -----
toggleRoundness
+ roundness := roundness not.
+ self fullBounds changed
+ !
- | sm w |
- w := self world.
- self isRound
- ifTrue: [owner delete.
- w addMorph: self]
- ifFalse: [sm := ScreeningMorph new position: self position.
- sm addMorph: self.
- sm addMorph: (EllipseMorph newBounds: self bounds).
- w addMorph: sm]!
Item was changed:
----- Method: MagnifierMorph>>trackingPointerString (in category 'menu') -----
trackingPointerString
+ "Answer a string describing whether or not I'm currently tracking the pointer."
+
^ (trackPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'track pointer' translated!
- ifTrue: ['stop tracking pointer']
- ifFalse: ['start tracking pointer']) translated!
Item was changed:
----- Method: MessageNames class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MessageNames. #prototypicalToolWindow. 'Message Names' translatedNoop. 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: Morph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
^ { DescriptionForPartsBin
+ formalName: 'Status' translatedNoop
+ categoryList: #()
+ documentation: 'Buttons to run, stop, or single-step scripts' translatedNoop
- formalName: 'Status'
- categoryList: #(Scripting)
- documentation: 'Buttons to run, stop, or single-step scripts'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #scriptControlButtons.
DescriptionForPartsBin
+ formalName: 'Scripting' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop
- formalName: 'Scripting'
- categoryList: #(Scripting)
- documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #newScriptingSpace.
DescriptionForPartsBin
+ formalName: 'Random' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A tile that will produce a random number in a given range' translatedNoop
+ globalReceiverSymbol: #FunctionTile
+ nativitySelector: #randomNumberTile.
- formalName: 'Random'
- categoryList: #(Scripting)
- documentation: 'A tile that will produce a random number in a given range'
- globalReceiverSymbol: #RandomNumberTile
- nativitySelector: #new.
DescriptionForPartsBin
+ formalName: 'ButtonDown?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is down' translatedNoop
- formalName: 'ButtonDown?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is down'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #anyButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'ButtonUp?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is up' translatedNoop
- formalName: 'ButtonUp?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is up'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #noButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'NextPage' translatedNoop
+ categoryList: {'Multimedia' translatedNoop}
+ documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop
- formalName: 'NextPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #nextPageButton.
DescriptionForPartsBin
+ formalName: 'PreviousPage' translatedNoop
+ categoryList: {'Multimedia'}
+ documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop
- formalName: 'PreviousPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #previousPageButton.},
+ self partsDescriptionsFromToolsFlap!
- (Flaps quadsDefiningToolsFlap collect:
- [:aQuad | DescriptionForPartsBin fromQuad: aQuad categoryList: #(Tools)])!
Item was changed:
----- Method: ObjectsTool class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Objects' translatedNoop
+ categories: #()
+ documentation: 'A place to obtain many kinds of objects' translatedNoop!
- ^ self partName: 'Objects'
- categories: #('Useful')
- documentation: 'A place to obtain many kinds of objects'!
Item was changed:
----- Method: ObjectsTool class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ObjectsTool. #newStandAlone. 'Object Catalog' translatedNoop. 'A tool that lets you browse the catalog of objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ObjectsTool . #newStandAlone. 'Object Catalog' translatedNoop.'A tool that lets you browse the catalog of objects' translatedNoop}
- cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: ObjectsTool>>minimumWidth (in category 'layout') -----
minimumWidth
+ "Answer a width that assures that the alphabet fits in two rows. For olpc, this is increased in order to make the Connectors category not too absurdly tall."
- "Answer a width that assures that the alphabet fits in two rows"
+ ^ 400!
- ^ 300!
Item was changed:
----- Method: PackagePaneBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PackagePaneBrowser. #prototypicalToolWindow . 'Packages' translatedNoop. 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: PaintBoxMorph class>>localeChanged (in category 'notification') -----
localeChanged
| caption |
caption := ColorPickerMorph noColorCaption.
+ ColorChart ifNotNil: [
+ caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)].!
- caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)!
Item was changed:
----- Method: PaintBoxMorph>>offsetFromMaxBounds (in category 'other') -----
offsetFromMaxBounds
"location of normal PaintBox within maxBounds."
+ | left |
+ left _ self left.
+ Preferences useBiggerPaintingBox ifTrue: [left _ left - (( self width * 1.5)- self width)].
+ ^ left - colorMemory left @ 0!
-
- ^ self left - colorMemory left @ 0!
Item was changed:
----- Method: PaintBoxMorph>>recentColor: (in category 'recent colors') -----
recentColor: aColor
"Remember the color as one of our recent colors"
+ Prototype currentColor: aColor.
+ (recentColors anySatisfy: [:any | any color = aColor])
+ ifTrue: [^self]. "already remembered"
+ RecentColors := {aColor}, RecentColors allButLast.
+ RecentColors keysAndValuesDo: [:i :each |
+ (recentColors at: i) color: each]!
-
- (recentColors anySatisfy: [:any | any color = aColor]) ifTrue: [^self]. "already remembered"
- recentColors size to: 2
- by: -1
- do:
- [:i |
- (recentColors at: i) color: (recentColors at: i - 1) color.
- RecentColors at: i put: (RecentColors at: i - 1)].
- (recentColors first) color: aColor.
- RecentColors at: 1 put: aColor!
Item was changed:
----- Method: PaintBoxMorph>>showColorPalette: (in category 'actions') -----
showColorPalette: evt
| w box |
self comeToFront.
colorMemory align: colorMemory bounds topRight
with: colorMemoryThin bounds topRight.
"make sure color memory fits or else align with left"
+ w _ self world.
+ box _ self bounds: colorMemory fullBounds in: w.
- w := self world.
- box := self bounds: colorMemory fullBounds in: w.
box left < 0 ifTrue:[
colorMemory align: colorMemory bounds topLeft
with: colorMemoryThin bounds topLeft].
+ self addMorphFront: colorMemory.
+ self changed!
- self addMorphFront: colorMemory.!
Item was changed:
----- Method: PaintBoxMorph>>toggleShapes (in category 'actions') -----
toggleShapes
| tab sh stamps |
"The sub panel that has the shape tools on it. Rect, line..."
+ stamps _ self submorphNamed: 'stamps'.
+ tab _ self submorphNamed: 'shapeTab'.
+ (sh _ self submorphNamed: 'shapes') visible
- stamps := self submorphNamed: 'stamps'.
- tab := self submorphNamed: 'shapeTab'.
- (sh := self submorphNamed: 'shapes') visible
ifTrue: [sh hide. tab top: stamps bottom-1]
ifFalse: [sh comeToFront. sh top: stamps bottom-9.
sh show. tab top: sh bottom - tab height + 10].
self layoutChanged.
+ self changed
!
Item was changed:
----- Method: PaintBoxMorph>>toggleStamps (in category 'actions') -----
toggleStamps
| tab otherTab st shapes |
"The sub panel that has the stamps in it. For saving and moving parts of an image."
+ shapes _ self submorphNamed: 'shapes'.
+ otherTab _ self submorphNamed: 'shapeTab'.
+ tab _ self submorphNamed: 'stampTab'.
+ (st _ self submorphNamed: 'stamps') visible
- shapes := self submorphNamed: 'shapes'.
- otherTab := self submorphNamed: 'shapeTab'.
- tab := self submorphNamed: 'stampTab'.
- (st := self submorphNamed: 'stamps') visible
ifTrue: [st hide. st bottom: self bottom. tab top: self bottom-1.
shapes top: self bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [self bottom-1])]
ifFalse: [st top: self bottom-10. st show. tab top: st bottom-0.
shapes top: st bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [st bottom-0])].
+ self layoutChanged.
+ self changed!
- self layoutChanged.!
Item was changed:
----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Paint' translatedNoop
+ categories: #()
+ documentation: 'Drop this icon to start painting a new object.' translatedNoop!
- ^ self partName: 'Paint'
- categories: #('Basic' 'Graphics')
- documentation: 'Drop this icon to start painting a new object.'!
Item was changed:
----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PartsBin>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
wantsDroppedMorph: aMorph event: evt
"Answer whether the receiver would like to accept the given morph. For a Parts bin, we accept just about anything except something that just originated from ourselves"
(aMorph hasProperty: #beFullyVisibleAfterDrop) ifTrue:
+ [^ true].
- ["Sign that this was launched from a parts bun, probably indeed this very parts bin"
- ^ false].
^ super wantsDroppedMorph: aMorph event: evt!
Item was changed:
----- Method: PasteUpMorph class>>initialize (in category '*MorphicExtras-class initialization') -----
initialize
"Initialize the class"
+ #('keyStroke') translatedNoop.
+
self registerInFlapsRegistry.
+ ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' translatedNoop targetMorphClass: PasteUpMorph.!
- ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' targetMorphClass: PasteUpMorph.!
Item was changed:
----- Method: PasteUpMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Holder' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop
- formalName: 'Holder'
- categoryList: #(Scripting)
- documentation: 'A place for storing alternative pictures in an animation, ec.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #prototypicalHolder}!
Item was changed:
----- Method: PianoKeyboardMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'PianoKeyboard' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A piano keyboard' translatedNoop!
- ^ self partName: 'PianoKeyboard'
- categories: #('Multimedia')
- documentation: 'A piano keyboard'!
Item was changed:
----- Method: PianoKeyboardMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+
+ whiteKeyColor _ Color gray: 0.95.
+ blackKeyColor _ Color black.
+ playingKeyColor _ Color red.
+ nOctaves _ 6.
-
- whiteKeyColor := Color gray: 0.95.
- blackKeyColor := Color black.
- playingKeyColor := Color red.
- nOctaves := 6.
self buildKeyboard.
+ soundPrototype _ FMSound brass1 duration: 9.9.
+ frequency _ 0.
+ soundPrototype _ FMSound new.
+ allowingChord _ false. "Sorry!!"
+ soundPlayingList _ Array new: self submorphs size.
+ !
- soundPrototype := FMSound brass1 duration: 9.9!
Item was changed:
----- Method: PolygonMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: PolygonMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-instance creation') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {DescriptionForPartsBin
+ formalName: 'Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.' translatedNoop
- formalName: 'Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.'
globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #arrowPrototype.
+ DescriptionForPartsBin
+ formalName: 'Triangle' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A three-sided polygon.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #trianglePrototype.
+
+ DescriptionForPartsBin
+ formalName: 'Curve' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A smooth wiggly curve, or a curved solid. Shift-click to get handles and move the points. Using the halo menu, can be coverted into a polygon, and can be made "open" rather than closed.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #curvePrototype.
+ }
+
+
- nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFlaps (in category 'the buttons') -----
buttonFlaps
^self inFlapsSuppressedMode ifTrue: [
+ self makeButton: 'Show tabs' translated balloonText: 'Show tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Show tabs' balloonText: 'Show tabs' for: #toggleFlapsSuppressed
] ifFalse: [
+ self makeButton: 'Hide tabs' translated balloonText: 'Hide tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Hide tabs' balloonText: 'Hide tabs' for: #toggleFlapsSuppressed
].
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFullScreen (in category 'the buttons') -----
buttonFullScreen
^self inFullScreenMode ifTrue: [
+ self makeButton: 'Browser Reentry' translated balloonText: 'Re-enter the browser' translated for: #fullScreenOff
- self makeButton: 'Browser Reentry' balloonText: 'Re-enter the browser' for: #fullScreenOff
] ifFalse: [
+ self makeButton: 'Escape Browser' translated balloonText: 'Use the full screen' translated for: #fullScreenOn
- self makeButton: 'Escape Browser' balloonText: 'Use the full screen' for: #fullScreenOn
]
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonGoTo (in category 'the buttons') -----
buttonGoTo
+ ^self makeButton: 'GO TO' translated balloonText: 'Go to another project' translated for: #gotoAnother
- ^self makeButton: 'GO TO' balloonText: 'Go to another project' for: #gotoAnother
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewProject (in category 'the buttons') -----
buttonNewProject
+ ^self makeButton: 'NEW' translated balloonText: 'Start a new project' translated for: #newProject
- ^self makeButton: 'NEW' balloonText: 'Start a new project' for: #newProject
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewer (in category 'the buttons') -----
buttonNewer
+ ^self makeButton: 'Newer?' translated balloonText: 'Is there a newer version of this project ?' translated for: #getNewerVersionIfAvailable!
- ^self makeButton: 'Newer?' balloonText: 'Is there a newer version of this project ?' for: #getNewerVersionIfAvailable!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNext (in category 'the buttons') -----
buttonNext
+ ^self makeButton: 'NEXT >' translated balloonText: 'Next project' translated for: #nextProject!
- ^self makeButton: 'NEXT >' balloonText: 'Next project' for: #nextProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPaint (in category 'the buttons') -----
buttonPaint
| pb oldArgs brush myButton m |
+ myButton _ self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting.
+ pb _ PaintBoxMorph new submorphNamed: #paint:.
- myButton := self makeButton: '' balloonText: 'Make a painting' for: #doNewPainting.
- pb := PaintBoxMorph new submorphNamed: #paint:.
pb ifNil: [
+ (brush _ Form extent: 16@16 depth: 16) fillColor: Color red
- (brush := Form extent: 16@16 depth: 16) fillColor: Color red
] ifNotNil: [
+ oldArgs _ pb arguments.
+ brush _ oldArgs third.
+ brush _ brush copy: (2@0 extent: 42@38).
+ brush _ brush scaledToSize: brush extent // 2.
- oldArgs := pb arguments.
- brush := oldArgs third.
- brush := brush copy: (2@0 extent: 42@38).
- brush := brush scaledToSize: brush extent // 2.
].
+ myButton addMorph: (m _ brush asMorph lock).
- myButton addMorph: (m := brush asMorph lock).
myButton extent: m extent + (myButton borderWidth + 6).
m position: myButton center - (m extent // 2).
^myButton
+ "brush _ (ScriptingSystem formAtKey: 'Painting')."
- "brush := (ScriptingSystem formAtKey: 'Painting')."
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPrev (in category 'the buttons') -----
buttonPrev
+ ^self makeButton: '< PREV' translated balloonText: 'Previous project' translated for: #previousProject!
- ^self makeButton: '< PREV' balloonText: 'Previous project' for: #previousProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonQuit (in category 'the buttons') -----
buttonQuit
+ "Make and answer a button whose pressing will result in quitting out of Squeak."
+ ^self makeButton: 'QUIT' translated balloonText: 'Quit Etoys (without saving)' translated for: #quitSqueak
- ^self makeButton: 'QUIT' balloonText: 'Quit Squeak altogether' for: #quitSqueak
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonTell (in category 'the buttons') -----
buttonTell
+ ^self makeButton: 'Tell!!' translated balloonText: 'Tell a friend about this project' translated for: #tellAFriend
- ^self makeButton: 'Tell!!' balloonText: 'Tell a friend about this project' for: #tellAFriend
!
Item was changed:
----- Method: ProjectNavigationMorph>>fontForButtons (in category 'as yet unclassified') -----
fontForButtons
+ ^ Preferences standardButtonFont!
-
- ^TextStyle defaultFont!
Item was changed:
----- Method: ProjectNavigationMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self layoutInset: 6;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
useRoundedCorners.
+ mouseInside _ false.
+ !
- mouseInside := false.
- self addButtons!
Item was changed:
----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'as yet unclassified') -----
makeButton: aString balloonText: anotherString for: aSymbol
- self flag: #yo.
- "In principle, this method shouldn't call #translated."
-
^ SimpleButtonDelayedMenuMorph new target: self;
borderColor: #raised;
color: self colorForButtons;
+ label: aString font: self fontForButtons;
+ setBalloonText: anotherString;
- label: aString translated font: self fontForButtons;
- setBalloonText: anotherString translated;
actionSelector: aSymbol!
Item was changed:
----- Method: ProjectNavigationMorph>>publishDifferent (in category 'the actions') -----
publishDifferent
self
+ publishStyle: #initialDirectoryListForProjects
- publishStyle: #initialDirectoryList
forgetURL: true
withRename: false
!
Item was changed:
----- Method: ProjectNavigationMorph>>publishStyle:forgetURL:withRename: (in category 'the actions') -----
publishStyle: aSymbol forgetURL: aBoolean withRename: renameBoolean
| w saveOwner primaryServer rename |
+ w _ self world ifNil: [^Beeper beep].
- w := self world ifNil: [^Beeper beep].
w setProperty: #SuperSwikiPublishOptions toValue: aSymbol.
+ primaryServer _ w project primaryServerIfNil: [nil].
+ rename _ ((primaryServer notNil
- primaryServer := w project primaryServerIfNil: [nil].
- rename := ((primaryServer notNil
and: [primaryServer acceptsUploads]) not)
or: [renameBoolean].
+ rename := rename or: [(primaryServer isKindOf: DAVMultiUserServerDirectory)].
w setProperty: #SuperSwikiRename toValue: rename.
+ saveOwner _ owner.
- saveOwner := owner.
self delete.
[w project
storeOnServerShowProgressOn: self
forgetURL: aBoolean | rename]
ensure: [saveOwner addMorphFront: self]!
Item was changed:
+ ----- Method: ProjectSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: ProjectSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
- | b r partsBinButton newButton |
+ | b r partsBinButton newButton aWrapper |
+ newButton _ ImageMorph new image: (World project makeThumbnail scaledToSize: 48@36).
- newButton := ImageMorph new image: (World project makeThumbnail scaledToSize: 24@18).
newButton on: #mouseDown send: #insertNewProject: to: self.
newButton setBalloonText: 'Make a new Project' translated.
+ (partsBinButton _ UpdatingThreePhaseButtonMorph checkBox)
- (partsBinButton := UpdatingThreePhaseButtonMorph checkBox)
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ (r _ AlignmentMorph newRow)
- (r := AlignmentMorph newRow)
color: Color transparent;
borderWidth: 0;
layoutInset: 0;
+ cellInset: 10@0;
wrapCentering: #center;
+ cellPositioning: #leftCenter;
- cellPositioning: #topCenter;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5@5.
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- r addMorphBack: (self wrapperFor: (b label: 'Okay' translated; actionSelector: #acceptSort)).
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete));
- r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated; actionSelector: #delete));
- addMorphBack: (self wrapperFor: (newButton));
addTransparentSpacerOfSize: 8 @ 0;
+ addMorphBack: (self wrapperFor: (newButton));
+ addTransparentSpacerOfSize: 8 @ 0.
+
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
addMorphBack: (self wrapperFor: partsBinButton);
+ addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons) lock).
+ r addMorphBack: aWrapper.
- addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated) lock).
self addMorphFront: r.
!
Item was changed:
----- Method: ProjectSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
super initialize.
- ""
self useRoundedCorners.
pageHolder useRoundedCorners; borderWidth: 0;
color: (self
gridFormOrigin: 0 @ 0
+ grid: ScriptingSystem sorterGridSize
- grid: 16 @ 16
background: Color white
line: Color blue muchLighter)!
Item was changed:
----- Method: ProjectSorterMorph>>sorterMorphForProjectNamed: (in category 'as yet unclassified') -----
sorterMorphForProjectNamed: projName
| pvm proj |
+ (proj _ Project named: projName) ifNil: [^nil].
+ pvm _ (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
- (proj := Project named: projName) ifNil: [^nil].
- pvm := (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
pvm setProperty: #nameOfThisProject toValue: projName.
+ pvm isOpaque: true.
pvm setBalloonText: projName.
pvm on: #mouseDown send: #clickFromSorterEvent:morph: to: self.
pvm on: #mouseUp send: #clickFromSorterEvent:morph: to: self.
^pvm
!
Item was changed:
----- Method: RealEstateAgent class>>reduceByFlaps: (in category '*MorphicExtras-utilities') -----
reduceByFlaps: aScreenRect
"Return a rectangle that won't interfere with default shared flaps"
Flaps sharedFlapsAllowed ifFalse: [^ aScreenRect copy].
(Flaps globalFlapTabsIfAny allSatisfy:
[:ft | ft flapID = 'Painting' translated or: [ft edgeToAdhereTo == #bottom]])
ifTrue: [^ aScreenRect withHeight: aScreenRect height - 18]
+ ifFalse: [^ aScreenRect insetBy: 64]!
- ifFalse: [^ aScreenRect insetBy: 18]!
Item was changed:
----- Method: RecordingControlsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.'}
- cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: RecordingControlsMorph>>addButtonRows (in category 'initialization') -----
addButtonRows
+ | r fullWidth |
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- | r |
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Morph' translated action: #makeSoundMorph).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Tile' translated action: #makeTile).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Trim' translated action: #trim).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Show' translated action: #showEditor).
- r addMorphBack: (self buttonName: 'Show' translated action: #show).
self addMorphBack: r.
+ r layoutChanged.
+ fullWidth := r fullBounds width.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Record' translated action: #record).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Stop' translated action: #stop).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Play' translated action: #playback).
+ r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Codec' translated action: #chooseCodec).
r addMorphBack: self makeStatusLight.
self addMorphBack: r.
+ self changeCodec: OggSpeexCodec name: 'Speex'.
+ r layoutChanged.
+ fullWidth := fullWidth max: r fullBounds width.
+ ^ fullWidth@(r fullBounds height).
!
Item was changed:
----- Method: RecordingControlsMorph>>buttonName:action: (in category 'other') -----
buttonName: aString action: aSymbol
^ SimpleButtonMorph new
target: self;
+ label: aString font: Preferences standardButtonFont;
- label: aString;
actionSelector: aSymbol
!
Item was changed:
----- Method: RecordingControlsMorph>>initialize (in category 'initialization') -----
initialize
+ | r full |
- | r |
super initialize.
self hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ borderWidth _ 2.
- borderWidth := 2.
self listDirection: #topToBottom.
+ recorder _ SoundRecorder new.
+ full := self addButtonRows.
+ self addRecordLevelSliderIn: full.
- recorder := SoundRecorder new.
- self addButtonRows.
- self addRecordLevelSlider.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
+ r addMorphBack: (self makeRecordMeterIn: full).
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
- r addMorphBack: self makeRecordMeter.
self addMorphBack: r.
self extent: 10@10. "make minimum size"
!
Item was changed:
----- Method: RectangleMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RectangleMorph, #roundRectPrototype, 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: RectangleMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundRect' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A rectangle with rounded corners' translatedNoop
- formalName: 'RoundRect'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with rounded corners'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #roundRectPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a horizontal gradient' translatedNoop
- formalName: 'Gradient'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a horizontal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #gradientPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient (slanted)' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a diagonal gradient' translatedNoop
- formalName: 'Gradient (slanted)'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a diagonal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #diagonalPrototype}!
Item was changed:
----- Method: ReferenceMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'ref' translatedNoop!
- ^ 'ref'!
Item was changed:
----- Method: ScrollableField class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Info for build parts-bin entries."
+
+ ^ self partName: 'Scrolling Text' translatedNoop
+ categories: #(Basic)
+ documentation: 'A scrollable, editable body of text' translatedNoop!
- ^ self partName: 'Scrolling Text'
- categories: #('Text' )
- documentation: 'A scrollable, editable body of text'!
Item was changed:
----- Method: ScrollableField class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
forFlapNamed: 'Stack Tools'.]!
Item was changed:
----- Method: SelectorBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SelectorBrowser. #prototypicalToolWindow. 'Method Finder' translatedNoop. 'A tool for discovering methods by providing sample values for arguments and results' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results')
forFlapNamed: 'Tools']
!
Item was changed:
----- Method: SimpleSliderMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'Slider' translatedNoop!
- ^ 'Slider'!
Item was changed:
----- Method: SimpleSliderMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Slider' translatedNoop
+ categories: {'Basic' translatedNoop}
+ documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.' translatedNoop!
- ^ self partName: 'Slider'
- categories: #('Scripting')
- documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.'!
Item was changed:
----- Method: SimpleSliderMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: SimpleSliderMorph>>adjustToValue: (in category 'private') -----
adjustToValue: aNumber
"Adjust the position of this slider to correspond to the given value in the range minVal..maxVal."
"Details: Internal values are normalized to the range 0..1."
+ | toUse |
+ toUse := minVal = maxVal
+ ifTrue:
+ [minVal]
+ ifFalse:
+ [(aNumber - minVal) asFloat / (maxVal - minVal)].
+ self value: toUse
- self value:
- (aNumber - minVal) asFloat / (maxVal - minVal).
!
Item was changed:
----- Method: SimpleSliderMorph>>descendingString (in category 'menu') -----
descendingString
^ (self descending
+ ifTrue: ['switch to ascending' translatedNoop]
+ ifFalse: ['switch to descending' translatedNoop]) translated!
- ifTrue: ['switch to ascending']
- ifFalse: ['switch to descending']) translated!
Item was changed:
----- Method: SimpleSliderMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]!
Item was changed:
----- Method: SimpleSliderMorph>>truncateString (in category 'menu') -----
truncateString
^ (truncate
+ ifTrue: ['turn off truncation' translatedNoop]
+ ifFalse: ['turn on truncation' translatedNoop]) translated!
- ifTrue: ['turn off truncation']
- ifFalse: ['turn on truncation']) translated!
Item was changed:
----- Method: SketchEditorMorph>>addRotationScaleHandles (in category 'start & finish') -----
addRotationScaleHandles
"Rotation and scaling handles"
+ rotationButton _ SketchMorph withForm: (palette rotationTabForm).
- rotationButton := SketchMorph withForm: (palette rotationTabForm).
rotationButton position: bounds topCenter - (6@0).
rotationButton on: #mouseDown send: #rotateScalePrep: to: self.
rotationButton on: #mouseMove send: #rotateBy: to: self.
rotationButton on: #mouseUp send: #rotateDone: to: self.
rotationButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
rotationButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: rotationButton].
- self addMorph: rotationButton.
rotationButton setBalloonText: 'Drag me sideways to
rotate your
picture.' translated.
+ scaleButton _ SketchMorph withForm: (palette scaleTabForm).
- scaleButton := SketchMorph withForm: (palette scaleTabForm).
scaleButton position: bounds rightCenter - ((scaleButton width)@6).
scaleButton on: #mouseDown send: #rotateScalePrep: to: self.
scaleButton on: #mouseMove send: #scaleBy: to: self.
scaleButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
scaleButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: scaleButton].
- self addMorph: scaleButton.
scaleButton setBalloonText: 'Drag me up and down to change
the size
of your picture.' translated.
"REMOVED:
+ fwdButton _ PolygonMorph new.
+ pt _ bounds topCenter.
- fwdButton := PolygonMorph new.
- pt := bounds topCenter.
fwdButton borderWidth: 2; makeOpen; makeBackArrow; borderColor:
(Color r: 0 g: 0.8 b: 0).
fwdButton removeHandles; setVertices: (Array with: pt+(0@7) with:
pt+(0@22)).
fwdButton on: #mouseMove send: #forward:direction: to: self.
fwdButton on: #mouseEnter send: #mouseLeave: to: self.
fwdButton on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdButton toValue: fwdButton.
self addMorph: fwdButton.
fwdButton setBalloonText: 'Drag me around to point
in the direction
I go forward.' translated.
+ toggle _ EllipseMorph
- toggle := EllipseMorph
newBounds: (Rectangle center: fwdButton vertices last +
(-4@4) extent: 8@8)
color: Color gray.
toggle on: #mouseUp send: #toggleDirType:in: to: self.
toggle on: #mouseEnter send: #mouseLeave: to: self.
toggle on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdToggle toValue: toggle.
fwdButton addMorph: toggle.
toggle setBalloonText: 'When your object turns,
how should its
picture change?
It can rotate, face left or right,
face up or down, or not
change.' translated.
"
self setProperty: #rotationStyle toValue: hostView rotationStyle.
" self forward: hostView setupAngle direction: fwdButton. "
"Set to its current value"
!
Item was changed:
----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: (in category 'initialization') -----
initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph
+ "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
+
| aPaintBox newPaintBoxBounds worldBounds requiredWidth newOrigin aPosition aPal aTab paintBoxFullBounds |
+ (aTab _ self world paintingFlapTab) ifNotNil:
- (aTab := self world paintingFlapTab) ifNotNil:
[aTab showFlap.
^ self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: nil].
+ self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
+ aPaintBox _ self world paintBox.
+ worldBounds _ self world bounds.
+ requiredWidth _ aPaintBox width.
- aPaintBox := self world paintBox.
- worldBounds := self world bounds.
- requiredWidth := aPaintBox width.
+ aPosition _ (aPal _ aPasteUpMorph standardPalette)
- aPosition := (aPal := aPasteUpMorph standardPalette)
ifNotNil:
[aPal showNoPalette.
aPal topRight + (aPaintBox width negated @ 0 "aPal tabsMorph height")]
ifNil:
[boundsToUse topRight].
+ newOrigin _ ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
- newOrigin := ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
ifTrue: "will fit to right of aPasteUpMorph"
[aPosition]
ifFalse: "won't fit to right, try left"
[boundsToUse topLeft - (requiredWidth @ 0)].
+ paintBoxFullBounds _ aPaintBox maxBounds.
+ paintBoxFullBounds _ (newOrigin - aPaintBox offsetFromMaxBounds) extent:
- paintBoxFullBounds := aPaintBox maxBounds.
- paintBoxFullBounds := (newOrigin - aPaintBox offsetFromMaxBounds) extent:
paintBoxFullBounds extent.
+ newPaintBoxBounds _ paintBoxFullBounds translatedToBeWithin: worldBounds.
- newPaintBoxBounds := paintBoxFullBounds translatedToBeWithin: worldBounds.
self initializeFor: aSketchMorph inBounds: boundsToUse
pasteUpMorph: aPasteUpMorph
+ paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.
+ !
- paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.!
Item was changed:
----- Method: SketchEditorMorph>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "In the middle of drawing a stroke of any kind."
- "In the middle of drawing a stroke. 6/11/97 19:51 tk"
+ | pt priorEvt actionSelector |
- | pt priorEvt |
WorldState canSurrenderToOS: false. "we want maximum responsiveness"
pt := evt cursorPoint.
priorEvt := self get: #lastEvent for: evt.
(priorEvt notNil and: [pt = priorEvt cursorPoint]) ifTrue: [^self].
+ self perform: (actionSelector _ self getActionFor: evt) with: evt.
- self perform: (self getActionFor: evt) with: evt.
"Each action must do invalidRect:"
self
set: #lastEvent
for: evt
to: evt.
+ "If recording painting, mark these events so they will not be condensed. The actual path the brush takes is important."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: actionSelector]].
false
ifTrue:
["So senders will find the things performed here"
self
paint: nil;
fill: nil;
erase: nil;
pickup: nil;
stamp: nil.
self
rect: nil;
ellipse: nil;
polygon: nil;
line: nil;
star: nil]!
Item was changed:
----- Method: SketchEditorMorph>>mouseUp: (in category 'event handling') -----
mouseUp: evt
| myAction |
"Do nothing except those that work on mouseUp."
+ myAction _ self getActionFor: evt.
- myAction := self getActionFor: evt.
myAction == #fill: ifTrue: [
self perform: myAction with: evt.
"Each action must do invalidRect:"
].
myAction == #pickup: ifTrue: [
self pickupMouseUp: evt].
myAction == #polygon: ifTrue: [self polyEdit: evt]. "a mode lets you drag vertices"
self set: #lastEvent for: evt to: nil.
+ "If recording painting, note that we stopped a stroke. OK to condense points."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: #mouseUp:]].
!
Item was changed:
----- Method: SketchEditorMorph>>paint: (in category 'actions & preps') -----
paint: evt
"While the mouse is down, lay down paint, but only within window bounds.
11/28/96 sw: no longer stop painting when pen strays out of window; once it comes back in, resume painting rather than waiting for a mouse up"
+ | mousePoint startToEnd pfPen newPoint |
+ pfPen _ self get: #paintingFormPen for: evt.
+ mousePoint _ evt cursorPoint.
+ newPoint _ mousePoint - bounds origin.
+ startToEnd _ pfPen regionFor: newPoint.
+ evt shiftPressed
+ ifTrue: [pfPen gotoBack: newPoint]
+ ifFalse: [pfPen goto: newPoint].
- | mousePoint startRect endRect startToEnd pfPen myBrush |
-
- pfPen := self get: #paintingFormPen for: evt.
- myBrush := self getBrushFor: evt.
- mousePoint := evt cursorPoint.
- startRect := pfPen location + myBrush offset extent: myBrush extent.
- pfPen goto: mousePoint - bounds origin.
- endRect := pfPen location + myBrush offset extent: myBrush extent.
- "self render: (startRect merge: endRect). Show the user what happened"
- startToEnd := startRect merge: endRect.
self invalidRect: (startToEnd translateBy: bounds origin).
!
Item was changed:
----- Method: SoundEventMorph>>releaseCachedState (in category 'caching') -----
releaseCachedState
super releaseCachedState.
+ sound isCompressed
+ ifFalse: [sound _ sound compressWith: GSMCodec].
- sound := sound compressWith: GSMCodec.
!
Item was changed:
----- Method: SquishedNameMorph>>fontForName (in category 'as yet unclassified') -----
fontForName
+ ^(TextStyle default fontOfSize: 15) emphasized: 1
- | pickem |
- pickem := 3.
-
- pickem = 1 ifTrue: [
- ^(((TextStyle named: #Helvetica) ifNil: [TextStyle default]) fontOfSize: 13) emphasized: 1.
- ].
- pickem = 2 ifTrue: [
- ^(((TextStyle named: #Palatino) ifNil: [TextStyle default]) fontOfSize: 12) emphasized: 1.
- ].
- ^((TextStyle default) fontAt: 1) emphasized: 1
!
Item was changed:
----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}
- cl registerQuad: #(ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop}
- cl registerQuad: #(ScriptingSystem holderWithAlphabet 'Alphabet' 'A source for single-letter objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: StarMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Star' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'A symmetrical polygon in the shape of a star' translatedNoop!
- ^ self partName: 'Star'
- categories: #('Graphics')
- documentation: 'A symmetrical polygon in the shape of a star'!
Item was changed:
----- Method: StarMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: StickyPadMorph class>>defaultNameStemForInstances (in category 'parts bin') -----
defaultNameStemForInstances
"Answer the default name stem to use"
+ ^ 'tear off' translatedNoop
+ !
- ^ 'tear off'!
Item was changed:
----- Method: StickyPadMorph class>>descriptionForPartsBin (in category 'parts bin') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StickyPadMorph class>>launchPartVia:label: (in category 'parts bin') -----
launchPartVia: aSelector label: aString
"Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins. Overridden here so that all instances will be given the name, unlike the prevailing convention for other object types"
| aMorph |
+ aMorph _ self perform: aSelector.
- aMorph := self perform: aSelector.
aMorph setNameTo: self defaultNameStemForInstances. "i.e., circumvent uniqueness in this case"
aMorph setProperty: #beFullyVisibleAfterDrop toValue: true.
+ aMorph openInHand.
+ ^ aMorph!
- aMorph openInHand!
Item was changed:
----- Method: StickyPadMorph class>>registerInFlapsRegistry (in category 'as yet unclassified') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: StoryboardBookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Storyboard' translatedNoop
+ categories: #()
+ documentation: 'A storyboard authoring tool' translatedNoop!
- ^ self partName: 'Storyboard'
- categories: #('Presentation')
- documentation: 'A storyboard authoring tool'!
Item was changed:
----- Method: StringButtonMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'SButton' translatedNoop!
- ^ 'SButton'!
Item was changed:
----- Method: StringButtonMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]
ifFalse: [nil]!
Item was changed:
----- Method: TabMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tab' translatedNoop!
- ^ 'tab'!
Item was changed:
+ ----- Method: TabSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: TabSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
| b r |
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r _ AlignmentMorph newRow.
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r := AlignmentMorph newRow.
r color: b color; borderWidth: 0; layoutInset: 0.
r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
r wrapCentering: #topLeft.
+ r addMorphBack: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort).
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #cancelSort).
- r addMorphBack: (b label: 'Okay'; actionSelector: #acceptSort).
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (b label: 'Cancel'; actionSelector: #cancelSort).
self addMorphFront: r.
!
Item was changed:
----- Method: TabSorterMorph>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
self removeAllMorphs.
self extent: 300@100.
+ pageHolder _ PasteUpMorph new.
- pageHolder := PasteUpMorph new.
pageHolder vResizeToFit: true; autoLineLayout: true.
pageHolder extent: self extent - borderWidth.
pageHolder padding: 8.
pageHolder cursor: 0.
+ pageHolder wantsMouseOverHalos: false.
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: TabbedPalette class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tabbedPalette' translatedNoop!
- ^ 'tabbedPalette'!
Item was changed:
----- Method: TextMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {
DescriptionForPartsBin
+ formalName: 'Text (border)' translatedNoop
+ categoryList: #()
+ documentation: 'A text field with border' translatedNoop
- formalName: 'Text (border)'
- categoryList: #('Text')
- documentation: 'A text field with border'
globalReceiverSymbol: #TextMorph
nativitySelector: #borderedPrototype.
" DescriptionForPartsBin
+ formalName: 'Text (fancy)' translatedNoop
+ categoryList: {'Text' translatedNoop}
+ documentation: 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop
- formalName: 'Text (fancy)'
- categoryList: #('Text')
- documentation: 'A text field with a rounded shadowed border, with a fancy font.'
globalReceiverSymbol: #TextMorph
nativitySelector: #fancyPrototype."
DescriptionForPartsBin
+ formalName: 'Text' translatedNoop
+ categoryList: {'Basic' translatedNoop}
+ documentation:
+ 'A raw piece of text which you can edit into anything you want' translatedNoop
- formalName: 'Text'
- categoryList: #('Basic' 'Text')
- documentation: 'A raw piece of text which you can edit into anything you want'
globalReceiverSymbol: #TextMorph
+ nativitySelector: #nonwrappingPrototype.
- nativitySelector: #boldAuthoringPrototype.
}
!
Item was changed:
----- Method: Thumbnail>>makeThumbnailFromForm: (in category 'thumnail creation') -----
makeThumbnailFromForm: aForm
"Make a thumbnail from the form provided, obeying my min and max width and height preferences"
+ | scaleX scaleY margin opaque nominalWidth minimumWidth |
+ minimumWidth := self minimumWidth.
+ scaleY _ minimumHeight / aForm height. "keep height invariant"
+
+ scaleX _ ((nominalWidth := aForm width * scaleY) <= maximumWidth)
+ ifTrue:
+ [(nominalWidth < minimumWidth)
+ ifFalse:
+ [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
+ ifTrue:
+ [minimumWidth / aForm width]]
+ ifFalse:
+ [scaleY _ maximumWidth / aForm width].
- | scaleX scaleY margin opaque |
- scaleY := minimumHeight / aForm height. "keep height invariant"
- scaleX := ((aForm width * scaleY) <= maximumWidth)
- ifTrue: [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
- ifFalse: [scaleY := maximumWidth / aForm width].
"self form: (aForm magnify: aForm boundingBox by: (scaleX @ scaleY) smoothing: 2)."
"Note: A problem with magnify:by: fails to reproduce borders properly.
The following code does a better job..."
+ margin _ 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
+ opaque _ (Form extent: aForm extent + margin depth: 32) "fillWhite".
+ aForm displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
+ self form: ((opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2) fixAlpha).
- margin := 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
- opaque := (Form extent: aForm extent + margin depth: 32) "fillWhite".
- aForm fixAlpha displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
- opaque fixAlpha.
- self form: (opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2).
self extent: originalForm extent!
Item was changed:
----- Method: Thumbnail>>setStandardDefaultMetrics (in category 'initialization') -----
setStandardDefaultMetrics
"Provide the current choices for min.max width/height for thumbnails"
+ self maxWidth: 60 minHeight: 32.
+ self setProperty: #minimumWidth toValue: 16!
- self maxWidth: 60 minHeight: 24!
Item was changed:
----- Method: ThumbnailMorph>>step (in category 'stepping and presenter') -----
step
"Optimization: Don't redraw if we're viewing some kind of SketchMorph and its rotated Form hasn't changed."
| viewee f |
+ viewee _ self actualViewee.
+ viewee ifNil: [self stopStepping. ^ self].
+ viewee isSketchMorph
+ ifTrue:
+ [f := viewee rotatedForm.
+ f == lastSketchForm ifTrue: [^ self]. "The optimization"
+ lastSketchForm _ f]
+ ifFalse:
+ [lastSketchForm := nil]. "Avoids subtle bug if sketchMorph removed and then put back in"
+ self changed
- viewee := self actualViewee.
- viewee ifNil: [ self stopStepping. ^self ].
- (viewee isSketchMorph) ifTrue: [
- f := viewee rotatedForm.
- f == lastSketchForm ifTrue: [^ self].
- lastSketchForm := f].
- self changed.
!
Item was changed:
----- Method: TickIndicatorMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ self extent: 30 @ 30.
+ index _ 0!
- self extent: 20 @ 20.
- index := 0!
Item was changed:
----- Method: TransitionMorph class>>allEffects (in category 'available effects') -----
allEffects
+ #('none' 'slide over' 'slide both' 'slide away' 'slide border'
+ 'page forward' 'page back'
+ 'french door' 'zoom frame' 'zoom' 'dissolve') translatedNoop.
^ #(none
slideOver slideBoth slideAway slideBorder
pageForward pageBack
frenchDoor
zoomFrame zoom
dissolve)!
Item was changed:
----- Method: TransitionMorph class>>directionsForEffect: (in category 'available effects') -----
directionsForEffect: eff
"All these arrays are ordered so inverse is atWrap: size//2."
+ #('right' 'down right' 'down' 'down left' 'left' 'up left' 'up' 'up right'
+ 'in' 'in h' 'out' 'out h') translatedNoop.
+
(#(slideOver slideBoth slideAway slideBorder) includes: eff)
ifTrue: [^ #(right downRight down downLeft left upLeft up upRight)].
(#(pageForward pageBack) includes: eff)
ifTrue: [^ #(right down left up)].
(#(frenchDoor) includes: eff)
ifTrue: [^ #(in inH out outH)].
(#(zoomFrame zoom) includes: eff)
ifTrue: [^ #(in out)].
^ Array new!
Item was changed:
----- Method: TrashCanMorph class>>descriptionForPartsBin (in category 'miscellaneous') -----
descriptionForPartsBin
+ ^ self partName: 'Trash' translatedNoop
+ categories: { 'Basic' translatedNoop}
+ documentation: 'a tool for discarding objects' translatedNoop
+ sampleImageForm: (Form extent: 42@54 depth: 8 fromArray: #( 0 0 0 2555943 992034 555814414 587202599 654311424 0 0 0 0 0 654320418 550751400 2829625512 2829625512 2829625357 556007424 0 0 0 0 36 3553874600 2829155709 2105376125 2711726248 2829625512 2728926240 587212583 0 0 0 639882194 3433594237 1400339837 2107746472 2812848296 2829634764 2829623677 2820612864 640090112 0 0 3553809064 2097828727 2108216018 3537030348 3436367016 2829625548 3537021096 2105452577 603989760 0 9427 3537019218 22259922 4141011666 3536637138 4160212129 2712183208 2832398034 2709355944 539103014 0 2413266 3531411713 2110979575 3537031884 3435975671 4157384573 2812846461 2108216055 3430776189 488645135 654311424 651416310 2823946621 4160606930 3537030348 3539466451 2829559720 2829625506 2105398007 3534257533 2718769186 0 601019090 2097238994 4258452178 3537031891 4160213671 2812782760 2829559976 2105387218 4154948989 2099055886 254214144 4174566098 1392595922 4258452178 3537041442 3551045799 2829625512 2829625505 2105396471 3534257533 2098863648 606470144 4275229394 2097238696 4260811474 3536977959 3550980264 2829625512 2829558141 2108225271 2826796413 1998134560 589758464 584241874 3427991891 3438727890 3537031970 3433614504 2829625512 2829164961 3436377804 2709355901 1394154783 589692928 617861842 3534246674 1403572946 3537031890 3536627880 2829625512 2812848338 4157778045 2105376083 1394154527 587202560 265540306 3537030269 1397980584 2831994060 3435964584 2829625512 2831995602 3433594237 2105365330 1394154783 589758464 13871314 3537041106 2826796413 2105385640 2829559976 2829625548 3436367016 2709355901 1397902346 1394220320 606535680 639674536 2831995602 3537030312 2829625256 2829625512 2829634728 2829625469 2105365331 1280463699 186260768 606535680 1037224 2829625512 3436368594 3537030348 3433605288 2829625512 2709355895 1397967954 1376389715 404364814 254214144 9164 2829625512 2829166760 2829625512 2829625505 2709355901 1397951058 1280463370 173167480 421203235 637534208 35 2829625511 2711715197 2105376125 2105376119 1397969747 1397903954 168430156 1397954174 421339392 654311424 0 4174162088 2728492413 2105376125 2105374547 1397969747 1397969490 1280070483 2105350169 438182694 0 0 267898023 2829155709 2105376125 2104981331 1397969747 1397902346 1397979005 2105376282 455025703 0 0 16241320 2832387239 2105376125 2004318035 1397969747 1397980541 2104982910 2105350427 471928576 0 0 653775528 2832388812 2712119464 2829221245 2728960381 2105387170 2104982910 2105350683 488701990 0 0 16700071 2832388818 2829625548 3433603489 2829625469 2105387170 2104982909 2105350683 504233984 0 0 2413224 2815218380 2829559976 3433594237 2829625469 2105387176 2104982910 2105416476 220266496 0 0 2413516 2815218386 2812782760 2829614461 2829625469 2105387176 2104982909 2105416476 220341760 0 0 2413516 2815218386 2829166796 2829623677 2829625469 2105387176 2104982909 2105416733 522397440 0 0 54226 2829636306 2810030284 3433605245 2829625469 2105385640 2104982910 2105416733 522397440 0 0 2619346 2829636306 2829166760 2829625469 2829625505 2105385634 2104982945 2097945629 522462976 0 0 65234 2812859090 2829166760 3433604989 2829625469 2105387176 2104982945 2097945629 539240192 0 0 8914 2829636306 2829166760 3433605245 2829625505 2105387176 2104982945 2098797853 537863936 0 0 9427 2829634770 3433539752 3433604989 2829625505 2105387176 2104982946 2098797597 554641152 0 0 211 3433549010 3433146536 3433605245 2728962209 2105387176 2104983208 2098863389 553658112 0 0 9975 3433539794 3433144744 2829625213 2728962209 2105387176 2104983208 2098863134 234881024 0 0 10238 3433539794 3534201256 3435964321 2712184993 2105387176 2104983202 2115640350 234891008 0 0 35 3534203090 3534266792 3435964577 2108205217 2105387176 2104982946 2115705886 234881024 0 0 36 3550980306 3534268328 2831984801 2108205223 2105385640 2104982946 2115706142 570425344 0 0 0 3551045836 3534266792 2831984801 2108205224 2105385640 2105376161 2115705869 572915712 0 0 38 4155025356 3534266792 2831984801 2108205224 2105385640 2105376161 2115706125 572915712 0 0 39 4174162088 3536626088 2831984801 2108205224 2105385640 2105376126 2115771661 589758464 0 0 0 583837608 3536626087 2831984801 2108205224 2105387176 2105376161 2115771679 589692928 0 0 0 601006503 3537020839 2831984807 2108205224 2102623656 2105385342 2719751456 254214144 0 0 0 617850792 3537020833 2831984808 2108214440 2097238952 2105387170 438111502 0 0 0 0 668191948 3537021095 2829634727 2108205224 2097238952 2726142590 471736591 654311424 0 0 0 2282194 3537020833 2829634728 2711726248 2097238690 2826796314 220275750 0 0 0 0 63442 3537021095 2832387240 2107746472 2709355937 2105350686 539168550 640090112 0 0 0 211 3537030312 3536627879 2712194216 2815677352 2820414989 555885347 588195584 0 0 0 39 584307410 3433605288 2812848295 2714576126 3542093084 504176397 521015079 0 0 0 0 8992 3553414312 2829625512 2820673060 3553470632 2829589020 488579879 0 0 0 0 39 991758 235807524 2564819 3433605288 2829614621 220270375 0 0 0 0 0 0 0 2140364 3536627880 2709356064 571418112 0 0 0 0 0 0 0 581478568 3433605246 2719813120 640090112 0 0 0 0 0 0 0 13880488 2829589793 603989798 0 0 0 0 0 0 0 0 991758 570435111 654311424 0 0) offset: 0@0)!
- ^ self partName: 'Trash'
- categories: #('Useful' 'Basic')
- documentation: 'a tool for discarding objects'!
Item was changed:
----- Method: TrashCanMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'viewerFlapTab' translatedNoop!
- ^ 'viewerFlapTab'!
Item was changed:
----- Method: WaveEditor class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'WaveEditor' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A workbench for seing and editing wave forms' translatedNoop!
- ^ self partName: 'WaveEditor'
- categories: #('Multimedia')
- documentation: 'A workbench for seing and editing wave forms'!
Item was changed:
----- Method: WaveEditor>>addControls (in category 'initialization') -----
addControls
+ | slider aWrapper m aButton |
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: Color transparent;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ extent: 5 @ 5.
+ aWrapper wrapCentering: #topLeft.
+ aButton := self buttonName: 'X' action: #delete.
+ aButton setBalloonText: 'Close WaveEditor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Menu' translated action: #invokeMenu.
+ aButton setBalloonText: 'Open a menu' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play' translated action: #play.
+ aButton setBalloonText: 'Play sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor.
+ aButton setBalloonText: 'Play before cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play After' translated action: #playAfterCursor.
+ aButton setBalloonText: 'Play after cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Loop' translated action: #playLoop.
+ aButton setBalloonText: 'Play the loop' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Test' translated action: #playTestNote.
+ aButton setBalloonText: 'Test the note' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Save' translated action: #saveInstrument.
+ aButton setBalloonText: 'Save the sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd.
+ aButton setBalloonText: 'Set loop end at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle.
+ aButton setBalloonText: 'Set one cycle' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart.
+ aButton setBalloonText: 'Set the loop start at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ self addMorphBack: aWrapper.
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: self color;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #spaceFill;
+ vResizing: #rigid;
+ extent: 5 @ 20;
+ wrapCentering: #center;
+ cellPositioning: #leftCenter.
+ m := StringMorph new contents: 'Index: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #cursor;
+ putSelector: #cursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 71;
+ step.
+ aWrapper addMorphBack: m.
+ m := StringMorph new contents: 'Value: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #valueAtCursor;
+ putSelector: #valueAtCursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 50;
+ step.
+ aWrapper addMorphBack: m.
+ slider := SimpleSliderMorph new color: color;
+ extent: 200 @ 10;
+ target: self;
+ actionSelector: #scrollTime:.
+ aWrapper addMorphBack: slider.
+ m := Morph new color: aWrapper color;
+ extent: 10 @ 5.
+ "spacer"
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #startIndex;
+ putSelector: #startIndex:;
+ font: Preferences standardEToysButtonFont;
+ width: 40;
+ step.
+ aWrapper addMorphBack: m.
+ self addMorphBack: aWrapper!
- | slider bb r m |
- r := AlignmentMorph newRow.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r color: bb color; borderWidth: 0; layoutInset: 0.
- r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
- r wrapCentering: #topLeft.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'X'; actionSelector: #delete).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: '<>'; actWhen: #buttonDown;
- actionSelector: #invokeMenu).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play' translated; actionSelector: #play).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Before' translated; actionSelector: #playBeforeCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play After' translated; actionSelector: #playAfterCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Loop' translated; actionSelector: #playLoop).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Test' translated; actionSelector: #playTestNote).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Save' translated; actionSelector: #saveInstrument).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop End' translated; actionSelector: #setLoopEnd).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'One Cycle' translated; actionSelector: #setOneCycle).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop Start' translated; actionSelector: #setLoopStart).
- self addMorphBack: r.
-
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
-
- m := StringMorph new contents: 'Index: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #cursor; putSelector: #cursor:;
- growable: false; width: 71; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Value: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:;
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- slider := SimpleSliderMorph new
- color: color;
- extent: 200@2;
- target: self;
- actionSelector: #scrollTime:.
- r addMorphBack: slider.
-
- m := Morph new color: r color; extent: 10@5. "spacer"
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #startIndex; putSelector: #startIndex:;
- width: 40; step.
- r addMorphBack: m.
-
- self addMorphBack: r.
-
- !
Item was changed:
----- Method: WaveEditor>>addLoopPointControls (in category 'initialization') -----
addLoopPointControls
+ | m aWrapper |
+ aWrapper _ AlignmentMorph newRow.
+ aWrapper color: self color; borderWidth: 0; layoutInset: 0.
+ aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
- | r m |
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
+ m _ StringMorph new contents: 'Loop end: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- m := StringMorph new contents: 'Loop end: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopEnd; putSelector: #loopEnd:;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop length: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopLength; putSelector: #loopLength:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop cycles: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopCycles; putSelector: #loopCycles:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Frequency: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Frequency: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
- growable: false; width: 50; step.
- r addMorphBack: m.
+ self addMorphBack: aWrapper
- self addMorphBack: r.
!
Item was changed:
----- Method: WaveEditor>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ samplingRate _ SoundPlayer samplingRate.
+ loopEnd _ loopLength _ 0.
+ loopCycles _ 1.
+ perceivedFrequency _ 0.
- samplingRate := SoundPlayer samplingRate.
- loopEnd := loopLength := 0.
- loopCycles := 1.
- perceivedFrequency := 0.
"zero means unknown"
self extent: 5 @ 5;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ graph _ GraphMorph new extent: 450 @ 100.
- graph := GraphMorph new extent: 450 @ 100.
graph cursor: 0.
graph cursorColorAtZeroCrossings: Color blue.
self addControls.
self addLoopPointControls.
self addMorphBack: graph.
self
addMorphBack: (Morph
newBounds: (0 @ 0 extent: 0 @ 3)
color: Color transparent).
+ self addMorphBack: (keyboard _ PianoKeyboardMorph new).
+ "self sound: (SampledSound soundNamed: 'croak')."
- self addMorphBack: (keyboard := PianoKeyboardMorph new).
- self sound: (SampledSound soundNamed: 'croak').
!
Item was changed:
----- Method: Workspace class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#Workspace. #prototypicalToolWindow. 'Workspace' translatedNoop. 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.' translatedNoop} forFlapNamed: 'Tools'.]!
- ifPresent: [:cl | cl registerQuad: #(Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')
- forFlapNamed: 'Tools'.]!
1
0
Tim Felgentreff uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-tfel.185.mcz
==================== Summary ====================
Name: MorphicExtras-tfel.185
Author: tfel
Time: 6 August 2016, 1:09:14.720059 pm
UUID: 95c2b377-5926-4125-bc16-d4aa4cbaf0ac
Ancestors: MorphicExtras-pre.180, MorphicExtras-tfel.184
merge with trunk
=============== Diff against MorphicExtras-pre.180 ===============
Item was changed:
----- Method: AlignmentMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Extra items for parts bins"
^ {DescriptionForPartsBin
+ formalName: 'Column' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a column' translatedNoop
- formalName: 'Column'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a column'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #columnPrototype.
DescriptionForPartsBin
+ formalName: 'Row' translatedNoop
+ categoryList: #()
+ documentation: 'An object that presents the things within it in a row' translatedNoop
- formalName: 'Row'
- categoryList: #('Presentation')
- documentation: 'An object that presents the things within it in a row'
globalReceiverSymbol: #AlignmentMorph
nativitySelector: #rowPrototype}!
Item was changed:
+ ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'olpc support') -----
+ fancyText: aString font: aFont color: aColor
+ "Answer a morph containing a TextMorph containing the given string in the given font with the given color."
+
+ | answer tm |
+ answer _ self inAColumn: {
+ tm _ TextMorph new
+ textColor: aColor;
+ contents: aString;
+ beAllFont: aFont;
+ yourself
+ }.
+
- ----- Method: AlignmentMorphBob1>>fancyText:font:color: (in category 'as yet unclassified') -----
- fancyText: aString font: aFont color: aColor
- | answer tm col |
- col := ColorTheme current dialog3DTitles
- ifTrue: [aColor]
- ifFalse: [aColor negated].
- tm := TextMorph new.
- tm beAllFont: aFont;
- color: col;
- contents: aString.
- answer := self inAColumn: {tm}.
- ColorTheme current dialog3DTitles
- ifTrue: [""
- tm addDropShadow.
- tm shadowPoint: 5 @ 5 + tm bounds center].
tm lock.
+ ^ answer
+ !
- ^ answer!
Item was changed:
----- Method: AlignmentMorphBob1>>inARow: (in category 'as yet unclassified') -----
inARow: aCollectionOfMorphs
| row |
row := AlignmentMorph newRow color: Color transparent;
vResizing: #shrinkWrap;
layoutInset: 2;
wrapCentering: #center;
cellPositioning: #leftCenter.
aCollectionOfMorphs
+ do: [:each | each ifNotNil: [row addMorphBack: each]].
- do: [:each | row addMorphBack: each].
^ row!
Item was changed:
----- Method: BOBTransformationMorph>>recomputeExtent (in category 'as yet unclassified') -----
recomputeExtent
| scalePt newScale theGreenThingie greenIBE myNewExtent |
submorphs isEmpty ifTrue: [^self extent].
+ worldBoundsToShow ifNil: [worldBoundsToShow _ self firstSubmorph bounds].
- worldBoundsToShow ifNil: [worldBoundsToShow := self firstSubmorph bounds].
worldBoundsToShow area = 0 ifTrue: [^self extent].
+ scalePt _ owner innerBounds extent / worldBoundsToShow extent.
+ newScale _ scalePt x min: scalePt y.
+ theGreenThingie _ owner.
+ greenIBE _ theGreenThingie innerBounds extent.
+ myNewExtent _ (greenIBE min: worldBoundsToShow extent * newScale) truncated.
- scalePt := owner innerBounds extent / worldBoundsToShow extent.
- newScale := scalePt x min: scalePt y.
- theGreenThingie := owner.
- greenIBE := theGreenThingie innerBounds extent.
- myNewExtent := (greenIBE min: worldBoundsToShow extent * newScale) truncated.
self
scale: newScale;
offset: worldBoundsToShow origin * newScale.
+ smoothing _ (newScale < 1.0) ifTrue: [1] ifFalse: [1].
- smoothing := (newScale < 1.0) ifTrue: [2] ifFalse: [1].
^myNewExtent!
Item was changed:
----- Method: BasicButton class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'button' translatedNoop!
- ^ 'button'!
Item was changed:
+ ----- Method: BasicButton>>label:font: (in category 'initialization') -----
- ----- Method: BasicButton>>label:font: (in category 'as yet unclassified') -----
label: aString font: aFontOrNil
+ "Set the receiver's label and font as indicated."
| oldLabel m aFont |
+ (oldLabel _ self findA: StringMorph)
- (oldLabel := self findA: StringMorph)
ifNotNil: [oldLabel delete].
+ aFont _ aFontOrNil ifNil: [Preferences standardEToysButtonFont].
+ m _ StringMorph contents: aString font: aFont.
- aFont := aFontOrNil ifNil: [Preferences standardButtonFont].
- m := StringMorph contents: aString font: aFont.
self extent: (m width + 6) @ (m height + 6).
m position: self center - (m extent // 2).
self addMorph: m.
m lock
!
Item was changed:
----- Method: BookMorph class>>alreadyInFromUrl: (in category 'url') -----
alreadyInFromUrl: aUrl
"Does a bookMorph living in some world in this image represent the same set of server pages? If so, don't create another one. It will steal pages from the existing one. Go delete the first one."
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world ifNotNil: [
+ self inform: 'This book is already open in some project' translated.
- self inform: 'This book is already open in some project'.
^ true]]]].
^ false!
Item was changed:
----- Method: BookMorph class>>authoringPrototype (in category 'scripting') -----
authoringPrototype
"Answer an instance of the receiver suitable for placing in a parts bin for authors"
| book |
+ book := self new initializeToStandAlone.
+ book markAsPartsDonor.
- book := self new markAsPartsDonor.
- book removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
- book borderWidth: 1; borderColor: Color black.
- book beSticky.
- book showPageControls; insertPage.
^ book!
Item was changed:
----- Method: BookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Book' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'Multi-page structures' translatedNoop
+ sampleImageForm: (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAAMgAAACgCAYAAABJ/yOpAAAABHNCSVQFBQUBSsjp7wAABMtJ
+ REFUeF7l3S2S4kAAgFEkEonkCEiOgEQikUgkEolEcgSOgEQiOcYcAZfdniqmpnaBkE43JHni
+ 7dZuzWR7m3z5ISHT6/X6hc/ne+TvL9fr1efz/cMPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5OhLI
+ 19eXz9dZfiA+nx+Iz+cH4vN1K5Dz+fxUEyaoCWP0xwAF8ntSy94l+NQL0IQx+mMAA3llop+9
+ AO+K49Nj9MeABfLqVujVrVTOvcYnx+iPAQwkxWTn3kI1YYz+GMBAckx4kw4lUo3RH4MfiB9I
+ hTHU/ZSbH0gLAsk54akmvuoYY+5LKxvjvTGkDCR2DKnnoq2RZAkkNo4cK2DKOGJv3Hw0xkdj
+ SB1IzBhyzEedSC6XS7Hf74vFYlGMx+Nit9uVfs9yufz++jrLaFwg75r0KmMsW/nkQKrMSexr
+ dTgc/vs/rlar0u/r9/vfkdRZRiMDecekvzrGV1Y+PZBX5yX2tTqdTsVmsymOx+PPir5er0uj
+ CoGE74ldRpZA6px7xK6Mud7OrLtSPhvjszHkCKTqGHLMQYpzkdvKXbb1D3uO0WhUaxmNDyTX
+ pKdeMXIFkvoQNXcgMfMQG0jZ1n84HP4cXsUuoxWB5Jj0sjGm3GprgZSN+x17kHA4Fb4mfG3n
+ 9yA5Jj3H4Y1/iBU3hhx7kHCuMRgMau+F/ED8QFobyLOt/2QyKebzee3zGP8Qyz/Eau0h1qOt
+ f7jWEd69Ctc7iD2If5Lun6RX2fqHi3/PDq86tQfx3+b13+atuvUPh1az2SzJO2H+hUL/QmEr
+ LhTermuELX5Y+cO/F84zwp/D34d3rX5fPd9ut7WW4d9q0pJbTVLOX5tvNbmdeIf7p+79frta
+ ftszhPOQ2GX4Nyu26GbFNgTSpDt6w02I0+nUv93dv93dv9390Qn6o4uD/gem/A9M+R+Y8j9R
+ 6H/k1v/Irf/QBv+hDf5DG/zH/viP/fHH4AfiPzjOH4MfiP/oUf/Ro/6jR/2HV/sPr/YfXu3/
+ +AOfzw/E5/MD8fn8QHy+pgfi8/k/BtqfDJ/PD8Tn8wPx+fxAfD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fzw/E5/MD8fn8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8QPx+fxAfD4/EJ/PD8Tn8wPx+fxAfL47ro3i
+ B+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fD4/EJ/PD8Tn8wPx+fxAfD4/
+ EJ/PD8Tn8wPx+fxAfD4/EJ/PD8QPxOfzA/H5/EB8Pj8Qn88PxOfzA/H5/EB8Pj8Qn88PxOfz
+ A/H5fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiM/nB+Lz+YH4fH4gPp8fiB+Iz+cH4vP5gfg+o6P8
+ QHw+PxCfzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHw+PxCfz+cH4vP5gfh8fiA+nx+Iz+cH
+ 4vP5gfh8fiA+nx+Iz+cH4vP5gfiB+Hx+ID6fH4jP5wfi8/mB+Hx+ID6fH4jP5wfi8/mB+Hx+
+ ID6fzw/E5/MD8fn8QHw+PxCfzw/E5/MD8fn8QHy+jgXi8/nu+wM79mpMjbRBXAAAAABJRU5E
+ rkJggg==' readStream) readStream) nextImage!
- ^ self partName: 'Book'
- categories: #('Presentation')
- documentation: 'Multi-page structures'!
Item was changed:
----- Method: BookMorph class>>initialize (in category 'class initialization') -----
initialize
- FileList registerFileReader: self.
-
self registerInFlapsRegistry. !
Item was changed:
----- Method: BookMorph class>>isInWorld:withUrl: (in category 'url') -----
isInWorld: aWorld withUrl: aUrl
| urls bks short |
"If a book with this url is in the that (current) world, return it. Say if it is out or in another world."
+ urls _ OrderedCollection new.
+ bks _ OrderedCollection new.
- urls := OrderedCollection new.
- bks := OrderedCollection new.
aWorld allMorphsDo: [:aBook | (aBook isKindOf: BookMorph) ifTrue: [
bks add: aBook.
(urls add: (aBook valueOfProperty: #url)) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]]]]. "shortcut"
self withAllSubclassesDo: [:cls |
cls allInstancesDo: [:aBook |
(aBook valueOfProperty: #url) = aUrl ifTrue: [
aBook world == aWorld
ifTrue: [^ aBook]
ifFalse: [
+ self inform: 'Book may be open in some other project' translated.
- self inform: 'Book may be open in some other project'.
^ aBook]]]].
"if same book name, use it"
+ short _ (aUrl findTokens: '/') last.
- short := (aUrl findTokens: '/') last.
urls withIndexDo: [:kk :ind | (kk findTokens: '/') last = short ifTrue: [
^ bks at: ind]].
^ #out!
Item was changed:
----- Method: BookMorph class>>nextPageButton (in category 'scripting') -----
nextPageButton
+ "Answer a button that will take the user to the next page of its
+ enclosing book"
- "Answer a button that will take the user to the next page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #NextPage.
+ aButton target: aButton.
+ aButton actionSelector: #nextOwnerPage.
+ aButton arguments: #().
+ aButton setNameTo: 'previous'.
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #nextOwnerPage; label: '->'; color: Color yellow.
- aButton setNameTo: 'next'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>openFromFile: (in category 'fileIn/Out') -----
openFromFile: fullName
"Reconstitute a Morph from the selected file, presumed to be represent
a Morph saved via the SmartRefStream mechanism, and open it in an
appropriate Morphic world"
| book aFileStream |
Smalltalk verifyMorphicAvailability ifFalse: [^ self].
+ aFileStream _ FileStream readOnlyFileNamed: fullName.
+ book _ BookMorph new.
- aFileStream := FileStream oldFileNamed: fullName.
- book := BookMorph new.
book setProperty: #url toValue: aFileStream url.
book fromRemoteStream: aFileStream.
aFileStream close.
Smalltalk isMorphic
ifTrue: [ActiveWorld addMorphsAndModel: book]
ifFalse:
[book isMorph ifFalse: [^self inform: 'Can only load a single morph
+ into an mvc project via this mechanism.' translated].
- into an mvc project via this mechanism.'].
book openInWorld].
book goToPage: 1!
Item was changed:
----- Method: BookMorph class>>previousPageButton (in category 'scripting') -----
previousPageButton
+ "Answer a button that will take the user to the previous page of its
+ enclosing book"
- "Answer a button that will take the user to the previous page of its enclosing book"
-
| aButton |
+ aButton := ThreePhaseButtonMorph labelSymbol: #PrevPage.
+ aButton target: aButton.
+ aButton actionSelector: #previousOwnerPage.
+ aButton arguments: #().
- aButton := SimpleButtonMorph new.
- aButton target: aButton; actionSelector: #previousOwnerPage; color: Color yellow; label: '<-'.
aButton setNameTo: 'previous'.
^ aButton!
Item was changed:
----- Method: BookMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BookMorph . #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
- cl registerQuad: #(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}
- cl registerQuad: #(BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}
- cl registerQuad: #(BookMorph authoringPrototype 'Book' 'A multi-paged structure')
forFlapNamed: 'Supplies']!
Item was changed:
----- Method: BookMorph class>>serviceLoadAsBook (in category 'fileIn/Out') -----
serviceLoadAsBook
^ SimpleServiceEntry
provider: self
+ label: 'load as book' translatedNoop
- label: 'load as book'
selector: #openFromFile:
+ description: 'open as bookmorph' translatedNoop!
- description: 'open as bookmorph'!
Item was changed:
----- Method: BookMorph>>goToPageMorph:transitionSpec: (in category 'navigation') -----
goToPageMorph: newPage transitionSpec: transitionSpec
+ "Go to a page, which is assumed to be an element of my pages array (if it is not, this method returns quickly. Apply the transitionSpec provided."
+
| pageIndex aWorld oldPageIndex ascending tSpec readIn |
pages isEmpty ifTrue: [^self].
self setProperty: #searchContainer toValue: nil. "forget previous search"
self setProperty: #searchOffset toValue: nil.
self setProperty: #searchKey toValue: nil.
pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"].
readIn := newPage isInMemory not.
oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil].
ascending := (oldPageIndex isNil or: [newPage == currentPage])
ifTrue: [nil]
ifFalse: [oldPageIndex < pageIndex].
tSpec := transitionSpec ifNil:
["If transition not specified by requestor..."
newPage valueOfProperty: #transitionSpec
ifAbsent:
[" ... then consult new page"
self transitionSpecFor: self " ... otherwise this is the default"]].
self flag: #arNote. "Probably unnecessary"
(aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus].
currentPage ifNotNil: [currentPage updateCachedThumbnail].
self currentPage notNil
ifTrue:
[(((pages at: pageIndex) owner isKindOf: TransitionMorph)
and: [(pages at: pageIndex) isInWorld])
ifTrue: [^self "In the process of a prior pageTurn"].
self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts].
+ self removeViewersOnSubsIn: ActiveWorld presenter.
ascending ifNotNil:
["Show appropriate page transition and start new page when done"
currentPage stopStepping.
(pages at: pageIndex) position: currentPage position.
^(TransitionMorph
effect: tSpec second
direction: tSpec third
inverse: (ascending or: [transitionSpec notNil]) not)
showTransitionFrom: currentPage
to: (pages at: pageIndex)
in: self
whenStart: [self playPageFlipSound: tSpec first]
whenDone:
[currentPage
delete;
fullReleaseCachedState.
self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrlInBook: self url.
currentPage sqkPage computeThumbnail "just store it"]]].
"No transition, but at least decommission current page"
currentPage
delete;
fullReleaseCachedState].
+ self insertPageMorphInCorrectSpot: (pages at: pageIndex). "sets currentPage"
- self insertPageMorphInCorrectSpot: (pages at: pageIndex).
self adjustCurrentPageForFullScreen.
self snapToEdgeIfAppropriate.
aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage].
self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts].
(aWorld := self world) ifNotNil:
["WHY??"
-
aWorld displayWorld].
readIn
ifTrue:
[currentPage updateThumbnailUrl.
+ currentPage sqkPage computeThumbnail "just store it"].
+ ActiveWorld ifNotNil: [ActiveWorld presenter flushPlayerListCache]!
- currentPage sqkPage computeThumbnail "just store it"]!
Item was changed:
----- Method: BookMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
+ super initializeToStandAlone.
+ self removeEverything; pageSize: 360@228; color: Color white.
- self initialize.
- self removeEverything; pageSize: 360@228; color: (Color gray: 0.9).
self borderWidth: 1; borderColor: Color black.
self beSticky.
self showPageControls; insertPage.
^ self!
Item was changed:
----- Method: BookMorph>>pasteBookPage (in category 'menu') -----
pasteBookPage
+ "If the paste buffer has something to paste, paste it as a book page."
+
| aPage |
+ aPage _ self primaryHand objectToPaste.
+ aPage removeProperty: #revertKey.
- aPage := self primaryHand objectToPaste.
self insertPage: aPage pageSize: aPage extent atIndex: ((pages indexOf: currentPage) - 1).
"self goToPageMorph: aPage"!
Item was changed:
----- Method: BookMorph>>setNewPagePrototype (in category 'menu') -----
setNewPagePrototype
"Record the current page as the prototype to be copied when inserting new pages."
currentPage ifNotNil:
+ [newPagePrototype _ currentPage veryDeepCopy.
+ newPagePrototype removeProperty: #revertKey].
+ "When a new page is inserted, it will not have any original page to revert to. After author improves the new page, he can save it for later revert."
- [newPagePrototype := currentPage veryDeepCopy].
!
Item was changed:
+ ----- Method: BookPageSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: BookPageSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
+ | bb r str aCheckbox aWrapper |
+ r _ AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
+ r wrapCentering: #center; cellPositioning: #leftCenter;
- | bb r aButton str |
- r := AlignmentMorph newRow color: Color transparent; borderWidth: 0; layoutInset: 0.
- r wrapCentering: #center; cellPositioning: #topCenter;
hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ bb setBalloonText: 'Accept the changes made here as the new page-order for this book' translated.
+ r addTransparentSpacerOfSize: 12.
+ bb _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete)).
+ bb setBalloonText: 'Forgot any changes made here, and dismiss this sorter' translated.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Okay' translated; actionSelector: #acceptSort)).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (self wrapperFor: (bb label: 'Cancel' translated; actionSelector: #delete)).
+ "eliminate the parts-bin button on the book-page sorters...
+ r addTransparentSpacerOfSize: 24 @ 0.
+
+ aCheckbox := UpdatingThreePhaseButtonMorph checkBox.
+ aCheckbox
- r addTransparentSpacerOfSize: 8 @ 0.
- r addMorphBack: (self wrapperFor: (aButton := UpdatingThreePhaseButtonMorph checkBox)).
- aButton
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ str _ StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons.
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
+ addMorphBack: (self wrapperFor: aCheckbox);
+ addMorphBack: (self wrapperFor: str lock).
+ r addMorphBack: aWrapper."
- str := StringMorph contents: 'Parts bin' translated.
- r addMorphBack: (self wrapperFor: str lock).
+ self addMorphFront: r
- self addMorphFront: r.
!
Item was changed:
----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'as yet unclassified') -----
book: aBookMorph morphsToSort: morphList
+ | innerBounds scrollPane newHeight |
+ book _ aBookMorph.
+ newHeight _ self currentWorld height.
- | innerBounds |
- book := aBookMorph.
pageHolder removeAllMorphs.
pageHolder addAllMorphs: morphList.
pageHolder extent: pageHolder width@pageHolder fullBounds height.
+ innerBounds _ Rectangle merging: (morphList collect: [:m | m bounds]).
+ pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.
+ (pageHolder height > newHeight) ifTrue: [
+ scrollPane _ ScrollPane new.
+
+ self height: newHeight.
+ scrollPane model: pageHolder.
+ scrollPane extent: pageHolder width@(newHeight - aBookMorph submorphs first height - 28).
+ self addMorph: scrollPane inFrontOf: pageHolder.
+ scrollPane scroller addMorph: pageHolder.
+ scrollPane scrollBarOnLeft: false.
+ scrollPane retractable: false.
+ scrollPane hideHScrollBarIndefinitely: true.
+ scrollPane borderWidth: 1; borderColor: Color gray.
+ ].
+ !
- innerBounds := Rectangle merging: (morphList collect: [:m | m bounds]).
- pageHolder extent: innerBounds extent + pageHolder borderWidth + 6.!
Item was changed:
----- Method: BookPageSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: Display extent - 100;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ pageHolder _ PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
- pageHolder := PasteUpMorph new behaveLikeHolder extent: self extent -self borderWidth.
pageHolder hResizing: #shrinkWrap.
+ pageHolder wantsMouseOverHalos: false.
"pageHolder cursor: 0."
"causes a walkback as of 5/25/2000"
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: BookPageThumbnailMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
| f |
super initialize.
+ flipOnClick _ false.
- ""
- flipOnClick := false.
+ f _ Form extent: 160@120 depth: Display depth.
- f := Form extent: 60 @ 80 depth: Display depth.
f fill: f boundingBox fillColor: color.
self form: f!
Item was changed:
----- Method: BooklikeMorph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
"This factoring allows subclasses to have different menu yet still use the super call for the rest of the metamenu."
super addCustomMenuItems: aCustomMenu hand: aHandMorph.
+ aCustomMenu add: 'book...' translated target: self action: #invokeBookMenu.
+
+ "self addBookMenuItemsTo: aCustomMenu hand: aHandMorph"!
- self addBookMenuItemsTo: aCustomMenu hand: aHandMorph!
Item was changed:
----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') -----
currentPlayerDo: aBlock
| aPlayer aPage |
(aPage := self currentPage) ifNil: [^ self].
+ aPage allMorphsDo:[ :m|
+ (aPlayer := m player) ifNotNil:
+ [aBlock value: aPlayer]]!
- (aPlayer := aPage player) ifNotNil:
- [aBlock value: aPlayer]!
Item was changed:
----- Method: BooklikeMorph>>makePageControlsFrom: (in category 'page controls') -----
makePageControlsFrom: controlSpecs
"From the controlSpecs, create a set of page control and return them -- this method does *not* add the controls to the receiver."
| c col row |
c := (color saturation > 0.1) ifTrue: [color slightlyLighter] ifFalse: [color slightlyDarker].
col := AlignmentMorph newColumn.
col color: c; borderWidth: 0; layoutInset: 0.
col hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5.
row := AlignmentMorph newRow.
row color: c; borderWidth: 0; layoutInset: 0.
row hResizing: #spaceFill; vResizing: #shrinkWrap; extent: 5@5.
controlSpecs do: [:spec | | lastGuy b |
+ spec == #showDescription ifTrue: [row addMorphBack: self makeDescriptionViewer].
+ spec == #pageNumber ifTrue: [row addMorphBack: self makePageNumberItem].
+ spec == #spacer ifTrue: [row addTransparentSpacerOfSize: (10 @ 0)].
+ spec == #variableSpacer ifTrue: [
+ row addMorphBack: AlignmentMorph newVariableTransparentSpacer].
+ spec class == Array ifTrue: [
+ spec first isSymbol
+ ifTrue: [b := ThreePhaseButtonMorph labelSymbol: spec first]
+ ifFalse: [b := SimpleButtonMorph new borderWidth: 2;
+ borderColor: Color black; color: Color veryLightGray.
+ b label: spec first font: Preferences standardMenuFont].
+ b target: self; actionSelector: spec second; setBalloonText: spec third.
+ (spec atPin: 4) = #border
+ ifTrue: [b actWhen: #buttonDown]
+ ifFalse: [b borderWidth: 0]. "default is none"
+ row addMorphBack: b.
+ (((lastGuy _ spec last asLowercase) includesSubString: 'menu') or:
+ [lastGuy includesSubString: 'designations'])
+ ifTrue: [b actWhen: #buttonDown]]]. "pop up menu on mouseDown"
- spec == #spacer
- ifTrue:
- [row addTransparentSpacerOfSize: (10 @ 0)]
- ifFalse:
- [spec == #variableSpacer
- ifTrue:
- [row addMorphBack: AlignmentMorph newVariableTransparentSpacer]
- ifFalse:
- [b := SimpleButtonMorph new target: self; borderWidth: 1;
- borderColor: Color veryLightGray; color: c.
- b label: spec first;
- actionSelector: spec second;
- borderWidth: 0;
- setBalloonText: spec third.
- row addMorphBack: b.
- (((lastGuy := spec last asLowercase) includesSubstring: 'menu') or:
- [lastGuy includesSubstring: 'designations'])
- ifTrue: [b actWhen: #buttonDown]]]]. "pop up menu on mouseDown"
col addMorphBack: row.
^ col!
Item was changed:
----- Method: BooklikeMorph>>shortControlSpecs (in category 'page controls') -----
shortControlSpecs
+ "Answer specs defining the widgets in the short form of the control panel."
+
^ {
#spacer.
#variableSpacer.
{'<'. #previousPage. 'Previous page' translated}.
#spacer.
+ {#MenuIcon. #invokeShortBookMenu. 'Click here to get a menu of options for this book.' translated}.
- {'·'. #invokeBookMenu. 'Click here to get a menu of options for this book.' translated}.
#spacer.
{'>'. #nextPage. 'Next page' translated}.
#spacer.
#variableSpacer.
+ {#RightCaret. #showMoreControls. 'More controls' translated}
- {'³'. #showMoreControls. 'More controls' translated}
}
!
Item was changed:
----- Method: BooklikeMorph>>showingFullScreenString (in category 'misc') -----
showingFullScreenString
+ "Answer a string characterizing whether the receiver is operating in full-screen mode."
+
+ ^ (self isInFullScreenMode ifTrue: ['<yes>'] ifFalse: ['<no>']), 'view pages full-screen' translated!
- ^ (self isInFullScreenMode
- ifTrue: ['exit full screen']
- ifFalse: ['show full screen']) translated!
Item was changed:
----- Method: BooklikeMorph>>showingPageControlsString (in category 'misc') -----
showingPageControlsString
+ "Answer a string characterizing whether page controls are currently showing."
+
+ ^ (self pageControlsVisible ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'page controls visible' translated!
- ^ (self pageControlsVisible
- ifTrue: ['hide page controls']
- ifFalse: ['show page controls']) translated!
Item was changed:
----- Method: BouncingAtomsMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'BouncingAtoms' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney' translatedNoop!
- ^ self partName: 'BouncingAtoms'
- categories: #('Demo')
- documentation: 'The original, intensively-optimized bouncing-atoms simulation by John Maloney'!
Item was changed:
----- Method: BouncingAtomsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#BouncingAtomsMorph, #new. 'Bouncing Atoms' translatedNoop. 'Atoms, mate' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(BouncingAtomsMorph new 'Bouncing Atoms' 'Atoms, mate')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: ClockMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Answer a description for use in parts bins."
+
+ ^ self partName: 'Digital Clock' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A digital clock' translatedNoop!
- ^ self partName: 'Clock'
- categories: #('Useful')
- documentation: 'A digital clock'!
Item was changed:
----- Method: ClockMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ClockMorph, #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}
- cl registerQuad: #(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: ClockMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
+ "Add toggles for showing-seconds and display-24-hrs to the halo menu"
+
+ "NB: intentionallyi no super call here!!"
+
+ aCustomMenu add: 'change font' translated action: #changeFont.
+
+ aCustomMenu addUpdating: #showingSecondsString action: #toggleShowingSeconds.
+ aCustomMenu addUpdating: #displaying24HourString action: #toggleShowing24hr!
- "Note minor loose end here -- if the menu is persistent, then the wording will be wrong half the time"
- | item |
- super addCustomMenuItems: aCustomMenu hand: aHandMorph.
- item := showSeconds == true
- ifTrue: ['stop showing seconds']
- ifFalse: ['start showing seconds'].
- aCustomMenu add: item translated target: self action: #toggleShowingSeconds.
- item := show24hr == true
- ifTrue: ['display Am/Pm']
- ifFalse: ['display 24 hour'].
- aCustomMenu add: item translated target: self action: #toggleShowing24hr.
-
- !
Item was changed:
----- Method: ClockMorph>>initialize (in category 'initialization') -----
initialize
+ "initialize the state of the receiver"
+
- "initialize the state of the receiver"
super initialize.
+
+ showSeconds _ true.
+ show24hr _ false.
+ self font: Preferences standardMenuFont emphasis: 1.
- ""
- showSeconds := true.
- show24hr := false.
self step!
Item was changed:
----- Method: ClockMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
super initializeToStandAlone.
+ showSeconds _ false.
+ self font: (Preferences standardMenuFont emphasized: 1).
- showSeconds := true.
self step!
Item was changed:
----- Method: CurveMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#CurveMorph, #authoringPrototype. 'Curve' translatedNoop, 'A curve' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#CurveMorph. #authoringPrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}
- cl registerQuad: #(CurveMorph authoringPrototype 'Curve' 'A curve')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: CurveMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Curvy Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.' translatedNoop
- formalName: 'Curvy Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A curved line with an arrowhead. Shift-click to get handles and move the points.'
globalReceiverSymbol: #CurveMorph
nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: EllipseMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}
- cl registerQuad: #(EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: EnvelopeEditorMorph>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: menu hand: aHandMorph
super addCustomMenuItems: menu hand: aHandMorph.
menu addLine.
envelope updateSelector = #ratio: ifTrue:
[menu add: 'choose denominator...' translated action: #chooseDenominator:].
menu add: 'adjust scale...' translated action: #adjustScale:.
- SoundPlayer isReverbOn
- ifTrue: [menu add: 'turn reverb off' translated target: SoundPlayer selector: #stopReverb]
- ifFalse: [menu add: 'turn reverb on' translated target: SoundPlayer selector: #startReverb].
menu addLine.
menu add: 'get sound from lib' translated action: #chooseSound:.
menu add: 'put sound in lib' translated action: #saveSound:.
menu add: 'read sound from disk...' translated action: #readFromDisk:.
menu add: 'save sound on disk...' translated action: #saveToDisk:.
menu add: 'save library on disk...' translated action: #saveLibToDisk:.
!
Item was changed:
----- Method: EnvelopeEditorMorph>>buildScalesIn: (in category 'editing') -----
buildScalesIn: frame
+ | env |
+ env _ envelope.
+ pixPerTick _ graphArea width // (self maxTime//10) max: 1.
+ "hminortick _ ( 1 + ( self maxTime // 800 ) ) * 10.
+ hmajortick _ ( 1 + ( self maxTime // 800 ) ) * 100."
+ hScale _ (Morph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1))) color: Color lightGreen.
+ " hScale _ (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
- | env hmajortick hminortick |
- env := envelope.
- pixPerTick := graphArea width // (self maxTime//10) max: 1.
- hminortick := ( 1 + ( self maxTime // 800 ) ) * 10.
- hmajortick := ( 1 + ( self maxTime // 800 ) ) * 100.
- hScale := (ScaleMorph newBounds: ((graphArea left)@(frame top) corner: (self xFromMs: self maxTime)@(graphArea top - 1)))
start: 0 stop: self maxTime
minorTick: hminortick minorTickLength: 3
majorTick: hmajortick majorTickLength: 10
caption: 'milliseconds' tickPrintBlock: [:v | v printString].
+ "
self addMorph: hScale.
+ vScale _ (Morph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))) color: Color lightGreen.
+ "vScale _ ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left))."
- vScale := ScaleMorph newBounds: (0@0 extent: (graphArea height)@(graphArea left - frame left)).
env name = 'pitch'
ifTrue:
[env scale >= 2.0
ifTrue:
[vScale start: 0 stop: env scale
minorTick: env scale / 24 minorTickLength: 3
majorTick: env scale / 2.0 majorTickLength: 10
caption: 'pitch (octaves)'
tickPrintBlock: [:v | (v-(env scale/2)) asInteger printString]]
ifFalse:
[vScale start: 0 stop: env scale
minorTick: 1.0/48.0 minorTickLength: 3
majorTick: 1.0/12.0 majorTickLength: 10
caption: 'pitch (half-steps)'
tickPrintBlock: [:v | (v-(env scale/2)*12) rounded printString]]]
ifFalse: [
env name = 'random pitch:'
ifTrue: [
vScale start: 0.9 stop: 1.1
minorTick: 0.2 / 50.0 minorTickLength: 3
majorTick: 0.2 / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]]
ifFalse: [
vScale start: 0 stop: env scale
minorTick: env scale / 50.0 minorTickLength: 3
majorTick: env scale / 5.0 majorTickLength: 10
caption: env name
tickPrintBlock: [:v | v printString]].
].
+ vScale _ TransformationMorph new asFlexOf: vScale.
- vScale := TransformationMorph new asFlexOf: vScale.
vScale angle: Float pi / 2.0.
self addMorph: vScale.
vScale position: (frame left)@(graphArea top-1) - (3@1).
!
Item was changed:
----- Method: EventRecorderMorph>>addButtons (in category 'initialization') -----
addButtons
+ | r b w |
- | r b |
caption ifNotNil: ["Special setup for play-only interface"
+ (r _ self makeARowForButtons)
- (r := self makeARowForButtons)
addMorphBack: (SimpleButtonMorph new target: self;
+ label: caption font: Preferences standardButtonFont; actionSelector: #play);
- label: caption; actionSelector: #play);
- addMorphBack: self makeASpacer;
- addMorphBack: self makeStatusLight;
addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
+ addMorphBack: self makeASpacer.
^ self addMorphBack: r
].
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#record. nil. 'Begin recording'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#record. nil. 'Begin recording'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#stop. b width. 'Stop recording - you can also use the ESC key to stop it'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#play. b width. 'Play current recording'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#writeTape. nil. 'Save current recording on disk'});
addMorphBack: self makeASpacer;
addMorphBack: (self buttonFor: {#readTape. b width. 'Get a new recording from disk'}).
self addMorphBack: r.
+ (r _ self makeARowForButtons)
+ addMorphBack: (b _ self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
+ addMorphBack: self makeASpacer.
+ w := r fullBounds height * 0.5.
+ r addMorphBack: (self makeStatusLightIn: (w@w));
- (r := self makeARowForButtons)
- addMorphBack: (b := self buttonFor: {#shrink. nil. 'Make recording shorter by removing unneeded events'});
addMorphBack: self makeASpacer;
+ addMorphBack: (self buttonFor: {#createPlayButton. b width. 'Make a simple button to play this recording'}).
- addMorphBack: self makeStatusLight;
- addMorphBack: self makeASpacer;
- addMorphBack: (self buttonFor: {#button. b width. 'Make a simple button to play this recording'}).
self addMorph: r.
self setStatusLight: #ready.!
Item was changed:
----- Method: EventRecorderMorph>>handleListenEvent: (in category 'events-processing') -----
handleListenEvent: anEvent
"Record the given event"
+ anEvent hand == recHand ifFalse: [^ self]. "not for me"
+ state == #record ifFalse: [
+ "If user got an error while recording and deleted recorder, will still be listening"
+ recHand ifNotNil: [recHand removeEventListener: self].
+ ^self].
- (state == #record and:[anEvent hand == recHand])
- ifFalse:[^self].
anEvent = lastEvent ifTrue: [^ self].
(anEvent isKeyboard and:[anEvent keyValue = 27 "esc"])
ifTrue: [^ self stop].
+ time _ anEvent timeStamp.
- time := anEvent timeStamp.
tapeStream nextPut: (anEvent copy setHand: nil).
journalFile ifNotNil:
[journalFile store: anEvent; cr; flush].
+ lastEvent _ anEvent.!
- lastEvent := anEvent.!
Item was changed:
----- Method: EventRecorderMorph>>pauseIn: (in category 'pause/resume') -----
pauseIn: aWorld
"Suspend playing or recording, either as part of a stop command,
or as part of a project switch, after which it will be resumed."
self setStatusLight: #ready.
state = #play ifTrue:
+ [state _ #suspendedPlay.
+ playHand halo ifNotNil: [playHand halo delete].
- [state := #suspendedPlay.
playHand delete.
aWorld removeHand: playHand.
+ playHand _ nil].
- playHand := nil].
state = #record ifTrue:
+ [state _ #suspendedRecord.
- [state := #suspendedRecord.
recHand removeEventListener: self.
+ recHand _ nil].
- recHand := nil].
voiceRecorder ifNotNil:
[voiceRecorder pause.
startSoundEvent ifNotNil:
[startSoundEvent argument: voiceRecorder recordedSound.
voiceRecorder clearRecordedSound.
+ startSoundEvent _ nil]].
- startSoundEvent := nil]].
!
Item was changed:
----- Method: EventRecorderMorph>>readTape (in category 'fileIn/Out') -----
readTape
^ self readTape: (UIManager default
+ request: 'Tape to read' translated
- request: 'Tape to read'
initialAnswer: 'tapeName.tape').!
Item was changed:
----- Method: EventRecorderMorph>>resumeIn: (in category 'pause/resume') -----
resumeIn: aWorld
"Resume playing or recording after a project switch."
+ self state = #suspendedPlay ifTrue:
- state = #suspendedPlay ifTrue:
[self resumePlayIn: aWorld].
+ self state = #suspendedRecord ifTrue:
- state = #suspendedRecord ifTrue:
[self resumeRecordIn: aWorld].
!
Item was changed:
----- Method: EventRecorderMorph>>resumePlayIn: (in category 'pause/resume') -----
resumePlayIn: aWorld
+ playHand _ HandMorphForReplay new recorder: self.
- playHand := HandMorphForReplay new recorder: self.
playHand position: tapeStream peek position.
aWorld addHand: playHand.
playHand newKeyboardFocus: aWorld.
playHand userInitials: 'play' andPicture: nil.
+ lastEvent _ nil.
+ lastDelta _ 0@0.
+ self findPlayOffset.
+ state _ #play.
- lastEvent := nil.
- lastDelta := 0@0.
- state := #play.
self synchronize.
!
Item was changed:
----- Method: EventRecorderMorph>>synchronize (in category 'event handling') -----
synchronize
+ time _ lastInterpolation _ Time millisecondClockValue.
+ deltaTime _ nil.!
- time := Time millisecondClockValue.
- deltaTime := nil.!
Item was changed:
----- Method: EventRecorderMorph>>writeTape: (in category 'fileIn/Out') -----
writeTape: fileName
+ | name bb |
+ name _ self writeFileNamed: fileName.
+ bb _ self findDeepSubmorphThat: [:mm | (mm isKindOf: SimpleButtonMorph)
+ and: [mm label = 'writeTape']]
+ ifAbsent: [^ self].
+ bb actionSelector: #writeTape:.
+ bb arguments: (Array with: name).
- | b name |
- name := self writeFileNamed: fileName.
- (b := self button: 'writeTape') ifNotNil: [
- b actionSelector: #writeTape:.
- b arguments: (Array with: name)].
!
Item was changed:
----- Method: FlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'flap tab' translatedNoop!
- ^ 'flap tab'!
Item was changed:
----- Method: FlapTab>>adaptToWorld (in category 'initialization') -----
adaptToWorld
| wasShowing new |
+ (wasShowing _ self flapShowing) ifTrue:
- (wasShowing := self flapShowing) ifTrue:
[self hideFlap].
(self respondsTo: #unhibernate) ifTrue: [
+ (new _ self unhibernate) == self ifFalse: [
- (new := self unhibernate) == self ifFalse: [
^ new adaptToWorld]].
- self spanWorld.
- self positionObject: self.
wasShowing ifTrue:
+ [self spanWorld.
+ self positionObject: self.
+ self showFlap]!
- [self showFlap]!
Item was changed:
----- Method: FlapTab>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aMenu hand: aHandMorph
"Add further items to the menu as appropriate"
aMenu add: 'tab color...' translated target: self action: #changeColor.
aMenu add: 'flap color...' translated target: self action: #changeFlapColor.
aMenu addLine.
aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo.
aMenu addLine.
aMenu addUpdating: #textualTabString action: #textualTab.
aMenu addUpdating: #graphicalTabString action: #graphicalTab.
aMenu addUpdating: #solidTabString enablement: #notSolid action: #solidTab.
aMenu addLine.
(referent isKindOf: PasteUpMorph) ifTrue:
[aMenu addUpdating: #partsBinString action: #togglePartsBinMode].
aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior.
aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior.
aMenu addLine.
aMenu addUpdating: #isGlobalFlapString enablement: #sharedFlapsAllowed action: #toggleIsGlobalFlap.
+ aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.' translated.
- aMenu balloonTextForLastItem: 'If checked, this flap will be available in all morphic projects; if not, it will be private to this project.,' translated.
aMenu addLine.
+ aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap.
aMenu add: 'destroy this flap' translated action: #destroyFlap.
"aMenu addUpdating: #slideString action: #toggleSlideBehavior.
aMenu addUpdating: #inboardString action: #toggleInboardness.
aMenu addUpdating: #thicknessString ('thickness... (current: ', self thickness printString, ')') action: #setThickness."
!
Item was changed:
----- Method: FlapTab>>balloonTextForFlapsMenu (in category 'miscellaneous') -----
balloonTextForFlapsMenu
"Answer the balloon text to show on a menu item in the flaps menu that governs the visibility of the receiver in the current project"
| id |
+ id _ self flapID.
- id := self flapID.
#(
+ ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects' translatedNoop)
+ ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.' translatedNoop)
+ ('Widgets' 'A variety of controls and media tools' translatedNoop)
+ ('Supplies' 'Supplies' translatedNoop)
+ ('Help' 'A flap providing documentation, tutorials, and other help' translatedNoop)
+ ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented' translatedNoop)
+ ('Scripting' 'Tools useful when doing tile scripting' translatedNoop)
+ ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment' translatedNoop)
+ ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting' translatedNoop)) do:
- ('Squeak' 'Has a few generally-useful controls; it is also a place where you can "park" objects')
- ('Tools' 'A quick way to get browsers, change sorters, file lists, etc.')
- ('Widgets' 'A variety of controls and media tools')
- ('Supplies' 'A source for many basic types of objects')
- ('Stack Tools' 'Tools for building stacks. Caution!! Powerful but young and underdocumented')
- ('Scripting' 'Tools useful when doing tile scripting')
- ('Navigator' 'Project navigator: includes controls for navigating through linked projects. Also supports finding, loading and publishing projects in a shared environment')
- ('Painting' 'A flap housing the paint palette. Click on the closed tab to make make a new painting')) do:
[:pair | (FlapTab givenID: id matches: pair first translated) ifTrue: [^ pair second translated]].
^ self balloonText!
Item was changed:
----- Method: FlapTab>>computeEdgeFraction (in category 'edge') -----
computeEdgeFraction
"Compute and remember the edge fraction"
| aBox aFraction |
self isCurrentlySolid ifTrue: [^ edgeFraction ifNil: [self edgeFraction: 0.5]].
+ aBox := ((self pasteUpMorph ifNil: [self currentWorld]) bounds) insetBy: (self extent // 2).
- aBox := ((owner ifNil: [ActiveWorld]) bounds) insetBy: (self extent // 2).
aFraction := self
ifVertical:
[(self center y - aBox top) / (aBox height max: 1)]
ifHorizontal:
[(self center x - aBox left) / (aBox width max: 1)].
^ self edgeFraction: aFraction!
Item was changed:
----- Method: FlapTab>>destroyFlap (in category 'menu') -----
destroyFlap
"Destroy the receiver"
| reply request |
+ request _ self isGlobalFlap
- request := self isGlobalFlap
ifTrue:
['Caution -- this would permanently
remove this flap, so it would no longer be
available in this or any other project.
+ Do you really want to this? ' translated]
- Do you really want to this? ']
ifFalse:
['Caution -- this is permanent!! Do
+ you really want to do this? ' translated].
+ reply _ self confirm: request translated orCancel: [^ self].
- you really want to do this? '].
- reply := self confirm: request translated orCancel: [^ self].
reply ifTrue:
[self isGlobalFlap
ifTrue:
[Flaps removeFlapTab: self keepInList: false.
self currentWorld reformulateUpdatingMenus]
ifFalse:
[referent isInWorld ifTrue: [referent delete].
self delete]]!
Item was changed:
----- Method: FlapTab>>flapMenuTitle (in category 'menu') -----
flapMenuTitle
+ ^ 'flap: ' translated , self wording!
- ^ 'flap: ', self wording!
Item was changed:
----- Method: FlapTab>>graphicalTabString (in category 'graphical tabs') -----
graphicalTabString
^ (self isCurrentlyGraphical
+ ifTrue: ['choose new graphic...' translated]
+ ifFalse: ['use graphical tab' translated]) !
- ifTrue: ['choose new graphic...']
- ifFalse: ['use graphical tab']) translated!
Item was changed:
----- Method: FlapTab>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "Handle a mouse-move event. The event, a MorphicEvent, is passed in."
+
| aPosition newReferentThickness adjustedPosition thick |
dragged ifFalse: [(thick := self referentThickness) > 0
ifTrue: [lastReferentThickness := thick]].
((self containsPoint: (aPosition := evt cursorPoint)) and: [dragged not])
ifFalse:
[flapShowing ifFalse: [self showFlap].
adjustedPosition := aPosition - evt hand targetOffset.
(edgeToAdhereTo == #bottom)
ifTrue:
[newReferentThickness := inboard
ifTrue:
[self world height - adjustedPosition y]
ifFalse:
[self world height - adjustedPosition y - self height]].
(edgeToAdhereTo == #left)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition x + self width]
ifFalse:
[adjustedPosition x]].
(edgeToAdhereTo == #right)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[self world width - adjustedPosition x]
ifFalse:
[self world width - adjustedPosition x - self width]].
(edgeToAdhereTo == #top)
ifTrue:
[newReferentThickness :=
inboard
ifTrue:
[adjustedPosition y + self height]
ifFalse:
[adjustedPosition y]].
self isCurrentlySolid ifFalse:
[(#(left right) includes: edgeToAdhereTo)
ifFalse:
[self left: adjustedPosition x]
ifTrue:
[self top: adjustedPosition y]].
+ ((edgeToAdhereTo == #left) and: [(self valueOfProperty: #rigidThickness) notNil]) ifTrue:
+ [newReferentThickness := referent width].
+
self applyThickness: newReferentThickness.
dragged := true.
self fitOnScreen.
self computeEdgeFraction]!
Item was changed:
----- Method: FlapTab>>solidTabString (in category 'solid tabs') -----
solidTabString
^ (self isCurrentlySolid
+ ifTrue: ['currently using solid tab' translated]
+ ifFalse: ['use solid tab' translated]) !
- ifTrue: ['currently using solid tab']
- ifFalse: ['use solid tab']) translated!
Item was changed:
----- Method: FlapTab>>textualTabString (in category 'textual tabs') -----
textualTabString
^ (self isCurrentlyTextual
+ ifTrue: ['change tab wording...' translated]
+ ifFalse: ['use textual tab' translated]) !
- ifTrue: ['change tab wording...']
- ifFalse: ['use textual tab']) translated!
Item was changed:
----- Method: Flaps class>>addAndEnableEToyFlaps (in category 'predefined flaps') -----
addAndEnableEToyFlaps
"Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed."
| aSuppliesFlap |
SharedFlapTabs
ifNotNil: [^ self].
SharedFlapTabs := OrderedCollection new.
aSuppliesFlap := self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right.
aSuppliesFlap referent setNameTo: 'Supplies Flap' translated. "Per request from Kim Rose, 7/19/02"
SharedFlapTabs add: aSuppliesFlap. "The #center designation doesn't quite work at the moment"
+ (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false])
+ ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap]
+ ifFalse: [Preferences showProjectNavigator
+ ifTrue:[ SharedFlapTabs add: self newNavigatorFlap]].
- Preferences showProjectNavigator
- ifTrue:[ SharedFlapTabs add: self newNavigatorFlap ].
self enableGlobalFlapWithID: 'Supplies' translated.
+ (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false])
+ ifTrue:
+ [self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated.
+ (self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNilDo:
+ [:navTab | aSuppliesFlap sugarNavTab: navTab]]
+ ifFalse: [
+ Preferences showProjectNavigator
+ ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated]].
- Preferences showProjectNavigator
- ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated ].
SharedFlapsAllowed := true.
Project current flapsSuppressed: false.
^ SharedFlapTabs
"Flaps addAndEnableEToyFlaps"!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category 'flaps registry') -----
defaultsQuadsDefiningScriptingFlap
"Answer a structure defining the default items in the Scripting flap.
previously in quadsDeiningScriptingFlap"
+ ^ {
+ {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
+ {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}.
- ^ #(
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
- (ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#FunctionTile. #randomNumberTile. 'Random' translatedNoop. 'A tile that will produce a random number in a given range' translatedNoop}.
+ {#ScriptingSystem. #anyButtonPressedTiles. 'ButtonDown?' translatedNoop. 'Tiles for querying whether the mouse button is down' translatedNoop}.
+ {#ScriptingSystem. #noButtonPressedTiles. 'ButtonUp?' translatedNoop. 'Tiles for querying whether the mouse button is up' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (RandomNumberTile new 'Random' 'A tile that will produce a random number in a given range')
- (ScriptingSystem anyButtonPressedTiles 'ButtonDown?' 'Tiles for querying whether the mouse button is down')
- (ScriptingSystem noButtonPressedTiles 'ButtonUp?' 'Tiles for querying whether the mouse button is up')
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}.
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (TextFieldMorph exampleBackgroundField 'Scrolling Field' 'A scrolling data field which will have a different value on every card of the background')
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#TextMorph. #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}.
+ {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop}
+ } asOrderedCollection!
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (TextMorph exampleBackgroundLabel 'Background Label' 'A piece of text that will occur on every card of the background')
- (TextMorph exampleBackgroundField 'Background Field' 'A data field which will have a different value on every card of the background')
-
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningStackToolsFlap (in category 'flaps registry') -----
defaultsQuadsDefiningStackToolsFlap
"Answer a structure defining the items on the default system Stack Tools flap.
previously in quadsDefiningStackToolsFlap"
+ ^ {
+ {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}.
+ {#StackMorph. #stackHelpWindow. 'Stack Help' translatedNoop. 'Some hints about how to use Stacks' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Simple Text' translatedNoop. 'Text that you can edit into anything you wish' translatedNoop}.
+ {#TextMorph . #fancyPrototype. 'Fancy Text' translatedNoop. 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop}.
+ {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Scriptable Button' translatedNoop. 'A button whose script will be a method of the background Player' translatedNoop}.
+ {#StackMorph. #previousCardButton. 'Previous Card' translatedNoop. 'A button that takes the user to the previous card in the stack' translatedNoop}.
+ {#StackMorph. #nextCardButton. 'Next Card' translatedNoop. 'A button that takes the user to the next card in the stack' translatedNoop} } asOrderedCollection
- ^ #(
- (StackMorph authoringPrototype 'Stack' 'A multi-card data base' )
- (StackMorph stackHelpWindow 'Stack Help' 'Some hints about how to use Stacks')
- (TextMorph authoringPrototype 'Simple Text' 'Text that you can edit into anything you wish')
- (TextMorph fancyPrototype 'Fancy Text' 'A text field with a rounded shadowed border, with a fancy font.')
- (ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
- (ScriptableButton authoringPrototype 'Scriptable Button' 'A button whose script will be a method of the background Player')
- (StackMorph previousCardButton 'Previous Card' 'A button that takes the user to the previous card in the stack')
- (StackMorph nextCardButton 'Next Card' 'A button that takes the user to the next card in the stack')) asOrderedCollection
!
Item was changed:
----- Method: Flaps class>>defaultsQuadsDefiningSuppliesFlap (in category 'flaps registry') -----
defaultsQuadsDefiningSuppliesFlap
"Answer a list of quads which define the objects to appear in the default Supplies flap.
previously in quadsDefiningSuppliesFlap"
+ ^ {
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}.
+ {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'TabbedPalette' translatedNoop. 'A structure with tabs' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ClockMorph. #authoringPrototype. 'Clock' translatedNoop. 'A simple digital clock' translatedNoop}.
+ {#BookMorph. #previousPageButton. 'PreviousPage' translatedNoop. 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph. #nextPageButton. 'NextPage' translatedNoop. 'A button that takes you to the next page' translatedNoop}
+ } asOrderedCollection!
- ^ #(
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'TabbedPalette' 'A structure with tabs')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
- ) asOrderedCollection!
Item was changed:
----- Method: Flaps class>>disableGlobalFlaps: (in category 'menu commands') -----
disableGlobalFlaps: interactive
"Clobber all the shared flaps structures. First read the user her Miranda rights."
interactive
ifTrue: [(self confirm:
'CAUTION!! This will destroy all the shared
flaps, so that they will not be present in
*any* project. If, later, you want them
back, you will have to reenable them, from
this same menu, whereupon the standard
default set of shared flaps will be created.
Do you really want to go ahead and clobber
all shared flaps at this time?' translated) ifFalse: [^ self]].
self globalFlapTabsIfAny do:
[:aFlapTab | self removeFlapTab: aFlapTab keepInList: false.
aFlapTab isInWorld ifTrue: [self error: 'Flap problem' translated]].
self clobberFlapTabList.
+ self initializeFlapsQuads.
+ SharedFlapsAllowed _ false.
- SharedFlapsAllowed := false.
Smalltalk isMorphic ifTrue:
[ActiveWorld restoreMorphicDisplay.
ActiveWorld reformulateUpdatingMenus].
"The following reduces the risk that flaps will be created with variant IDs
such as 'Stack Tools2', potentially causing some shared flap logic to fail."
"Smalltalk garbageCollect." "-- see if we are OK without this"
!
Item was changed:
----- Method: Flaps class>>explainFlapsText (in category 'menu commands') -----
explainFlapsText
"Answer the text, in English, to show in a help-window about Flaps."
^'Flaps are like drawers on the edge of the screen, which can be opened so that you can use what is inside them, and closed when you do not need them. They have many possible uses, a few of which are illustrated by the default set of flaps you can get as described below.
+ ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
- ''Shared flaps'' are available in every morphic project. As you move from project to project, you will see these same shared flaps in each, though there are also options, on a project-by-project basis, to choose which of the shared flaps should be shown, and also momentarily to suppress the showing of all shared flaps.
+ To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
- To get started using flaps, bring up the desktop menu and choose ''flaps...'', and make the menu stay up by choosing ''keep this menu up''. If you see, in this flaps menu, a list of flap names such as ''Squeak'', ''Tools'', etc., it means that shared flaps are already set up in your image. If you do not see the list, you will instead see a menu item that invites you to ''install default shared flaps''; choose that, and new flaps will be created, and the flaps menu will change to reflect their presence.
+ ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
- ''Project flaps'' are flaps that belong to a single morphic project. You will see them when you are in that project, but not when you are in any other morphic project.
+ If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
- If a flap is set up as a parts bin (such as the default Tools and Supplies flaps), you can use it to create new objects -- just open the flap, then find the object you want, and drag it out; when the cursor leaves the flap, the flap itself will snap closed, and you''ll be left holding the new object -- just click to place it exactly where you want it.
+ If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
- If a flap is *not* set up as a parts bin (such as the default ''Squeak'' flap at the left edge of the screen) you can park objects there (this is an easy way to move objects from project to project) and you can place your own private controls there, etc. Everything in the default ''Squeak'' flap (and all the other default flaps, for that matter) is there only for illustrative purposes -- every user will want to fine-tune the flaps to suit his/her own style and needs.
+ Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
- Each flap may be set up to appear on mouseover, dragover, both, or neither. See the menu items described below for more about these and other options.
+ You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
- You can open a closed flap by clicking on its tab, or by dragging the tab toward the center of the screen
+ You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
- You can close an open flap by clicking on its tab or by dragging the tab back off the edge of the screen.
+ Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
- Drag the tab of a flap to reposition the tab and to resize the flap itself. Repositioning starts when you drag the cursor out of the original tab area.
+ If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
- If flaps or their tabs seem wrongly positioned or lost, try issuing a restoreDisplay from the screen menu.
+ The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
- The red-halo menu on a flap allows you to change the flap''s properties. For greatest ease of use, request ''keep this menu up'' here -- that way, you can easily explore all the options in the menu.
+ tab color... Lets you change the color of the flap''s tab.
+ flap color... Lets you change the color of the flap itself.
- tab color... Lets you change the color of the flap''s tab.
- flap color... Lets you change the color of the flap itself.
+ use textual tab... If the tab is not textual, makes it become textual.
+ change tab wording... If the tab is already textual, allows you to edit
- use textual tab... If the tab is not textual, makes it become textual.
- change tab wording... If the tab is already textual, allows you to edit
its wording.
+ use graphical tab... If the tab is not graphical, makes it become
- use graphical tab... If the tab is not graphical, makes it become
graphical.
+ choose tab graphic... If the tab is already graphical, allows you
- choose tab graphic... If the tab is already graphical, allows you
to change the picture.
+ use solid tab... If the tab is not solid, makes it become solid, i.e.
- use solid tab... If the tab is not solid, makes it become solid, i.e.
appear as a solid band of color along the
entire length or width of the screen.
+ parts-bin behavior If set, then dragging an object from the flap
- parts-bin behavior If set, then dragging an object from the flap
tears off a new copy of the object.
+ dragover If set, the flap opens on dragover and closes
- dragover If set, the flap opens on dragover and closes
again on drag-leave.
+
+ mouseover If set, the flap opens on mouseover and closes
- mouseover If set, the flap opens on mouseover and closes
again on mouse-leave.
+ cling to edge... Governs which edge (left, right, top, bottom)
- cling to edge... Governs which edge (left, right, top, bottom)
the flap adheres to.
+ shared If set, the same flap will be available in all projects; if not, the
- shared If set, the same flap will be available in all projects; if not, the
flap will will occur only in one project.
+ destroy this flap Deletes the flap.
- destroy this flap Deletes the flap.
+ To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
- To define a new flap, use ''make a new flap'', found in the ''flaps'' menu.
+ To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
- To reinstate the default system flaps, you can use ''destroy all shared flaps'' from the ''flaps'' menu, and once they are destroyed, choose ''install default shared flaps''.
+ To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
- To add, delete, or edit things on a given flap, it is often wise first to suspend the flap''s mouse-over and drag-over sensitivity, so it won''t keep disappearing on you while you''re trying to work with it.
+ Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.' translated!
- Besides the three standard flaps delivered with the default system, there are two other flaps readily available on demand from the ''flaps'' menu -- one is called ''Stack Tools'', which provides some tools useful for building stack-like content, the other is called ''Painting'', which provides a quick way to make a new painting. Simply clicking on the appropriate checkbox in the ''flaps'' menu will toggle the corresponding flap between being visible and not being visible in the project.'!
Item was changed:
----- Method: Flaps class>>newFlapTitled:onEdge:inPasteUp: (in category 'new flap') -----
newFlapTitled: aString onEdge: anEdge inPasteUp: aPasteUpMorph
"Add a flap with the given title, placing it on the given edge, in the given pasteup"
| aFlapBody aFlapTab |
aFlapBody := PasteUpMorph newSticky.
aFlapTab := FlapTab new referent: aFlapBody.
aFlapTab setName: aString edge: anEdge color: (Color r: 0.516 g: 0.452 b: 1.0).
anEdge == #left ifTrue:
[aFlapTab position: (aPasteUpMorph left @ aPasteUpMorph top).
aFlapBody extent: (200 @ aPasteUpMorph height)].
anEdge == #right ifTrue:
[aFlapTab position: ((aPasteUpMorph right - aFlapTab width) @ aPasteUpMorph top).
aFlapBody extent: (200 @ aPasteUpMorph height)].
anEdge == #top ifTrue:
[aFlapTab position: ((aPasteUpMorph left + 50) @ aPasteUpMorph top).
aFlapBody extent: (aPasteUpMorph width @ 200)].
anEdge == #bottom ifTrue:
[aFlapTab position: ((aPasteUpMorph left + 50) @ (aPasteUpMorph bottom - aFlapTab height)).
aFlapBody extent: (aPasteUpMorph width @ 200)].
+ aFlapBody
+ beFlap: true;
+ color: self defaultColorForFlapBackgrounds;
+ changeTableLayout.
- aFlapBody beFlap: true.
- aFlapBody color: self defaultColorForFlapBackgrounds.
-
^ aFlapTab!
Item was changed:
----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') -----
newLoneSuppliesFlap
+ "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch. We're still evidently nurturing this method along, but it is a disused branch, whose lone sender has no senders..."
- "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch"
| aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly"
+ aStrip _ PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: {
- aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: #(
+ {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}.
+ {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}.
+ {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}.
- (TrashCanMorph new 'Trash' 'A tool for discarding objects')
- (ScriptingSystem scriptControlButtons 'Status' 'Buttons to run, stop, or single-step scripts')
- (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'A tool that lets you control all the running scripts in your world')
+ {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}.
+ {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}.
+ {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}.
+ {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}.
+ {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}.
+ {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}.
+ {#PolygonMorph . #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}.
+ {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}.
+ {#SimpleSliderMorph . #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}.
+ {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}.
+ {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}.
+ " {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}."
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+ {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}.
+ {#TabbedPalette. #authoringPrototype. 'Tabs' translatedNoop. 'A structure with tabs' translatedNoop}.
- (PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
- (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle' )
- (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
- (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle')
- (StarMorph authoringPrototype 'Star' 'A star')
- (CurveMorph authoringPrototype 'Curve' 'A curve')
- (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
- (TextMorph authoringPrototype 'Text' 'Text that you can edit into anything you desire.')
- (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
- (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
- (ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, ec.')
- (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
- (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
- (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
- (TabbedPalette authoringPrototype 'Tabs' 'A structure with tabs')
+ {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}.
+ {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}.
- (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
- (MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
+ {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}.
+ {#ClockMorph. #authoringPrototype, 'Clock' translatedNoop, 'A simple digital clock' translatedNoop}.
+ {#BookMorph, #previousPageButton, 'Previous' translatedNoop, 'A button that takes you to the previous page' translatedNoop}.
+ {#BookMorph, #nextPageButton, 'Next' translatedNoop, 'A button that takes you to the next page' translatedNoop}.
+ }.
- (ImageMorph authoringPrototype 'Picture' 'A non-editable picture of something')
- (ClockMorph authoringPrototype 'Clock' 'A simple digital clock')
- (BookMorph previousPageButton 'Previous' 'A button that takes you to the previous page')
- (BookMorph nextPageButton 'Next' 'A button that takes you to the next page')
- ).
+ aFlapTab _ FlapTab new referent: aStrip beSticky.
- aFlapTab := FlapTab new referent: aStrip beSticky.
aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter.
aStrip extent: self currentWorld width @ 78.
+ leftEdge _ ((Display width - (16 + aFlapTab width)) + 556) // 2.
- leftEdge := ((Display width - (16 + aFlapTab width)) + 556) // 2.
aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)).
aStrip beFlap: true.
aStrip autoLineLayout: true.
^ aFlapTab!
Item was changed:
----- Method: Flaps class>>newNavigatorFlap (in category 'predefined flaps') -----
newNavigatorFlap
"Answer a newly-created flap which adheres to the bottom edge of the screen and which holds the project navigator controls. "
| aFlapTab navBar aFlap |
+ navBar _ ProjectNavigationMorph preferredNavigator new addButtons.
+ aFlap _ PasteUpMorph newSticky borderWidth: 0;
- navBar := ProjectNavigationMorph preferredNavigator new.
- aFlap := PasteUpMorph newSticky borderWidth: 0;
extent: navBar extent + (0@20);
color: (Color orange alpha: 0.8);
beFlap: true;
addMorph: navBar beSticky.
aFlap hResizing: #shrinkWrap; vResizing: #shrinkWrap.
aFlap useRoundedCorners.
aFlap setNameTo: 'Navigator Flap' translated.
navBar fullBounds. "to establish width"
+ aFlapTab _ FlapTab new referent: aFlap.
- aFlapTab := FlapTab new referent: aFlap.
aFlapTab setName: 'Navigator' translated edge: #bottom color: Color orange.
aFlapTab position: ((navBar width // 2) - (aFlapTab width // 2))
@ (self currentWorld height - aFlapTab height).
aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Navigator' translated "
!
Item was changed:
----- Method: Flaps class>>newSuppliesFlapFromQuads:positioning: (in category 'predefined flaps') -----
newSuppliesFlapFromQuads: quads positioning: positionSymbol
"Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen. Use #center as the positionSymbol to have it centered at the bottom of the screen, or #right to have it placed off near the right edge."
| aFlapTab aStrip hPosition |
+ Smalltalk at: #SugarNavigatorBar ifPresent: [:c |
+ c showSugarNavigator ifTrue: [
+ ^ self newSuppliesFlapFromQuads: quads positioning: positionSymbol withPreviousEntries: nil]].
aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: quads.
"self twiddleSuppliesButtonsIn: aStrip."
aFlapTab := FlapTab new referent: aStrip beSticky.
aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter.
hPosition := positionSymbol == #center
ifTrue:
[(Display width // 2) - (aFlapTab width // 2)]
ifFalse:
[Display width - (aFlapTab width + 22)].
aFlapTab position: (hPosition @ (self currentWorld height - aFlapTab height)).
aFlapTab setBalloonText: aFlapTab balloonTextForFlapsMenu.
aStrip extent: self currentWorld width @ 136.
aStrip beFlap: true.
aStrip autoLineLayout: true.
^ aFlapTab
"Flaps replaceGlobalFlapwithID: 'Supplies' translated"!
Item was changed:
----- Method: Flasher class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver for use in a parts bin"
+ ^ self partName: 'Flasher' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A circle that flashes' translatedNoop!
- ^ self partName: 'Flasher'
- categories: #('Demo')
- documentation: 'A circle that flashes'!
Item was changed:
----- Method: FrameRateMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'FrameRate' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A readout that allows you to monitor the frame rate of your system' translatedNoop!
- ^ self partName: 'FrameRate'
- categories: #('Useful')
- documentation: 'A readout that allows you to monitor the frame rate of your system'!
Item was changed:
----- Method: FrameRateMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#FrameRateMorph. #authoringPrototype. 'Frame Rate' translatedNoop. 'An indicator of how fast your system is running' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(FrameRateMorph authoringPrototype 'Frame Rate' 'An indicator of how fast your system is running')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: FrameRateMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ lastDisplayTime _ 0.
+ framesSinceLastDisplay _ 0.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ !
- lastDisplayTime := 0.
- framesSinceLastDisplay := 0!
Item was changed:
----- Method: FrameRateMorph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
"Initialize the receiver as a stand-alone entity"
super initializeToStandAlone.
self color: Color blue.
+ self font: (Preferences standardMenuFont emphasized: 1).
+ self step.
+ !
- self step!
Item was changed:
----- Method: GrabPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver's instances for a parts bin"
+ ^ self partName: 'Grab Patch' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Use this to grab a rectangular patch from the screen' translatedNoop!
- ^ self partName: 'Grab Patch'
- categories: #('Graphics')
- documentation: 'Use this to grab a rectangular patch from the screen'!
Item was changed:
----- Method: GrabPatchMorph>>initialize (in category 'initialization') -----
initialize
"Initialize the receiver. Emblazon the GrabPatch icon on its face"
super initialize.
+ self image: (ScriptingSystem formAtKey: 'GrabPatch').
+ self setProperty: #ignorePartsBinDrop toValue: true!
- self image: (ScriptingSystem formAtKey: 'GrabPatch')!
Item was changed:
----- Method: GraphMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Graph' translatedNoop
+ categories: #()
+ documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.' translatedNoop!
- ^ self partName: 'Graph'
- categories: #('Useful')
- documentation: 'A graph of numbers, normalized so the full range of values just fits my height. I support a movable cursor that can be dragged with the mouse.'!
Item was changed:
----- Method: GraphMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self extent: 365 @ 80.
+ dataColor _ Color darkGray.
+ cursor _ 1.0.
+ samplingRate := 11025.
- dataColor := Color darkGray.
- cursor := 1.0.
"may be fractional"
+ cursorColor _ Color red.
+ cursorColorAtZeroCrossings _ Color red.
+ startIndex _ 1.
+ hasChanged _ false.
- cursorColor := Color red.
- cursorColorAtZeroCrossings := Color red.
- startIndex := 1.
- hasChanged := false.
self
data: ((0 to: 360 - 1)
collect: [:x | (100.0 * x degreesToRadians sin) asInteger])!
Item was changed:
----- Method: GraphicalDictionaryMenu class>>openOn:withLabel: (in category 'instance creation') -----
openOn: aFormDictionary withLabel: aLabel
"open a graphical dictionary in a window having the label aLabel.
aFormDictionary should be a dictionary containing as value a form."
| inst aWindow |
+ aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!' translated].
- aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!'].
inst := self new initializeFor: nil fromDictionary: aFormDictionary.
+ aWindow _ (SystemWindow labelled: aLabel) model: inst.
- aWindow := (SystemWindow labelled: aLabel) model: inst.
aWindow addMorph: inst frame: (0@0 extent: 1@1).
aWindow extent: inst fullBounds extent + (3 @ aWindow labelHeight + 3);
minimumExtent: inst minimumExtent + (3 @ aWindow labelHeight + 3).
HandMorph attach: aWindow.
^ inst!
Item was changed:
----- Method: GraphicalDictionaryMenu>>renameGraphicTo: (in category 'menu commands') -----
renameGraphicTo: newName
| curr |
+ curr _ entryNames at: currentIndex.
- curr := entryNames at: currentIndex.
(newName isEmptyOrNil or: [newName = curr]) ifTrue: [^ Beeper beep].
(baseDictionary includesKey: newName) ifTrue:
[^ self inform: 'sorry that conflicts with
the name of another
+ entry in this dictionary' translated].
- entry in this dictionary'].
baseDictionary at: newName put: (baseDictionary at: curr).
baseDictionary removeKey: curr.
self baseDictionary: baseDictionary.
+ currentIndex _ entryNames indexOf: newName.
- currentIndex := entryNames indexOf: newName.
self updateThumbnail!
Item was changed:
----- Method: GraphicalMenu>>initializeFor:withForms:coexist: (in category 'initialization') -----
initializeFor: aTarget withForms: formList coexist: aBoolean
"World primaryHand attachMorph:
(GraphicalMenu new initializeFor: nil
withForms: Form allInstances coexist: true)"
| buttons bb anIndex buttonCage |
target := aTarget.
coexistWithOriginal := aBoolean.
formChoices := formList.
currentIndex := 1.
self borderWidth: 1;
cellPositioning: #center;
color: Color white;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap.
buttons := AlignmentMorph newRow.
buttons borderWidth: 0;
layoutInset: 0.
buttons hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5 @ 5.
buttons wrapCentering: #topLeft.
buttonCage := AlignmentMorph newColumn.
buttonCage hResizing: #shrinkWrap;
vResizing: #spaceFill.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Prev' translated;
- buttons addMorphBack: (bb label: 'Prev';
actionSelector: #downArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 9 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Next' translated;
- buttons addMorphBack: (bb label: 'Next';
actionSelector: #upArrowHit;
actWhen: #whilePressed).
buttons addTransparentSpacerOfSize: 5 @ 0.
buttons submorphs last color: Color white.
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 12.
buttons := AlignmentMorph newRow.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'OK' translated;
- buttons addMorphBack: (bb label: 'OK';
actionSelector: #okay).
buttons addTransparentSpacerOfSize: 5 @ 0.
bb := SimpleButtonMorph new target: self;
borderColor: Color black.
+ buttons addMorphBack: (bb label: 'Cancel' translated;
- buttons addMorphBack: (bb label: 'Cancel';
actionSelector: #cancel).
buttonCage addMorphBack: buttons.
buttonCage addTransparentSpacerOfSize: 0 @ 10.
self addMorphFront: buttonCage.
formDisplayMorph := Thumbnail new extent: 100 @ 100;
maxWidth: 100 minHeight: 30;
yourself.
self addMorphBack: (Morph new color: Color white;
layoutPolicy: TableLayout new;
layoutInset: 4 @ 4;
hResizing: #spaceFill;
vResizing: #spaceFill;
listCentering: #center;
addMorphBack: formDisplayMorph;
yourself).
target
ifNotNil: [(anIndex := formList
indexOf: target form
ifAbsent: [])
ifNotNil: [currentIndex := anIndex]].
self updateThumbnail!
Item was changed:
----- Method: HandMorphForReplay>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
+ suspended := false.
+ self showTemporaryCursor: Cursor normal
- self showTemporaryCursor: Cursor normal.
!
Item was changed:
----- Method: HandMorphForReplay>>processEvents (in category 'event handling') -----
processEvents
"Play back the next event"
+ | evt hadMouse hadAny tracker |
+ suspended == true ifTrue: [^ self].
- | evt hadMouse hadAny |
hadMouse := hadAny := false.
+ tracker := recorder objectTrackingEvents.
[(evt := recorder nextEventToPlay) isNil] whileFalse:
+ [
+ ((evt isMemberOf: MouseMoveEvent) and: [evt trail isNil]) ifTrue: [^ self].
+ tracker ifNotNil: [tracker currentEventTimeStamp: evt timeStamp].
+ evt type == #EOF
- [evt type == #EOF
ifTrue:
+ [recorder pauseIn: ActiveWorld.
+ ^ self].
- [recorder pauseIn: self world.
- ^self].
evt type == #startSound
ifTrue:
+ [recorder perhapsPlaySound: evt argument.
- [evt argument play.
recorder synchronize.
+ ^ self].
+ evt type == #startEventPlayback
+ ifTrue:
+ [evt argument launchPlayback.
+ recorder synchronize.
+ ^ self].
+
+ evt type == #noteTheatreBounds
+ ifTrue:
+ ["The argument holds the content rect --for now we don't make any use of that info in this form."
+ ^ self].
+
- ^self].
evt isMouse ifTrue: [hadMouse := true].
(evt isMouse or: [evt isKeyboard])
ifTrue:
[self handleEvent: (evt setHand: self) resetHandlerFields.
hadAny := true]].
(mouseClickState notNil and: [hadMouse not])
ifTrue:
["No mouse events during this cycle. Make sure click states time out accordingly"
mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
hadAny
ifFalse:
["No pending events. Make sure z-order is up to date"
self mouseOverHandler processMouseOver: lastMouseEvent]!
Item was changed:
----- Method: HandMorphForReplay>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
+ "Handmorph blocks deep copy. Go up to Morph"
+
+ ^ self perform: #veryDeepCopyWith: withArguments: {deepCopier} inSuperclass: Morph!
- ^ self copy!
Item was changed:
----- Method: IndexTabs class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'tabs' translatedNoop!
- ^ 'tabs'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>cacheThumbnailFor: (in category 'thumbnails') -----
cacheThumbnailFor: aProject
+ "Save a thumbnail of the given project in my thumbnail cache."
| form |
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
-
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
CachedThumbnails
at: aProject name
+ put: (form _ self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter).
+ ^ form
- put: (form := self sorterFormForProject: aProject sized: nil).
- ^form
!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'ThreadNavigator' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A tool that lets you navigate through a thread of projects.' translatedNoop!
- ^ self partName: 'ThreadNavigator'
- categories: #('Navigation')
- documentation: 'A tool that lets you navigate through a thread of projects.'!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>getThumbnailFor: (in category 'thumbnails') -----
getThumbnailFor: aProject
+ "Answer a thumbnail for the given project, retrieving it from a cache of such objects if possible, else creating a fresh thumbnail, storing it in the cache, and answering it."
+ CachedThumbnails ifNil: [CachedThumbnails _ Dictionary new].
- CachedThumbnails ifNil: [CachedThumbnails := Dictionary new].
^CachedThumbnails
at: aProject name
+ ifAbsentPut: [self sorterFormForProject: aProject sized: ScriptingSystem sizeForThumbnailsInProjectSorter]!
- ifAbsentPut: [self sorterFormForProject: aProject sized: nil]!
Item was changed:
----- Method: InternalThreadNavigationMorph class>>sorterFormForProject:sized: (in category 'sorter') -----
+ sorterFormForProject: aProject sized: aSize
+ "Answer a form to use in a project-sorter to represent the project."
- sorterFormForProject: aProject sized: ignored
+ ^ (ProjectViewMorph on: aProject) imageForm scaledToSize: aSize
- ^(ProjectViewMorph on: aProject) imageForm scaledToSize: 80@60.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>buttonForMenu (in category 'navigation') -----
buttonForMenu
+ ^self makeButton: '?' balloonText: 'More commands' translated for: #moreCommands.
- ^self makeButton: '?' balloonText: 'More commands' for: #moreCommands.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>editThisThread (in category 'navigation') -----
editThisThread
| sorter |
+ sorter _ ProjectSorterMorph new.
- sorter := ProjectSorterMorph new.
sorter navigator: self listOfPages: listOfPages.
self currentWorld addMorphFront: sorter.
+ sorter align: sorter topCenter with: self currentWorld topCenter.
- sorter align: sorter center with: self currentWorld center.
self delete.
!
Item was changed:
----- Method: InternalThreadNavigationMorph>>positionAppropriately (in category 'navigation') -----
positionAppropriately
+ | others otherRects overlaps bottomRight |
- | others otherRects overlaps |
-
(self ownerThatIsA: HandMorph) ifNotNil: [^self].
+ others _ ActiveWorld submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
+ otherRects _ others collect: [ :each | each bounds].
+ bottomRight _ (ActiveWorld hasProperty: #threadNavigatorPosition) ifTrue: [
+ ActiveWorld valueOfProperty: #threadNavigatorPosition.
+ ] ifFalse: [
+ ActiveWorld bottomRight.
+ ].
+ self align: self fullBounds bottomRight with: bottomRight.
- others := self world submorphs select: [ :each | each ~~ self and: [each isKindOf: self class]].
- otherRects := others collect: [ :each | each bounds].
- self align: self fullBounds bottomRight with: self world bottomRight.
self setProperty: #previousWorldBounds toValue: self world bounds.
[
+ overlaps _ false.
- overlaps := false.
otherRects do: [ :r |
+ (r intersects: bounds) ifTrue: [overlaps _ true. self bottom: r top].
- (r intersects: bounds) ifTrue: [overlaps := true. self bottom: r top].
].
self top < self world top ifTrue: [
+ self bottom: bottomRight y.
- self bottom: self world bottom.
self right: self left - 1.
].
overlaps
] whileTrue.!
Item was changed:
----- Method: InternalThreadNavigationMorph>>sizeRatio (in category 'accessing') -----
sizeRatio
"answer the size ratio for the receiver"
+ ^ 1.0
+
+ "^ Preferences standardMenuFont height / 12" "Good grief!!"!
- ^ Preferences standardMenuFont height / 12!
Item was changed:
----- Method: LassoPatchMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
"Answer a description of the receiver to be used in a parts bin"
+ ^ self partName: 'Lasso' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Drop this icon to grab a patch from the screen with a lasso.' translatedNoop!
- ^ self partName: 'Lasso'
- categories: #('Graphics')
- documentation: 'Drop this icon to grab a patch from the screen with a lasso.'!
Item was changed:
----- Method: LassoPatchMorph>>wantsToBeDroppedInto: (in category 'dropping') -----
wantsToBeDroppedInto: aMorph
+ "Only wanted by the world"
- "Only into PasteUps that are not part bins"
+ ^ aMorph isWorldMorph!
- ^ aMorph isPlayfieldLike!
Item was changed:
----- Method: MagnifierMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Magnifier' translatedNoop
+ categories: {'Just for Fun' translatedNoop}
+ documentation: 'A magnifying glass' translatedNoop!
- ^ self partName: 'Magnifier'
- categories: #('Useful')
- documentation: 'A magnifying glass'!
Item was changed:
----- Method: MagnifierMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MagnifierMorph. #newRound. 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MagnifierMorph newRound 'Magnifier' 'A magnifying glass')
forFlapNamed: 'Widgets']!
Item was changed:
----- Method: MagnifierMorph class>>supplementaryPartsDescriptions (in category 'parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundGlass' translatedNoop
+ categoryList: {'Just for Fun' translatedNoop}
+ documentation: 'A round magnifying glass' translatedNoop
- formalName: 'RoundGlass'
- categoryList: #(Useful)
- documentation: 'A round magnifying glass'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newRound.
DescriptionForPartsBin
+ formalName: 'Hand Magnifier' translatedNoop
+ categoryList: #()
+ documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.' translatedNoop
- formalName: 'Hand Magnifier'
- categoryList: #(Useful)
- documentation: 'A magnifying glass that also shows Morphs in the Hand and displays the Hand position.'
globalReceiverSymbol: #MagnifierMorph
nativitySelector: #newShowingPointer }!
Item was changed:
----- Method: MagnifierMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas
+ | stencil newForm bb |
+
- super drawOn: aCanvas. "border and fill"
aCanvas isShadowDrawing ifFalse: [
"Optimize because #magnifiedForm is expensive"
+ self isRound
+ ifTrue:[stencil := (EllipseMorph new extent: self extent; color: Color white) imageForm.
+ bb := BitBlt toForm: stencil.
+ newForm := (bb copyForm: self magnifiedForm to: 0@0 rule: Form and) destForm.
+ aCanvas paintImage: newForm at: self innerBounds origin ]
+ ifFalse:[super drawOn: aCanvas. "border and fill"
+ aCanvas paintImage: self magnifiedForm at: self innerBounds origin]]
+
+ !
- aCanvas paintImage: self magnifiedForm at: self innerBounds origin]!
Item was changed:
----- Method: MagnifierMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
+ trackPointer _ true.
+ showPointer _ false.
+ magnification _ 2.
+ roundness := false.
- trackPointer := true.
- showPointer := false.
- magnification := 2.
-
self extent: 128 @ 128!
Item was changed:
----- Method: MagnifierMorph>>isRound (in category 'round view') -----
isRound
+ ^ roundness == true!
- ^ owner isMemberOf: ScreeningMorph!
Item was changed:
----- Method: MagnifierMorph>>showingPointerString (in category 'menu') -----
showingPointerString
+ "Answer a string characterizing whether or not I'm showing the pointer."
+
+ ^ (self showPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'show pointer' translated!
- ^ (self showPointer
- ifTrue: ['stop showing pointer']
- ifFalse: ['start showing pointer']) translated!
Item was changed:
----- Method: MagnifierMorph>>sourcePoint (in category 'magnifying') -----
sourcePoint
"If we are being dragged use our center, otherwise use pointer position"
^(trackPointer not or: [owner notNil and: [owner isHandMorph]])
+ ifTrue: [self isFlexed ifTrue:[owner center] ifFalse:[self center]]
- ifTrue: [self center]
ifFalse: [self currentHand position]!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundString (in category 'round view') -----
toggleRoundString
+ "Answer a string describing whether the receiver is currently round."
+
+ ^ (self isRound ifTrue: ['<yes>'] ifFalse: ['<no>']),
+ 'round' translated!
- ^ (self isRound
- ifTrue: ['be square']
- ifFalse: ['be round']) translated!
Item was changed:
----- Method: MagnifierMorph>>toggleRoundness (in category 'round view') -----
toggleRoundness
+ roundness := roundness not.
+ self fullBounds changed
+ !
- | sm w |
- w := self world.
- self isRound
- ifTrue: [owner delete.
- w addMorph: self]
- ifFalse: [sm := ScreeningMorph new position: self position.
- sm addMorph: self.
- sm addMorph: (EllipseMorph newBounds: self bounds).
- w addMorph: sm]!
Item was changed:
----- Method: MagnifierMorph>>trackingPointerString (in category 'menu') -----
trackingPointerString
+ "Answer a string describing whether or not I'm currently tracking the pointer."
+
^ (trackPointer
+ ifTrue: ['<yes>']
+ ifFalse: ['<no>']), 'track pointer' translated!
- ifTrue: ['stop tracking pointer']
- ifFalse: ['start tracking pointer']) translated!
Item was changed:
----- Method: MessageNames class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#MessageNames. #prototypicalToolWindow. 'Message Names' translatedNoop. 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(MessageNames prototypicalToolWindow 'Message Names' 'A tool for finding, viewing, and editing all methods whose names contain a given character sequence.')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: Morph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
"Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
^ { DescriptionForPartsBin
+ formalName: 'Status' translatedNoop
+ categoryList: #()
+ documentation: 'Buttons to run, stop, or single-step scripts' translatedNoop
- formalName: 'Status'
- categoryList: #(Scripting)
- documentation: 'Buttons to run, stop, or single-step scripts'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #scriptControlButtons.
DescriptionForPartsBin
+ formalName: 'Scripting' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop
- formalName: 'Scripting'
- categoryList: #(Scripting)
- documentation: 'A confined place for drawing and scripting, with its own private stop/step/go buttons.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #newScriptingSpace.
DescriptionForPartsBin
+ formalName: 'Random' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A tile that will produce a random number in a given range' translatedNoop
+ globalReceiverSymbol: #FunctionTile
+ nativitySelector: #randomNumberTile.
- formalName: 'Random'
- categoryList: #(Scripting)
- documentation: 'A tile that will produce a random number in a given range'
- globalReceiverSymbol: #RandomNumberTile
- nativitySelector: #new.
DescriptionForPartsBin
+ formalName: 'ButtonDown?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is down' translatedNoop
- formalName: 'ButtonDown?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is down'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #anyButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'ButtonUp?' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'Tiles for querying whether the mouse button is up' translatedNoop
- formalName: 'ButtonUp?'
- categoryList: #(Scripting)
- documentation: 'Tiles for querying whether the mouse button is up'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #noButtonPressedTiles.
DescriptionForPartsBin
+ formalName: 'NextPage' translatedNoop
+ categoryList: {'Multimedia' translatedNoop}
+ documentation: 'A button which, when clicked, takes the reader to the next page of a book' translatedNoop
- formalName: 'NextPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #nextPageButton.
DescriptionForPartsBin
+ formalName: 'PreviousPage' translatedNoop
+ categoryList: {'Multimedia'}
+ documentation: 'A button which, when clicked, takes the reader to the previous page of a book' translatedNoop
- formalName: 'PreviousPage'
- categoryList: #(Presentation)
- documentation: 'A button which, when clicked, takes the reader to the next page of a book'
globalReceiverSymbol: #BookMorph
nativitySelector: #previousPageButton.},
+ self partsDescriptionsFromToolsFlap!
- (Flaps quadsDefiningToolsFlap collect:
- [:aQuad | DescriptionForPartsBin fromQuad: aQuad categoryList: #(Tools)])!
Item was changed:
----- Method: ObjectsTool class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Objects' translatedNoop
+ categories: #()
+ documentation: 'A place to obtain many kinds of objects' translatedNoop!
- ^ self partName: 'Objects'
- categories: #('Useful')
- documentation: 'A place to obtain many kinds of objects'!
Item was changed:
----- Method: ObjectsTool class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ObjectsTool. #newStandAlone. 'Object Catalog' translatedNoop. 'A tool that lets you browse the catalog of objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ObjectsTool . #newStandAlone. 'Object Catalog' translatedNoop.'A tool that lets you browse the catalog of objects' translatedNoop}
- cl registerQuad: #(ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: ObjectsTool>>minimumWidth (in category 'layout') -----
minimumWidth
+ "Answer a width that assures that the alphabet fits in two rows. For olpc, this is increased in order to make the Connectors category not too absurdly tall."
- "Answer a width that assures that the alphabet fits in two rows"
+ ^ 400!
- ^ 300!
Item was changed:
----- Method: PackagePaneBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PackagePaneBrowser. #prototypicalToolWindow . 'Packages' translatedNoop. 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PackagePaneBrowser prototypicalToolWindow 'Packages' 'Package Browser: like a System Browser, except that if has extra level of categorization in the top-left pane, such that class-categories are further organized into groups called "packages"')
forFlapNamed: 'Tools']!
Item was changed:
----- Method: PaintBoxMorph class>>localeChanged (in category 'notification') -----
localeChanged
| caption |
caption := ColorPickerMorph noColorCaption.
+ ColorChart ifNotNil: [
+ caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)].!
- caption displayOn: ColorChart at: ColorChart boundingBox topCenter - (caption width // 2 @ 0)!
Item was changed:
----- Method: PaintBoxMorph>>offsetFromMaxBounds (in category 'other') -----
offsetFromMaxBounds
"location of normal PaintBox within maxBounds."
+ | left |
+ left _ self left.
+ Preferences useBiggerPaintingBox ifTrue: [left _ left - (( self width * 1.5)- self width)].
+ ^ left - colorMemory left @ 0!
-
- ^ self left - colorMemory left @ 0!
Item was changed:
----- Method: PaintBoxMorph>>recentColor: (in category 'recent colors') -----
recentColor: aColor
"Remember the color as one of our recent colors"
+ Prototype currentColor: aColor.
+ (recentColors anySatisfy: [:any | any color = aColor])
+ ifTrue: [^self]. "already remembered"
+ RecentColors := {aColor}, RecentColors allButLast.
+ RecentColors keysAndValuesDo: [:i :each |
+ (recentColors at: i) color: each]!
-
- (recentColors anySatisfy: [:any | any color = aColor]) ifTrue: [^self]. "already remembered"
- recentColors size to: 2
- by: -1
- do:
- [:i |
- (recentColors at: i) color: (recentColors at: i - 1) color.
- RecentColors at: i put: (RecentColors at: i - 1)].
- (recentColors first) color: aColor.
- RecentColors at: 1 put: aColor!
Item was changed:
----- Method: PaintBoxMorph>>showColorPalette: (in category 'actions') -----
showColorPalette: evt
| w box |
self comeToFront.
colorMemory align: colorMemory bounds topRight
with: colorMemoryThin bounds topRight.
"make sure color memory fits or else align with left"
+ w _ self world.
+ box _ self bounds: colorMemory fullBounds in: w.
- w := self world.
- box := self bounds: colorMemory fullBounds in: w.
box left < 0 ifTrue:[
colorMemory align: colorMemory bounds topLeft
with: colorMemoryThin bounds topLeft].
+ self addMorphFront: colorMemory.
+ self changed!
- self addMorphFront: colorMemory.!
Item was changed:
----- Method: PaintBoxMorph>>toggleShapes (in category 'actions') -----
toggleShapes
| tab sh stamps |
"The sub panel that has the shape tools on it. Rect, line..."
+ stamps _ self submorphNamed: 'stamps'.
+ tab _ self submorphNamed: 'shapeTab'.
+ (sh _ self submorphNamed: 'shapes') visible
- stamps := self submorphNamed: 'stamps'.
- tab := self submorphNamed: 'shapeTab'.
- (sh := self submorphNamed: 'shapes') visible
ifTrue: [sh hide. tab top: stamps bottom-1]
ifFalse: [sh comeToFront. sh top: stamps bottom-9.
sh show. tab top: sh bottom - tab height + 10].
self layoutChanged.
+ self changed
!
Item was changed:
----- Method: PaintBoxMorph>>toggleStamps (in category 'actions') -----
toggleStamps
| tab otherTab st shapes |
"The sub panel that has the stamps in it. For saving and moving parts of an image."
+ shapes _ self submorphNamed: 'shapes'.
+ otherTab _ self submorphNamed: 'shapeTab'.
+ tab _ self submorphNamed: 'stampTab'.
+ (st _ self submorphNamed: 'stamps') visible
- shapes := self submorphNamed: 'shapes'.
- otherTab := self submorphNamed: 'shapeTab'.
- tab := self submorphNamed: 'stampTab'.
- (st := self submorphNamed: 'stamps') visible
ifTrue: [st hide. st bottom: self bottom. tab top: self bottom-1.
shapes top: self bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [self bottom-1])]
ifFalse: [st top: self bottom-10. st show. tab top: st bottom-0.
shapes top: st bottom-9.
otherTab top: (shapes visible ifTrue: [shapes bottom - otherTab height + 10]
ifFalse: [st bottom-0])].
+ self layoutChanged.
+ self changed!
- self layoutChanged.!
Item was changed:
----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Paint' translatedNoop
+ categories: #()
+ documentation: 'Drop this icon to start painting a new object.' translatedNoop!
- ^ self partName: 'Paint'
- categories: #('Basic' 'Graphics')
- documentation: 'Drop this icon to start painting a new object.'!
Item was changed:
----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
- cl registerQuad: #(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PartsBin>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
wantsDroppedMorph: aMorph event: evt
"Answer whether the receiver would like to accept the given morph. For a Parts bin, we accept just about anything except something that just originated from ourselves"
(aMorph hasProperty: #beFullyVisibleAfterDrop) ifTrue:
+ [^ true].
- ["Sign that this was launched from a parts bun, probably indeed this very parts bin"
- ^ false].
^ super wantsDroppedMorph: aMorph event: evt!
Item was changed:
----- Method: PasteUpMorph class>>initialize (in category '*MorphicExtras-class initialization') -----
initialize
"Initialize the class"
+ #('keyStroke') translatedNoop.
+
self registerInFlapsRegistry.
+ ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' translatedNoop targetMorphClass: PasteUpMorph.!
- ScriptingSystem addCustomEventFor: self named: #keyStroke help: 'when a keystroke happens and nobody heard it' targetMorphClass: PasteUpMorph.!
Item was changed:
----- Method: PasteUpMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}
- cl registerQuad: #(PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'Holder' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop
- formalName: 'Holder'
- categoryList: #(Scripting)
- documentation: 'A place for storing alternative pictures in an animation, ec.'
globalReceiverSymbol: #ScriptingSystem
nativitySelector: #prototypicalHolder}!
Item was changed:
----- Method: PianoKeyboardMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'PianoKeyboard' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A piano keyboard' translatedNoop!
- ^ self partName: 'PianoKeyboard'
- categories: #('Multimedia')
- documentation: 'A piano keyboard'!
Item was changed:
----- Method: PianoKeyboardMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+
+ whiteKeyColor _ Color gray: 0.95.
+ blackKeyColor _ Color black.
+ playingKeyColor _ Color red.
+ nOctaves _ 6.
-
- whiteKeyColor := Color gray: 0.95.
- blackKeyColor := Color black.
- playingKeyColor := Color red.
- nOctaves := 6.
self buildKeyboard.
+ soundPrototype _ FMSound brass1 duration: 9.9.
+ frequency _ 0.
+ soundPrototype _ FMSound new.
+ allowingChord _ false. "Sorry!!"
+ soundPlayingList _ Array new: self submorphs size.
+ !
- soundPrototype := FMSound brass1 duration: 9.9!
Item was changed:
----- Method: PolygonMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PolygonMorph. #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}
- cl registerQuad: #(PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: PolygonMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-instance creation') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {DescriptionForPartsBin
+ formalName: 'Arrow' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.' translatedNoop
- formalName: 'Arrow'
- categoryList: #('Basic' 'Graphics')
- documentation: 'A line with an arrowhead. Shift-click to get handles and move the ends.'
globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #arrowPrototype.
+ DescriptionForPartsBin
+ formalName: 'Triangle' translatedNoop
+ categoryList: {'Graphics' translatedNoop}
+ documentation: 'A three-sided polygon.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #trianglePrototype.
+
+ DescriptionForPartsBin
+ formalName: 'Curve' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A smooth wiggly curve, or a curved solid. Shift-click to get handles and move the points. Using the halo menu, can be coverted into a polygon, and can be made "open" rather than closed.' translatedNoop
+ globalReceiverSymbol: #PolygonMorph
+ nativitySelector: #curvePrototype.
+ }
+
+
- nativitySelector: #arrowPrototype}
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFlaps (in category 'the buttons') -----
buttonFlaps
^self inFlapsSuppressedMode ifTrue: [
+ self makeButton: 'Show tabs' translated balloonText: 'Show tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Show tabs' balloonText: 'Show tabs' for: #toggleFlapsSuppressed
] ifFalse: [
+ self makeButton: 'Hide tabs' translated balloonText: 'Hide tabs' translated for: #toggleFlapsSuppressed
- self makeButton: 'Hide tabs' balloonText: 'Hide tabs' for: #toggleFlapsSuppressed
].
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonFullScreen (in category 'the buttons') -----
buttonFullScreen
^self inFullScreenMode ifTrue: [
+ self makeButton: 'Browser Reentry' translated balloonText: 'Re-enter the browser' translated for: #fullScreenOff
- self makeButton: 'Browser Reentry' balloonText: 'Re-enter the browser' for: #fullScreenOff
] ifFalse: [
+ self makeButton: 'Escape Browser' translated balloonText: 'Use the full screen' translated for: #fullScreenOn
- self makeButton: 'Escape Browser' balloonText: 'Use the full screen' for: #fullScreenOn
]
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonGoTo (in category 'the buttons') -----
buttonGoTo
+ ^self makeButton: 'GO TO' translated balloonText: 'Go to another project' translated for: #gotoAnother
- ^self makeButton: 'GO TO' balloonText: 'Go to another project' for: #gotoAnother
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewProject (in category 'the buttons') -----
buttonNewProject
+ ^self makeButton: 'NEW' translated balloonText: 'Start a new project' translated for: #newProject
- ^self makeButton: 'NEW' balloonText: 'Start a new project' for: #newProject
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNewer (in category 'the buttons') -----
buttonNewer
+ ^self makeButton: 'Newer?' translated balloonText: 'Is there a newer version of this project ?' translated for: #getNewerVersionIfAvailable!
- ^self makeButton: 'Newer?' balloonText: 'Is there a newer version of this project ?' for: #getNewerVersionIfAvailable!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonNext (in category 'the buttons') -----
buttonNext
+ ^self makeButton: 'NEXT >' translated balloonText: 'Next project' translated for: #nextProject!
- ^self makeButton: 'NEXT >' balloonText: 'Next project' for: #nextProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPaint (in category 'the buttons') -----
buttonPaint
| pb oldArgs brush myButton m |
+ myButton _ self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting.
+ pb _ PaintBoxMorph new submorphNamed: #paint:.
- myButton := self makeButton: '' balloonText: 'Make a painting' for: #doNewPainting.
- pb := PaintBoxMorph new submorphNamed: #paint:.
pb ifNil: [
+ (brush _ Form extent: 16@16 depth: 16) fillColor: Color red
- (brush := Form extent: 16@16 depth: 16) fillColor: Color red
] ifNotNil: [
+ oldArgs _ pb arguments.
+ brush _ oldArgs third.
+ brush _ brush copy: (2@0 extent: 42@38).
+ brush _ brush scaledToSize: brush extent // 2.
- oldArgs := pb arguments.
- brush := oldArgs third.
- brush := brush copy: (2@0 extent: 42@38).
- brush := brush scaledToSize: brush extent // 2.
].
+ myButton addMorph: (m _ brush asMorph lock).
- myButton addMorph: (m := brush asMorph lock).
myButton extent: m extent + (myButton borderWidth + 6).
m position: myButton center - (m extent // 2).
^myButton
+ "brush _ (ScriptingSystem formAtKey: 'Painting')."
- "brush := (ScriptingSystem formAtKey: 'Painting')."
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonPrev (in category 'the buttons') -----
buttonPrev
+ ^self makeButton: '< PREV' translated balloonText: 'Previous project' translated for: #previousProject!
- ^self makeButton: '< PREV' balloonText: 'Previous project' for: #previousProject!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonQuit (in category 'the buttons') -----
buttonQuit
+ "Make and answer a button whose pressing will result in quitting out of Squeak."
+ ^self makeButton: 'QUIT' translated balloonText: 'Quit Etoys (without saving)' translated for: #quitSqueak
- ^self makeButton: 'QUIT' balloonText: 'Quit Squeak altogether' for: #quitSqueak
!
Item was changed:
----- Method: ProjectNavigationMorph>>buttonTell (in category 'the buttons') -----
buttonTell
+ ^self makeButton: 'Tell!!' translated balloonText: 'Tell a friend about this project' translated for: #tellAFriend
- ^self makeButton: 'Tell!!' balloonText: 'Tell a friend about this project' for: #tellAFriend
!
Item was changed:
----- Method: ProjectNavigationMorph>>fontForButtons (in category 'as yet unclassified') -----
fontForButtons
+ ^ Preferences standardButtonFont!
-
- ^TextStyle defaultFont!
Item was changed:
----- Method: ProjectNavigationMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
self layoutInset: 6;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
useRoundedCorners.
+ mouseInside _ false.
+ !
- mouseInside := false.
- self addButtons!
Item was changed:
----- Method: ProjectNavigationMorph>>makeButton:balloonText:for: (in category 'as yet unclassified') -----
makeButton: aString balloonText: anotherString for: aSymbol
- self flag: #yo.
- "In principle, this method shouldn't call #translated."
-
^ SimpleButtonDelayedMenuMorph new target: self;
borderColor: #raised;
color: self colorForButtons;
+ label: aString font: self fontForButtons;
+ setBalloonText: anotherString;
- label: aString translated font: self fontForButtons;
- setBalloonText: anotherString translated;
actionSelector: aSymbol!
Item was changed:
----- Method: ProjectNavigationMorph>>publishDifferent (in category 'the actions') -----
publishDifferent
self
+ publishStyle: #initialDirectoryListForProjects
- publishStyle: #initialDirectoryList
forgetURL: true
withRename: false
!
Item was changed:
----- Method: ProjectNavigationMorph>>publishStyle:forgetURL:withRename: (in category 'the actions') -----
publishStyle: aSymbol forgetURL: aBoolean withRename: renameBoolean
| w saveOwner primaryServer rename |
+ w _ self world ifNil: [^Beeper beep].
- w := self world ifNil: [^Beeper beep].
w setProperty: #SuperSwikiPublishOptions toValue: aSymbol.
+ primaryServer _ w project primaryServerIfNil: [nil].
+ rename _ ((primaryServer notNil
- primaryServer := w project primaryServerIfNil: [nil].
- rename := ((primaryServer notNil
and: [primaryServer acceptsUploads]) not)
or: [renameBoolean].
+ rename := rename or: [(primaryServer isKindOf: DAVMultiUserServerDirectory)].
w setProperty: #SuperSwikiRename toValue: rename.
+ saveOwner _ owner.
- saveOwner := owner.
self delete.
[w project
storeOnServerShowProgressOn: self
forgetURL: aBoolean | rename]
ensure: [saveOwner addMorphFront: self]!
Item was changed:
+ ----- Method: ProjectSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: ProjectSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
- | b r partsBinButton newButton |
+ | b r partsBinButton newButton aWrapper |
+ newButton _ ImageMorph new image: (World project makeThumbnail scaledToSize: 48@36).
- newButton := ImageMorph new image: (World project makeThumbnail scaledToSize: 24@18).
newButton on: #mouseDown send: #insertNewProject: to: self.
newButton setBalloonText: 'Make a new Project' translated.
+ (partsBinButton _ UpdatingThreePhaseButtonMorph checkBox)
- (partsBinButton := UpdatingThreePhaseButtonMorph checkBox)
target: self;
actionSelector: #togglePartsBinStatus;
arguments: #();
getSelector: #getPartsBinStatus.
+ (r _ AlignmentMorph newRow)
- (r := AlignmentMorph newRow)
color: Color transparent;
borderWidth: 0;
layoutInset: 0;
+ cellInset: 10@0;
wrapCentering: #center;
+ cellPositioning: #leftCenter;
- cellPositioning: #topCenter;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
extent: 5@5.
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort)).
+ b _ SimpleButtonMorph new target: self; color: self defaultColor darker;
- r addMorphBack: (self wrapperFor: (b label: 'Okay' translated; actionSelector: #acceptSort)).
- b := SimpleButtonMorph new target: self; color: self defaultColor darker;
borderColor: Color black.
+ r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #delete));
- r addMorphBack: (self wrapperFor: (b label: 'Cancel' translated; actionSelector: #delete));
- addMorphBack: (self wrapperFor: (newButton));
addTransparentSpacerOfSize: 8 @ 0;
+ addMorphBack: (self wrapperFor: (newButton));
+ addTransparentSpacerOfSize: 8 @ 0.
+
+ aWrapper := AlignmentMorph newRow beTransparent.
+ aWrapper cellInset: 0; layoutInset: 0; borderWidth: 0.
+ aWrapper
addMorphBack: (self wrapperFor: partsBinButton);
+ addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated font: ScriptingSystem fontForEToyButtons) lock).
+ r addMorphBack: aWrapper.
- addMorphBack: (self wrapperFor: (StringMorph contents: 'Parts bin' translated) lock).
self addMorphFront: r.
!
Item was changed:
----- Method: ProjectSorterMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
+
super initialize.
- ""
self useRoundedCorners.
pageHolder useRoundedCorners; borderWidth: 0;
color: (self
gridFormOrigin: 0 @ 0
+ grid: ScriptingSystem sorterGridSize
- grid: 16 @ 16
background: Color white
line: Color blue muchLighter)!
Item was changed:
----- Method: ProjectSorterMorph>>sorterMorphForProjectNamed: (in category 'as yet unclassified') -----
sorterMorphForProjectNamed: projName
| pvm proj |
+ (proj _ Project named: projName) ifNil: [^nil].
+ pvm _ (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
- (proj := Project named: projName) ifNil: [^nil].
- pvm := (InternalThreadNavigationMorph getThumbnailFor: proj) asMorph.
pvm setProperty: #nameOfThisProject toValue: projName.
+ pvm isOpaque: true.
pvm setBalloonText: projName.
pvm on: #mouseDown send: #clickFromSorterEvent:morph: to: self.
pvm on: #mouseUp send: #clickFromSorterEvent:morph: to: self.
^pvm
!
Item was changed:
----- Method: RealEstateAgent class>>reduceByFlaps: (in category '*MorphicExtras-utilities') -----
reduceByFlaps: aScreenRect
"Return a rectangle that won't interfere with default shared flaps"
Flaps sharedFlapsAllowed ifFalse: [^ aScreenRect copy].
(Flaps globalFlapTabsIfAny allSatisfy:
[:ft | ft flapID = 'Painting' translated or: [ft edgeToAdhereTo == #bottom]])
ifTrue: [^ aScreenRect withHeight: aScreenRect height - 18]
+ ifFalse: [^ aScreenRect insetBy: 64]!
- ifFalse: [^ aScreenRect insetBy: 18]!
Item was changed:
----- Method: RecordingControlsMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RecordingControlsMorph. #authoringPrototype. 'Sound' translatedNoop. 'A device for making sound recordings.'}
- cl registerQuad: #(RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: RecordingControlsMorph>>addButtonRows (in category 'initialization') -----
addButtonRows
+ | r fullWidth |
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- | r |
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Morph' translated action: #makeSoundMorph).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Tile' translated action: #makeTile).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Trim' translated action: #trim).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Show' translated action: #showEditor).
- r addMorphBack: (self buttonName: 'Show' translated action: #show).
self addMorphBack: r.
+ r layoutChanged.
+ fullWidth := r fullBounds width.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
r addMorphBack: (self buttonName: 'Record' translated action: #record).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Stop' translated action: #stop).
r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
r addMorphBack: (self buttonName: 'Play' translated action: #playback).
+ r addMorphBack: (Morph new extent: 4@1; color: Color transparent).
+ r addMorphBack: (self buttonName: 'Codec' translated action: #chooseCodec).
r addMorphBack: self makeStatusLight.
self addMorphBack: r.
+ self changeCodec: OggSpeexCodec name: 'Speex'.
+ r layoutChanged.
+ fullWidth := fullWidth max: r fullBounds width.
+ ^ fullWidth@(r fullBounds height).
!
Item was changed:
----- Method: RecordingControlsMorph>>buttonName:action: (in category 'other') -----
buttonName: aString action: aSymbol
^ SimpleButtonMorph new
target: self;
+ label: aString font: Preferences standardButtonFont;
- label: aString;
actionSelector: aSymbol
!
Item was changed:
----- Method: RecordingControlsMorph>>initialize (in category 'initialization') -----
initialize
+ | r full |
- | r |
super initialize.
self hResizing: #shrinkWrap; vResizing: #shrinkWrap.
+ borderWidth _ 2.
- borderWidth := 2.
self listDirection: #topToBottom.
+ recorder _ SoundRecorder new.
+ full := self addButtonRows.
+ self addRecordLevelSliderIn: full.
- recorder := SoundRecorder new.
- self addButtonRows.
- self addRecordLevelSlider.
+ r _ AlignmentMorph newRow vResizing: #shrinkWrap.
+ r addMorphBack: (self makeRecordMeterIn: full).
- r := AlignmentMorph newRow vResizing: #shrinkWrap.
- r addMorphBack: self makeRecordMeter.
self addMorphBack: r.
self extent: 10@10. "make minimum size"
!
Item was changed:
----- Method: RectangleMorph class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#RectangleMorph, #roundRectPrototype, 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}
- cl registerQuad: #(RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}
- cl registerQuad: #(RectangleMorph authoringPrototype 'Rectangle' 'A rectangle')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: RectangleMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
^ {DescriptionForPartsBin
+ formalName: 'RoundRect' translatedNoop
+ categoryList: {'Graphics' translatedNoop. 'Basic' translatedNoop}
+ documentation: 'A rectangle with rounded corners' translatedNoop
- formalName: 'RoundRect'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with rounded corners'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #roundRectPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a horizontal gradient' translatedNoop
- formalName: 'Gradient'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a horizontal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #gradientPrototype.
DescriptionForPartsBin
+ formalName: 'Gradient (slanted)' translatedNoop
+ categoryList: #()
+ documentation: 'A rectangle with a diagonal gradient' translatedNoop
- formalName: 'Gradient (slanted)'
- categoryList: #('Graphics' 'Basic')
- documentation: 'A rectangle with a diagonal gradient'
globalReceiverSymbol: #RectangleMorph
nativitySelector: #diagonalPrototype}!
Item was changed:
----- Method: ReferenceMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'ref' translatedNoop!
- ^ 'ref'!
Item was changed:
----- Method: ScrollableField class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ "Info for build parts-bin entries."
+
+ ^ self partName: 'Scrolling Text' translatedNoop
+ categories: #(Basic)
+ documentation: 'A scrollable, editable body of text' translatedNoop!
- ^ self partName: 'Scrolling Text'
- categories: #('Text' )
- documentation: 'A scrollable, editable body of text'!
Item was changed:
----- Method: ScrollableField class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScrollableField. #newStandAlone. 'Scrolling Text' translatedNoop. 'Holds any amount of text; has a scroll bar' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScrollableField newStandAlone 'Scrolling Text' 'Holds any amount of text; has a scroll bar')
forFlapNamed: 'Stack Tools'.]!
Item was changed:
----- Method: SelectorBrowser class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SelectorBrowser. #prototypicalToolWindow. 'Method Finder' translatedNoop. 'A tool for discovering methods by providing sample values for arguments and results' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SelectorBrowser prototypicalToolWindow 'Method Finder' 'A tool for discovering methods by providing sample values for arguments and results')
forFlapNamed: 'Tools']
!
Item was changed:
----- Method: SimpleSliderMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
"Answer a basis for names of default instances of the receiver"
+ ^ 'Slider' translatedNoop!
- ^ 'Slider'!
Item was changed:
----- Method: SimpleSliderMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Slider' translatedNoop
+ categories: {'Basic' translatedNoop}
+ documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.' translatedNoop!
- ^ self partName: 'Slider'
- categories: #('Scripting')
- documentation: 'A scriptable control that allows you to choose a numeric value by dragging a knob.'!
Item was changed:
----- Method: SimpleSliderMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}
- cl registerQuad: #(SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: SimpleSliderMorph>>adjustToValue: (in category 'private') -----
adjustToValue: aNumber
"Adjust the position of this slider to correspond to the given value in the range minVal..maxVal."
"Details: Internal values are normalized to the range 0..1."
+ | toUse |
+ toUse := minVal = maxVal
+ ifTrue:
+ [minVal]
+ ifFalse:
+ [(aNumber - minVal) asFloat / (maxVal - minVal)].
+ self value: toUse
- self value:
- (aNumber - minVal) asFloat / (maxVal - minVal).
!
Item was changed:
----- Method: SimpleSliderMorph>>descendingString (in category 'menu') -----
descendingString
^ (self descending
+ ifTrue: ['switch to ascending' translatedNoop]
+ ifFalse: ['switch to descending' translatedNoop]) translated!
- ifTrue: ['switch to ascending']
- ifFalse: ['switch to descending']) translated!
Item was changed:
----- Method: SimpleSliderMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]!
Item was changed:
----- Method: SimpleSliderMorph>>truncateString (in category 'menu') -----
truncateString
^ (truncate
+ ifTrue: ['turn off truncation' translatedNoop]
+ ifFalse: ['turn on truncation' translatedNoop]) translated!
- ifTrue: ['turn off truncation']
- ifFalse: ['turn on truncation']) translated!
Item was changed:
----- Method: SketchEditorMorph>>addRotationScaleHandles (in category 'start & finish') -----
addRotationScaleHandles
"Rotation and scaling handles"
+ rotationButton _ SketchMorph withForm: (palette rotationTabForm).
- rotationButton := SketchMorph withForm: (palette rotationTabForm).
rotationButton position: bounds topCenter - (6@0).
rotationButton on: #mouseDown send: #rotateScalePrep: to: self.
rotationButton on: #mouseMove send: #rotateBy: to: self.
rotationButton on: #mouseUp send: #rotateDone: to: self.
rotationButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
rotationButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: rotationButton].
- self addMorph: rotationButton.
rotationButton setBalloonText: 'Drag me sideways to
rotate your
picture.' translated.
+ scaleButton _ SketchMorph withForm: (palette scaleTabForm).
- scaleButton := SketchMorph withForm: (palette scaleTabForm).
scaleButton position: bounds rightCenter - ((scaleButton width)@6).
scaleButton on: #mouseDown send: #rotateScalePrep: to: self.
scaleButton on: #mouseMove send: #scaleBy: to: self.
scaleButton on: #mouseEnter send: #mouseLeave: to: self.
"Put cursor back"
scaleButton on: #mouseLeave send: #mouseEnter: to: self.
+ Preferences rotationAndScaleHandlesInPaintBox ifTrue:
+ [self addMorph: scaleButton].
- self addMorph: scaleButton.
scaleButton setBalloonText: 'Drag me up and down to change
the size
of your picture.' translated.
"REMOVED:
+ fwdButton _ PolygonMorph new.
+ pt _ bounds topCenter.
- fwdButton := PolygonMorph new.
- pt := bounds topCenter.
fwdButton borderWidth: 2; makeOpen; makeBackArrow; borderColor:
(Color r: 0 g: 0.8 b: 0).
fwdButton removeHandles; setVertices: (Array with: pt+(0@7) with:
pt+(0@22)).
fwdButton on: #mouseMove send: #forward:direction: to: self.
fwdButton on: #mouseEnter send: #mouseLeave: to: self.
fwdButton on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdButton toValue: fwdButton.
self addMorph: fwdButton.
fwdButton setBalloonText: 'Drag me around to point
in the direction
I go forward.' translated.
+ toggle _ EllipseMorph
- toggle := EllipseMorph
newBounds: (Rectangle center: fwdButton vertices last +
(-4@4) extent: 8@8)
color: Color gray.
toggle on: #mouseUp send: #toggleDirType:in: to: self.
toggle on: #mouseEnter send: #mouseLeave: to: self.
toggle on: #mouseLeave send: #mouseEnter: to: self.
self setProperty: #fwdToggle toValue: toggle.
fwdButton addMorph: toggle.
toggle setBalloonText: 'When your object turns,
how should its
picture change?
It can rotate, face left or right,
face up or down, or not
change.' translated.
"
self setProperty: #rotationStyle toValue: hostView rotationStyle.
" self forward: hostView setupAngle direction: fwdButton. "
"Set to its current value"
!
Item was changed:
----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph: (in category 'initialization') -----
initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph
+ "Initialize the receiver to edit the given sketchMorph in the given bounds, with the resulting object to reside in the given pasteUpMorph."
+
| aPaintBox newPaintBoxBounds worldBounds requiredWidth newOrigin aPosition aPal aTab paintBoxFullBounds |
+ (aTab _ self world paintingFlapTab) ifNotNil:
- (aTab := self world paintingFlapTab) ifNotNil:
[aTab showFlap.
^ self initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: nil].
+ self setProperty: #recipientPasteUp toValue: aPasteUpMorph.
+ aPaintBox _ self world paintBox.
+ worldBounds _ self world bounds.
+ requiredWidth _ aPaintBox width.
- aPaintBox := self world paintBox.
- worldBounds := self world bounds.
- requiredWidth := aPaintBox width.
+ aPosition _ (aPal _ aPasteUpMorph standardPalette)
- aPosition := (aPal := aPasteUpMorph standardPalette)
ifNotNil:
[aPal showNoPalette.
aPal topRight + (aPaintBox width negated @ 0 "aPal tabsMorph height")]
ifNil:
[boundsToUse topRight].
+ newOrigin _ ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
- newOrigin := ((aPosition x + requiredWidth <= worldBounds right) or: [Preferences unlimitedPaintArea])
ifTrue: "will fit to right of aPasteUpMorph"
[aPosition]
ifFalse: "won't fit to right, try left"
[boundsToUse topLeft - (requiredWidth @ 0)].
+ paintBoxFullBounds _ aPaintBox maxBounds.
+ paintBoxFullBounds _ (newOrigin - aPaintBox offsetFromMaxBounds) extent:
- paintBoxFullBounds := aPaintBox maxBounds.
- paintBoxFullBounds := (newOrigin - aPaintBox offsetFromMaxBounds) extent:
paintBoxFullBounds extent.
+ newPaintBoxBounds _ paintBoxFullBounds translatedToBeWithin: worldBounds.
- newPaintBoxBounds := paintBoxFullBounds translatedToBeWithin: worldBounds.
self initializeFor: aSketchMorph inBounds: boundsToUse
pasteUpMorph: aPasteUpMorph
+ paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.
+ !
- paintBoxPosition: newPaintBoxBounds origin + aPaintBox offsetFromMaxBounds.!
Item was changed:
----- Method: SketchEditorMorph>>mouseMove: (in category 'event handling') -----
mouseMove: evt
+ "In the middle of drawing a stroke of any kind."
- "In the middle of drawing a stroke. 6/11/97 19:51 tk"
+ | pt priorEvt actionSelector |
- | pt priorEvt |
WorldState canSurrenderToOS: false. "we want maximum responsiveness"
pt := evt cursorPoint.
priorEvt := self get: #lastEvent for: evt.
(priorEvt notNil and: [pt = priorEvt cursorPoint]) ifTrue: [^self].
+ self perform: (actionSelector _ self getActionFor: evt) with: evt.
- self perform: (self getActionFor: evt) with: evt.
"Each action must do invalidRect:"
self
set: #lastEvent
for: evt
to: evt.
+ "If recording painting, mark these events so they will not be condensed. The actual path the brush takes is important."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: actionSelector]].
false
ifTrue:
["So senders will find the things performed here"
self
paint: nil;
fill: nil;
erase: nil;
pickup: nil;
stamp: nil.
self
rect: nil;
ellipse: nil;
polygon: nil;
line: nil;
star: nil]!
Item was changed:
----- Method: SketchEditorMorph>>mouseUp: (in category 'event handling') -----
mouseUp: evt
| myAction |
"Do nothing except those that work on mouseUp."
+ myAction _ self getActionFor: evt.
- myAction := self getActionFor: evt.
myAction == #fill: ifTrue: [
self perform: myAction with: evt.
"Each action must do invalidRect:"
].
myAction == #pickup: ifTrue: [
self pickupMouseUp: evt].
myAction == #polygon: ifTrue: [self polyEdit: evt]. "a mode lets you drag vertices"
self set: #lastEvent for: evt to: nil.
+ "If recording painting, note that we stopped a stroke. OK to condense points."
+ evt hand ifNotNil: [
+ evt hand eventRecorders do: [:er | er doNotCondense: #mouseUp:]].
!
Item was changed:
----- Method: SketchEditorMorph>>paint: (in category 'actions & preps') -----
paint: evt
"While the mouse is down, lay down paint, but only within window bounds.
11/28/96 sw: no longer stop painting when pen strays out of window; once it comes back in, resume painting rather than waiting for a mouse up"
+ | mousePoint startToEnd pfPen newPoint |
+ pfPen _ self get: #paintingFormPen for: evt.
+ mousePoint _ evt cursorPoint.
+ newPoint _ mousePoint - bounds origin.
+ startToEnd _ pfPen regionFor: newPoint.
+ evt shiftPressed
+ ifTrue: [pfPen gotoBack: newPoint]
+ ifFalse: [pfPen goto: newPoint].
- | mousePoint startRect endRect startToEnd pfPen myBrush |
-
- pfPen := self get: #paintingFormPen for: evt.
- myBrush := self getBrushFor: evt.
- mousePoint := evt cursorPoint.
- startRect := pfPen location + myBrush offset extent: myBrush extent.
- pfPen goto: mousePoint - bounds origin.
- endRect := pfPen location + myBrush offset extent: myBrush extent.
- "self render: (startRect merge: endRect). Show the user what happened"
- startToEnd := startRect merge: endRect.
self invalidRect: (startToEnd translateBy: bounds origin).
!
Item was changed:
----- Method: SoundEventMorph>>releaseCachedState (in category 'caching') -----
releaseCachedState
super releaseCachedState.
+ sound isCompressed
+ ifFalse: [sound _ sound compressWith: GSMCodec].
- sound := sound compressWith: GSMCodec.
!
Item was changed:
----- Method: SquishedNameMorph>>fontForName (in category 'as yet unclassified') -----
fontForName
+ ^(TextStyle default fontOfSize: 15) emphasized: 1
- | pickem |
- pickem := 3.
-
- pickem = 1 ifTrue: [
- ^(((TextStyle named: #Helvetica) ifNil: [TextStyle default]) fontOfSize: 13) emphasized: 1.
- ].
- pickem = 2 ifTrue: [
- ^(((TextStyle named: #Palatino) ifNil: [TextStyle default]) fontOfSize: 12) emphasized: 1.
- ].
- ^((TextStyle default) fontAt: 1) emphasized: 1
!
Item was changed:
----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
- cl registerQuad: #(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}
- cl registerQuad: #(ScriptingSystem newScriptingSpace 'Scripting' 'A confined place for drawing and scripting, with its own private stop/step/go buttons.')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop}
- cl registerQuad: #(ScriptingSystem holderWithAlphabet 'Alphabet' 'A source for single-letter objects')
forFlapNamed: 'Widgets'.]!
Item was changed:
----- Method: StarMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Star' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'A symmetrical polygon in the shape of a star' translatedNoop!
- ^ self partName: 'Star'
- categories: #('Graphics')
- documentation: 'A symmetrical polygon in the shape of a star'!
Item was changed:
----- Method: StarMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}
- cl registerQuad: #(StarMorph authoringPrototype 'Star' 'A star')
forFlapNamed: 'Supplies'.]!
Item was changed:
----- Method: StickyPadMorph class>>defaultNameStemForInstances (in category 'parts bin') -----
defaultNameStemForInstances
"Answer the default name stem to use"
+ ^ 'tear off' translatedNoop
+ !
- ^ 'tear off'!
Item was changed:
----- Method: StickyPadMorph class>>descriptionForPartsBin (in category 'parts bin') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StickyPadMorph class>>launchPartVia:label: (in category 'parts bin') -----
launchPartVia: aSelector label: aString
"Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins. Overridden here so that all instances will be given the name, unlike the prevailing convention for other object types"
| aMorph |
+ aMorph _ self perform: aSelector.
- aMorph := self perform: aSelector.
aMorph setNameTo: self defaultNameStemForInstances. "i.e., circumvent uniqueness in this case"
aMorph setProperty: #beFullyVisibleAfterDrop toValue: true.
+ aMorph openInHand.
+ ^ aMorph!
- aMorph openInHand!
Item was changed:
----- Method: StickyPadMorph class>>registerInFlapsRegistry (in category 'as yet unclassified') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'Supplies'.
+ cl registerQuad: {#StickyPadMorph. #newStandAlone. 'Sticky Pad' translatedNoop. 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.' translatedNoop}
- cl registerQuad: #(StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.')
forFlapNamed: 'PlugIn Supplies'.]!
Item was changed:
----- Method: StoryboardBookMorph class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'Storyboard' translatedNoop
+ categories: #()
+ documentation: 'A storyboard authoring tool' translatedNoop!
- ^ self partName: 'Storyboard'
- categories: #('Presentation')
- documentation: 'A storyboard authoring tool'!
Item was changed:
----- Method: StringButtonMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'SButton' translatedNoop!
- ^ 'SButton'!
Item was changed:
----- Method: StringButtonMorph>>setTarget: (in category 'menu') -----
setTarget: evt
| rootMorphs |
+ rootMorphs _ self world rootMorphsAt: evt targetPoint.
+ target _ rootMorphs size > 1
- rootMorphs := self world rootMorphsAt: evt hand targetOffset.
- target := rootMorphs size > 1
ifTrue: [rootMorphs second]
ifFalse: [nil]!
Item was changed:
----- Method: TabMorph class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tab' translatedNoop!
- ^ 'tab'!
Item was changed:
+ ----- Method: TabSorterMorph>>addControls (in category 'initialization') -----
- ----- Method: TabSorterMorph>>addControls (in category 'as yet unclassified') -----
addControls
+ "Add the control bar at the top of the tool."
| b r |
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r _ AlignmentMorph newRow.
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r := AlignmentMorph newRow.
r color: b color; borderWidth: 0; layoutInset: 0.
r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
r wrapCentering: #topLeft.
+ r addMorphBack: (b label: 'Okay' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #acceptSort).
+ b _ SimpleButtonMorph new target: self; borderColor: Color black.
+ r addMorphBack: (b label: 'Cancel' translated font: ScriptingSystem fontForEToyButtons; actionSelector: #cancelSort).
- r addMorphBack: (b label: 'Okay'; actionSelector: #acceptSort).
- b := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (b label: 'Cancel'; actionSelector: #cancelSort).
self addMorphFront: r.
!
Item was changed:
----- Method: TabSorterMorph>>initialize (in category 'initialization') -----
initialize
+ "Initialize the receiver."
+
super initialize.
self removeAllMorphs.
self extent: 300@100.
+ pageHolder _ PasteUpMorph new.
- pageHolder := PasteUpMorph new.
pageHolder vResizeToFit: true; autoLineLayout: true.
pageHolder extent: self extent - borderWidth.
pageHolder padding: 8.
pageHolder cursor: 0.
+ pageHolder wantsMouseOverHalos: false.
self addControls.
self addMorphBack: pageHolder!
Item was changed:
----- Method: TabbedPalette class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'tabbedPalette' translatedNoop!
- ^ 'tabbedPalette'!
Item was changed:
----- Method: TextMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') -----
supplementaryPartsDescriptions
+ "Answer a list of DescriptionForPartsBin objects that characterize objects that this class wishes to contribute to Stationery bins *other* than by the standard default #newStandAlone protocol"
+
^ {
DescriptionForPartsBin
+ formalName: 'Text (border)' translatedNoop
+ categoryList: #()
+ documentation: 'A text field with border' translatedNoop
- formalName: 'Text (border)'
- categoryList: #('Text')
- documentation: 'A text field with border'
globalReceiverSymbol: #TextMorph
nativitySelector: #borderedPrototype.
" DescriptionForPartsBin
+ formalName: 'Text (fancy)' translatedNoop
+ categoryList: {'Text' translatedNoop}
+ documentation: 'A text field with a rounded shadowed border, with a fancy font.' translatedNoop
- formalName: 'Text (fancy)'
- categoryList: #('Text')
- documentation: 'A text field with a rounded shadowed border, with a fancy font.'
globalReceiverSymbol: #TextMorph
nativitySelector: #fancyPrototype."
DescriptionForPartsBin
+ formalName: 'Text' translatedNoop
+ categoryList: {'Basic' translatedNoop}
+ documentation:
+ 'A raw piece of text which you can edit into anything you want' translatedNoop
- formalName: 'Text'
- categoryList: #('Basic' 'Text')
- documentation: 'A raw piece of text which you can edit into anything you want'
globalReceiverSymbol: #TextMorph
+ nativitySelector: #nonwrappingPrototype.
- nativitySelector: #boldAuthoringPrototype.
}
!
Item was changed:
----- Method: Thumbnail>>makeThumbnailFromForm: (in category 'thumnail creation') -----
makeThumbnailFromForm: aForm
"Make a thumbnail from the form provided, obeying my min and max width and height preferences"
+ | scaleX scaleY margin opaque nominalWidth minimumWidth |
+ minimumWidth := self minimumWidth.
+ scaleY _ minimumHeight / aForm height. "keep height invariant"
+
+ scaleX _ ((nominalWidth := aForm width * scaleY) <= maximumWidth)
+ ifTrue:
+ [(nominalWidth < minimumWidth)
+ ifFalse:
+ [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
+ ifTrue:
+ [minimumWidth / aForm width]]
+ ifFalse:
+ [scaleY _ maximumWidth / aForm width].
- | scaleX scaleY margin opaque |
- scaleY := minimumHeight / aForm height. "keep height invariant"
- scaleX := ((aForm width * scaleY) <= maximumWidth)
- ifTrue: [scaleY] "the usual case; same scale factor, to preserve aspect ratio"
- ifFalse: [scaleY := maximumWidth / aForm width].
"self form: (aForm magnify: aForm boundingBox by: (scaleX @ scaleY) smoothing: 2)."
"Note: A problem with magnify:by: fails to reproduce borders properly.
The following code does a better job..."
+ margin _ 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
+ opaque _ (Form extent: aForm extent + margin depth: 32) "fillWhite".
+ aForm displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
+ self form: ((opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2) fixAlpha).
- margin := 1.0 / (scaleX@scaleY) // 2 max: 0@0. "Extra margin around border"
- opaque := (Form extent: aForm extent + margin depth: 32) "fillWhite".
- aForm fixAlpha displayOn: opaque at: aForm offset negated rule: Form blendAlpha. "Opaque form shrinks better"
- opaque fixAlpha.
- self form: (opaque magnify: opaque boundingBox by: (scaleX @ scaleY) smoothing: 2).
self extent: originalForm extent!
Item was changed:
----- Method: Thumbnail>>setStandardDefaultMetrics (in category 'initialization') -----
setStandardDefaultMetrics
"Provide the current choices for min.max width/height for thumbnails"
+ self maxWidth: 60 minHeight: 32.
+ self setProperty: #minimumWidth toValue: 16!
- self maxWidth: 60 minHeight: 24!
Item was changed:
----- Method: ThumbnailMorph>>step (in category 'stepping and presenter') -----
step
"Optimization: Don't redraw if we're viewing some kind of SketchMorph and its rotated Form hasn't changed."
| viewee f |
+ viewee _ self actualViewee.
+ viewee ifNil: [self stopStepping. ^ self].
+ viewee isSketchMorph
+ ifTrue:
+ [f := viewee rotatedForm.
+ f == lastSketchForm ifTrue: [^ self]. "The optimization"
+ lastSketchForm _ f]
+ ifFalse:
+ [lastSketchForm := nil]. "Avoids subtle bug if sketchMorph removed and then put back in"
+ self changed
- viewee := self actualViewee.
- viewee ifNil: [ self stopStepping. ^self ].
- (viewee isSketchMorph) ifTrue: [
- f := viewee rotatedForm.
- f == lastSketchForm ifTrue: [^ self].
- lastSketchForm := f].
- self changed.
!
Item was changed:
----- Method: TickIndicatorMorph>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ self extent: 30 @ 30.
+ index _ 0!
- self extent: 20 @ 20.
- index := 0!
Item was changed:
----- Method: TransitionMorph class>>allEffects (in category 'available effects') -----
allEffects
+ #('none' 'slide over' 'slide both' 'slide away' 'slide border'
+ 'page forward' 'page back'
+ 'french door' 'zoom frame' 'zoom' 'dissolve') translatedNoop.
^ #(none
slideOver slideBoth slideAway slideBorder
pageForward pageBack
frenchDoor
zoomFrame zoom
dissolve)!
Item was changed:
----- Method: TransitionMorph class>>directionsForEffect: (in category 'available effects') -----
directionsForEffect: eff
"All these arrays are ordered so inverse is atWrap: size//2."
+ #('right' 'down right' 'down' 'down left' 'left' 'up left' 'up' 'up right'
+ 'in' 'in h' 'out' 'out h') translatedNoop.
+
(#(slideOver slideBoth slideAway slideBorder) includes: eff)
ifTrue: [^ #(right downRight down downLeft left upLeft up upRight)].
(#(pageForward pageBack) includes: eff)
ifTrue: [^ #(right down left up)].
(#(frenchDoor) includes: eff)
ifTrue: [^ #(in inH out outH)].
(#(zoomFrame zoom) includes: eff)
ifTrue: [^ #(in out)].
^ Array new!
Item was changed:
----- Method: TrashCanMorph class>>descriptionForPartsBin (in category 'miscellaneous') -----
descriptionForPartsBin
+ ^ self partName: 'Trash' translatedNoop
+ categories: { 'Basic' translatedNoop}
+ documentation: 'a tool for discarding objects' translatedNoop
+ sampleImageForm: (Form extent: 42@54 depth: 8 fromArray: #( 0 0 0 2555943 992034 555814414 587202599 654311424 0 0 0 0 0 654320418 550751400 2829625512 2829625512 2829625357 556007424 0 0 0 0 36 3553874600 2829155709 2105376125 2711726248 2829625512 2728926240 587212583 0 0 0 639882194 3433594237 1400339837 2107746472 2812848296 2829634764 2829623677 2820612864 640090112 0 0 3553809064 2097828727 2108216018 3537030348 3436367016 2829625548 3537021096 2105452577 603989760 0 9427 3537019218 22259922 4141011666 3536637138 4160212129 2712183208 2832398034 2709355944 539103014 0 2413266 3531411713 2110979575 3537031884 3435975671 4157384573 2812846461 2108216055 3430776189 488645135 654311424 651416310 2823946621 4160606930 3537030348 3539466451 2829559720 2829625506 2105398007 3534257533 2718769186 0 601019090 2097238994 4258452178 3537031891 4160213671 2812782760 2829559976 2105387218 4154948989 2099055886 254214144 4174566098 1392595922 4258452178 3537041442 3551045799 2829625512 2829625505 2105396471 3534257533 2098863648 606470144 4275229394 2097238696 4260811474 3536977959 3550980264 2829625512 2829558141 2108225271 2826796413 1998134560 589758464 584241874 3427991891 3438727890 3537031970 3433614504 2829625512 2829164961 3436377804 2709355901 1394154783 589692928 617861842 3534246674 1403572946 3537031890 3536627880 2829625512 2812848338 4157778045 2105376083 1394154527 587202560 265540306 3537030269 1397980584 2831994060 3435964584 2829625512 2831995602 3433594237 2105365330 1394154783 589758464 13871314 3537041106 2826796413 2105385640 2829559976 2829625548 3436367016 2709355901 1397902346 1394220320 606535680 639674536 2831995602 3537030312 2829625256 2829625512 2829634728 2829625469 2105365331 1280463699 186260768 606535680 1037224 2829625512 3436368594 3537030348 3433605288 2829625512 2709355895 1397967954 1376389715 404364814 254214144 9164 2829625512 2829166760 2829625512 2829625505 2709355901 1397951058 1280463370 173167480 421203235 637534208 35 2829625511 2711715197 2105376125 2105376119 1397969747 1397903954 168430156 1397954174 421339392 654311424 0 4174162088 2728492413 2105376125 2105374547 1397969747 1397969490 1280070483 2105350169 438182694 0 0 267898023 2829155709 2105376125 2104981331 1397969747 1397902346 1397979005 2105376282 455025703 0 0 16241320 2832387239 2105376125 2004318035 1397969747 1397980541 2104982910 2105350427 471928576 0 0 653775528 2832388812 2712119464 2829221245 2728960381 2105387170 2104982910 2105350683 488701990 0 0 16700071 2832388818 2829625548 3433603489 2829625469 2105387170 2104982909 2105350683 504233984 0 0 2413224 2815218380 2829559976 3433594237 2829625469 2105387176 2104982910 2105416476 220266496 0 0 2413516 2815218386 2812782760 2829614461 2829625469 2105387176 2104982909 2105416476 220341760 0 0 2413516 2815218386 2829166796 2829623677 2829625469 2105387176 2104982909 2105416733 522397440 0 0 54226 2829636306 2810030284 3433605245 2829625469 2105385640 2104982910 2105416733 522397440 0 0 2619346 2829636306 2829166760 2829625469 2829625505 2105385634 2104982945 2097945629 522462976 0 0 65234 2812859090 2829166760 3433604989 2829625469 2105387176 2104982945 2097945629 539240192 0 0 8914 2829636306 2829166760 3433605245 2829625505 2105387176 2104982945 2098797853 537863936 0 0 9427 2829634770 3433539752 3433604989 2829625505 2105387176 2104982946 2098797597 554641152 0 0 211 3433549010 3433146536 3433605245 2728962209 2105387176 2104983208 2098863389 553658112 0 0 9975 3433539794 3433144744 2829625213 2728962209 2105387176 2104983208 2098863134 234881024 0 0 10238 3433539794 3534201256 3435964321 2712184993 2105387176 2104983202 2115640350 234891008 0 0 35 3534203090 3534266792 3435964577 2108205217 2105387176 2104982946 2115705886 234881024 0 0 36 3550980306 3534268328 2831984801 2108205223 2105385640 2104982946 2115706142 570425344 0 0 0 3551045836 3534266792 2831984801 2108205224 2105385640 2105376161 2115705869 572915712 0 0 38 4155025356 3534266792 2831984801 2108205224 2105385640 2105376161 2115706125 572915712 0 0 39 4174162088 3536626088 2831984801 2108205224 2105385640 2105376126 2115771661 589758464 0 0 0 583837608 3536626087 2831984801 2108205224 2105387176 2105376161 2115771679 589692928 0 0 0 601006503 3537020839 2831984807 2108205224 2102623656 2105385342 2719751456 254214144 0 0 0 617850792 3537020833 2831984808 2108214440 2097238952 2105387170 438111502 0 0 0 0 668191948 3537021095 2829634727 2108205224 2097238952 2726142590 471736591 654311424 0 0 0 2282194 3537020833 2829634728 2711726248 2097238690 2826796314 220275750 0 0 0 0 63442 3537021095 2832387240 2107746472 2709355937 2105350686 539168550 640090112 0 0 0 211 3537030312 3536627879 2712194216 2815677352 2820414989 555885347 588195584 0 0 0 39 584307410 3433605288 2812848295 2714576126 3542093084 504176397 521015079 0 0 0 0 8992 3553414312 2829625512 2820673060 3553470632 2829589020 488579879 0 0 0 0 39 991758 235807524 2564819 3433605288 2829614621 220270375 0 0 0 0 0 0 0 2140364 3536627880 2709356064 571418112 0 0 0 0 0 0 0 581478568 3433605246 2719813120 640090112 0 0 0 0 0 0 0 13880488 2829589793 603989798 0 0 0 0 0 0 0 0 991758 570435111 654311424 0 0) offset: 0@0)!
- ^ self partName: 'Trash'
- categories: #('Useful' 'Basic')
- documentation: 'a tool for discarding objects'!
Item was changed:
----- Method: TrashCanMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- ifPresent: [:cl | cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Widgets'.
+ cl registerQuad: {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}
- cl registerQuad: #(TrashCanMorph new 'Trash' 'A tool for discarding objects')
forFlapNamed: 'Scripting']!
Item was changed:
----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') -----
defaultNameStemForInstances
+ ^ 'viewerFlapTab' translatedNoop!
- ^ 'viewerFlapTab'!
Item was changed:
----- Method: WaveEditor class>>descriptionForPartsBin (in category 'parts bin') -----
descriptionForPartsBin
+ ^ self partName: 'WaveEditor' translatedNoop
+ categories: {'Multimedia' translatedNoop}
+ documentation: 'A workbench for seing and editing wave forms' translatedNoop!
- ^ self partName: 'WaveEditor'
- categories: #('Multimedia')
- documentation: 'A workbench for seing and editing wave forms'!
Item was changed:
----- Method: WaveEditor>>addControls (in category 'initialization') -----
addControls
+ | slider aWrapper m aButton |
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: Color transparent;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #shrinkWrap;
+ vResizing: #shrinkWrap;
+ extent: 5 @ 5.
+ aWrapper wrapCentering: #topLeft.
+ aButton := self buttonName: 'X' action: #delete.
+ aButton setBalloonText: 'Close WaveEditor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Menu' translated action: #invokeMenu.
+ aButton setBalloonText: 'Open a menu' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play' translated action: #play.
+ aButton setBalloonText: 'Play sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Before' translated action: #playBeforeCursor.
+ aButton setBalloonText: 'Play before cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play After' translated action: #playAfterCursor.
+ aButton setBalloonText: 'Play after cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Play Loop' translated action: #playLoop.
+ aButton setBalloonText: 'Play the loop' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Test' translated action: #playTestNote.
+ aButton setBalloonText: 'Test the note' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Save' translated action: #saveInstrument.
+ aButton setBalloonText: 'Save the sound' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop End' translated action: #setLoopEnd.
+ aButton setBalloonText: 'Set loop end at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set One Cycle' translated action: #setOneCycle.
+ aButton setBalloonText: 'Set one cycle' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ aButton := self buttonName: 'Set Loop Start' translated action: #setLoopStart.
+ aButton setBalloonText: 'Set the loop start at cursor' translated.
+ aWrapper addMorphBack: aButton.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ self addMorphBack: aWrapper.
+ aWrapper := AlignmentMorph newRow.
+ aWrapper color: self color;
+ borderWidth: 0;
+ layoutInset: 0.
+ aWrapper hResizing: #spaceFill;
+ vResizing: #rigid;
+ extent: 5 @ 20;
+ wrapCentering: #center;
+ cellPositioning: #leftCenter.
+ m := StringMorph new contents: 'Index: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #cursor;
+ putSelector: #cursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 71;
+ step.
+ aWrapper addMorphBack: m.
+ m := StringMorph new contents: 'Value: ' translated;
+ font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #valueAtCursor;
+ putSelector: #valueAtCursor:;
+ font: Preferences standardEToysButtonFont;
+ growable: false;
+ width: 50;
+ step.
+ aWrapper addMorphBack: m.
+ slider := SimpleSliderMorph new color: color;
+ extent: 200 @ 10;
+ target: self;
+ actionSelector: #scrollTime:.
+ aWrapper addMorphBack: slider.
+ m := Morph new color: aWrapper color;
+ extent: 10 @ 5.
+ "spacer"
+ aWrapper addMorphBack: m.
+ m := UpdatingStringMorph new target: graph;
+ getSelector: #startIndex;
+ putSelector: #startIndex:;
+ font: Preferences standardEToysButtonFont;
+ width: 40;
+ step.
+ aWrapper addMorphBack: m.
+ self addMorphBack: aWrapper!
- | slider bb r m |
- r := AlignmentMorph newRow.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r color: bb color; borderWidth: 0; layoutInset: 0.
- r hResizing: #shrinkWrap; vResizing: #shrinkWrap; extent: 5@5.
- r wrapCentering: #topLeft.
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'X'; actionSelector: #delete).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: '<>'; actWhen: #buttonDown;
- actionSelector: #invokeMenu).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play' translated; actionSelector: #play).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Before' translated; actionSelector: #playBeforeCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play After' translated; actionSelector: #playAfterCursor).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Play Loop' translated; actionSelector: #playLoop).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Test' translated; actionSelector: #playTestNote).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Save' translated; actionSelector: #saveInstrument).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop End' translated; actionSelector: #setLoopEnd).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'One Cycle' translated; actionSelector: #setOneCycle).
- bb := SimpleButtonMorph new target: self; borderColor: Color black.
- r addMorphBack: (bb label: 'Set Loop Start' translated; actionSelector: #setLoopStart).
- self addMorphBack: r.
-
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
-
- m := StringMorph new contents: 'Index: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #cursor; putSelector: #cursor:;
- growable: false; width: 71; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Value: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #valueAtCursor; putSelector: #valueAtCursor:;
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- slider := SimpleSliderMorph new
- color: color;
- extent: 200@2;
- target: self;
- actionSelector: #scrollTime:.
- r addMorphBack: slider.
-
- m := Morph new color: r color; extent: 10@5. "spacer"
- r addMorphBack: m.
- m := UpdatingStringMorph new
- target: graph; getSelector: #startIndex; putSelector: #startIndex:;
- width: 40; step.
- r addMorphBack: m.
-
- self addMorphBack: r.
-
- !
Item was changed:
----- Method: WaveEditor>>addLoopPointControls (in category 'initialization') -----
addLoopPointControls
+ | m aWrapper |
+ aWrapper _ AlignmentMorph newRow.
+ aWrapper color: self color; borderWidth: 0; layoutInset: 0.
+ aWrapper hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
- | r m |
- r := AlignmentMorph newRow.
- r color: self color; borderWidth: 0; layoutInset: 0.
- r hResizing: #spaceFill; vResizing: #rigid; extent: 5@20; wrapCentering: #center; cellPositioning: #leftCenter.
+ m _ StringMorph new contents: 'Loop end: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- m := StringMorph new contents: 'Loop end: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopEnd; putSelector: #loopEnd:;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop length: ' translated ; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop length: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopLength; putSelector: #loopLength:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Loop cycles: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Loop cycles: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #loopCycles; putSelector: #loopCycles:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
+ aWrapper addTransparentSpacerOfSize: 4 @ 1.
+ m _ StringMorph new contents: 'Frequency: ' translated; font: Preferences standardEToysButtonFont.
+ aWrapper addMorphBack: m.
+ m _ UpdatingStringMorph new
- growable: false; width: 50; step.
- r addMorphBack: m.
-
- m := StringMorph new contents: 'Frequency: ' translated.
- r addMorphBack: m.
- m := UpdatingStringMorph new
target: self; getSelector: #perceivedFrequency; putSelector: #perceivedFrequency:;
floatPrecision: 0.001;
+ font: Preferences standardEToysButtonFont;
+ growable: false; width: 100; step.
+ aWrapper addMorphBack: m.
- growable: false; width: 50; step.
- r addMorphBack: m.
+ self addMorphBack: aWrapper
- self addMorphBack: r.
!
Item was changed:
----- Method: WaveEditor>>initialize (in category 'initialization') -----
initialize
"initialize the state of the receiver"
super initialize.
""
+ samplingRate _ SoundPlayer samplingRate.
+ loopEnd _ loopLength _ 0.
+ loopCycles _ 1.
+ perceivedFrequency _ 0.
- samplingRate := SoundPlayer samplingRate.
- loopEnd := loopLength := 0.
- loopCycles := 1.
- perceivedFrequency := 0.
"zero means unknown"
self extent: 5 @ 5;
listDirection: #topToBottom;
wrapCentering: #topLeft;
hResizing: #shrinkWrap;
vResizing: #shrinkWrap;
layoutInset: 3.
+ graph _ GraphMorph new extent: 450 @ 100.
- graph := GraphMorph new extent: 450 @ 100.
graph cursor: 0.
graph cursorColorAtZeroCrossings: Color blue.
self addControls.
self addLoopPointControls.
self addMorphBack: graph.
self
addMorphBack: (Morph
newBounds: (0 @ 0 extent: 0 @ 3)
color: Color transparent).
+ self addMorphBack: (keyboard _ PianoKeyboardMorph new).
+ "self sound: (SampledSound soundNamed: 'croak')."
- self addMorphBack: (keyboard := PianoKeyboardMorph new).
- self sound: (SampledSound soundNamed: 'croak').
!
Item was changed:
----- Method: Workspace class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') -----
registerInFlapsRegistry
"Register the receiver in the system's flaps registry"
self environment
at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#Workspace. #prototypicalToolWindow. 'Workspace' translatedNoop. 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.' translatedNoop} forFlapNamed: 'Tools'.]!
- ifPresent: [:cl | cl registerQuad: #(Workspace prototypicalToolWindow 'Workspace' 'A Workspace is a simple window for editing text. You can later save the contents to a file if you desire.')
- forFlapNamed: 'Tools'.]!
1
0