Marcel Taeumel uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-mt.1436.mcz
==================== Summary ====================
Name: System-mt.1436
Author: mt
Time: 28 November 2023, 10:33:10.464569 am
UUID: 81edd9b9-3897-434b-840b-a628c005b995
Ancestors: System-dtl.1435
Complements Tools-mt.1241
=============== Diff against System-dtl.1435 ===============
Item was changed:
----- Method: Process>>debug (in category '*System-debugging') -----
debug
+ "See the comment in #debugWithCue:."
- "See the comment in #debugWithTitle:full:contents:."
^ self debugWithTitle: 'Debugger' translated!
Item was added:
+ ----- Method: Process>>debugWithCue: (in category '*System-debugging') -----
+ debugWithCue: invocationCue
+ "BEWARE!! Open a debugger on the receiver, which must neither be running nor be simulated. Examples include workspace do-its, test execution, and helper processes. If you want to begin with a certain context, use #runUntil: before calling to here.
+
+ [ 3 + 4 ] newProcess debug.
+ (Process forBlock: [ 3 + 4 ]) debug.
+
+ Note that for debugging the currently running process, which might currently simulate the receiver, use ProcessorScheduler >> #debugWithTitle:.
+
+ (IMPLEMENTATION NOTE: The debugger interface is capable of debugging the active process correctly. However, unconditionally sending debug messages to the active process, in the past, led to a very tedious number of infinite debugger chains in an edge case when the effectiveProcess differs from the genuineProcess being executed by the VM (see ProcessorScheduler >> #activeProcess). This edge case occurs when a debugger is raised while another process is being simulated (aka process-faithful debugging, see #evaluate:onBehalfOf:), so at the very least Kernel methods should never send this message to the active process. For more information, see http://forum.world.st/I-broke-the-debugger-td5110752.html)"
+
+ self assert: [self suspendedContext notNil "= not running"].
+ self assert: [self isActiveProcess not "= not even simulated"].
+
+ self assert: [invocationCue process isNil].
+ invocationCue process: self.
+ self assert: [invocationCue context isNil].
+ invocationCue context: self suspendedContext.
+
+ ^ ToolSet debugWithCue: invocationCue!
Item was changed:
----- Method: Process>>debugWithTitle: (in category '*System-debugging') -----
debugWithTitle: title
+ "See the comment in #debugWithCue:."
- "See the comment in #debugWithTitle:full:contents:."
^ self debugWithTitle: title full: true!
Item was changed:
----- Method: Process>>debugWithTitle:full: (in category '*System-debugging') -----
debugWithTitle: title full: aBoolean
+ "See the comment in #debugWithCue:."
- "See the comment in #debugWithTitle:full:contents:."
^ self debugWithTitle: title full: aBoolean contents: nil!
Item was changed:
----- Method: Process>>debugWithTitle:full:contents: (in category '*System-debugging') -----
debugWithTitle: title full: bool contents: contents
+ "See the comment in #debugWithCue:."
- "BEWARE!! Open a debugger on the receiver, which must neither be running nor be simulated. Examples include workspace do-its, test execution, and helper processes. If you want to begin with a certain context, use #runUntil: before calling to here.
-
- [ 3 + 4 ] newProcess debug.
- (Process forBlock: [ 3 + 4 ]) debug.
-
- Note that for debugging the currently running process, which might currently simulate the receiver, use ProcessorScheduler >> #debugWithTitle:.
-
- (IMPLEMENTATION NOTE: The debugger interface is capable of debugging the active process correctly. However, unconditionally sending debug messages to the active process, in the past, led to a very tedious number of infinite debugger chains in an edge case when the effectiveProcess differs from the genuineProcess being executed by the VM (see ProcessorScheduler >> #activeProcess). This edge case occurs when a debugger is raised while another process is being simulated (aka process-faithful debugging, see #evaluate:onBehalfOf:), so at the very least Kernel methods should never send this message to the active process. For more information, see http://forum.world.st/I-broke-the-debugger-td5110752.html)"
+ ^ self debugWithCue: (DebuggerInvocationCue new
+ "process: nil;"
+ "context: nil;"
+ label: title;
+ contents: contents;
+ fullView: bool;
+ yourself)!
- self assert: [self suspendedContext notNil "= not running"].
- self assert: [self isActiveProcess not "= not even simulated"].
-
- ^ ToolSet
- debugProcess: self
- context: self suspendedContext
- label: title
- contents: contents
- fullView: bool!
Item was changed:
----- Method: ProcessorScheduler>>debugContext:title:full:contents: (in category '*System-Applications-debugging') -----
debugContext: aContext title: title full: aBoolean contents: contents
- "Open a debugger on the currently running (i.e. genuine) process. Note that that process might actually simulate another process, which ends up here by checking #isActiveProcess. If no code simulation is involved, the genuine process will be suspended along the way -- and hopefully replaced to keep the system responsive. For the simulated case, an existing debugger should take over and leave the genuine process running, that is, simulating. Examples include (a) handling unhandled errors in a tool set and (b) introspecting thisContext to reveal dialog invocation.
+ self flag: #deprecated.
+ ^ self debugWithCue: (DebuggerInvocationCue new
+ "process: nil;"
+ context: aContext;
+ label: title;
+ contents: contents;
+ fullView: aBoolean;
+ yourself)!
- Processor debugWithTitle: 'Debug' full: false contents: 'Carpe Squeak!!'
-
- Note that, outside code simulation, suspended processes can be debugged directly via Process >> #debugWithTitle:. "
-
- self assert: [thisContext hasSender: aContext].
-
- ^ ToolSet
- debugProcess: genuineProcess
- context: aContext
- label: title
- contents: contents
- fullView: aBoolean!
Item was changed:
----- Method: ProcessorScheduler>>debugContextThat:title: (in category '*System-Applications-debugging') -----
debugContextThat: aBlock title: title
+ "See the comment in #debugWithCue:."
- "See the comment in #debugContext:title:full:contents:."
+ ^ self debugWithCue: (DebuggerInvocationCue new
+ "process: nil;"
+ context: (thisContext sender findContextSuchThat: aBlock);
+ label: title;
+ "contents: nil;"
+ fullView: true;
+ yourself)!
- ^ self
- debugContext: (thisContext sender findContextSuchThat: aBlock)
- title: title
- full: true
- contents: nil!
Item was changed:
----- Method: ProcessorScheduler>>debugContextThat:title:full: (in category '*System-Applications-debugging') -----
debugContextThat: aBlock title: title full: aBoolean
+ "See the comment in #debugWithCue:."
- "See the comment in #debugContext:title:full:contents:."
+ ^ self debugWithCue: (DebuggerInvocationCue new
+ "process: nil;"
+ context: (thisContext sender findContextSuchThat: aBlock);
+ label: title;
+ "contents: nil;"
+ fullView: aBoolean;
+ yourself)!
- ^ self
- debugContext: (thisContext sender findContextSuchThat: aBlock)
- title: title
- full: aBoolean
- contents: nil!
Item was changed:
----- Method: ProcessorScheduler>>debugContextThat:title:full:contents: (in category '*System-Applications-debugging') -----
debugContextThat: aBlock title: title full: aBoolean contents: contents
+ "See the comment in #debugWithCue:."
- "See the comment in #debugContext:title:full:contents:."
+ ^ self debugWithCue: (DebuggerInvocationCue new
+ "process: nil;"
+ context: (thisContext sender findContextSuchThat: aBlock);
+ label: title;
+ contents: contents;
+ fullView: aBoolean;
+ yourself)!
- ^ self
- debugContext: (thisContext sender findContextSuchThat: aBlock)
- title: title
- full: aBoolean
- contents: contents!
Item was added:
+ ----- Method: ProcessorScheduler>>debugWithCue: (in category '*System-Applications-debugging') -----
+ debugWithCue: invocationCue
+ "Open a debugger on the currently running (i.e. genuine) process. Note that that process might actually simulate another process, which ends up here by checking #isActiveProcess. If no code simulation is involved, the genuine process will be suspended along the way -- and hopefully replaced to keep the system responsive. For the simulated case, an existing debugger should take over and leave the genuine process running, that is, simulating. Examples include (a) handling unhandled errors in a tool set and (b) introspecting thisContext to reveal dialog invocation.
+
+ Processor debugWithTitle: 'Debug' full: false contents: 'Carpe Squeak!!'
+
+ Note that, outside code simulation, suspended processes can be debugged directly via Process >> #debugWithTitle:. "
+
+ self assert: [invocationCue context notNil].
+ self assert: [thisContext hasSender: invocationCue context].
+
+ self assert: [invocationCue process isNil].
+ invocationCue process: genuineProcess.
+
+ ^ ToolSet debugWithCue: invocationCue!
Item was changed:
----- Method: ProcessorScheduler>>debugWithTitle: (in category '*System-Applications-debugging') -----
debugWithTitle: title
+ "See the comment in #debugWithCue:."
- "See the comment in #debugContext:title:full:contents:."
+ ^ self debugWithCue: (DebuggerInvocationCue new
+ "process: nil;"
+ context: thisContext sender;
+ label: title;
+ "contents: nil;"
+ fullView: true;
+ yourself)!
- ^ self
- debugContext: thisContext sender
- title: title
- full: true
- contents: nil!
Item was changed:
----- Method: ProcessorScheduler>>debugWithTitle:full: (in category '*System-Applications-debugging') -----
debugWithTitle: title full: aBoolean
+ "See the comment in #debugWithCue:."
- "See the comment in #debugContext:title:full:contents:."
+ ^ self debugWithCue: (DebuggerInvocationCue new
+ "process: nil;"
+ context: thisContext sender;
+ label: title;
+ "contents: nil;"
+ fullView: aBoolean;
+ yourself)!
- ^ self
- debugContext: thisContext sender
- title: title
- full: aBoolean
- contents: nil!
Item was changed:
----- Method: ProcessorScheduler>>debugWithTitle:full:contents: (in category '*System-Applications-debugging') -----
debugWithTitle: title full: aBoolean contents: contents
+ "See the comment in #debugWithCue:."
+
+ ^ self debugWithCue: (DebuggerInvocationCue new
+ "process: nil;"
+ context: thisContext sender;
+ label: title;
+ contents: contents;
+ fullView: aBoolean;
+ yourself)!
- "See the comment in #debugContext:title:full:contents:."
-
- ^ self
- debugContext: thisContext sender
- title: title
- full: aBoolean
- contents: contents!
Item was changed:
----- Method: ToolSet class>>debugProcess:context:label:contents:fullView: (in category 'debugging') -----
debugProcess: aProcess context: aContext label: aString contents: contents fullView: aBool
- "Open a debugger on the given process, which might be active, suspended, or terminated. You can also use the convenience protocol for debugging on Process and ProcessorScheduler.
-
- NOTE that you SHOULD NOT pass 'Processor activeProcess' directly to this method to avoid mixing code simulation with genuine code execution. Always use the indirection via ProcessorScheduler >>#debug... See also the comment in Process >> #debugWithTitle:full:contents:."
+ self flag: #deprecated.
- "First, guard this incident to detect and handle recursive errors."
- ^ Project current guardRecursiveError: aString during: [
+ ^ self debugWithCue: (DebuggerInvocationCue new
+ process: aProcess;
+ context: aContext;
+ label: aString;
+ contents: contents;
+ fullView: aBool;
+ yourself)!
- "In any case, log the debugging incident into an external file."
- Smalltalk tryLogSqueakError: aString inContext: aContext.
-
- self default
- ifNotNil: [:toolSet |
- "Let the current tool set decide about the best tool for the job."
- toolSet
- debugProcess: aProcess context: aContext
- label: aString contents: contents
- fullView: aBool]
- ifNil: [
- "There is no tool set!! :-O ... Inform the user in a simple dialog."
- Project current
- debugProcess: aProcess
- inDialog: ('No debugger available for process:\\ Name: {1}\ Hash: {2}\ Context: {3}\ Title: {4}\ Message: {5}' translated withCRs
- format: {aProcess name. aProcess hash. aContext. aString. contents})] ]!
Item was added:
+ ----- Method: ToolSet class>>debugWithCue: (in category 'debugging') -----
+ debugWithCue: invocationCue
+ "Open a debugger on the given process, which might be active, suspended, or terminated. You can also use the convenience protocol for debugging on Process and ProcessorScheduler.
+
+ NOTE that you SHOULD NOT pass 'Processor activeProcess' directly to this method to avoid mixing code simulation with genuine code execution. Always use the indirection via ProcessorScheduler >>#debug... See also the comment in Process >> #debugWithTitle:full:contents:."
+
+ self assert: [invocationCue process notNil].
+ self assert: [invocationCue context notNil].
+
+ "First, guard this incident to detect and handle recursive errors."
+ ^ Project current guardRecursiveError: invocationCue label during: [
+
+ "In any case, log the debugging incident into an external file."
+ Smalltalk tryLogSqueakError: invocationCue label inContext: invocationCue context.
+
+ self default
+ ifNotNil: [:toolSet |
+ "Let the current tool set decide about the best tool for the job."
+ toolSet debugWithCue: invocationCue]
+ ifNil: [
+ "There is no tool set!! :-O ... Inform the user in a simple dialog."
+ Project current
+ debugProcess: invocationCue process
+ inDialog: ('No debugger available for process:\\ Name: {1}\ Hash: {2}\ Context: {3}\ Title: {4}\ Message: {5}' translated withCRs
+ format: {
+ invocationCue process name.
+ invocationCue process hash.
+ invocationCue context.
+ invocationCue label.
+ invocationCue contents})] ]!
1
0
Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.1241.mcz
==================== Summary ====================
Name: Tools-mt.1241
Author: mt
Time: 28 November 2023, 10:32:22.826569 am
UUID: 5ecdd41c-8d57-fc45-8b23-d96784261782
Ancestors: Tools-dtl.1240
Adds DebuggerInvocationCue as an extension point to pass on more information from exceptions to the debugger.
See senders of #todoDebugger if you want to make use of this new extension point.
Thanks to Eliot (eem) for the idea and Jaromir (jar) for the use case via BlockCannotReturn.
See discussions here:
- http://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfoun…
- http://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfoun…
=============== Diff against Tools-dtl.1240 ===============
Item was changed:
----- Method: Debugger class>>openOn:context:label:contents:fullView: (in category 'opening') -----
openOn: process context: context label: title contents: contentsStringOrNil fullView: bool
- "PRIVATE!! Open a notifier or a full debugger window for the given process
- at the given context. Clients MUST use a ToolSet that is configured with the
- receiver class (or tool) to then debug a process via
- Process >> #debug(WithTitle:)
- ProcessorScheduler >> #debugWithTitle:
- ToolSet >> #debugProcess:context:...
- and similar messages in Process or ProcessorScheduler.
-
- Example invocations:
- Processor debugWithTitle: 'Example'.
- (Process forBlock: [3+4]) debug.
- 7/0.
-
- Configure a new tool set like this
- ToolSet default: StandardToolSet
- See commentary in
- Process >> #debugWithTitle:full:contents:
- ProcessorScheduler >> #debugContext:title:full:contents:"
+ self flag: #deprecated.
+
+ ^ self openOnCue: (DebuggerInvocationCue new
+ process: process;
+ context: context;
+ label: title;
+ contents: contentsStringOrNil;
- ^ (self onProcess: process context: context)
- openWithLabel: title
- contents: contentsStringOrNil
fullView: bool;
+ yourself)!
- yourself!
Item was added:
+ ----- Method: Debugger class>>openOnCue: (in category 'opening') -----
+ openOnCue: invocationCue
+ "PRIVATE!! Open a notifier or a full debugger window for the given process
+ at the given context. Clients MUST use a ToolSet that is configured with the
+ receiver class (or tool) to then debug a process via
+ Process >> #debug(WithTitle:)
+ ProcessorScheduler >> #debugWithTitle:
+ ToolSet >> #debugProcess:context:...
+ and similar messages in Process or ProcessorScheduler.
+
+ Example invocations:
+ Processor debugWithTitle: 'Example'.
+ (Process forBlock: [3+4]) debug.
+ 7/0.
+
+ Configure a new tool set like this
+ ToolSet default: StandardToolSet
+ See commentary in
+ Process >> #debugWithTitle:full:contents:
+ ProcessorScheduler >> #debugContext:title:full:contents:"
+
+ self flag: #todoDebugger. "mt: Use exception-specific parameters from the invocation cue such as for BlockCannotReturn. See discussions here:
+ - http://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfoun…
+ - http://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfoun…
+ "
+
+ ^ (self onProcess: invocationCue process context: invocationCue context)
+ openWithLabel: invocationCue label
+ contents: invocationCue contents
+ fullView: invocationCue fullView;
+ yourself!
Item was added:
+ Object subclass: #DebuggerInvocationCue
+ instanceVariableNames: 'process context label contents fullView'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-Debugger'!
Item was added:
+ ----- Method: DebuggerInvocationCue>>contents (in category 'accessing') -----
+ contents
+
+ ^ contents!
Item was added:
+ ----- Method: DebuggerInvocationCue>>contents: (in category 'accessing') -----
+ contents: anObject
+
+ contents := anObject.!
Item was added:
+ ----- Method: DebuggerInvocationCue>>context (in category 'accessing') -----
+ context
+
+ ^ context!
Item was added:
+ ----- Method: DebuggerInvocationCue>>context: (in category 'accessing') -----
+ context: anObject
+
+ context := anObject.!
Item was added:
+ ----- Method: DebuggerInvocationCue>>fullView (in category 'accessing') -----
+ fullView
+
+ ^ fullView ifNil: [false]!
Item was added:
+ ----- Method: DebuggerInvocationCue>>fullView: (in category 'accessing') -----
+ fullView: anObject
+
+ fullView := anObject.!
Item was added:
+ ----- Method: DebuggerInvocationCue>>label (in category 'accessing') -----
+ label
+
+ ^ label!
Item was added:
+ ----- Method: DebuggerInvocationCue>>label: (in category 'accessing') -----
+ label: anObject
+
+ label := anObject.!
Item was added:
+ ----- Method: DebuggerInvocationCue>>process (in category 'accessing') -----
+ process
+
+ ^ process!
Item was added:
+ ----- Method: DebuggerInvocationCue>>process: (in category 'accessing') -----
+ process: anObject
+
+ process := anObject.!
Item was changed:
----- Method: StandardToolSet class>>debugProcess:context:label:contents:fullView: (in category 'debugging') -----
debugProcess: aProcess context: aContext label: aString contents: contents fullView: aBool
+ self flag: #deprecated.
- (aProcess isTerminated and: [aString isNil or: [aString beginsWith: 'Debug it']]) ifTrue: [
- ^ Project uiManager inform: 'Nothing to debug. Process has terminated.\Expression optimized.' translated withCRs].
+ ^ self debugWithCue: (DebuggerInvocationCue new
+ process: aProcess;
+ context: aContext;
+ label: aString;
+ contents: contents;
+ fullView: aBool;
+ yourself)!
- ^ Debugger
- openOn: aProcess
- context: aContext
- label: aString
- contents: contents
- fullView: aBool!
Item was added:
+ ----- Method: StandardToolSet class>>debugWithCue: (in category 'debugging') -----
+ debugWithCue: invocationCue
+
+ (invocationCue process isTerminated and: [invocationCue label isNil or: [invocationCue label beginsWith: 'Debug it']]) ifTrue: [
+ ^ Project uiManager inform: 'Nothing to debug. Process has terminated.\Expression optimized.' translated withCRs].
+
+ ^ Debugger openOnCue: invocationCue!
Item was changed:
----- Method: StandardToolSet class>>handleError: (in category 'debugging - handlers') -----
handleError: anError
"Double dispatch. Let the processor take care of that error, which usually calls back here to #debugProcess:..."
+ self flag: #todoDebugger. "mt: Pass exception-specific parameters to the invocation cue such as for BlockCannotReturn. See discussions here:
+ - http://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfoun…
+ - http://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfoun…
+ "
+
+ ^ Processor debugWithCue: (DebuggerInvocationCue new
+ context: anError signalerContext;
+ label: anError description;
+ fullView: false;
+ "contents: nil;"
+ yourself)!
- ^ Processor
- debugContext: anError signalerContext
- title: anError description
- full: false
- contents: nil!
Item was changed:
----- Method: StandardToolSet class>>handleWarning: (in category 'debugging - handlers') -----
handleWarning: aWarning
"Double dispatch. Let the processor take care of that warning, which usually calls back here to #debugProcess:..."
| message |
message := '{1}\\{2}' withCRs asText format: {
"First, show the actual text of this warning."
aWarning messageText.
"Second, append some helpful information that apply to all kinds of warnings."
('{1} {2}' asText format: {
'Select "Proceed" to continue or close this window to cancel the operation.' translated.
'If you do not want to be interrupted anymore, you can {1} this kind of warning. You can also {2}, which resets such warnings on the next image startup.' translated asText format: {
"Provide clickable text links so that the user can directly suppress warnings."
'always suppress' asText
addAttribute: (PluggableTextAttribute evalBlock: [
aWarning class suppressWarnings.
self inform: ('All ''{1}'' warnings will be suppressed.' translated format: {aWarning class name})]).
'suppress temporarily' asText
addAttribute: (PluggableTextAttribute evalBlock: [
aWarning class suppressAndResetOnStartUp.
self inform: ('All ''{1}'' warnings will be suppressed\and reset on the next image startup.' translated withCRs format: {aWarning class name})])}.
}) addAttribute: (
"Show this helpful information in a smaller font."
TextFontReference toFont: Preferences standardButtonFont)}.
+
+ self flag: #todoDebugger. "mt: Pass exception-specific parameters to the invocation cue such as for BlockCannotReturn. See discussions here:
+ - http://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfoun…
+ - http://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfoun…
+ "
+
+ ^ Processor debugWithCue: (DebuggerInvocationCue new
+ context: aWarning signalerContext;
+ label: 'Warning' translated;
+ fullView: false;
+ contents: message;
+ yourself)!
-
- ^ Processor
- debugContext: aWarning signalerContext
- title: 'Warning' translated
- full: false
- contents: message!
Item was changed:
----- Method: SyntaxError>>debug (in category 'menu') -----
debug
"Show the stack of the process leading to this syntax editor, typically showing the stack of the compiler as called from fileIn."
+ ToolSet debugWithCue: (DebuggerInvocationCue new
+ process: compilerProcess;
+ context: notification signalerContext;
+ label: 'Stack of the Syntax Error' translated;
+ "contents: nil;"
+ fullView: true;
+ yourself).
- ToolSet
- debugProcess: compilerProcess
- context: notification signalerContext
- label: 'Stack of the Syntax Error' translated
- contents: nil
- fullView: true.
"Receiver must give up control over that process now."
compilerProcess := nil.
self changed: #close.!
1
0
Marcel Taeumel uploaded a new version of Monticello to project The Trunk:
http://source.squeak.org/trunk/Monticello-mt.805.mcz
==================== Summary ====================
Name: Monticello-mt.805
Author: mt
Time: 27 November 2023, 2:21:19.803485 pm
UUID: 1fa477fb-13f1-b54a-b0d3-48d3fbccc59c
Ancestors: Monticello-ct.804
Fixes regression (i.e. missing #withCRs) in flush-cache dialog text.
=============== Diff against Monticello-ct.804 ===============
Item was changed:
----- Method: MCWorkingCopyBrowser>>flushCachedVersions (in category 'actions') -----
flushCachedVersions
| beforeBytes afterBytes beforeVersions afterVersions |
Cursor wait showWhile: [
Smalltalk garbageCollect.
beforeBytes := Smalltalk bytesLeft: true.
beforeVersions := MCVersion allSubInstances size.
MCFileBasedRepository flushAllCaches.
afterBytes := Smalltalk bytesLeft: true.
afterVersions := MCVersion allSubInstances size.
].
+ ^self inform: ('{1} versions flushed\{2} bytes reclaimed' translated withCRs format: {beforeVersions - afterVersions. beforeBytes - afterBytes})!
- ^self inform: ('{1} versions flushed\{2} bytes reclaimed' translated format: {beforeVersions - afterVersions. beforeBytes - afterBytes})!
1
0
David T. Lewis uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-dtl.509.mcz
==================== Summary ====================
Name: EToys-dtl.509
Author: dtl
Time: 25 November 2023, 5:23:42.432774 pm
UUID: ddbcb0de-59ad-4980-b768-d5b34db91d15
Ancestors: EToys-dtl.508
Clean up package categories
=============== Diff against EToys-dtl.508 ===============
Item was changed:
SystemOrganization addCategory: #'Etoys-Buttons'!
SystemOrganization addCategory: #'Etoys-CustomEvents'!
SystemOrganization addCategory: #'Etoys-Experimental'!
SystemOrganization addCategory: #'Etoys-OLPC-Display'!
SystemOrganization addCategory: #'Etoys-Outliner'!
SystemOrganization addCategory: #'Etoys-Protocols'!
SystemOrganization addCategory: #'Etoys-Protocols-Type Vocabularies'!
SystemOrganization addCategory: #'Etoys-ReleaseBuilder'!
SystemOrganization addCategory: #'Etoys-Scripting'!
SystemOrganization addCategory: #'Etoys-Scripting Support'!
SystemOrganization addCategory: #'Etoys-Scripting Tiles'!
SystemOrganization addCategory: #'Etoys-Squeakland-EToys-Kedama'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Buttons'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Debugger'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Help'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Input'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting Support'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting Tiles'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-SpeechBubbles'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Tile Scriptors'!
SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Text'!
SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Intersection'!
SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Simplification'!
SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Triangulation'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Basic'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Books'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Components'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Experimental'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-GeeMail'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Kernel'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Mentoring'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Navigators'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-PDA'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-PartsBin'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Support'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Widgets'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Windows'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Worlds'!
SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-AdditionalMorphs'!
SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Charts'!
SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Postscript Filters'!
SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Widgets'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Formatter'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Forms'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Parser'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Parser Entities'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Tokenizer'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-TelNet WordNet'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-UI'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-Url'!
SystemOrganization addCategory: #'Etoys-Squeakland-SISS-Serialization'!
SystemOrganization addCategory: #'Etoys-Squeakland-ST80-Morphic'!
SystemOrganization addCategory: #'Etoys-Squeakland-SUnit'!
SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Interface'!
SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Ogg'!
SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Scores'!
SystemOrganization addCategory: #'Etoys-Squeakland-Sugar'!
SystemOrganization addCategory: #'Etoys-Squeakland-Support'!
SystemOrganization addCategory: #'Etoys-Squeakland-System-Compiler'!
SystemOrganization addCategory: #'Etoys-Squeakland-System-Exceptions Kernel'!
SystemOrganization addCategory: #'Etoys-Squeakland-System-Support'!
SystemOrganization addCategory: #'Etoys-Squeakland-Tools-Changes'!
SystemOrganization addCategory: #'Etoys-Squeakland-Tools-Explorer'!
SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ObjectVectors'!
SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ParseTree-AttributeDefinition'!
SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!
SystemOrganization addCategory: #'Etoys-Stacks'!
SystemOrganization addCategory: #'Etoys-StarSqueak'!
SystemOrganization addCategory: #'Etoys-Support'!
SystemOrganization addCategory: #'Etoys-Tests'!
SystemOrganization addCategory: #'Etoys-Tile Scriptors'!
SystemOrganization addCategory: #'Etoys-UserInterfaceTheme'!
SystemOrganization addCategory: #'Etoys-Widgets'!
SystemOrganization addCategory: #'Etoys-Help'!
- SystemOrganization addCategory: #'Etoys-Morphic-Worlds'!
- SystemOrganization addCategory: #'Etoys-Tools-Base'!
- SystemOrganization addCategory: #'Etoys-MorphicExtras-Widgets'!
- SystemOrganization addCategory: #'Etoys-MorphicExtras-Flaps'!
- SystemOrganization addCategory: #'Etoys-Morphic-Pluggable Widgets'!
- SystemOrganization addCategory: #'Etoys-Tools-Browser'!
SystemOrganization addCategory: #'Etoys-Morphic-Windows'!
SystemOrganization addCategory: #'Etoys-Morphic-Text Support'!
SystemOrganization addCategory: #'Etoys-Morphic-Explorer'!
+ SystemOrganization addCategory: #'Etoys-MorphicExtras-Flaps'!
+ SystemOrganization addCategory: #'Etoys-MorphicExtras-Widgets'!
+ SystemOrganization addCategory: #'Etoys-Morphic-Pluggable Widgets'!
+ SystemOrganization addCategory: #'Etoys-Morphic-Worlds'!
SystemOrganization addCategory: #'Etoys-MorphicExtras-Obsolete'!
+ SystemOrganization addCategory: #'Etoys-Tools-Browser'!
+ SystemOrganization addCategory: #'Etoys-Tools-Base'!
1
0
David T. Lewis uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-dtl.353.mcz
==================== Summary ====================
Name: MorphicExtras-dtl.353
Author: dtl
Time: 25 November 2023, 5:11:42.574063 pm
UUID: c74b04f5-88cf-421f-8170-f921d0cee58b
Ancestors: MorphicExtras-dtl.352
Clean up package categories
=============== Diff against MorphicExtras-dtl.352 ===============
Item was changed:
SystemOrganization addCategory: #'MorphicExtras-AdditionalMorphs'!
SystemOrganization addCategory: #'MorphicExtras-AdditionalSupport'!
SystemOrganization addCategory: #'MorphicExtras-AdditionalWidgets'!
SystemOrganization addCategory: #'MorphicExtras-Books'!
SystemOrganization addCategory: #'MorphicExtras-Demo'!
- SystemOrganization addCategory: #'MorphicExtras-EToy-Download'!
SystemOrganization addCategory: #'MorphicExtras-Exceptions'!
SystemOrganization addCategory: #'MorphicExtras-Flaps'!
SystemOrganization addCategory: #'MorphicExtras-GeeMail'!
SystemOrganization addCategory: #'MorphicExtras-Leds'!
SystemOrganization addCategory: #'MorphicExtras-Navigators'!
SystemOrganization addCategory: #'MorphicExtras-Obsolete'!
SystemOrganization addCategory: #'MorphicExtras-Palettes'!
SystemOrganization addCategory: #'MorphicExtras-PartsBin'!
SystemOrganization addCategory: #'MorphicExtras-Postscript Canvases'!
SystemOrganization addCategory: #'MorphicExtras-Postscript Filters'!
SystemOrganization addCategory: #'MorphicExtras-SoundInterface'!
SystemOrganization addCategory: #'MorphicExtras-SqueakPage'!
SystemOrganization addCategory: #'MorphicExtras-Support'!
SystemOrganization addCategory: #'MorphicExtras-Text Support'!
SystemOrganization addCategory: #'MorphicExtras-Undo'!
SystemOrganization addCategory: #'MorphicExtras-WebCam'!
SystemOrganization addCategory: #'MorphicExtras-Widgets'!
SystemOrganization addCategory: #'MorphicExtras-Games'!
SystemOrganization addCategory: #'MorphicExtras-Games-Chess'!
SystemOrganization addCategory: #'MorphicExtras-Games-Chess960'!
1
0
David T. Lewis uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-dtl.508.mcz
==================== Summary ====================
Name: EToys-dtl.508
Author: dtl
Time: 25 November 2023, 2:52:44.022697 pm
UUID: 3bbaad99-ca8d-4afa-ae22-497a7dee7d51
Ancestors: EToys-ct.507
Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script.
Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
=============== Diff against EToys-ct.507 ===============
Item was changed:
SystemOrganization addCategory: #'Etoys-Buttons'!
SystemOrganization addCategory: #'Etoys-CustomEvents'!
SystemOrganization addCategory: #'Etoys-Experimental'!
SystemOrganization addCategory: #'Etoys-OLPC-Display'!
SystemOrganization addCategory: #'Etoys-Outliner'!
SystemOrganization addCategory: #'Etoys-Protocols'!
SystemOrganization addCategory: #'Etoys-Protocols-Type Vocabularies'!
SystemOrganization addCategory: #'Etoys-ReleaseBuilder'!
SystemOrganization addCategory: #'Etoys-Scripting'!
SystemOrganization addCategory: #'Etoys-Scripting Support'!
SystemOrganization addCategory: #'Etoys-Scripting Tiles'!
SystemOrganization addCategory: #'Etoys-Squeakland-EToys-Kedama'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Buttons'!
- SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Calendar'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Debugger'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Help'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Input'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting Support'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Scripting Tiles'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-SpeechBubbles'!
SystemOrganization addCategory: #'Etoys-Squeakland-Etoys-Tile Scriptors'!
SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Text'!
SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Intersection'!
SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Simplification'!
SystemOrganization addCategory: #'Etoys-Squeakland-Graphics-Tools-Triangulation'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Basic'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Books'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Components'!
- SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Demo'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Experimental'!
- SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Games'!
- SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Games-Chess'!
- SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Games-Chess960'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-GeeMail'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Kernel'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Mentoring'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Navigators'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-PDA'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-PartsBin'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Support'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Widgets'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Windows'!
SystemOrganization addCategory: #'Etoys-Squeakland-Morphic-Worlds'!
SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-AdditionalMorphs'!
SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Charts'!
SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Postscript Filters'!
SystemOrganization addCategory: #'Etoys-Squeakland-MorphicExtras-Widgets'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Formatter'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Forms'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Parser'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Parser Entities'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-HTML-Tokenizer'!
- SystemOrganization addCategory: #'Etoys-Squeakland-Network-MIME'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-TelNet WordNet'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-UI'!
SystemOrganization addCategory: #'Etoys-Squeakland-Network-Url'!
SystemOrganization addCategory: #'Etoys-Squeakland-SISS-Serialization'!
SystemOrganization addCategory: #'Etoys-Squeakland-ST80-Morphic'!
SystemOrganization addCategory: #'Etoys-Squeakland-SUnit'!
SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Interface'!
SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Ogg'!
SystemOrganization addCategory: #'Etoys-Squeakland-Sound-Scores'!
SystemOrganization addCategory: #'Etoys-Squeakland-Sugar'!
SystemOrganization addCategory: #'Etoys-Squeakland-Support'!
- SystemOrganization addCategory: #'Etoys-Squeakland-System-Clipboard-Extended'!
SystemOrganization addCategory: #'Etoys-Squeakland-System-Compiler'!
SystemOrganization addCategory: #'Etoys-Squeakland-System-Exceptions Kernel'!
SystemOrganization addCategory: #'Etoys-Squeakland-System-Support'!
SystemOrganization addCategory: #'Etoys-Squeakland-Tools-Changes'!
SystemOrganization addCategory: #'Etoys-Squeakland-Tools-Explorer'!
SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ObjectVectors'!
SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ParseTree-AttributeDefinition'!
SystemOrganization addCategory: #'Etoys-Squeakland-Tweak-Kedama-ParseTreeTransformer'!
SystemOrganization addCategory: #'Etoys-Stacks'!
SystemOrganization addCategory: #'Etoys-StarSqueak'!
SystemOrganization addCategory: #'Etoys-Support'!
SystemOrganization addCategory: #'Etoys-Tests'!
SystemOrganization addCategory: #'Etoys-Tile Scriptors'!
SystemOrganization addCategory: #'Etoys-UserInterfaceTheme'!
SystemOrganization addCategory: #'Etoys-Widgets'!
SystemOrganization addCategory: #'Etoys-Help'!
+ SystemOrganization addCategory: #'Etoys-Morphic-Worlds'!
+ SystemOrganization addCategory: #'Etoys-Tools-Base'!
+ SystemOrganization addCategory: #'Etoys-MorphicExtras-Widgets'!
+ SystemOrganization addCategory: #'Etoys-MorphicExtras-Flaps'!
+ SystemOrganization addCategory: #'Etoys-Morphic-Pluggable Widgets'!
+ SystemOrganization addCategory: #'Etoys-Tools-Browser'!
+ SystemOrganization addCategory: #'Etoys-Morphic-Windows'!
+ SystemOrganization addCategory: #'Etoys-Morphic-Text Support'!
+ SystemOrganization addCategory: #'Etoys-Morphic-Explorer'!
+ SystemOrganization addCategory: #'Etoys-MorphicExtras-Obsolete'!
Item was added:
+ PluggableTextMorph subclass: #AcceptableCleanTextMorph
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-Morphic-Pluggable Widgets'!
Item was added:
+ ----- Method: AcceptableCleanTextMorph>>accept (in category '*Etoys-menu commands') -----
+ accept
+ "Overridden to allow accept of clean text"
+
+ | textToAccept ok |
+ textToAccept := textMorph text.
+ ok := setTextSelector isNil or:
+ [setTextSelector numArgs = 2
+ ifTrue:
+ [model
+ perform: setTextSelector
+ with: textToAccept
+ with: self]
+ ifFalse: [model perform: setTextSelector with: textToAccept]].
+ ok
+ ifTrue:
+ [self setText: self getText.
+ self hasUnacceptedEdits: false]!
Item was added:
+ ----- Method: AlignmentMorph>>addTransparentSpacerOfSize: (in category '*Etoys-*MorphicExtras-geometry') -----
+ addTransparentSpacerOfSize: aPoint
+ "Required for several MorphicExtras and other non-Etoys stuff."
+
+ self addMorphBack: ((Morph new extent: aPoint asPoint) color: Color transparent)!
Item was added:
+ ----- Method: BookMorph>>goToPage:transitionSpec:runTransitionScripts: (in category '*Etoys-navigation') -----
+ goToPage: pageNumber transitionSpec: transitionSpec runTransitionScripts: aBoolean
+ "Go the the given page number; use the transitionSpec supplied, and if the boolean parameter is true, run opening and closing scripts as appropriate"
+
+ | pageMorph |
+ pages isEmpty ifTrue: [^ self].
+ pageMorph := (self hasProperty: #dontWrapAtEnd)
+ ifTrue: [pages atPin: pageNumber]
+ ifFalse: [pages atWrap: pageNumber].
+ ^ self goToPageMorph: pageMorph transitionSpec: transitionSpec runTransitionScripts: aBoolean!
Item was added:
+ ----- Method: BookMorph>>goToPageMorph:runTransitionScripts: (in category '*Etoys-navigation') -----
+ goToPageMorph: aMorph runTransitionScripts: aBoolean
+ "Set the given morph as the current page. If the boolean parameter is true, then opening and closing scripts will be run"
+
+ self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil runTransitionScripts: aBoolean
+ !
Item was added:
+ ----- Method: BookMorph>>goToPageMorph:transitionSpec:runTransitionScripts: (in category '*Etoys-navigation') -----
+ goToPageMorph: newPage transitionSpec: transitionSpec runTransitionScripts: aBoolean
+ "Install the given page as the new current page; use the given transition spec, and if the boolean parameter is true, run closing and opening scripts on the outgoing and incoming players"
+
+ | 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"].
+ aBoolean
+ ifTrue: [self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts]].
+ 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].
+ aBoolean
+ ifTrue: [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).
+ 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"]!
Item was added:
+ ----- Method: BookMorph>>goto: (in category '*Etoys-navigation') -----
+ goto: aPlayer
+ self goToPageMorph: aPlayer costume!
Item was added:
+ ----- Method: BookMorph>>keepTogether (in category '*Etoys-menu') -----
+ keepTogether
+ "Mark this book so that each page will not go into a separate file. Do this when pages share referenes to a common Player. Don't want many copies of that Player when bring in. Do not write pages of book out. Write the PasteUpMorph that the entire book lives in."
+
+ self setProperty: #keepTogether toValue: true.!
Item was added:
+ ----- Method: BooklikeMorph>>currentPlayerDo: (in category '*Etoys-e-toy support') -----
+ currentPlayerDo: aBlock
+ | aPlayer aPage |
+ (aPage := self currentPage) ifNil: [^ self].
+ aPage allMorphsDo:[ :m|
+ (aPlayer := m player) ifNotNil:
+ [aBlock value: aPlayer]]!
Item was added:
+ ----- Method: BooleanType>>initialValueForASlotFor: (in category '*Etoys-initial value') -----
+ initialValueForASlotFor: aPlayer
+ "Answer the value to give initially to a newly created slot of the given type in the given player"
+ ^ true!
Item was added:
+ BorderedMorph subclass: #BorderedSubpaneDividerMorph
+ instanceVariableNames: 'resizingEdge'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-Morphic-Windows'!
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph class>>forBottomEdge (in category '*Etoys-instance creation') -----
+ forBottomEdge
+ ^self new horizontal resizingEdge: #bottom!
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph class>>forTopEdge (in category '*Etoys-instance creation') -----
+ forTopEdge
+ ^self new horizontal resizingEdge: #top!
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph class>>horizontal (in category '*Etoys-instance creation') -----
+ horizontal
+ ^self new horizontal!
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph class>>vertical (in category '*Etoys-instance creation') -----
+ vertical
+ ^self new vertical!
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph>>defaultBorderWidth (in category '*Etoys-initialization') -----
+ defaultBorderWidth
+ "answer the default border width for the receiver"
+ ^ 0!
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph>>defaultColor (in category '*Etoys-initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ ^ Color black!
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph>>firstEnter: (in category '*Etoys-private') -----
+ firstEnter: evt
+ "The first time this divider is activated, find its window and redirect further interaction there."
+ | window |
+
+ window := self firstOwnerSuchThat: [:m | m respondsTo: #secondaryPaneTransition:divider:].
+ window ifNil: [ self suspendEventHandler. ^ self ]. "not working out"
+ window secondaryPaneTransition: evt divider: self.
+ self on: #mouseEnter send: #secondaryPaneTransition:divider: to: window.
+ !
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph>>horizontal (in category '*Etoys-layout') -----
+ horizontal
+
+ self hResizing: #spaceFill.!
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph>>initialize (in category '*Etoys-initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ super initialize.
+ ""
+ self extent: 1 @ 1!
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph>>resizingEdge (in category '*Etoys-accessing') -----
+ resizingEdge
+
+ ^resizingEdge
+ !
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph>>resizingEdge: (in category '*Etoys-accessing') -----
+ resizingEdge: edgeSymbol
+
+ (#(top bottom) includes: edgeSymbol) ifFalse:
+ [ self error: 'resizingEdge must be #top or #bottom' ].
+ resizingEdge := edgeSymbol.
+ self on: #mouseEnter send: #firstEnter: to: self.
+ !
Item was added:
+ ----- Method: BorderedSubpaneDividerMorph>>vertical (in category '*Etoys-layout') -----
+ vertical
+
+ self vResizing: #spaceFill.!
Item was added:
+ PluggableTextMorph subclass: #BrowserCommentTextMorph
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-Tools-Browser'!
+
+ !BrowserCommentTextMorph commentStamp: '<historical>' prior: 0!
+ I am a PluggableTextMorph that knows enough to make myself invisible when necessary.!
Item was added:
+ ----- Method: BrowserCommentTextMorph>>hideOrShowPane (in category '*Etoys-displaying') -----
+ hideOrShowPane
+ (self model editSelection == #editClass)
+ ifTrue: [ self showPane ]
+ ifFalse: [ self hidePane ]!
Item was added:
+ ----- Method: BrowserCommentTextMorph>>hidePane (in category '*Etoys-displaying') -----
+ hidePane
+ | win |
+ self window ifNotNil: [:window | window removePaneSplitters].
+
+ self lowerPane ifNotNil:
+ [ :lp |
+ lp layoutFrame bottomFraction: self layoutFrame bottomFraction.
+ lp layoutFrame bottomOffset: SystemWindow borderWidth negated].
+ win := self window ifNil: [ ^self ].
+ self delete.
+ win updatePanesFromSubmorphs.
+ win addPaneSplitters!
Item was added:
+ ----- Method: BrowserCommentTextMorph>>lowerPane (in category '*Etoys-accessing') -----
+ lowerPane
+ "Answer the AlignmentMorph that I live beneath"
+ ^self valueOfProperty: #browserLowerPane!
Item was added:
+ ----- Method: BrowserCommentTextMorph>>noteNewOwner: (in category '*Etoys-updating') -----
+ noteNewOwner: win
+ super noteNewOwner: win.
+ self setProperty: #browserWindow toValue: win.
+ win ifNil: [ ^self ].
+ win setProperty: #browserClassCommentPane toValue: self.
+ self setProperty: #browserLowerPane
+ toValue: (win submorphThat: [ :m |
+ m isAlignmentMorph
+ and: [ m layoutFrame bottomFraction notNil
+ and: [ m layoutFrame bottomFraction >= self layoutFrame topFraction ]]]
+ ifNone: [])!
Item was added:
+ ----- Method: BrowserCommentTextMorph>>showPane (in category '*Etoys-displaying') -----
+ showPane
+ owner ifNil: [
+ | win |
+ win := self window ifNil: [ ^self ].
+ win addMorph: self fullFrame: self layoutFrame.
+ win updatePanesFromSubmorphs ].
+
+ self lowerPane ifNotNil: [ :lp | lp layoutFrame bottomFraction: self layoutFrame topFraction ].
+
+ self window ifNotNil: [:win | win addPaneSplitters]!
Item was added:
+ ----- Method: BrowserCommentTextMorph>>update: (in category '*Etoys-updating') -----
+ update: anAspect
+ super update: anAspect.
+ anAspect == #editSelection ifFalse: [ ^self ].
+ self hideOrShowPane!
Item was added:
+ ----- Method: BrowserCommentTextMorph>>window (in category '*Etoys-accessing') -----
+ window
+ ^self owner ifNil: [ self valueOfProperty: #browserWindow ].!
Item was added:
+ ----- Method: ChangeList>>buildMorphicCodePaneWith: (in category '*Etoys-menu actions') -----
+ buildMorphicCodePaneWith: editString
+
+ | codePane |
+
+ codePane := AcceptableCleanTextMorph
+ on: self
+ text: #contents
+ accept: #contents:
+ readSelection: #contentsSelection
+ menu: #codePaneMenu:shifted:.
+ codePane font: Preferences standardCodeFont.
+ editString ifNotNil: [
+ codePane editString: editString.
+ codePane hasUnacceptedEdits: true
+ ].
+ ^codePane
+ !
Item was added:
+ ----- Method: CodeHolder>>installTextualCodingPane (in category '*Etoys-diffs') -----
+ installTextualCodingPane
+ "Install text into the code pane"
+
+ | aWindow codePane aPane boundsToUse |
+ (aWindow := self containingWindow) ifNil: [self error: 'where''s that window?'].
+ codePane := self codeTextMorph ifNil: [self error: 'no code pane'].
+ aPane := self buildMorphicCodePaneWith: nil.
+ boundsToUse := (codePane bounds origin- (1@1)) corner: (codePane owner bounds corner " (1@1").
+ aWindow replacePane: codePane with: aPane.
+ aPane vResizing: #spaceFill; hResizing: #spaceFill; borderWidth: 0.
+ aPane bounds: boundsToUse.
+ aPane owner clipSubmorphs: false.
+
+ self contentsChanged!
Item was added:
+ ----- Method: CodeHolder>>restoreTextualCodingPane (in category '*Etoys-diffs') -----
+ restoreTextualCodingPane
+ "If the receiver is showing tiles, restore the textual coding pane"
+
+ contentsSymbol == #tiles ifTrue:
+ [contentsSymbol := #source.
+ self installTextualCodingPane]!
Item was added:
+ ----- Method: ColorPickerMorph>>delete (in category '*Etoys-submorphs - add/remove') -----
+ delete
+ "The moment of departure has come.
+ If the receiver has an affiliated command, finalize it and have the system remember it.
+ In any case, delete the receiver"
+
+ (selector isNil or: [ target isNil ]) ifFalse: [
+ self rememberCommand:
+ (Command new
+ cmdWording: 'color change' translated;
+ undoTarget: target selector: selector arguments: (self argumentsWith: originalColor);
+ redoTarget: target selector: selector arguments: (self argumentsWith: selectedColor)).
+ ].
+ super delete!
Item was added:
+ ----- Method: ColorPickerMorph>>getColorFromKedamaWorldIfPossible: (in category '*Etoys-kedama') -----
+ getColorFromKedamaWorldIfPossible: aGlobalPoint
+
+ self world submorphs do: [:sub |
+ (sub isKedamaMorph) ifTrue: [
+ sub morphsAt: aGlobalPoint unlocked: false do: [:e |
+ ^ e colorAt: (aGlobalPoint - e topLeft).
+ ].
+ ].
+ ].
+ ^ nil.
+ !
Item was added:
+ ----- Method: ColorType>>initialValueForASlotFor: (in category '*Etoys-initial value') -----
+ initialValueForASlotFor: aPlayer
+ "Answer the value to give initially to a newly created slot of the given type in the given player"
+
+ ^ Color random!
Item was added:
+ ----- Method: DataType>>initialValueForASlotFor: (in category '*Etoys-initial value') -----
+ initialValueForASlotFor: aPlayer
+ "Answer the value to give initially to a newly created slot of the given type in the given player"
+
+ ^ 'no value'!
Item was added:
+ ----- Method: DeepCopier>>mapUniClasses (in category '*Etoys-like fullCopy') -----
+ mapUniClasses
+ "For new Uniclasses, map their class vars to the new objects. And their additional class instance vars. (scripts slotInfo) and cross references like (player321)."
+ "Players also refer to each other using associations in the References dictionary. Search the methods of our Players for those. Make new entries in References and point to them."
+ | pp |
+
+ newUniClasses ifFalse: [^ self]. "All will be siblings. uniClasses is empty"
+ "Uniclasses use class vars to hold onto siblings who are referred to in code"
+ pp := (Smalltalk at: #Player ifAbsent:[^self]) class superclass instSize.
+ uniClasses do: [:playersClass | "values = new ones"
+ playersClass classPool associationsDo: [:assoc |
+ assoc value: (assoc value veryDeepCopyWith: self)].
+ playersClass scripts: (playersClass privateScripts veryDeepCopyWith: self). "pp+1"
+ "(pp+2) slotInfo was deepCopied in copyUniClass and that's all it needs"
+ pp+3 to: playersClass class instSize do: [:ii |
+ playersClass instVarAt: ii put:
+ ((playersClass instVarAt: ii) veryDeepCopyWith: self)].
+ ].
+
+ "Make new entries in References and point to them."
+ References keys "copy" do: [:playerName | | oldPlayer newKey |
+ oldPlayer := References at: playerName.
+ (references includesKey: oldPlayer) ifTrue: [
+ newKey := (references at: oldPlayer) "new player" uniqueNameForReference.
+ "now installed in References"
+ (references at: oldPlayer) renameTo: newKey]].
+ uniClasses "values" do: [:newClass | | newSelList oldSelList |
+ oldSelList := OrderedCollection new. newSelList := OrderedCollection new.
+ newClass selectorsAndMethodsDo: [:sel :m |
+ m literals do: [:assoc | | newAssoc newKey |
+ assoc isVariableBinding ifTrue: [
+ (References associationAt: assoc key ifAbsent: [nil]) == assoc ifTrue: [
+ newKey := (references at: assoc value ifAbsent: [assoc value])
+ externalName asSymbol.
+ (assoc key ~= newKey) & (References includesKey: newKey) ifTrue: [
+ newAssoc := References associationAt: newKey.
+ newClass methodDictionary at: sel put:
+ (newClass compiledMethodAt: sel) shallowCopy. "were sharing it"
+ (newClass compiledMethodAt: sel)
+ literalAt: ((newClass compiledMethodAt: sel) literals indexOf: assoc)
+ put: newAssoc.
+ (oldSelList includes: assoc key) ifFalse: [
+ oldSelList add: assoc key. newSelList add: newKey]]]]]].
+ oldSelList with: newSelList do: [:old :new |
+ newClass replaceSilently: old to: new]]. "This is text replacement and can be wrong"!
Item was added:
+ ----- Method: DeepCopier>>newUniClasses (in category '*Etoys-like fullCopy') -----
+ newUniClasses
+ "If false, all new Players are merely siblings of the old players"
+
+ ^ newUniClasses!
Item was added:
+ ----- Method: DeepCopier>>newUniClasses: (in category '*Etoys-like fullCopy') -----
+ newUniClasses: newVal
+ "If false, all new players are merely siblings of the old players"
+
+ newUniClasses := newVal!
Item was added:
+ ----- Method: DeepCopier>>uniClasses (in category '*Etoys-like fullCopy') -----
+ uniClasses
+ ^uniClasses!
Item was added:
+ ----- Method: DockingBarMorph>>isSticky (in category '*Etoys-accessing') -----
+ isSticky
+ "answer whether the receiver is Sticky"
+ ^ Preferences noviceMode
+ or: [super isSticky] !
Item was added:
+ ----- Method: DockingBarMorph>>resistsRemoval (in category '*Etoys-accessing') -----
+ resistsRemoval
+ "Answer whether the receiver is marked as resisting removal"
+ ^ Preferences noviceMode
+ or: [super resistsRemoval]!
Item was added:
+ ----- Method: EventHandler>>adaptToWorld: (in category '*Etoys-*MorphicExtras-initialization') -----
+ adaptToWorld: aWorld
+ "If any of my recipients refer to a world or a hand, make them now refer
+ to the corresponding items in the new world. (instVarNamed: is slow, later
+ use perform of two selectors.)"
+
+
+ #(mouseDownRecipient mouseStillDownRecipient mouseUpRecipient
+ mouseEnterRecipient mouseLeaveRecipient mouseEnterDraggingRecipient
+ mouseLeaveDraggingRecipient clickRecipient doubleClickRecipient startDragRecipient keyStrokeRecipient valueParameter) do:
+ [:aName | | value newValue |
+ (value := self instVarNamed: aName asString) ifNotNil:[
+ newValue := value adaptedToWorld: aWorld.
+ (newValue notNil and: [newValue ~~ value])
+ ifTrue:
+ [self instVarNamed: aName asString put: newValue]]]!
Item was added:
+ ----- Method: FlapTab>>makeNewDrawing: (in category '*Etoys-mouseover & dragover') -----
+ makeNewDrawing: evt
+ self flapShowing ifTrue:[
+ self world makeNewDrawing: evt.
+ ] ifFalse:[
+ self world assureNotPaintingEvent: evt.
+ ].!
Item was added:
+ ----- Method: FlapTab>>startOrFinishDrawing: (in category '*Etoys-mouseover & dragover') -----
+ startOrFinishDrawing: evt
+ | w |
+ self flapShowing ifTrue:[
+ (w := self world) makeNewDrawing: evt at: w center.
+ ] ifFalse:[
+ self world endDrawing: evt.
+ ].!
Item was added:
+ ----- Method: FlapTab>>thicknessString (in category '*Etoys-menu') -----
+ thicknessString
+ ^ 'thickness... (currently ', self thickness printString, ')'!
Item was added:
+ ----- Method: Flaps class>>addAndEnableEToyFlaps (in category '*Etoys-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]].
+
+ 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) ifNotNil:
+ [:navTab | aSuppliesFlap sugarNavTab: navTab]]
+ ifFalse: [
+ Preferences showProjectNavigator
+ ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated]].
+
+ SharedFlapsAllowed := true.
+ Project current flapsSuppressed: false.
+ ^ SharedFlapTabs
+
+ "Flaps addAndEnableEToyFlaps"!
Item was added:
+ ----- Method: Flaps class>>defaultsQuadsDefiningPlugInSuppliesFlap (in category '*Etoys-predefined flaps') -----
+ defaultsQuadsDefiningPlugInSuppliesFlap
+ "Answer a list of quads which define the objects to appear in the default Supplies flap used in the Plug-in image"
+
+ "PartsBin reconstructAllPartsIcons"
+
+ ^ #(
+ (ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of available objects')
+ (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'Stop, Step, and Go buttons for controlling all your scripts at once. The tool can also be "opened up" to control each script in your project individually.')
+ (TrashCanMorph new 'Trash' 'A tool for discarding objects')
+ (GrabPatchMorph new 'Grab Patch' 'Allows you to create a new Sketch by grabbing a rectangular patch from the screen')
+ (LassoPatchMorph new 'Lasso' 'Allows you to create a new Sketch by lassoing an area from the screen')
+
+ (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.')
+ "(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')"
+ (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.')
+ (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.')
+ (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')
+ (ScriptableButton authoringPrototype 'Button' 'A Scriptable button')
+ "(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page')
+ (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')"
+ "(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')"
+ (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations')
+ (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.')
+ (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control')
+ (BookMorph authoringPrototype 'Book' 'A multi-paged structure')
+ "(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')"
+ (KedamaMorph newSet 'Particles' 'A Kedama World with pre-made components')
+ "(RandomNumberTile new 'Random' 'A random-number tile for use with tile scripting')") asOrderedCollection!
Item was added:
+ ----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category '*Etoys-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}.
+
+ {#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}.
+
+ {#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}.
+
+ {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}.
+
+
+ {#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!
Item was added:
+ ----- Method: Flaps class>>enableEToyFlaps (in category '*Etoys-menu support') -----
+ enableEToyFlaps
+ "Start using global flaps, plug-in version, given that they were not present."
+
+ Cursor wait showWhile:
+ [self addAndEnableEToyFlaps.
+ self enableGlobalFlaps]!
Item was added:
+ ----- Method: Flaps class>>newLoneSuppliesFlap (in category '*Etoys-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..."
+
+ | aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly"
+ 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}.
+
+ {#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}.
+
+ {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}.
+ {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}.
+
+ {#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}.
+ }.
+
+ 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.
+
+ aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)).
+
+ aStrip beFlap: true.
+ aStrip autoLineLayout: true.
+
+ ^ aFlapTab!
Item was added:
+ ----- Method: Flaps class>>newPaintingFlap (in category '*Etoys-predefined flaps') -----
+ newPaintingFlap
+ "Add a flap with the paint palette in it"
+
+ | aFlap aFlapTab |
+ "Flaps reinstateDefaultFlaps. Flaps newPaintingFlap"
+
+ aFlap := PasteUpMorph new borderWidth: 0.
+ aFlap color: Color transparent.
+ aFlap layoutPolicy: TableLayout new.
+ aFlap hResizing: #shrinkWrap.
+ aFlap vResizing: #shrinkWrap.
+ aFlap cellPositioning: #topLeft.
+ aFlap clipSubmorphs: false.
+
+ aFlap beSticky. "really?!!"
+ aFlap addMorphFront: PaintBoxMorph new.
+ aFlap beFlap: true.
+ aFlap fullBounds. "force layout"
+
+ aFlapTab := FlapTab new referent: aFlap.
+ aFlapTab setNameTo: 'Painting' translated.
+ aFlapTab setProperty: #priorWording toValue: 'Paint' translated.
+ aFlapTab useGraphicalTab.
+ aFlapTab removeAllMorphs.
+ aFlapTab setProperty: #paintingFlap toValue: true.
+ aFlapTab addMorphFront:
+ "(SketchMorph withForm: (ScriptingSystem formAtKey: #PaintingFlapPic))"
+ self paintFlapButton.
+ aFlapTab cornerStyle: #rounded.
+ aFlapTab edgeToAdhereTo: #right.
+ aFlapTab setToPopOutOnDragOver: false.
+ aFlapTab setToPopOutOnMouseOver: false.
+ aFlapTab on: #mouseUp send: #startOrFinishDrawing: to: aFlapTab.
+ aFlapTab setBalloonText:'Click here to start or finish painting.' translated.
+
+ aFlapTab fullBounds. "force layout"
+ aFlapTab position: (0@6).
+ self currentWorld addMorphFront: aFlapTab.
+ ^ aFlapTab!
Item was added:
+ ----- Method: Flaps class>>paintFlapButton (in category '*Etoys-miscellaneous') -----
+ paintFlapButton
+ "Answer a button to serve as the paint flap"
+
+ | pb oldArgs brush myButton m |
+ pb := PaintBoxMorph new submorphNamed: #paint:.
+ pb
+ ifNil:
+ [(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].
+ myButton := BorderedMorph new.
+ myButton color: (Color r: 0.833 g: 0.5 b: 0.0); borderStyle: (BorderStyle raised width: 2).
+ myButton addMorph: (m := brush asMorph lock).
+ myButton extent: m extent + (myButton borderWidth + 6).
+ m position: myButton center - (m extent // 2).
+ ^ myButton
+
+ !
Item was added:
+ ----- Method: Flaps class>>possiblyReplaceEToyFlaps (in category '*Etoys-construction support') -----
+ possiblyReplaceEToyFlaps
+ "If in eToyFriendly mode, and if it's ok to reinitialize flaps, replace the existing flaps with up-too-date etoy flaps. Caution: this is destructive of existing flaps. If preserving the contents of existing flaps is important, set the preference 'okToReinitializeFlaps' to true"
+
+ PartsBin thumbnailForPartsDescription: StickyPadMorph descriptionForPartsBin. "Puts StickyPadMorph's custom icon back in the cache which typically will have been called"
+ (Preferences eToyFriendly and: [Preferences okToReinitializeFlaps]) ifTrue:
+ [Flaps disableGlobalFlaps: false.
+ Flaps addAndEnableEToyFlaps.
+ Smalltalk isMorphic ifTrue: [Project current world enableGlobalFlaps]].
+ "PartsBin clearThumbnailCache"
+
+ "Flaps possiblyReplaceEToyFlaps"!
Item was added:
+ ----- Method: Flaps class>>setUpSuppliesFlapOnly (in category '*Etoys-menu support') -----
+ setUpSuppliesFlapOnly
+ "Set up the Supplies flap as the only shared flap. A special version formulated for this stand-alone use is used, defined in #newLoneSuppliesFlap"
+
+ | supplies |
+ SharedFlapTabs isEmptyOrNil ifFalse: "get rid of pre-existing guys if any"
+ [SharedFlapTabs do:
+ [:t | t referent delete. t delete]].
+
+ SharedFlapsAllowed := true.
+ SharedFlapTabs := OrderedCollection new.
+ SharedFlapTabs add: (supplies := self newLoneSuppliesFlap).
+ self enableGlobalFlapWithID: 'Supplies' translated.
+ supplies setToPopOutOnMouseOver: false.
+
+ Smalltalk isMorphic ifTrue: [
+ Project current world
+ addGlobalFlaps;
+ reformulateUpdatingMenus].!
Item was added:
+ ----- Method: Form>>graphicForViewerTab (in category '*Etoys-*MorphicExtras-other') -----
+ graphicForViewerTab
+ "Answer the graphic to be used in the tab of a viewer open on me"
+
+ ^ self!
Item was added:
+ ----- Method: GraphicType>>initialValueForASlotFor: (in category '*Etoys-initial value') -----
+ initialValueForASlotFor: aPlayer
+ "Answer the value to give initially to a newly created slot of the given type in the given player"
+
+ ^ ScriptingSystem formAtKey: #PaintTab!
Item was added:
+ ----- Method: HaloMorph>>addChooseGraphicHandle: (in category '*Etoys-handles') -----
+ addChooseGraphicHandle: haloSpec
+ "If the target is a sketch morph, and if the governing preference is set, add a halo handle allowing the user to select a new graphic"
+
+ (Preferences showChooseGraphicHaloHandle and: [innerTarget isSketchMorph]) ifTrue:
+ [self addHandle: haloSpec
+ on: #mouseDown send: #chooseNewGraphicFromHalo to: innerTarget]
+ !
Item was added:
+ ----- Method: HaloMorph>>addMakeSiblingHandle: (in category '*Etoys-handles') -----
+ addMakeSiblingHandle: haloSpec
+ "Add the halo handle that allows a sibling instance to be torn off, or, if the shift key is down, for a deep-copy duplicate to be made."
+
+ self addHandle: haloSpec on: #mouseDown send: #doMakeSiblingOrDup:with: to: self
+
+ !
Item was added:
+ ----- Method: HaloMorph>>addPaintBgdHandle: (in category '*Etoys-handles') -----
+ addPaintBgdHandle: haloSpec
+ (innerTarget isKindOf: PasteUpMorph) ifTrue:
+ [self addHandle: haloSpec
+ on: #mouseDown send: #paintBackground to: innerTarget].
+ !
Item was added:
+ ----- Method: HaloMorph>>addPoohHandle: (in category '*Etoys-handles') -----
+ addPoohHandle: handleSpec
+ (innerTarget isKindOf: (Smalltalk at: #WonderlandCameraMorph ifAbsent:[nil])) ifTrue:
+ [self addHandle: handleSpec on: #mouseDown send: #strokeMode to: innerTarget]
+ !
Item was added:
+ ----- Method: HaloMorph>>addRepaintHandle: (in category '*Etoys-handles') -----
+ addRepaintHandle: haloSpec
+ (innerTarget isSketchMorph) ifTrue:
+ [self addHandle: haloSpec
+ on: #mouseDown send: #editDrawing to: innerTarget]
+ !
Item was added:
+ ----- Method: HaloMorph>>addScriptHandle: (in category '*Etoys-handles') -----
+ addScriptHandle: haloSpec
+ "If the halo's innerTarget claims it wants a Script handle, add one to the receiver, forming it as per haloSpec"
+
+ innerTarget wantsScriptorHaloHandle ifTrue:
+ [self addHandle: haloSpec
+ on: #mouseUp send: #editButtonsScript to: innerTarget]
+ !
Item was added:
+ ----- Method: HaloMorph>>addTileHandle: (in category '*Etoys-handles') -----
+ addTileHandle: haloSpec
+ "Add the 'tear-off-tile' handle from the spec"
+
+ self addHandle: haloSpec on: #mouseDown send: #tearOffTileForTarget:with: to: self
+ !
Item was added:
+ ----- Method: HaloMorph>>addViewHandle: (in category '*Etoys-handles') -----
+ addViewHandle: haloSpec
+ "Add the 'open viewer' handle from the halo spec"
+
+ self addHandle: haloSpec
+ on: #mouseDown send: #openViewerForTarget:with: to: self
+
+
+ !
Item was added:
+ ----- Method: HaloMorph>>addViewingHandle: (in category '*Etoys-handles') -----
+ addViewingHandle: haloSpec
+ "If appropriate, add a special Viewing halo handle to the receiver. On 26 Sept 07, we decided to eliminate this item from the UI, so the code of is method is now commented out...
+
+ (innerTarget isKindOf: PasteUpMorph) ifTrue:
+ [self addHandle: haloSpec
+ on: #mouseDown send: #presentViewMenu to: innerTarget].
+ "
+ !
Item was added:
+ ----- Method: HaloMorph>>doDupOrMakeSibling:with: (in category '*Etoys-handles') -----
+ doDupOrMakeSibling: evt with: dupHandle
+ "Ask hand to duplicate my target, if shift key *not* pressed, or make a sibling if shift key *is* pressed"
+
+ ^ (evt shiftPressed and: [target couldMakeSibling])
+ ifTrue:
+ [dupHandle color: Color green muchDarker.
+ self doMakeSibling: evt with: dupHandle]
+ ifFalse:
+ [self doDup: evt with: dupHandle]!
Item was added:
+ ----- Method: HaloMorph>>doMakeSibling:with: (in category '*Etoys-private') -----
+ doMakeSibling: evt with: dupHandle
+ "Ask hand to make a sibling of my target. Only reachable if target is of a uniclass"
+
+ target couldMakeSibling ifFalse: [^ self].
+
+ target assuredPlayer assureUniClass.
+ self obtainHaloForEvent: evt andRemoveAllHandlesBut: dupHandle.
+ self setTarget: (target makeSiblings: 1) first.
+ evt hand grabMorph: target.
+ self step. "update position if necessary"
+ evt hand addMouseListener: self. "Listen for the drop"!
Item was added:
+ ----- Method: HaloMorph>>doMakeSiblingOrDup:with: (in category '*Etoys-handles') -----
+ doMakeSiblingOrDup: evt with: dupHandle
+ "Ask hand to duplicate my target, if shift key *is* pressed, or make a sibling if shift key *not* pressed"
+
+ ^ (evt shiftPressed or: [target couldMakeSibling not])
+ ifFalse:
+ [self doMakeSibling: evt with: dupHandle]
+ ifTrue:
+ [dupHandle color: Color green.
+ self doDup: evt with: dupHandle]!
Item was added:
+ ----- Method: HaloMorph>>fadeIn (in category '*Etoys-stepping') -----
+ fadeIn
+ self magicAlpha >= 1.0 ifTrue:[self stopSteppingSelector: #fadeIn].
+ self magicAlpha: ((self magicAlpha + 0.1) min: 1.0)
+ !
Item was added:
+ ----- Method: HaloMorph>>fadeInInitially (in category '*Etoys-stepping') -----
+ fadeInInitially
+ | max |
+ max := self isMagicHalo ifTrue:[0.3] ifFalse:[1.0].
+ self magicAlpha >= max ifTrue:[self stopSteppingSelector: #fadeInInitially].
+ self magicAlpha: ((self magicAlpha + (max * 0.1)) min: max)
+ !
Item was added:
+ ----- Method: HaloMorph>>fadeOut (in category '*Etoys-stepping') -----
+ fadeOut
+ self magicAlpha <= 0.3 ifTrue:[self stopSteppingSelector: #fadeOut].
+ self magicAlpha: ((self magicAlpha - 0.1) max: 0.3)
+ !
Item was added:
+ ----- Method: HaloMorph>>fadeOutFinally (in category '*Etoys-stepping') -----
+ fadeOutFinally
+ self magicAlpha <= 0.05 ifTrue:[^super delete].
+ self magicAlpha <= 0.3 ifTrue:[
+ ^self magicAlpha: (self magicAlpha - 0.03 max: 0.0)].
+ self magicAlpha: ((self magicAlpha * 0.5) max: 0.0)
+ !
Item was added:
+ ----- Method: HaloMorph>>handleEntered (in category '*Etoys-stepping') -----
+ handleEntered
+ self isMagicHalo ifFalse:[^self].
+ self stopStepping; startStepping.
+ self startSteppingSelector: #fadeIn.
+ !
Item was added:
+ ----- Method: HaloMorph>>handleLeft (in category '*Etoys-stepping') -----
+ handleLeft
+ self isMagicHalo ifFalse:[^self].
+ self stopStepping; startStepping.
+ self startSteppingSelector: #fadeOut.!
Item was added:
+ ----- Method: HaloMorph>>isMagicHalo (in category '*Etoys-accessing') -----
+ isMagicHalo
+ ^self valueOfProperty: #isMagicHalo ifAbsent:[false].!
Item was added:
+ ----- Method: HaloMorph>>isMagicHalo: (in category '*Etoys-accessing') -----
+ isMagicHalo: aBool
+ self setProperty: #isMagicHalo toValue: aBool.
+ aBool
+ ifTrue: [
+ self on: #mouseEnter send: #handleEntered to: self.
+ self on: #mouseLeave send: #handleLeft to: self]
+ ifFalse:[
+ "Reset everything"
+ self eventHandler ifNotNil: [:eh |
+ eh forgetDispatchesTo: #handleEntered;
+ forgetDispatchesTo: #handleLeft].
+ self stopStepping. "get rid of all"
+ self startStepping. "only those of interest"].!
Item was added:
+ ----- Method: HaloMorph>>mouseDown: (in category '*Etoys-events') -----
+ mouseDown: event
+
+ self isMagicHalo ifTrue: [
+ self isMagicHalo: false.
+ self magicAlpha: 1.0].
+
+ super mouseDown: event.!
Item was added:
+ ----- Method: HaloMorph>>openViewerForTarget:with: (in category '*Etoys-handles') -----
+ openViewerForTarget: evt with: aHandle
+ "Open a viewer for my inner target or if shift pressed make a snapshot of morph."
+ self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
+ evt shiftPressed
+ ifTrue: [target duplicateMorphImage: evt]
+ ifFalse: [innerTarget openViewerForArgument]!
Item was added:
+ ----- Method: HaloMorph>>popUpMagicallyFor:hand: (in category '*Etoys-pop up') -----
+ popUpMagicallyFor: aMorph hand: aHand
+ "Programatically pop up a halo for a given hand."
+
+ super
+ popUpMagicallyFor: aMorph
+ hand: aHand.
+
+ Preferences magicHalos
+ ifTrue: [self isMagicHalo: true].
+ (Preferences haloTransitions not and: [self isMagicHalo])
+ ifTrue: [self magicAlpha: 0.2].
+ !
Item was added:
+ ----- Method: HaloMorph>>tearOffTileForTarget:with: (in category '*Etoys-handles') -----
+ tearOffTileForTarget: evt with: aHandle
+ "Tear off a tile representing my inner target. If shift key is down, open up an instance browser on the morph itself, not the player, with tiles showing, instead"
+
+ self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
+ innerTarget tearOffTile!
Item was added:
+ ----- Method: HandMorph>>removePendingHaloFor: (in category '*Etoys-halo handling') -----
+ removePendingHaloFor: aMorph
+ "Get rid of pending balloon help or halo actions."
+ self removeAlarm: #spawnMagicHaloFor:.!
Item was added:
+ ----- Method: HandMorph>>spawnMagicHaloFor: (in category '*Etoys-halo handling') -----
+ spawnMagicHaloFor: aMorph
+
+ self halo ifNotNil: [ :halo |
+ halo target == aMorph ifTrue:[ ^self ] ].
+ aMorph addMagicHaloFor: self.!
Item was added:
+ ----- Method: HandMorph>>triggerHaloFor:after: (in category '*Etoys-halo handling') -----
+ triggerHaloFor: aMorph after: timeOut
+ "Trigger automatic halo after the given time out for some morph"
+ self addAlarm: #spawnMagicHaloFor: with: aMorph after: timeOut!
Item was added:
+ ----- Method: ImageMorph class>>descriptionForPartsBin (in category '*Etoys-parts bin') -----
+ descriptionForPartsBin
+ ^ self partName: 'Image' translatedNoop
+ categories: #('Graphics' 'Basic')
+ documentation: 'A non-editable picture. If you use the Paint palette to make a picture, you can edit it afterwards.' translatedNoop!
Item was added:
+ ----- Method: Inspector>>addEtoysItemsTo: (in category '*Etoys-menu - construction') -----
+ addEtoysItemsTo: aMenu
+
+ aMenu addLine; addTranslatedList: {
+ { 'tile for this value (t)'. [self selectionOrObject tearOffTile] }.
+ { 'viewer for this value (v)'. [self selectionOrObject beViewed] }}.!
Item was added:
+ ----- Method: InstanceBrowser>>viewViewee (in category '*Etoys-menu commands') -----
+ viewViewee
+ "Open a viewer on the object I view"
+
+ objectViewed beViewed!
Item was added:
+ Object subclass: #KeyboardBuffer
+ instanceVariableNames: 'event eventUsed'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-Morphic-Text Support'!
Item was added:
+ ----- Method: KeyboardBuffer>>commandKeyPressed (in category '*Etoys-testing') -----
+ commandKeyPressed
+ ^ event commandKeyPressed!
Item was added:
+ ----- Method: KeyboardBuffer>>controlKeyPressed (in category '*Etoys-testing') -----
+ controlKeyPressed
+ ^ event controlKeyPressed!
Item was added:
+ ----- Method: KeyboardBuffer>>flushKeyboard (in category '*Etoys-keyboard control') -----
+ flushKeyboard
+ eventUsed ifFalse: [^ eventUsed := true].!
Item was added:
+ ----- Method: KeyboardBuffer>>keyboard (in category '*Etoys-keyboard control') -----
+ keyboard
+ eventUsed ifFalse: [eventUsed := true. ^ event keyCharacter].
+ ^ nil!
Item was added:
+ ----- Method: KeyboardBuffer>>keyboardPeek (in category '*Etoys-keyboard control') -----
+ keyboardPeek
+ eventUsed ifFalse: [^ event keyCharacter].
+ ^ nil!
Item was added:
+ ----- Method: KeyboardBuffer>>keyboardPressed (in category '*Etoys-testing') -----
+ keyboardPressed
+ ^eventUsed not!
Item was added:
+ ----- Method: KeyboardBuffer>>leftShiftDown (in category '*Etoys-testing') -----
+ leftShiftDown
+ ^ event shiftPressed!
Item was added:
+ ----- Method: KeyboardBuffer>>startingEvent: (in category '*Etoys-private') -----
+ startingEvent: evt
+ event := evt.
+ eventUsed := false!
Item was added:
+ ----- Method: MenuItemMorph>>adaptToWorld: (in category '*Etoys-accessing') -----
+ adaptToWorld: aWorld
+
+ super adaptToWorld: aWorld.
+ target := target adaptedToWorld: aWorld.!
Item was added:
+ ----- Method: MenuItemMorph>>allWordingsNotInSubMenus: (in category '*Etoys-accessing') -----
+ allWordingsNotInSubMenus: verbotenSubmenuContentsList
+ "Answer a collection of the wordings of all items and subitems, but omit the stay-up item, and also any items in any submenu whose tag is in verbotenSubmenuContentsList"
+
+ self isStayUpItem ifTrue:[^ #()].
+ subMenu ifNotNil:
+ [^ (verbotenSubmenuContentsList includes: self contents asString)
+ ifTrue:
+ [#()]
+ ifFalse:
+ [subMenu allWordingsNotInSubMenus: verbotenSubmenuContentsList]].
+
+ ^ Array with: self contents asString!
Item was added:
+ ----- Method: MenuMorph>>allWordings (in category '*Etoys-*MorphicExtras-accessing') -----
+ allWordings
+ "Answer a collection of the wordings of all items and subitems, omitting the window-list in the embed... branch and (unless a certain hard-coded preference is set) also omitting items from the debug menu"
+
+ | verboten |
+ verboten := OrderedCollection with: 'embed into'.
+ Preferences debugMenuItemsInvokableFromScripts
+ ifFalse: [verboten add: 'debug...' translated].
+ ^ self allWordingsNotInSubMenus: verboten!
Item was added:
+ ----- Method: MenuMorph>>allWordingsNotInSubMenus: (in category '*Etoys-*MorphicExtras-accessing') -----
+ allWordingsNotInSubMenus: verbotenSubmenuContentsList
+ "Answer a collection of the wordings of all items and subitems, but omit the stay-up item, and also any items in any submenu whose tag is in verbotenSubmenuContents"
+
+ | aList |
+ aList := OrderedCollection new.
+ self items do: [:anItem | aList addAll: (anItem allWordingsNotInSubMenus: verbotenSubmenuContentsList)].
+ ^ aList!
Item was added:
+ ----- Method: MenuMorph>>undoGrabCommand (in category '*Etoys-dropping/grabbing') -----
+ undoGrabCommand
+ ^nil!
Item was added:
+ CodeHolder subclass: #MethodHolder
+ instanceVariableNames: 'methodClass methodSelector'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-Tools-Base'!
Item was added:
+ ----- Method: MethodHolder>>addModelMenuItemsTo:forMorph:hand: (in category '*Etoys-menu') -----
+ addModelMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph
+ aCustomMenu addLine.
+ aCustomMenu add: 'whose script is this?' translated target: self action: #identifyScript
+ !
Item was added:
+ ----- Method: MethodHolder>>changeMethodSelectorTo: (in category '*Etoys-miscellaneous') -----
+ changeMethodSelectorTo: aSelector
+ "Change my method selector as noted. Reset currentCompiledMethod"
+
+ methodSelector := aSelector.
+ currentCompiledMethod := methodClass compiledMethodAt: aSelector ifAbsent: [nil]!
Item was added:
+ ----- Method: MethodHolder>>compiledMethod (in category '*Etoys-miscellaneous') -----
+ compiledMethod
+
+ ^ methodClass compiledMethodAt: methodSelector!
Item was added:
+ ----- Method: MethodHolder>>contents (in category '*Etoys-contents') -----
+ contents
+ "Answer the contents, with due respect for my contentsSymbol"
+
+ contents := methodClass sourceCodeAt: methodSelector ifAbsent: [''].
+ currentCompiledMethod := methodClass compiledMethodAt: methodSelector ifAbsent: [nil].
+
+ self showingDecompile ifTrue: [^ self decompiledSourceIntoContents].
+ self showingDocumentation ifTrue: [^ self commentContents].
+ ^ contents := self sourceStringPrettifiedAndDiffed asText makeSelectorBoldIn: methodClass!
Item was added:
+ ----- Method: MethodHolder>>contents:notifying: (in category '*Etoys-contents') -----
+ contents: input notifying: aController
+ | selector |
+ (selector := methodClass newParser parseSelector: input asText) ifNil:
+ [self inform: 'Sorry - invalid format for the
+ method name and arguments -- cannot accept.'.
+ ^ false].
+
+ selector == methodSelector ifFalse:
+ [self inform:
+ 'You cannot change the name of
+ the method here -- it must continue
+ to be ', methodSelector.
+ ^ false].
+
+ selector := methodClass
+ compile: input asText
+ classified: self selectedMessageCategoryName
+ notifying: aController.
+ selector == nil ifTrue: [^ false].
+ contents := input asString copy.
+ currentCompiledMethod := methodClass compiledMethodAt: methodSelector.
+ ^ true!
Item was added:
+ ----- Method: MethodHolder>>identifyScript (in category '*Etoys-miscellaneous') -----
+ identifyScript
+ | msg aPlayer |
+ msg := methodClass isUniClass
+ ifTrue:
+ [aPlayer := methodClass someInstance.
+ aPlayer costume
+ ifNotNil:
+ ['This holds code for a script
+ named ', methodSelector, ' belonging
+ to an object named ', aPlayer externalName]
+ ifNil:
+ ['This formerly held code for a script
+ named ', methodSelector, ' for a Player
+ who once existed but now is moribund.']]
+ ifFalse:
+ ['This holds code for the method
+ named ', methodSelector, '
+ for class ', methodClass name].
+ self inform: msg!
Item was added:
+ ----- Method: MethodHolder>>methodClass:methodSelector: (in category '*Etoys-miscellaneous') -----
+ methodClass: aClass methodSelector: aSelector
+ methodClass := aClass.
+ methodSelector := aSelector.
+ currentCompiledMethod := aClass compiledMethodAt: aSelector ifAbsent: [nil]!
Item was added:
+ ----- Method: MethodHolder>>selectedClass (in category '*Etoys-selection') -----
+ selectedClass
+ ^ methodClass theNonMetaClass!
Item was added:
+ ----- Method: MethodHolder>>selectedClassOrMetaClass (in category '*Etoys-selection') -----
+ selectedClassOrMetaClass
+ ^ methodClass!
Item was added:
+ ----- Method: MethodHolder>>selectedMessageCategoryName (in category '*Etoys-selection') -----
+ selectedMessageCategoryName
+ ^ methodClass organization categoryOfElement: methodSelector!
Item was added:
+ ----- Method: MethodHolder>>selectedMessageName (in category '*Etoys-selection') -----
+ selectedMessageName
+ ^ methodSelector!
Item was added:
+ ----- Method: MethodHolder>>versions (in category '*Etoys-miscellaneous') -----
+ versions
+ "Return a VersionsBrowser (containing a list of ChangeRecords) of older versions of this method."
+
+ ^ VersionsBrowser new scanVersionsOf: self compiledMethod
+ class: self selectedClass
+ meta: methodClass isMeta
+ category: self selectedMessageCategoryName
+ "(classOfMethod whichCategoryIncludesSelector: selectorOfMethod)"
+ selector: methodSelector!
Item was added:
+ ----- Method: Morph class>>selectionBackground (in category '*Etoys-defaults') -----
+ selectionBackground
+ "The background for selected items in lists and tree-list thingies."
+ ^ self subduedHilites ifTrue: [
+ TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2
+ ] ifFalse: [
+ "This is tuned so the red-foreground used for list texts stays somewhat legible."
+ Color r: 0.8 g:0.8 b: 0.81 alpha: 0.85
+ ].
+ !
Item was added:
+ ----- Method: Morph>>adaptToWorld: (in category '*Etoys-e-toy support') -----
+ adaptToWorld: aWorld
+ "The receiver finds itself operating in a possibly-different new world. If any of the receiver's parts are world-dependent (such as a target of a SimpleButtonMorph, etc.), then have them adapt accordingly"
+ submorphs do: [:m | m adaptToWorld: aWorld].
+ self eventHandler ifNotNil:
+ [self eventHandler adaptToWorld: aWorld]!
Item was added:
+ ----- Method: Morph>>addMagicHaloFor: (in category '*Etoys-halos and balloon help') -----
+ addMagicHaloFor: aHand
+
+ aHand halo ifNotNil: [:halo |
+ halo target == self ifTrue:[^self].
+ halo isMagicHalo ifFalse:[^self]].
+
+ self createHalo
+ popUpMagicallyFor: self hand: aHand!
Item was added:
+ ----- Method: Morph>>addMorphNearBack: (in category '*Etoys-submorphs - misc') -----
+ addMorphNearBack: aMorph
+ | bg |
+ (submorphs notEmpty and: [submorphs last mustBeBackmost])
+ ifTrue:
+ [bg := submorphs last.
+ bg privateDelete].
+ self addMorphBack: aMorph.
+ bg ifNotNil: [self addMorphBack: bg]!
Item was added:
+ ----- Method: Morph>>addPaintingItemsTo:hand: (in category '*Etoys-menus') -----
+ addPaintingItemsTo: aMenu hand: aHandMorph
+ | subMenu movies |
+ subMenu := MenuMorph new defaultTarget: self.
+ subMenu
+ add: 'repaint' translated action: #editDrawing;
+ add: 'set rotation center' translated action: #setRotationCenter;
+ add: 'reset forward-direction' translated action: #resetForwardDirection;
+ add: 'set rotation style' translated action: #setRotationStyle;
+ add: 'erase pixels of color' translated action: #erasePixelsUsing:;
+ add: 'recolor pixels of color' translated action: #recolorPixelsUsing:;
+ add: 'reduce color palette' translated action: #reduceColorPalette:;
+ add: 'detect edges' translated action: #edgeDetect;
+ add: 'sharpen' translated action: #sharpen;
+ add: 'blur' translated action: #blur;
+ add: 'emboss' translated action: #emboss;
+ add: 'add a border around this shape...' translated action: #addBorderToShape:.
+ movies := (self world rootMorphsAt: aHandMorph targetPoint)
+ select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]].
+ movies size > 1
+ ifTrue:
+ [subMenu add: 'insert into movie' translated action: #insertIntoMovie:].
+ aMenu add: 'painting...' translated subMenu: subMenu!
Item was added:
+ ----- Method: Morph>>allMenuWordings (in category '*Etoys-menus') -----
+ allMenuWordings
+ | tempMenu |
+ tempMenu := self buildHandleMenu: self currentHand.
+ tempMenu allMorphsDo: [:m | m step]. "Get wordings current"
+ ^ tempMenu allWordings!
Item was added:
+ ----- Method: Morph>>allMorphsAndBookPagesInto: (in category '*Etoys-e-toy support') -----
+ allMorphsAndBookPagesInto: aSet
+ "Return a set of all submorphs. Don't forget the hidden ones like BookMorph pages that are not showing. Consider only objects that are in memory (see allNonSubmorphMorphs)."
+
+ submorphs do: [:m | m allMorphsAndBookPagesInto: aSet].
+ self allNonSubmorphMorphs do: [:m |
+ (aSet includes: m) ifFalse: ["Stop infinite recursion"
+ m allMorphsAndBookPagesInto: aSet]].
+ aSet add: self.
+ self player ifNotNil:
+ [self player allScriptEditors do: [:e | e allMorphsAndBookPagesInto: aSet]].
+ ^ aSet!
Item was added:
+ ----- Method: Morph>>allMorphsWithPlayersDo: (in category '*Etoys-submorphs - misc') -----
+ allMorphsWithPlayersDo: aTwoArgumentBlock
+ "Evaluate the given block for all morphs in this composite morph that have non-nil players.
+ Also evaluate the block for the receiver if it has a player."
+
+ submorphs do: [:m | m allMorphsWithPlayersDo: aTwoArgumentBlock ].
+ self playerRepresented ifNotNil: [ :p | aTwoArgumentBlock value: self value: p ].
+ !
Item was added:
+ ----- Method: Morph>>applyStatusToAllSiblings: (in category '*Etoys-meta-actions') -----
+ applyStatusToAllSiblings: evt
+ "Apply the statuses of all my scripts to the script status of all my siblings"
+
+ | aPlayer |
+ (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
+ aPlayer instantiatedUserScriptsDo:
+ [:aScriptInstantiation | aScriptInstantiation assignStatusToAllSiblings]!
Item was added:
+ ----- Method: Morph>>asNumber: (in category '*Etoys-e-toy support') -----
+ asNumber: aPointOrNumber
+ "Support for e-toy demo."
+
+ aPointOrNumber class = Point
+ ifTrue: [^ aPointOrNumber r]
+ ifFalse: [^ aPointOrNumber].
+ !
Item was added:
+ ----- Method: Morph>>automaticViewing (in category '*Etoys-e-toy support') -----
+ automaticViewing
+ "Backstop, in case this message gets sent to an owner that is not a playfield"
+ ^ false!
Item was added:
+ ----- Method: Morph>>bringAllSiblingsToMe: (in category '*Etoys-meta-actions') -----
+ bringAllSiblingsToMe: evt
+ "bring all siblings of the receiver's player found in the same container to the receiver's location."
+
+ | aPlayer aPosition aContainer |
+ (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
+ aPosition := self topRendererOrSelf position.
+ aContainer := self topRendererOrSelf owner.
+ (aPlayer class allInstances copyWithout: aPlayer) do:
+ [:each |
+ (aContainer submorphs includes: each costume) ifTrue:
+ [each costume position: aPosition]]!
Item was added:
+ ----- Method: Morph>>chooseNewGraphic (in category '*Etoys-menus') -----
+ chooseNewGraphic
+ "Used by any morph that can be represented by a graphic"
+ self chooseNewGraphicCoexisting: false
+ !
Item was added:
+ ----- Method: Morph>>chooseNewGraphicCoexisting: (in category '*Etoys-menus') -----
+ chooseNewGraphicCoexisting: aBoolean
+ "Allow the user to choose a different form for her form-based morph"
+
+ | replacee aGraphicalMenu |
+ self isInWorld ifFalse: "menu must have persisted for a not-in-world object."
+ [aGraphicalMenu := Project current world submorphThat:
+ [:m | (m isKindOf: GraphicalMenu) and: [m target == self]]
+ ifNone:
+ [^ self].
+ ^ aGraphicalMenu show; flashBounds].
+ aGraphicalMenu := GraphicalMenu new
+ initializeFor: self
+ withForms: self reasonableForms
+ coexist: aBoolean.
+ aBoolean
+ ifTrue: [self primaryHand attachMorph: aGraphicalMenu]
+ ifFalse: [replacee := self topRendererOrSelf.
+ replacee owner replaceSubmorph: replacee by: aGraphicalMenu]!
Item was added:
+ ----- Method: Morph>>chooseNewGraphicFromHalo (in category '*Etoys-menus') -----
+ chooseNewGraphicFromHalo
+ "Allow the user to select a changed graphic to replace the one in the receiver"
+
+ self currentWorld abandonAllHalos.
+ self chooseNewGraphicCoexisting: true
+ !
Item was added:
+ ----- Method: Morph>>couldMakeSibling (in category '*Etoys-testing') -----
+ couldMakeSibling
+ "Answer whether it is appropriate to ask the receiver to make a sibling"
+
+ ^ true!
Item was added:
+ ----- Method: Morph>>currentPlayerDo: (in category '*Etoys-e-toy support') -----
+ currentPlayerDo: aBlock
+ "If the receiver is a viewer/scriptor associated with a current Player object, evaluate the given block against that object"!
Item was added:
+ ----- Method: Morph>>cursor (in category '*Etoys-e-toy support') -----
+ cursor
+ "vacuous backstop in case it gets sent to a morph that doesn't know what to do with it"
+
+ ^ 1!
Item was added:
+ ----- Method: Morph>>cursor: (in category '*Etoys-e-toy support') -----
+ cursor: aNumber
+ "vacuous backstop in case it gets sent to a morph that doesn't know what to do with it"
+ !
Item was added:
+ ----- Method: Morph>>decimalPlacesForGetter: (in category '*Etoys-e-toy support') -----
+ decimalPlacesForGetter: aGetter
+ "Answer the decimal places I prefer for showing a slot with the given getter, or nil if none"
+
+ | decimalPrefs |
+ decimalPrefs := self renderedMorph valueOfProperty: #decimalPlacePreferences ifAbsent: [^ nil].
+ ^ decimalPrefs at: aGetter ifAbsent: [nil]!
Item was added:
+ ----- Method: Morph>>defaultValueOrNil (in category '*Etoys-e-toy support') -----
+ defaultValueOrNil
+ "If the receiver has a property named #defaultValue, return that property's value, else return nil"
+
+ ^ self valueOfProperty: #defaultValue ifAbsent: [nil]!
Item was added:
+ ----- Method: Morph>>demandsBoolean (in category '*Etoys-classification') -----
+ demandsBoolean
+ "Answer whether the receiver will only accept a drop if it is boolean-valued. Particular to tile-scripting."
+
+ ^ self hasProperty: #demandsBoolean!
Item was added:
+ ----- Method: Morph>>demandsThumbnailing (in category '*Etoys-thumbnail') -----
+ demandsThumbnailing
+ "Answer whether the receiver, if in a thumbnailable parts bin, wants to be thumbnailed whether or not size requires it"
+
+ ^ false!
Item was added:
+ ----- Method: Morph>>doMenuItem: (in category '*Etoys-menus') -----
+ doMenuItem: menuString
+ | aMenu anItem aNominalEvent aHand |
+ aMenu := self buildHandleMenu: (aHand := self currentHand).
+ aMenu allMorphsDo: [:m | m step]. "Get wordings current"
+ anItem := aMenu itemWithWording: menuString.
+ anItem ifNil:
+ [^ self player scriptingError: 'Menu item not found: ', menuString].
+ aNominalEvent := MouseButtonEvent new
+ setType: #mouseDown
+ position: anItem bounds center
+ which: 4 "red"
+ buttons: 4 "red"
+ hand: aHand
+ stamp: nil.
+ anItem invokeWithEvent: aNominalEvent!
Item was added:
+ ----- Method: Morph>>embedInWindow (in category '*Etoys-e-toy support') -----
+ embedInWindow
+
+ | window worldToUse |
+
+ worldToUse := self world. "I'm assuming we are already in a world"
+ window := (SystemWindow labelled: self defaultLabelForInspector) model: nil.
+ window bounds: ((self position - ((0@window labelHeight) + window borderWidth))
+ corner: self bottomRight + window borderWidth).
+ window addMorph: self frame: (0@0 extent: 1@1).
+ window updatePaneColors.
+ worldToUse addMorph: window.
+ window beKeyWindow.!
Item was added:
+ ----- Method: Morph>>embeddedInMorphicWindowLabeled: (in category '*Etoys-e-toy support') -----
+ embeddedInMorphicWindowLabeled: labelString
+ | window |
+ window := (SystemWindow labelled: labelString) model: nil.
+ window setStripeColorsFrom: Color white.
+ window addMorph: self frame: (0@0 extent: 1@1).
+ ^ window!
Item was added:
+ ----- Method: Morph>>getNumericValue (in category '*Etoys-e-toy support') -----
+ getNumericValue
+ "Only certain kinds of morphs know how to deal with this frontally; here we provide support for a numeric property of any morph"
+
+ ^ self valueOfProperty: #numericValue ifAbsent: [0]!
Item was added:
+ ----- Method: Morph>>gridFormOrigin:grid:background:line: (in category '*Etoys-e-toy support') -----
+ gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor
+
+ | bigGrid gridForm gridOrigin |
+ gridOrigin := origin \\ smallGrid.
+ bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y).
+ gridForm := Form extent: bigGrid depth: Display depth.
+ backColor ifNotNil: [gridForm fillWithColor: backColor].
+ gridOrigin x to: gridForm width by: smallGrid x do:
+ [:x | gridForm fill: (x@0 extent: 1@gridForm height) fillColor: lineColor].
+ gridOrigin y to: gridForm height by: smallGrid y do:
+ [:y | gridForm fill: (0@y extent: gridForm width@1) fillColor: lineColor].
+ ^ InfiniteForm with: gridForm
+ !
Item was added:
+ ----- Method: Morph>>handUserASibling (in category '*Etoys-e-toy support') -----
+ handUserASibling
+ "Make and hand the user a sibling instance. Force the creation of a uniclass at this point if one does not already exist for the receiver."
+
+ | topRend |
+ topRend := self topRendererOrSelf.
+ topRend couldMakeSibling ifFalse: [^ Beeper beep].
+
+ topRend assuredPlayer assureUniClass.
+ (topRend makeSiblings: 1) first openInHand!
Item was added:
+ ----- Method: Morph>>indicateAllSiblings (in category '*Etoys-meta-actions') -----
+ indicateAllSiblings
+ "Indicate all the receiver and all its siblings by flashing momentarily."
+
+ | aPlayer allBoxes |
+ (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [^ self "error: 'not uniclass'"].
+ allBoxes := aPlayer class allInstances
+ select: [:m | m costume world == self currentWorld]
+ thenCollect: [:m | m costume boundsInWorld].
+
+ 5 timesRepeat:
+ [Display flashAll: allBoxes andWait: 120].!
Item was added:
+ ----- Method: Morph>>inspectArgumentsPlayerInMorphic: (in category '*Etoys-debug and other') -----
+ inspectArgumentsPlayerInMorphic: evt
+ evt hand attachMorph: ((Inspector openOn: self player) extent: 300@200)!
Item was added:
+ ----- Method: Morph>>isAViewer (in category '*Etoys-e-toy support') -----
+ isAViewer
+ ^ false!
Item was added:
+ ----- Method: Morph>>isCompoundTileMorph (in category '*Etoys-classification') -----
+ isCompoundTileMorph
+ ^false!
Item was added:
+ ----- Method: Morph>>isKedamaMorph (in category '*Etoys-classification') -----
+ isKedamaMorph
+ ^false!
Item was added:
+ ----- Method: Morph>>isLikelyRecipientForMouseOverHalos (in category '*Etoys-halos and balloon help') -----
+ isLikelyRecipientForMouseOverHalos
+ ^self player notNil!
Item was added:
+ ----- Method: Morph>>isModalShell (in category '*Etoys-classification') -----
+ isModalShell
+ ^false!
Item was added:
+ ----- Method: Morph>>isNumericReadoutTile (in category '*Etoys-classification') -----
+ isNumericReadoutTile
+ ^false!
Item was added:
+ ----- Method: Morph>>isPhraseTileMorph (in category '*Etoys-classification') -----
+ isPhraseTileMorph
+ ^false!
Item was added:
+ ----- Method: Morph>>isPlayfieldLike (in category '*Etoys-classification') -----
+ isPlayfieldLike
+ ^ false!
Item was added:
+ ----- Method: Morph>>isSoundTile (in category '*Etoys-classification') -----
+ isSoundTile
+ ^false!
Item was added:
+ ----- Method: Morph>>isStandardViewer (in category '*Etoys-classification') -----
+ isStandardViewer
+ ^false!
Item was added:
+ ----- Method: Morph>>isStickySketchMorph (in category '*Etoys-classification') -----
+ isStickySketchMorph
+ ^false!
Item was added:
+ ----- Method: Morph>>isSyntaxMorph (in category '*Etoys-classification') -----
+ isSyntaxMorph
+ ^false!
Item was added:
+ ----- Method: Morph>>isTileEditor (in category '*Etoys-e-toy support') -----
+ isTileEditor
+ "No, I'm not"
+ ^false!
Item was added:
+ ----- Method: Morph>>isTileMorph (in category '*Etoys-classification') -----
+ isTileMorph
+ ^false!
Item was added:
+ ----- Method: Morph>>isTilePadMorph (in category '*Etoys-classification') -----
+ isTilePadMorph
+ ^false!
Item was added:
+ ----- Method: Morph>>isViewer (in category '*Etoys-classification') -----
+ isViewer
+ ^false!
Item was added:
+ ----- Method: Morph>>makeGraphPaper (in category '*Etoys-e-toy support') -----
+ makeGraphPaper
+ | smallGrid backColor lineColor |
+ smallGrid := Compiler evaluate: (UIManager default request: 'Enter grid size' translated initialAnswer: '16').
+ smallGrid ifNil: [^ self].
+ UIManager default informUser: 'Choose a background color' translated during: [backColor := Color fromUser].
+ UIManager default informUser: 'Choose a line color' translated during: [lineColor := Color fromUser].
+ self makeGraphPaperGrid: smallGrid background: backColor line: lineColor.!
Item was added:
+ ----- Method: Morph>>makeGraphPaperGrid:background:line: (in category '*Etoys-e-toy support') -----
+ makeGraphPaperGrid: smallGrid background: backColor line: lineColor
+
+ | gridForm |
+ gridForm := self gridFormOrigin: 0@0 grid: smallGrid asPoint background: backColor line: lineColor.
+ self color: gridForm.
+ self world ifNotNil: [self world fullRepaintNeeded].
+ self changed: #newColor. "propagate to view"
+ !
Item was added:
+ ----- Method: Morph>>makeMultipleSiblings: (in category '*Etoys-meta-actions') -----
+ makeMultipleSiblings: evt
+ "Make multiple siblings, first prompting the user for how many"
+
+ | result |
+ self topRendererOrSelf couldMakeSibling ifFalse: [^ Beeper beep].
+ result := UIManager default request: 'how many siblings do you want?' translated initialAnswer: '2'.
+ result isEmptyOrNil ifTrue: [^ self].
+ result first isDigit ifFalse: [^ Beeper beep].
+ self topRendererOrSelf makeSiblings: result asInteger.!
Item was added:
+ ----- Method: Morph>>makeNascentScript (in category '*Etoys-menus') -----
+ makeNascentScript
+ ^ self notYetImplemented!
Item was added:
+ ----- Method: Morph>>makeNewPlayerInstance: (in category '*Etoys-meta-actions') -----
+ makeNewPlayerInstance: evt
+ "Make a duplicate of the receiver's argument. This is called only where the argument has an associated Player as its costumee, and the intent here is to make another instance of the same uniclass as the donor Player itself. Much works, but there are flaws so this shouldn't be used without recognizing the risks"
+
+ evt hand attachMorph: self usableSiblingInstance!
Item was added:
+ ----- Method: Morph>>makeSiblings: (in category '*Etoys-meta-actions') -----
+ makeSiblings: count
+ "Make multiple sibling, and return the list"
+
+ | listOfNewborns aPosition |
+ aPosition := self position.
+ listOfNewborns := (1 to: count asInteger) asArray collect:
+ [:anIndex | | anInstance |
+ anInstance := self usableSiblingInstance.
+ owner addMorphFront: anInstance.
+ aPosition := aPosition + (10@10).
+ anInstance position: aPosition.
+ anInstance].
+ self currentWorld startSteppingSubmorphsOf: self topRendererOrSelf owner.
+ ^ listOfNewborns!
Item was added:
+ ----- Method: Morph>>makeSiblingsLookLikeMe: (in category '*Etoys-meta-actions') -----
+ makeSiblingsLookLikeMe: evt
+ "Make all my siblings wear the same costume that I am wearing."
+
+ | aPlayer |
+ (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
+ aPlayer class allInstancesDo:
+ [:anInstance | anInstance == aPlayer ifFalse:
+ [anInstance wearCostumeOf: aPlayer]]!
Item was added:
+ ----- Method: Morph>>menuItemAfter: (in category '*Etoys-menus') -----
+ menuItemAfter: menuString
+ | allWordings |
+ allWordings := self allMenuWordings.
+ ^ allWordings atWrap: ((allWordings indexOf: menuString) + 1)!
Item was added:
+ ----- Method: Morph>>menuItemBefore: (in category '*Etoys-menus') -----
+ menuItemBefore: menuString
+ | allWordings |
+ allWordings := self allMenuWordings.
+ ^ allWordings atWrap: ((allWordings indexOf: menuString) - 1)!
Item was added:
+ ----- Method: Morph>>methodCommentAsBalloonHelp (in category '*Etoys-accessing') -----
+ methodCommentAsBalloonHelp
+ "Given that I am a morph that is associated with an object and a method, answer a suitable method comment relating to that object & method if possible"
+
+ | inherentSelector actual |
+ (inherentSelector := self valueOfProperty: #inherentSelector)
+ ifNotNil:
+ [(actual := (self firstOwnerSuchThat:[:m| m isPhraseTileMorph or:[m isSyntaxMorph]]) actualObject) ifNotNil:
+ [^ actual class precodeCommentOrInheritedCommentFor: inherentSelector]].
+ ^ nil!
Item was added:
+ ----- Method: Morph>>mustBeBackmost (in category '*Etoys-e-toy support') -----
+ mustBeBackmost
+ "Answer whether the receiver needs to be the backmost morph in its owner's submorph list"
+
+ ^ false!
Item was added:
+ ----- Method: Morph>>noteDecimalPlaces:forGetter: (in category '*Etoys-e-toy support') -----
+ noteDecimalPlaces: aNumber forGetter: aGetter
+ "Make a mental note of the user's preference for a particular number of decimal places to be associated with the slot with the given getter"
+
+ (self renderedMorph valueOfProperty: #decimalPlacePreferences ifAbsentPut: [IdentityDictionary new])
+ at: aGetter put: aNumber!
Item was added:
+ ----- Method: Morph>>objectViewed (in category '*Etoys-e-toy support') -----
+ objectViewed
+ "Answer the morph associated with the player that the structure the receiver currently finds itself within represents."
+
+ ^ (self outermostMorphThat: [:o | o isViewer or:[ o isScriptEditorMorph]]) objectViewed
+ !
Item was added:
+ ----- Method: Morph>>offerCostumeViewerMenu: (in category '*Etoys-menu') -----
+ offerCostumeViewerMenu: aMenu
+ "do nothing"!
Item was added:
+ ----- Method: Morph>>openAPropertySheet (in category '*Etoys-meta-actions') -----
+ openAPropertySheet
+
+ Smalltalk at: #ObjectPropertiesMorph ifPresent:[:aClass|
+ ^aClass basicNew
+ targetMorph: self;
+ initialize;
+ openNearTarget
+ ].
+ Beeper beep.!
Item was added:
+ ----- Method: Morph>>openViewerForArgument (in category '*Etoys-player viewer') -----
+ openViewerForArgument
+ "Open up a viewer for a player associated with the morph in question. "
+ self presenter viewMorph: self!
Item was added:
+ ----- Method: Morph>>overlapsShadowForm:bounds: (in category '*Etoys-geometry - etoys') -----
+ overlapsShadowForm: itsShadow bounds: itsBounds
+ "Answer true if itsShadow and my shadow overlap at all"
+ | overlapExtent overlap myRect myShadow goalRect goalShadow bb |
+ overlap := self fullBounds intersect: itsBounds.
+ overlapExtent := overlap extent.
+ overlapExtent > (0 @ 0)
+ ifFalse: [^ false].
+ myRect := overlap translateBy: 0 @ 0 - self topLeft.
+ myShadow := (self imageForm contentsOfArea: myRect) stencil.
+ goalRect := overlap translateBy: 0 @ 0 - itsBounds topLeft.
+ goalShadow := (itsShadow contentsOfArea: goalRect) stencil.
+
+ "compute a pixel-by-pixel AND of the two stencils. Result will be black
+ (pixel value = 1) where black parts of the stencils overlap"
+ bb := BitBlt toForm: myShadow.
+ bb
+ copyForm: goalShadow
+ to: 0 @ 0
+ rule: Form and.
+
+ ^(bb destForm tallyPixelValues second) > 0 !
Item was added:
+ ----- Method: Morph>>pasteUpMorphHandlingTabAmongFields (in category '*Etoys-structure') -----
+ pasteUpMorphHandlingTabAmongFields
+ "Answer the nearest PasteUpMorph in my owner chain that has the tabAmongFields property, or nil if none"
+
+ | aPasteUp |
+ aPasteUp := self owner.
+ [aPasteUp notNil] whileTrue:
+ [aPasteUp tabAmongFields ifTrue:
+ [^ aPasteUp].
+ aPasteUp := aPasteUp owner].
+ ^ nil!
Item was added:
+ ----- Method: Morph>>player (in category '*Etoys-accessing') -----
+ player
+ "answer the receiver's player"
+ ^ extension ifNotNil: [extension player]!
Item was added:
+ ----- Method: Morph>>player: (in category '*Etoys-accessing') -----
+ player: anObject
+ "change the receiver's player"
+ self assureExtension player: anObject!
Item was added:
+ ----- Method: Morph>>playerRepresented (in category '*Etoys-accessing') -----
+ playerRepresented
+ "Answer the player represented by the receiver. Morphs that serve as references to other morphs reimplement this; be default a morph represents its own player."
+
+ ^ self player!
Item was added:
+ ----- Method: Morph>>preferredDuplicationHandleSelector (in category '*Etoys-halos and balloon help') -----
+ preferredDuplicationHandleSelector
+ "Answer the selector, either #addMakeSiblingHandle: or addDupHandle:, to be offered as the default in a halo open on me"
+
+ Preferences oliveHandleForScriptedObjects ifFalse:
+ [^ #addDupHandle:].
+ ^ self renderedMorph valueOfProperty: #preferredDuplicationHandleSelector ifAbsent:
+ [self player class isUniClass
+ ifTrue:
+ [#addMakeSiblingHandle:]
+ ifFalse:
+ [#addDupHandle:]]!
Item was added:
+ ----- Method: Morph>>presenter (in category '*Etoys-accessing') -----
+ presenter
+ ^ owner ifNotNil: [owner presenter] ifNil: [self currentWorld presenter]!
Item was added:
+ ----- Method: Morph>>readoutForField: (in category '*Etoys-thumbnail') -----
+ readoutForField: fieldSym
+ "Provide a readout that will show the value of the slot/pseudoslot of the receiver generated by sending fieldSym to the receiver"
+
+ | aContainer |
+ "still need to get this right"
+ aContainer := AlignmentMorph newColumn.
+ aContainer layoutInset: 0; hResizing: #rigid; vResizing: #shrinkWrap.
+ aContainer addMorphBack: (StringMorph new contents: (self perform: fieldSym) asString).
+ ^ aContainer!
Item was added:
+ ----- Method: Morph>>referencePlayfield (in category '*Etoys-e-toy support') -----
+ referencePlayfield
+ "Answer the PasteUpMorph to be used for cartesian-coordinate reference"
+
+ | former |
+ owner ifNotNil:
+ [(self topRendererOrSelf owner isHandMorph and: [(former := self formerOwner) notNil])
+ ifTrue:
+ [former := former renderedMorph.
+ ^ former isPlayfieldLike
+ ifTrue: [former]
+ ifFalse: [former referencePlayfield]]].
+
+ self allOwnersDo: [:o | o isPlayfieldLike ifTrue: [^ o]].
+ ^ Project current world!
Item was added:
+ ----- Method: Morph>>renameInternal: (in category '*Etoys-testing') -----
+ renameInternal: aName
+ "Change the internal name (because of a conflict) but leave the external name unchanged. Change Player class name, but do not change the names that appear in tiles. When coming in from disk, and have name conflict, References will already have the new name. "
+
+ self knownName = aName ifTrue: [^ aName].
+ self topRendererOrSelf setNameTo: aName.
+
+ "References dictionary already has key aName"
+
+ "If this player has a viewer flap, it will remain present"
+
+ "Tiles in scripts all stay the same"
+
+ "Compiled methods for scripts have been fixed up because the same association was reused"
+
+ ^ aName!
Item was added:
+ ----- Method: Morph>>rotationStyle (in category '*Etoys-e-toy support') -----
+ rotationStyle
+ "Return the 'rotation style' of the receiver"
+ ^#normal!
Item was added:
+ ----- Method: Morph>>rotationStyle: (in category '*Etoys-e-toy support') -----
+ rotationStyle: aSymbol
+ "Set the 'rotation style' of the receiver; this is ignored for non-sketches"!
Item was added:
+ ----- Method: Morph>>roundUpStrays (in category '*Etoys-miscellaneous') -----
+ roundUpStrays
+ "Bring submorphs of playfieldlike structures in the receiver's interior back within view."
+
+ self submorphsDo:
+ [:m | m isPlayfieldLike ifTrue: [m roundUpStrays]]!
Item was added:
+ ----- Method: Morph>>saveDocPane (in category '*Etoys-fileIn/out') -----
+ saveDocPane
+
+ Smalltalk at: #DocLibrary ifPresent:[:dl| dl external saveDocCheck: self]!
Item was added:
+ ----- Method: Morph>>screenLocation (in category '*Etoys-geometry - etoys') -----
+ screenLocation
+ "For compatibility only"
+
+ ^ self fullBounds origin!
Item was added:
+ ----- Method: Morph>>screenRectangle (in category '*Etoys-geometry - etoys') -----
+ screenRectangle
+ "For compatibility only"
+
+ ^ self fullBounds!
Item was added:
+ ----- Method: Morph>>setAsActionInButtonProperties: (in category '*Etoys-e-toy support') -----
+ setAsActionInButtonProperties: buttonProperties
+
+ ^false "means I don't know how to be set as a button action"!
Item was added:
+ ----- Method: Morph>>setNumericValue: (in category '*Etoys-e-toy support') -----
+ setNumericValue: aValue
+ "Set the receiver's contents to reflect the given numeric value. Only certain kinds of morphs know what to do with this, the rest, for now, stash the number in a property, where it may not be visible but at least it won't be lost, and can be retrieved by the companion getter. This code is never reached under normal circumstances, because the #numericValue slot is not shown in Viewers for most kinds of morphs, and those kinds of morphs that do show it also reimplement this method. However, this code *could* be reached via a user script which sends #setNumericValue: but whose receiver has been changed, via tile-scripting drag and drop for example, to one that doesn't directly handle numbers"
+
+ ScriptingSystem informScriptingUser: 'an unusual setNumericValue: call was made'.
+ self renderedMorph setProperty: #numericValue toValue: aValue
+ !
Item was added:
+ ----- Method: Morph>>setStandardTexture (in category '*Etoys-e-toy support') -----
+ setStandardTexture
+ | parms |
+ parms := self textureParameters.
+ self makeGraphPaperGrid: parms first
+ background: parms second
+ line: parms third!
Item was added:
+ ----- Method: Morph>>shouldRememberCostumes (in category '*Etoys-player') -----
+ shouldRememberCostumes
+ ^true!
Item was added:
+ ----- Method: Morph>>shuffleSubmorphs (in category '*Etoys-submorphs - misc') -----
+ shuffleSubmorphs
+ "Randomly shuffle the order of my submorphs. Don't call this method lightly!!"
+
+ | bg |
+ self invalidRect: self fullBounds.
+ (submorphs notEmpty and: [submorphs last mustBeBackmost])
+ ifTrue:
+ [bg := submorphs last.
+ bg privateDelete].
+ submorphs := submorphs shuffled.
+ bg ifNotNil: [self addMorphBack: bg].
+ self layoutChanged!
Item was added:
+ ----- Method: Morph>>standardPalette (in category '*Etoys-initialization') -----
+ standardPalette
+ "Answer a standard palette forced by some level of enclosing presenter, or nil if none"
+ | pal aPresenter itsOwner |
+ (aPresenter := self presenter) ifNil: [^ nil].
+ ^ (pal := aPresenter ownStandardPalette)
+ ifNotNil: [pal]
+ ifNil: [(itsOwner := aPresenter associatedMorph owner)
+ ifNotNil:
+ [itsOwner standardPalette]
+ ifNil:
+ [nil]]!
Item was added:
+ ----- Method: Morph>>tabAmongFields (in category '*Etoys-event handling') -----
+ tabAmongFields
+ ^ Preferences tabAmongFields
+ or: [self hasProperty: #tabAmongFields] !
Item was added:
+ ----- Method: Morph>>textureParameters (in category '*Etoys-e-toy support') -----
+ textureParameters
+ "Answer a triplet giving the preferred grid size, background color, and line color. The choices here are as suggested by Alan, 9/13/97"
+
+ ^ Array with: 16 with: Color lightYellow with: Color lightGreen lighter lighter!
Item was added:
+ ----- Method: Morph>>unlockOneSubpart (in category '*Etoys-e-toy support') -----
+ unlockOneSubpart
+ | unlockables reply |
+ unlockables := self submorphs select:
+ [:m | m isLocked].
+ unlockables size <= 1 ifTrue: [^ self unlockContents].
+ reply := UIManager default
+ chooseFrom: (unlockables collect: [:m | m externalName])
+ values: unlockables
+ title: 'Who should be be unlocked?' translated.
+ reply isNil ifTrue: [^ self].
+ reply unlock!
Item was added:
+ ----- Method: Morph>>updateAllScriptingElements (in category '*Etoys-naming') -----
+ updateAllScriptingElements
+ "A sledge-hammer sweep from the world down to make sure that all live scripting elements are up to date. Presently in eclipse, not sent at the moment."
+
+ | aPasteUp |
+ (aPasteUp := self topPasteUp) ifNotNil:
+ [aPasteUp allTileScriptingElements do: [:m | m bringUpToDate]]!
Item was added:
+ ----- Method: Morph>>updateCachedThumbnail (in category '*Etoys-e-toy support') -----
+ updateCachedThumbnail
+ "If I have a cached thumbnail, then update it. Copied up from Dan's original version in PasteUpMorph so it can be used by all morphs."
+ | cachedThumbnail |
+
+ (cachedThumbnail := self valueOfProperty: #cachedThumbnail) ifNotNil:
+ [(cachedThumbnail respondsTo: #computeThumbnail)
+ ifTrue: [cachedThumbnail computeThumbnail]
+ ifFalse: [self removeProperty: #computeThumbnail]].
+ "Test and removal are because the thumbnail is being replaced by another Morph. We don't know why. Need to fix that at the source."!
Item was added:
+ ----- Method: Morph>>usableSiblingInstance (in category '*Etoys-copying') -----
+ usableSiblingInstance
+ "Return another similar morph whose Player is of the same class as mine.
+ Do not open it in the world."
+
+ | aName newPlayer newMorph topRenderer counter world |
+ (topRenderer := self topRendererOrSelf) == self
+ ifFalse: [^topRenderer usableSiblingInstance].
+ self assuredPlayer assureUniClass.
+ newMorph := self veryDeepCopySibling.
+ newPlayer := newMorph player.
+ newPlayer resetCostumeList.
+ (aName := self knownName) isNil
+ ifTrue: [self player notNil ifTrue: [aName := newMorph innocuousName]].
+ "Force a difference here"
+
+ aName := aName stemAndNumericSuffix at: 1.
+
+ world := self world ifNil: [Project current world].
+ (world hasProperty: #nameCounter) ifFalse: [
+ (world setProperty: #nameCounter toValue: Dictionary new)
+ ].
+
+ counter := (world valueOfProperty: #nameCounter) at: aName ifAbsent: [1].
+ newMorph setNameTo: aName, counter.
+ (world valueOfProperty: #nameCounter) at: aName put: counter + 1.
+
+ newMorph privateOwner: nil.
+ newPlayer assureEventHandlerRepresentsStatus.
+ self presenter flushPlayerListCache.
+ ^newMorph!
Item was added:
+ ----- Method: Morph>>viewMorphDirectly (in category '*Etoys-debug and other') -----
+ viewMorphDirectly
+ "Open a Viewer directly on the Receiver, i.e. no Player involved"
+
+ self presenter viewObjectDirectly: self renderedMorph
+
+ !
Item was added:
+ ----- Method: Morph>>wantsHalo (in category '*Etoys-halos and balloon help') -----
+ wantsHalo
+ | topOwner |
+ ^(topOwner := self topRendererOrSelf owner) notNil
+ and: [topOwner wantsHaloFor: self]!
Item was added:
+ ----- Method: Morph>>wantsHaloFor: (in category '*Etoys-halos and balloon help') -----
+ wantsHaloFor: aSubMorph
+ ^ false!
Item was added:
+ ----- Method: Morph>>wantsScriptorHaloHandle (in category '*Etoys-halos and balloon help') -----
+ wantsScriptorHaloHandle
+ "Answer whether the receiver would like to have a Scriptor halo handle put up on its behalf. Initially, only the ScriptableButton says yes"
+
+ ^ false!
Item was added:
+ ----- Method: Morph>>wouldAcceptKeyboardFocusUponTab (in category '*Etoys-event handling') -----
+ wouldAcceptKeyboardFocusUponTab
+ "Answer whether the receiver is in the running as the new keyboard focus if the tab key were hit at a meta level. This provides the leverage for tabbing among fields of a card, for example."
+
+ ^ false!
Item was added:
+ ----- Method: Morph>>wrappedInWindow: (in category '*Etoys-e-toy support') -----
+ wrappedInWindow: aSystemWindow
+ | aWindow |
+ aWindow := aSystemWindow model: Model new.
+ aWindow addMorph: self frame: (0@0 extent: 1@1).
+ aWindow extent: self extent.
+ ^ aWindow!
Item was added:
+ ----- Method: Morph>>wrappedInWindowWithTitle: (in category '*Etoys-e-toy support') -----
+ wrappedInWindowWithTitle: aTitle
+ | aWindow w2 |
+ aWindow := (SystemWindow labelled: aTitle) model: Model new.
+ aWindow addMorph: self frame: (0@0 extent: 1@1).
+ w2 := aWindow borderWidth * 2.
+ w2 := 3. "oh, well"
+ aWindow extent: self fullBounds extent + (0 @ aWindow labelHeight) + (w2 @ w2).
+ ^ aWindow!
Item was added:
+ ----- Method: MorphExtension>>player (in category '*Etoys-accessing') -----
+ player
+ "answer the receiver's player"
+ ^ player!
Item was added:
+ ----- Method: MorphExtension>>player: (in category '*Etoys-accessing') -----
+ player: anObject
+ "change the receiver's player"
+ player := anObject !
Item was added:
+ ListItemWrapper subclass: #MorphWithSubmorphsWrapper
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-Morphic-Explorer'!
+
+ !MorphWithSubmorphsWrapper commentStamp: 'ls 3/1/2004 17:32' prior: 0!
+ Display a morph in a SimpleHierarchicalListMorph, and arrange to recursively display the morph's submorphs. The "item" that is wrapped is the morph to display.!
Item was added:
+ ----- Method: MorphWithSubmorphsWrapper>>contents (in category '*Etoys-hierarchy') -----
+ contents
+ ^item submorphs collect: [ :m |
+ self class with: m ]!
Item was added:
+ ----- Method: MorphicModel>>addModelYellowButtonMenuItemsTo:forMorph:hand: (in category '*Etoys-graph model') -----
+ addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph
+
+ Preferences noviceMode ifFalse: [
+ super addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph].
+ ^ aCustomMenu!
Item was added:
+ ----- Method: MorphicProject>>exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: (in category '*Etoys-file in/out') -----
+ exportSegmentInSexpWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction
+
+ | fd sexp actualName |
+
+ world ifNil: [^ false].
+ world presenter ifNil: [^ false].
+ (world respondsTo: #sissScanObjectsAsEtoysProject) ifFalse: [^ false].
+
+ Command initialize.
+ world clearCommandHistory.
+ world cleanseStepList.
+ world localFlapTabs size = world flapTabs size ifFalse: [
+ noInteraction ifTrue: [^ false].
+ self error: 'Still holding onto Global flaps'].
+
+ fd := aDirectory directoryNamed: self resourceDirectoryName.
+ fd assureExistence.
+
+ "Must activate old world because this is run at #armsLength.
+ Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
+ will not be captured correctly if referenced from blocks or user code."
+ world becomeActiveDuring:[
+ sexp := world sissScanObjectsAsEtoysProject.
+ ].
+ (aFileName endsWith: '.pr') ifTrue: [
+ actualName := (aFileName copyFrom: 1 to: aFileName size - 3), '.sexp'.
+ ] ifFalse: [
+ actualName := aFileName
+ ].
+
+ self
+ writeForExportInSexp: sexp withSources: actualName
+ inDirectory: fd
+ changeSet: aChangeSetOrNil.
+ SecurityManager default signFile: actualName directory: fd.
+ self storeHtmlPageIn: fd.
+ (world valueOfProperty: #ProjectDetails ifAbsent: [Dictionary new])
+ at: 'Project-Format' put: 'S-Expression'.
+ self storeManifestFileIn: fd.
+ self compressFilesIn: fd to: aFileName in: aDirectory.
+
+ ^ true
+ !
Item was added:
+ ----- Method: MorphicProject>>initMorphic (in category '*Etoys-initialize') -----
+ initMorphic
+ "Written so that Morphic can still be removed. Note that #initialize is never actually called for a morphic project -- see the senders of this method."
+
+ self flag: #toRemove. "check if this method still used by Etoys"
+ Smalltalk verifyMorphicAvailability ifFalse: [^ nil].
+ changeSet := ChangeSet new.
+ transcript := TranscriptStream new.
+ displayDepth := Display depth.
+ parentProject := CurrentProject.
+ world := PasteUpMorph newWorldForProject: self.
+ Locale switchToID: CurrentProject localeID.
+ self initializeProjectPreferences. "Do this *after* a world is installed so that the project will be recognized as a morphic one."
+ Preferences useVectorVocabulary ifTrue: [world installVectorVocabulary]!
Item was added:
+ ----- Method: MorphicProject>>myPlayerClasses (in category '*Etoys-release') -----
+ myPlayerClasses
+ "Answer all my (non-systemDefined) player classes"
+ | classes presenter |
+ classes := Set new.
+ presenter := self world presenter.
+ presenter ifNotNil: [
+ presenter flushPlayerListCache. "old and outside guys"
+ presenter allExtantPlayers do:
+ [:p | p class isSystemDefined ifFalse: [classes add: p class]]].
+ ^classes!
Item was added:
+ ----- Method: MorphicProject>>setFlaps (in category '*Etoys-flaps support') -----
+ setFlaps
+
+ | flapTabs flapIDs sharedFlapTabs navigationMorph |
+ self flag: #toRemove. "check if this method still used by Etoys"
+
+ flapTabs := self world flapTabs.
+ flapIDs := flapTabs collect: [:tab | tab knownName].
+ flapTabs
+ do: [:tab | (tab isMemberOf: ViewerFlapTab)
+ ifFalse: [tab isGlobalFlap
+ ifTrue: [Flaps removeFlapTab: tab keepInList: false.
+ tab currentWorld reformulateUpdatingMenus]
+ ifFalse: [| referent |
+ referent := tab referent.
+ referent isInWorld
+ ifTrue: [referent delete].
+ tab delete]]].
+ sharedFlapTabs := Flaps classPool at: #SharedFlapTabs.
+ flapIDs
+ do: [:id |
+ id = 'Navigator' translated
+ ifTrue: [sharedFlapTabs add: Flaps newNavigatorFlap].
+ id = 'Widgets' translated
+ ifTrue: [sharedFlapTabs add: Flaps newWidgetsFlap].
+ id = 'Tools' translated
+ ifTrue: [sharedFlapTabs add: Flaps newToolsFlap].
+ id = 'Squeak' translated
+ ifTrue: [sharedFlapTabs add: Flaps newSqueakFlap].
+ id = 'Supplies' translated
+ ifTrue: [sharedFlapTabs add: Flaps newSuppliesFlap].
+ id = 'Stack Tools' translated
+ ifTrue: [sharedFlapTabs add: Flaps newStackToolsFlap].
+ id = 'Painting' translated
+ ifTrue: [sharedFlapTabs add: Flaps newPaintingFlap].
+ id = 'Objects' translated
+ ifTrue: [sharedFlapTabs add: Flaps newObjectsFlap ]].
+ 2 timesRepeat: [flapIDs do: [:id | Flaps enableDisableGlobalFlapWithID: id]].
+ self world flapTabs
+ do: [:flapTab | flapTab isCurrentlyTextual
+ ifTrue: [flapTab changeTabText: flapTab knownName]].
+ Flaps positionNavigatorAndOtherFlapsAccordingToPreference.
+ navigationMorph := self currentWorld findDeeplyA: ProjectNavigationMorph preferredNavigator.
+ navigationMorph isNil
+ ifTrue: [^ self].
+ navigationMorph allMorphs
+ do: [:morph | morph class == SimpleButtonDelayedMenuMorph
+ ifTrue: [(morph findA: ImageMorph) isNil
+ ifTrue: [| label |
+ label := morph label.
+ label isNil
+ ifFalse: [| name |
+ name := morph knownName.
+ name isNil
+ ifTrue: [morph name: label.
+ name := label].
+ morph label: name translated]]]]!
Item was added:
+ ----- Method: NativeImageSegment>>findRogueRootsAllMorphs: (in category '*Etoys-testing') -----
+ findRogueRootsAllMorphs: rootArray
+ "This is a tool to track down unwanted pointers into the segment. If we don't deal with these pointers, the segment turns out much smaller than it should. These pointers keep a subtree of objects out of the segment.
+ 1) assemble all objects should be in seg: morph tree, presenter, scripts, player classes, metaclasses. Put in a Set.
+ 2) Remove the roots from this list. Ask for senders of each. Of the senders, forget the ones that are in the segment already. Keep others. The list is now all the 'incorrect' pointers into the segment."
+
+ | inSeg testRoots scriptEditors pointIn wld xRoots |
+ Smalltalk garbageCollect.
+ inSeg := IdentitySet new: 200.
+ arrayOfRoots := rootArray.
+ (testRoots := self rootsIncludingPlayers) ifNil: [testRoots := rootArray].
+ testRoots do:
+ [:obj |
+ (obj isKindOf: Project)
+ ifTrue:
+ [inSeg add: obj.
+ wld := obj world.
+ inSeg add: wld presenter].
+ (obj isKindOf: Presenter) ifTrue: [inSeg add: obj]].
+ xRoots := wld ifNil: [testRoots] ifNotNil: [testRoots , (Array with: wld)].
+ xRoots do:
+ [:obj |
+ "root is a project"
+
+ obj isMorph
+ ifTrue:
+ [obj allMorphs do:
+ [:mm |
+ inSeg add: mm.
+ mm player ifNotNil: [inSeg add: mm player]].
+ obj isWorldMorph ifTrue: [inSeg add: obj presenter]]].
+ scriptEditors := IdentitySet new.
+ inSeg do:
+ [:obj |
+ obj isPlayerLike
+ ifTrue:
+ [scriptEditors addAll: (obj class tileScriptNames
+ collect: [:nn | obj scriptEditorFor: nn])]].
+ scriptEditors do: [:se | inSeg addAll: se allMorphs].
+ testRoots do: [:each | inSeg remove: each ifAbsent: []].
+ "want them to be pointed at from outside"
+ pointIn := IdentitySet new: 400.
+ inSeg do: [:ob | pointIn addAll: (Utilities pointersTo: ob except: inSeg)].
+ testRoots do: [:each | pointIn remove: each ifAbsent: []].
+ pointIn remove: inSeg array ifAbsent: [].
+ pointIn remove: pointIn array ifAbsent: [].
+ inSeg do:
+ [:obj |
+ obj isMorph
+ ifTrue:
+ [pointIn remove: (obj instVarAt: 3)
+ ifAbsent:
+ ["submorphs"
+
+ ].
+ "associations in extension"
+ pointIn remove: obj extension ifAbsent: [].
+ obj extension ifNotNil:
+ [obj extension otherProperties ifNotNil:
+ [obj extension otherProperties associationsDo:
+ [:ass |
+ pointIn remove: ass ifAbsent: []
+ "*** and extension actorState"
+ "*** and ActorState instantiatedUserScriptsDictionary ScriptInstantiations"]]]].
+ obj isPlayerLike
+ ifTrue: [obj class scripts values do: [:us | pointIn remove: us ifAbsent: []]]].
+ "*** presenter playerlist"
+ self halt: 'Examine local variables pointIn and inSeg'.
+ ^pointIn!
Item was added:
+ ----- Method: NativeImageSegment>>rootsIncludingPlayers (in category '*Etoys-read/write segment') -----
+ rootsIncludingPlayers
+ "Return a new roots array with more objects. (Caller should store into rootArray.) Player (non-systemDefined) gets its class and metaclass put into the Roots array. Then ask for the segment again."
+
+ | extras havePresenter players morphs existing |
+ userRootCnt ifNil: [userRootCnt := arrayOfRoots size].
+ extras := OrderedCollection new.
+ arrayOfRoots do: [:root |
+ (root isKindOf: Presenter) ifTrue: [havePresenter := root].
+ (root isKindOf: PasteUpMorph) ifTrue: [
+ root isWorldMorph ifTrue: [havePresenter := root presenter]].
+ (root isKindOf: Project) ifTrue: [havePresenter := root world presenter]].
+ havePresenter ifNotNil: [
+ havePresenter flushPlayerListCache. "old and outside guys"
+ morphs := IdentitySet new: 400.
+ havePresenter associatedMorph allMorphsAndBookPagesInto: morphs.
+ players := (morphs select: [:m | m player ~~ nil]
+ thenCollect: [:m | m player]) asArray.
+ players := players select: [:ap | (arrayOfRoots includes: ap class) not
+ & (ap class isSystemDefined not)].
+ extras addAll: (players collect: [:each | each class]).
+ extras addAll: (players collect: [:each | each class class]).
+ extras addAll: morphs. "Make then ALL roots!!"
+ ].
+ existing := arrayOfRoots asIdentitySet.
+ extras := extras reject: [ :each | existing includes: each].
+ extras isEmpty ifTrue: [^ nil]. "no change"
+
+ havePresenter := players := morphs := nil.
+ ^ arrayOfRoots, extras "will contain multiples of some, but reduced later"!
Item was added:
+ ----- Method: NativeImageSegment>>savePlayerReferences: (in category '*Etoys-read/write segment') -----
+ savePlayerReferences: dictOfAllObjects
+ | save world |
+ "Save our associations we own in the shared References table. They will be installed when the segment is imported."
+
+ save := OrderedCollection new.
+ References associationsDo: [:assoc |
+ (dictOfAllObjects includesKey: assoc) ifTrue: [save add: assoc]].
+ 1 to: 5 do: [:ii | ((arrayOfRoots at: ii) respondsTo: #isCurrentProject) ifTrue: [
+ world := (arrayOfRoots at: ii) world]].
+ world setProperty: #References toValue: save.
+ "assume it is not refed from outside and will be traced"!
Item was added:
+ ----- Method: NumberType>>initialValueForASlotFor: (in category '*Etoys-initial value') -----
+ initialValueForASlotFor: aPlayer
+ "Answer the value to give initially to a newly created slot of the given type in the given player"
+
+ ^ (1 to: 9) atRandom!
Item was added:
+ ----- Method: Object>>adaptedToWorld: (in category '*Etoys-scripting') -----
+ adaptedToWorld: aWorld
+ "If I refer to a world or a hand, return the corresponding items in the new world."
+ ^self!
Item was added:
+ ----- Method: Object>>beViewed (in category '*Etoys-testing') -----
+ beViewed
+ "Open up a viewer on the receiver. The Presenter is invited to decide just how to present this viewer"
+
+ self uniqueNameForReference. "So the viewer will have something nice to refer to"
+ self presenter viewObject: self!
Item was added:
+ ----- Method: Object>>belongsToUniClass (in category '*Etoys-testing') -----
+ belongsToUniClass
+ "Answer whether the receiver belongs to a uniclass. For the moment (this is not entirely satisfactory) this is precisely equated with the classname ending in a digit"
+
+ ^ self class isUniClass!
Item was added:
+ ----- Method: Object>>costumes (in category '*Etoys-testing') -----
+ costumes
+ "Answer a list of costumes associated with the receiver. The appearance of this method in class Object serves only as a backstop, probably only transitionally"
+
+ ^ nil!
Item was added:
+ ----- Method: Object>>defaultFloatPrecisionFor: (in category '*Etoys-scripting') -----
+ defaultFloatPrecisionFor: aGetSelector
+ "Answer a number indicating the default float precision to be used in a numeric readout for which the receiver is the model."
+
+ ^ 1!
Item was added:
+ ----- Method: Object>>evaluateUnloggedForSelf: (in category '*Etoys-scripting') -----
+ evaluateUnloggedForSelf: aCodeString
+
+ ^Compiler evaluate:
+ aCodeString
+ for: self!
Item was added:
+ ----- Method: Object>>isPlayer (in category '*Etoys-testing') -----
+ isPlayer
+ ^false!
Item was added:
+ ----- Method: Object>>isPrimitiveCostume (in category '*Etoys-testing') -----
+ isPrimitiveCostume
+ "True for primitive costumes in Tweak. Added here because a Tweak override in DisplayScanner was merged into trunk for maintainability"
+ ^false!
Item was added:
+ ----- Method: Object>>isScriptEditorMorph (in category '*Etoys-testing') -----
+ isScriptEditorMorph
+ ^false!
Item was added:
+ ----- Method: Object>>isUniversalTiles (in category '*Etoys-macpal') -----
+ isUniversalTiles
+ "Return true if I (my world) uses universal tiles. This message can be called in places where the current World is not known, such as when writing out a project. For more information about the project-writing subtlety addressed by this protocol, kindly contact Ted Kaehler."
+
+ ^ Preferences universalTiles!
Item was added:
+ ----- Method: Object>>methodInterfacesForCategory:inVocabulary:limitClass: (in category '*Etoys-scripting') -----
+ methodInterfacesForCategory: aCategorySymbol inVocabulary: aVocabulary limitClass: aLimitClass
+ "Return a list of methodInterfaces for the receiver in the given category, given a vocabulary. aCategorySymbol is the inherent category symbol, not necessarily the wording as expressed in the vocabulary."
+
+ | categorySymbol |
+ categorySymbol := aCategorySymbol asSymbol.
+
+ (categorySymbol == ScriptingSystem nameForInstanceVariablesCategory) ifTrue: [
+ "user-defined instance variables"
+ ^ self methodInterfacesForInstanceVariablesCategoryIn: aVocabulary].
+ (categorySymbol == ScriptingSystem nameForScriptsCategory) ifTrue: [
+ "user-defined scripts"
+ ^ self methodInterfacesForScriptsCategoryIn: aVocabulary].
+ "all others"
+ ^ self usableMethodInterfacesIn: (aVocabulary methodInterfacesInCategory: categorySymbol
+ forInstance: self
+ ofClass: self class
+ limitClass: aLimitClass)
+ !
Item was added:
+ ----- Method: Object>>methodInterfacesForInstanceVariablesCategoryIn: (in category '*Etoys-scripting') -----
+ methodInterfacesForInstanceVariablesCategoryIn: aVocabulary
+ "Return a collection of methodInterfaces for the instance-variables category. The vocabulary parameter, at present anyway, is not used. And for non-players, the method is at present vacuous in any case"
+
+ ^ OrderedCollection new!
Item was added:
+ ----- Method: Object>>methodInterfacesForScriptsCategoryIn: (in category '*Etoys-scripting') -----
+ methodInterfacesForScriptsCategoryIn: aVocabulary
+ "Answer a list of method interfaces for the category #scripts, as seen in a viewer or other tool. The vocabulary argument is not presently used. Also, at present, only Players really do anyting interesting here."
+
+ ^ OrderedCollection new!
Item was added:
+ ----- Method: Object>>presenter (in category '*Etoys-accessing') -----
+ presenter
+ "Answer the presenter object associated with the receiver. For morphs, there is in effect a clear containment hierarchy of presenters (accessed via their association with PasteUpMorphs); for arbitrary objects the hook is simply via the current world, at least at present."
+
+ ^ self currentWorld presenter!
Item was added:
+ ----- Method: Object>>renameInternal: (in category '*Etoys-testing') -----
+ renameInternal: newName
+ "Change the internal name (because of a conflict) but leave the external name unchanged. Change Player class name, but do not change the names that appear in tiles. Any object that might be pointed to in the References dictionary might get this message sent to it upon reload"
+
+ ^ nil "caller will renameTo:. new name may be different"!
Item was added:
+ ----- Method: Object>>scriptPerformer (in category '*Etoys-macpal') -----
+ scriptPerformer
+
+ ^ self
+ !
Item was added:
+ ----- Method: Object>>selfWrittenAsIll (in category '*Etoys-scripting') -----
+ selfWrittenAsIll
+
+ ^self!
Item was added:
+ ----- Method: Object>>selfWrittenAsIm (in category '*Etoys-scripting') -----
+ selfWrittenAsIm
+
+ ^self!
Item was added:
+ ----- Method: Object>>selfWrittenAsMe (in category '*Etoys-scripting') -----
+ selfWrittenAsMe
+
+ ^self!
Item was added:
+ ----- Method: Object>>selfWrittenAsMy (in category '*Etoys-scripting') -----
+ selfWrittenAsMy
+
+ ^self!
Item was added:
+ ----- Method: Object>>selfWrittenAsThis (in category '*Etoys-scripting') -----
+ selfWrittenAsThis
+
+ ^self!
Item was added:
+ ----- Method: Object>>slotInfo (in category '*Etoys-macpal') -----
+ slotInfo
+ "Answer a list of slot-information objects. Initally only provides useful info for players"
+
+ ^ Dictionary new!
Item was added:
+ ----- Method: Object>>veryDeepCopySibling (in category '*Etoys-copying') -----
+ veryDeepCopySibling
+ "Do a complete tree copy using a dictionary. Substitute a clone of oldPlayer for the root. Normally, a Player or non systemDefined object would have a new class. We do not want one this time. An object in the tree twice, is only copied once. All references to the object in the copy of the tree will point to the new copy."
+
+ | copier new |
+ copier := DeepCopier new: self initialDeepCopierSize.
+ copier newUniClasses: false.
+ new := self veryDeepCopyWith: copier.
+ copier mapUniClasses.
+ copier references associationsDo: [:assoc |
+ assoc value veryDeepFixupWith: copier].
+ copier fixDependents.
+ ^ new!
Item was added:
+ ----- Method: ObjectExplorer>>viewerForValue (in category '*Etoys-menus - actions') -----
+ viewerForValue
+
+ self object beViewed.!
Item was added:
+ ----- Method: ObjectlandMorph>>createEtoysProject (in category '*Etoys-projects') -----
+ createEtoysProject
+
+ | etoysExample |
+ self flag: #forLater. "If we could enable etoysMode just for this project, this would be great"
+
+ etoysExample := Player extraExampleCar.
+ ^ self
+ createProjectNamed: 'Fun with Etoys' translated
+ colorRamp: {
+ 1 -> Color plum darker.
+ 0 -> Color lightMagenta }
+ morphSpecs: {
+ (0.46 @ 0.6 exactCenter: 0.25 @ 0.6) -> [HelpBrowser new
+ rootTopic: SqueakTutorialsEToys;
+ showTopicNamed: #raceCar;
+ yourself].
+ (0.3 @ 0.4 exactCenter: 0.7 @ 0.45) -> [etoysExample first addFlexShell]. "arena"
+ 0.3 @ 0.2 -> [AllScriptsTool newStandAlone].
+ 0.7 @ 0.83 -> [etoysExample second] "script editor" }
+ initializeWorld: [:world |
+ self class liftUpSubmorphsOf: etoysExample first.
+ etoysExample first owner delete.
+ world stopRunningAll]!
Item was added:
+ ----- Method: PackageDependencyTest>>testEtoys (in category '*Etoys-tests') -----
+ testEtoys
+ "Etoys clean-up is to be done for the after 5.2 release --pre"
+
+ self testPackage: #EToys dependsExactlyOn: #(
+ Balloon
+ #'Chronology-Core'
+ Collections
+ Compiler
+ Compression
+ Files
+ Graphics
+ Kernel
+ Morphic
+ MorphicExtras
+ Multilingual
+ Network
+ Protocols
+ SUnit
+ System
+ #'ToolBuilder-Kernel'
+ Tools
+ ).!
Item was added:
+ ImageMorph subclass: #PaintInvokingMorph
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-MorphicExtras-Widgets'!
+
+ !PaintInvokingMorph commentStamp: '<historical>' prior: 0!
+ When this is dropped inside some appropriate place, then painting is invoked for that place.!
Item was added:
+ ----- Method: PaintInvokingMorph class>>authoringPrototype (in category '*Etoys-scripting') -----
+ authoringPrototype
+ ^ self new image: (ScriptingSystem formAtKey: 'Painting'); markAsPartsDonor; setBalloonText: 'drop this into any playfield or book page to make a new painting there'; yourself!
Item was added:
+ ----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category '*Etoys-parts bin') -----
+ descriptionForPartsBin
+ ^ self partName: 'Paint' translatedNoop
+ categories: {'Graphics' translatedNoop}
+ documentation: 'Drop this icon to start painting a new object.' translatedNoop!
Item was added:
+ ----- Method: PaintInvokingMorph class>>initialize (in category '*Etoys-class initialization') -----
+ initialize
+
+ self registerInFlapsRegistry.!
Item was added:
+ ----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category '*Etoys-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}
+ forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
+ forFlapNamed: 'Widgets'.
+ cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}
+ forFlapNamed: 'Scripting']!
Item was added:
+ ----- Method: PaintInvokingMorph class>>unload (in category '*Etoys-class initialization') -----
+ unload
+ "Unload the receiver from global registries"
+
+ self environment at: #Flaps ifPresent: [:cl |
+ cl unregisterQuadsWithReceiver: self] !
Item was added:
+ ----- Method: PaintInvokingMorph>>initialize (in category '*Etoys-initialization') -----
+ initialize
+ super initialize.
+ self image: (ScriptingSystem formAtKey: 'Painting')!
Item was added:
+ ----- Method: PaintInvokingMorph>>initializeToStandAlone (in category '*Etoys-parts bin') -----
+ initializeToStandAlone
+ super initializeToStandAlone.
+ self image: (ScriptingSystem formAtKey: 'Painting')!
Item was added:
+ ----- Method: PaintInvokingMorph>>justDroppedInto:event: (in category '*Etoys-dropping/grabbing') -----
+ justDroppedInto: aPasteUpMorph event: anEvent
+ "This message is sent to a dropped morph after it has been dropped on--and been accepted by--a drop-sensitive morph"
+ aPasteUpMorph isPartsBin ifFalse:[
+ self removeHalo.
+ self delete.
+ ^aPasteUpMorph makeNewDrawing: anEvent].
+ ^super justDroppedInto: aPasteUpMorph event: anEvent!
Item was added:
+ ----- Method: PaintInvokingMorph>>wantsToBeDroppedInto: (in category '*Etoys-dropping/grabbing') -----
+ wantsToBeDroppedInto: aMorph
+ "Only into PasteUps that are not part bins"
+ ^aMorph isPlayfieldLike!
Item was added:
+ ----- Method: ParagraphEditor class>>yellowButtonExpertMenu (in category '*Etoys-class initialization') -----
+ yellowButtonExpertMenu
+
+ ^ SelectionMenu fromArray: StringHolder yellowButtonMenuItems.
+ !
Item was added:
+ ----- Method: ParagraphEditor class>>yellowButtonNoviceMenu (in category '*Etoys-class initialization') -----
+ yellowButtonNoviceMenu
+
+ ^ MenuMorph fromArray: {
+ {'set font... (k)' translated. #offerFontMenu}.
+ {'set style... (K)' translated. #changeStyle}.
+ {'set alignment... (u)' translated. #chooseAlignment}.
+ #-.
+ {'make project link (P)' translated. #makeProjectLink}.
+ #-.
+ {'find...(f)' translated. #find}.
+ {'find again (g)' translated. #findAgain}.
+ {'set search string (h)' translated. #setSearchString}.
+ #-.
+ {'do again (j)' translated. #again}.
+ {'undo (z)' translated. #undo}.
+ #-.
+ {'copy (c)' translated. #copySelection}.
+ {'cut (x)' translated. #cut}.
+ {'paste (v)' translated. #paste}.
+ {'paste...' translated. #pasteRecent}.
+ #-.
+ {'accept (s)' translated. #accept}.
+ {'cancel (l)' translated. #cancel}.
+ }.
+ !
Item was added:
+ ----- Method: PartsBin>>morphToDropFrom: (in category '*Etoys-dropping/grabbing') -----
+ morphToDropFrom: aMorph
+ "Answer the morph to drop if the user attempts to drop aMorph"
+
+ | aButton |
+ ((aMorph isKindOf: IconicButton) and: [aMorph actionSelector == #launchPartVia:label:])
+ ifTrue: [^ aMorph].
+ "The above handles the unusual case of a button that's already set up in a manner suitable for living in PartsBin; the archetypal example is the attempt to reposition an object within a partsflap by dragging it via the black halo handle."
+
+ aButton := IconicButton new.
+ aButton color: self color;
+ initializeToShow: aMorph withLabel: aMorph externalName andSend: #veryDeepCopy to: aMorph veryDeepCopy.
+ ^ aButton!
Item was added:
+ ----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*Etoys-*MorphicExtras-parts bin') -----
+ supplementaryPartsDescriptions
+ ^ {DescriptionForPartsBin
+ formalName: 'Holder' translatedNoop
+ categoryList: {'Scripting' translatedNoop}
+ documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop
+ globalReceiverSymbol: #ScriptingSystem
+ nativitySelector: #prototypicalHolder}!
Item was added:
+ ----- Method: PasteUpMorph>>abandonCostumeHistory (in category '*Etoys-misc') -----
+ abandonCostumeHistory
+ self allMorphsDo:
+ [:m | m player ifNotNil: [m player forgetOtherCostumes]]!
Item was added:
+ ----- Method: PasteUpMorph>>abandonVocabularyPreference (in category '*Etoys-*Protocols') -----
+ abandonVocabularyPreference
+ "Remove any memory of a preferred vocabulary in the project"
+
+ | standardViewers aVocabulary |
+ self removeProperty: #currentVocabularySymbol.
+
+ standardViewers := (self submorphsSatisfying: [:m | m isKindOf: ViewerFlapTab]) collect:
+ [:m | m referent firstSubmorph].
+ aVocabulary := Vocabulary vocabularyNamed: #eToy.
+ standardViewers do:
+ [:m | ((m valueOfProperty: #currentVocabularySymbol ifAbsent: [nil]) == #Vector) ifTrue:
+ [m switchToVocabulary: aVocabulary]]
+
+ "ActiveWorld abandonVocabularyPreference"!
Item was added:
+ ----- Method: PasteUpMorph>>adaptedToWorld: (in category '*Etoys-initialization') -----
+ adaptedToWorld: aWorld
+ "If I refer to a world or a hand, return the corresponding items in the new world."
+ self isWorldMorph ifTrue:[^aWorld].!
Item was added:
+ ----- Method: PasteUpMorph>>addPenMenuItems:hand: (in category '*Etoys-menu & halo') -----
+ addPenMenuItems: menu hand: aHandMorph
+ "Add a pen-trails-within submenu to the given menu"
+
+ menu add: 'pen trails...' translated target: self selector: #putUpPenTrailsSubmenu.
+ menu balloonTextForLastItem: 'its governing pen trails drawn within' translated!
Item was added:
+ ----- Method: PasteUpMorph>>addPenTrailsMenuItemsTo: (in category '*Etoys-menu & halo') -----
+ addPenTrailsMenuItemsTo: aMenu
+ "Add items relating to pen trails to aMenu"
+
+ | oldTarget |
+ oldTarget := aMenu defaultTarget.
+ aMenu defaultTarget: self.
+ aMenu add: 'clear pen trails' translated action: #clearTurtleTrails.
+ aMenu addLine.
+ aMenu add: 'all pens up' translated action: #liftAllPens.
+ aMenu add: 'all pens down' translated action: #lowerAllPens.
+ aMenu addLine.
+ aMenu add: 'all pens show lines' translated action: #linesForAllPens.
+ aMenu add: 'all pens show arrowheads' translated action: #arrowsForAllPens.
+ aMenu add: 'all pens show arrows' translated action: #linesAndArrowsForAllPens.
+ aMenu add: 'all pens show dots' translated action: #dotsForAllPens.
+ aMenu addLine.
+ aMenu addUpdating: #batchPenTrailsString action: #toggleBatchPenTrails.
+ aMenu balloonTextForLastItem: 'if true, detailed movement of pens between display updates is ignored. Thus multiple line segments drawn within a script may not be seen individually.' translated.
+
+ aMenu defaultTarget: oldTarget!
Item was added:
+ ----- Method: PasteUpMorph>>addPlayfieldMenuItems:hand: (in category '*Etoys-menu & halo') -----
+ addPlayfieldMenuItems: menu hand: aHandMorph
+ "Add playfield-related items to the menu"
+
+ menu add: 'playfield options...' translated target: self action: #presentPlayfieldMenu.
+ (self hasProperty: #donorTextMorph) ifTrue:
+ [menu add: 'send contents back to donor' translated action: #sendTextContentsBackToDonor]!
Item was added:
+ ----- Method: PasteUpMorph>>addStackMenuItems:hand: (in category '*Etoys-menu & halo') -----
+ addStackMenuItems: menu hand: aHandMorph
+ "Add appropriate stack-related items to the given menu"
+
+ self isStackBackground
+ ifTrue:
+ [menu add: 'card & stack...' target: self action: #presentCardAndStackMenu]!
Item was added:
+ ----- Method: PasteUpMorph>>allScriptEditors (in category '*Etoys-misc') -----
+ allScriptEditors
+ ^ self allMorphs select:
+ [:s | s isScriptEditorMorph]!
Item was added:
+ ----- Method: PasteUpMorph>>allScriptors (in category '*Etoys-misc') -----
+ allScriptors
+ "Answer a list of all active scriptors running on behalf of the receiver. This is a hook used in past demos and with a future life which however presently is vacuous"
+
+ ^ #()
+ "
+ ^ self allMorphs select: [:m | m isKindOf: Scriptor]"!
Item was added:
+ ----- Method: PasteUpMorph>>allTileScriptingElements (in category '*Etoys-scripting') -----
+ allTileScriptingElements
+ "Answer a list of all the morphs that pertain to tile-scripting. A sledge-hammer"
+
+ | all morphs |
+ morphs := IdentitySet new: 400.
+ self allMorphsAndBookPagesInto: morphs.
+ all := morphs select: [:s | s isTileScriptingElement].
+ " self closedViewerFlapTabs do:
+ [:aTab | all addAll: aTab referent allTileScriptingElements].
+ "
+ ^ all asOrderedCollection!
Item was added:
+ ----- Method: PasteUpMorph>>assureNotPaintingEvent: (in category '*Etoys-world state') -----
+ assureNotPaintingEvent: evt
+ "If painting is already underway
+ in the receiver, put up an informer to that effect and evalute aBlock"
+ | editor |
+ (editor := self sketchEditorOrNil) ifNotNil:[
+ editor save: evt.
+ Cursor normal show.
+ ].!
Item was added:
+ ----- Method: PasteUpMorph>>automaticPhraseExpansion (in category '*Etoys-dropping/grabbing') -----
+ automaticPhraseExpansion
+ ^ self hasProperty: #automaticPhraseExpansion!
Item was added:
+ ----- Method: PasteUpMorph>>automaticViewing (in category '*Etoys-e-toy support') -----
+ automaticViewing
+ ^ self hasProperty: #automaticViewing!
Item was added:
+ ----- Method: PasteUpMorph>>behaveLikeHolder (in category '*Etoys-options') -----
+ behaveLikeHolder
+
+ self vResizeToFit: true; autoLineLayout: true; indicateCursor: true!
Item was added:
+ ----- Method: PasteUpMorph>>behaveLikeHolder: (in category '*Etoys-options') -----
+ behaveLikeHolder: aBoolean
+ "Change the receiver's viewing properties such that they conform to what we commonly call a Holder, viz: resize-to-fit, do auto-line-layout, and indicate the 'cursor'"
+
+ self vResizeToFit: aBoolean; autoLineLayout: aBoolean; indicateCursor: aBoolean
+ !
Item was added:
+ ----- Method: PasteUpMorph>>behavingLikeAHolder (in category '*Etoys-options') -----
+ behavingLikeAHolder
+ "Answer whether the receiver is currently behaving like a Holder"
+
+ ^ self resizeToFit and: [self indicateCursor and: [self autoLineLayout]]!
Item was added:
+ ----- Method: PasteUpMorph>>browseAllScriptsTextually (in category '*Etoys-world menu') -----
+ browseAllScriptsTextually
+ "Put up a browser showing all scripts in the project textually"
+
+ self presenter browseAllScriptsTextually
+
+ "ActiveWorld browseAllScriptsTextually"!
Item was added:
+ ----- Method: PasteUpMorph>>buildDebugMenu: (in category '*Etoys-menu & halo') -----
+ buildDebugMenu: aHandMorph
+ | aMenu |
+ aMenu := super buildDebugMenu: aHandMorph.
+ aMenu add: 'abandon costume history' translated target: self action: #abandonCostumeHistory.
+ ^ aMenu!
Item was added:
+ ----- Method: PasteUpMorph>>closedViewerFlapTabs (in category '*Etoys-misc') -----
+ closedViewerFlapTabs
+ "Answer all the viewer flap tabs in receiver that are closed"
+
+ ^ self submorphs select:
+ [:m | (m isKindOf: ViewerFlapTab) and: [m flapShowing not]]!
Item was added:
+ ----- Method: PasteUpMorph>>couldMakeSibling (in category '*Etoys-classification') -----
+ couldMakeSibling
+
+ ^ self isWorldMorph not!
Item was added:
+ ----- Method: PasteUpMorph>>cursor (in category '*Etoys-e-toy support') -----
+ cursor
+ ^ cursor
+ !
Item was added:
+ ----- Method: PasteUpMorph>>cursor: (in category '*Etoys-e-toy support') -----
+ cursor: aNumber
+ "for backward compatibility"
+
+ self cursorWrapped: aNumber!
Item was added:
+ ----- Method: PasteUpMorph>>cursorWrapped: (in category '*Etoys-cursor') -----
+ cursorWrapped: aNumber
+ "Set the cursor to the given number, modulo the number of items I
+ contain. Fractional cursor values are allowed."
+ | oldRect newRect offset |
+ cursor = aNumber
+ ifTrue: [^ self].
+ self hasSubmorphs
+ ifFalse: [cursor := 1.
+ ^ self].
+ oldRect := self selectedRect.
+ offset := (self asNumber: aNumber) - 1 \\ submorphs size.
+ cursor := offset + 1.
+ newRect := self selectedRect.
+ self indicateCursor
+ ifTrue: [self invalidRect: oldRect;
+ invalidRect: newRect]!
Item was added:
+ ----- Method: PasteUpMorph>>detachableScriptingSpace (in category '*Etoys-world menu') -----
+ detachableScriptingSpace
+ ScriptingSystem newScriptingSpace openInWorld: self!
Item was added:
+ ----- Method: PasteUpMorph>>drawOn: (in category '*Etoys-drawing') -----
+ drawOn: aCanvas
+ "Draw in order:
+ - background color
+ - Update and draw the turtleTrails form. See the comment in updateTrailsForm.
+ - cursor box if any
+
+ Later (in drawSubmorphsOn:) I will skip drawing the background sketch."
+
+ "draw background fill"
+ super drawOn: aCanvas.
+
+ "draw turtle trails"
+ (lastTurtlePositions isNil or: [lastTurtlePositions isEmpty]) ifFalse:[
+ self updateTrailsForm.
+ ].
+ turtleTrailsForm
+ ifNotNil: [aCanvas paintImage: turtleTrailsForm at: self position].
+
+ "draw cursor"
+ (submorphs notEmpty and: [self indicateCursor])
+ ifTrue:
+ [aCanvas
+ frameRectangle: self selectedRect
+ width: 2
+ color: Color black]!
Item was added:
+ ----- Method: PasteUpMorph>>dumpPresenter (in category '*Etoys-accessing') -----
+ dumpPresenter
+ "Dump my current presenter"
+ presenter := nil.!
Item was added:
+ ----- Method: PasteUpMorph>>hideViewerFlaps (in category '*Etoys-misc') -----
+ hideViewerFlaps
+ self flapTabs do:[:aTab |
+ (aTab isKindOf: ViewerFlapTab) ifTrue:[aTab hideFlap]]!
Item was added:
+ ----- Method: PasteUpMorph>>hideViewerFlapsOtherThanFor: (in category '*Etoys-misc') -----
+ hideViewerFlapsOtherThanFor: aPlayer
+ self flapTabs do:
+ [:aTab | (aTab isKindOf: ViewerFlapTab)
+ ifTrue:
+ [aTab scriptedPlayer == aPlayer
+ ifFalse:
+ [aTab hideFlap]]]!
Item was added:
+ ----- Method: PasteUpMorph>>indicateCursor (in category '*Etoys-options') -----
+ indicateCursor
+ ^ indicateCursor == true!
Item was added:
+ ----- Method: PasteUpMorph>>indicateCursor: (in category '*Etoys-options') -----
+ indicateCursor: aBoolean
+ indicateCursor := aBoolean.
+ self changed.!
Item was added:
+ ----- Method: PasteUpMorph>>indicateCursorString (in category '*Etoys-menu & halo') -----
+ indicateCursorString
+ "Answer the string to be shown in a menu to represent the
+ whether-to-indicate-cursor status"
+ ^ (self indicateCursor
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'indicate cursor' translated!
Item was added:
+ ----- Method: PasteUpMorph>>installVectorVocabulary (in category '*Etoys-*Protocols') -----
+ installVectorVocabulary
+ "Install the experimental Vector vocabulary as the default for the current project"
+
+ | standardViewers aVocabulary |
+ self setProperty: #currentVocabularySymbol toValue: #Vector.
+ standardViewers := (self submorphsSatisfying: [:m | m isKindOf: ViewerFlapTab]) collect:
+ [:m | m referent firstSubmorph].
+ aVocabulary := Vocabulary vocabularyNamed: #Vector.
+ standardViewers do: [:m | m switchToVocabulary: aVocabulary]!
Item was added:
+ ----- Method: PasteUpMorph>>isPlayfieldLike (in category '*Etoys-classification') -----
+ isPlayfieldLike
+ ^ true!
Item was added:
+ ----- Method: PasteUpMorph>>makeNewDrawing: (in category '*Etoys-world menu') -----
+ makeNewDrawing: evt
+ ^self makeNewDrawing: evt at: evt position!
Item was added:
+ ----- Method: PasteUpMorph>>makeNewDrawing:at: (in category '*Etoys-world menu') -----
+ makeNewDrawing: evt at: aPoint
+ "make a new drawing, triggered by the given event, with the painting area centered around the given point"
+
+ | w newSketch newPlayer sketchEditor aPalette rect aPaintBox aPaintTab aWorld |
+ w := self world.
+ w assureNotPaintingElse: [^ self].
+ rect := self paintingBoundsAround: aPoint.
+ aPalette := self standardPalette.
+ aPalette ifNotNil: [aPalette showNoPalette; layoutChanged].
+ w prepareToPaint.
+
+ newSketch := self drawingClass new.
+ Smalltalk at: #UnscriptedPlayer ifPresent:[:aClass|
+ newSketch player: (newPlayer := aClass newUserInstance).
+ newPlayer costume: newSketch.
+ ].
+ newSketch nominalForm: (Form extent: rect extent depth: w assuredCanvas depth).
+ newSketch bounds: rect.
+ sketchEditor := SketchEditorMorph new.
+ w addMorphFront: sketchEditor.
+ sketchEditor initializeFor: newSketch inBounds: rect pasteUpMorph: self.
+ sketchEditor
+ afterNewPicDo: [:aForm :aRect | | tfx whereToPresent |
+ whereToPresent := self presenter.
+ newSketch form: aForm.
+ tfx := self transformFrom: w.
+ newSketch position: (tfx globalPointToLocal: aRect origin).
+ newSketch rotationStyle: sketchEditor rotationStyle.
+ newSketch forwardDirection: sketchEditor forwardDirection.
+
+ newPlayer ifNotNil:[newPlayer setHeading: sketchEditor forwardDirection].
+ (aPaintTab := (aWorld := self world) paintingFlapTab)
+ ifNotNil:[aPaintTab hideFlap]
+ ifNil:[(aPaintBox := aWorld paintBox) ifNotNil:[aPaintBox delete]].
+
+ self addMorphFront: (newPlayer ifNil:[newSketch] ifNotNil:[newPlayer costume]).
+ w startSteppingSubmorphsOf: newSketch.
+ whereToPresent drawingJustCompleted: newSketch]
+ ifNoBits:[
+ (aPaintTab := (aWorld := self world) paintingFlapTab)
+ ifNotNil:[aPaintTab hideFlap]
+ ifNil:[(aPaintBox := aWorld paintBox) ifNotNil:[aPaintBox delete]].
+ aPalette ifNotNil: [aPalette showNoPalette].]!
Item was added:
+ ----- Method: PasteUpMorph>>makeNewDrawingWithin (in category '*Etoys-painting') -----
+ makeNewDrawingWithin
+ "Start a painting session in my interior which will result in a new SketchMorph being created as one of my submorphs"
+
+ | evt |
+ evt := MouseEvent new setType: nil position: self center buttons: 0 hand: self world activeHand.
+ self makeNewDrawing: evt!
Item was added:
+ ----- Method: PasteUpMorph>>makeVectorUseConformToPreference (in category '*Etoys-*Protocols') -----
+ makeVectorUseConformToPreference
+ "Make certain that the use of vectors in this project conforms to the current preference setting."
+
+ | prefValue currentValue |
+ prefValue := Preferences useVectorVocabulary.
+ currentValue := self currentlyUsingVectorVocabulary.
+ prefValue ~~ currentValue ifTrue:
+ [currentValue
+ ifTrue:
+ [self abandonVocabularyPreference]
+ ifFalse:
+ [self installVectorVocabulary]]!
Item was added:
+ ----- Method: PasteUpMorph>>mouseOverHalosString (in category '*Etoys-menu & halo') -----
+ mouseOverHalosString
+ "Answer the string to be shown in a menu to represent the
+ mouse-over-halos status"
+ ^ (self wantsMouseOverHalos
+ ifTrue: ['<on>']
+ ifFalse: ['<off>'])
+ , 'mouse-over halos' translated!
Item was added:
+ ----- Method: PasteUpMorph>>newDrawingFromMenu: (in category '*Etoys-world menu') -----
+ newDrawingFromMenu: evt
+ self assureNotPaintingElse: [^ self].
+ evt hand attachMorph: PaintInvokingMorph new markAsPartsDonor!
Item was added:
+ ----- Method: PasteUpMorph>>numberAtCursor (in category '*Etoys-cursor') -----
+ numberAtCursor
+ "Answer the number represented by the object at my current cursor position"
+
+ | chosenMorph |
+ submorphs isEmpty ifTrue: [^ 0].
+ chosenMorph := submorphs at: ((cursor truncated max: 1) min: submorphs size).
+ ^ chosenMorph getNumericValue
+ !
Item was added:
+ ----- Method: PasteUpMorph>>openScrapsBook: (in category '*Etoys-world menu') -----
+ openScrapsBook: evt
+ "Open up the Scraps book in the center of the screen"
+
+ evt hand world addMorphCentered: ScrapBook default scrapBook!
Item was added:
+ ----- Method: PasteUpMorph>>paintArea (in category '*Etoys-world state') -----
+ paintArea
+ "What rectangle should the user be allowed to create a new painting in??
+ An area beside the paintBox. Allow playArea to override with its own
+ bounds!! "
+ | playfield paintBoxBounds |
+ playfield := self
+ submorphNamed: 'playfield'
+ ifNone: [].
+ playfield
+ ifNotNil: [^ playfield bounds].
+ paintBoxBounds := self paintBox bounds.
+ self firstHand targetPoint x < paintBoxBounds center x
+ ifTrue: [^ bounds topLeft corner: paintBoxBounds left @ bounds bottom"paint on left side"]
+ ifFalse: [^ paintBoxBounds right @ bounds top corner: bounds bottomRight]!
Item was added:
+ ----- Method: PasteUpMorph>>paintAreaFor: (in category '*Etoys-world state') -----
+ paintAreaFor: aSketchMorph
+ "Answer the area to comprise the onion-skinned canvas for painting/repainting aSketchMorph"
+
+ | itsOwner |
+ ((itsOwner := aSketchMorph owner) notNil and: [itsOwner isPlayfieldLike])
+ ifTrue: [^itsOwner bounds]. "handles every plausible situation"
+ ^self paintArea!
Item was added:
+ ----- Method: PasteUpMorph>>paintingBoundsAround: (in category '*Etoys-painting') -----
+ paintingBoundsAround: aPoint
+ "Return a rectangle for painting centered on the given point. Both the argument point and the result rectangle are in world coordinates."
+
+ | paintExtent maxPaintArea myBnds |
+ paintExtent := self reasonablePaintingExtent.
+ maxPaintArea := paintExtent x * paintExtent y.
+ myBnds := self boundsInWorld.
+ (myBnds area <= maxPaintArea) ifTrue: [^ myBnds].
+ ^ (aPoint - (paintExtent // 2) extent: paintExtent) intersect: myBnds
+ !
Item was added:
+ ----- Method: PasteUpMorph>>paintingFlapTab (in category '*Etoys-flaps') -----
+ paintingFlapTab
+ "If the receiver has a flap which has a paintbox, return it, else return nil"
+ self flapTabs do:
+ [:aTab | aTab referent submorphsDo:
+ [:aMorph | (aMorph isKindOf: PaintBoxMorph) ifTrue: [^ aTab]]].
+ ^ nil!
Item was added:
+ ----- Method: PasteUpMorph>>prepareToBeSaved (in category '*Etoys-misc') -----
+ prepareToBeSaved
+ "Prepare for export via the ReferenceStream mechanism"
+
+ | exportDict soundKeyList players |
+ super prepareToBeSaved.
+ turtlePen := nil.
+ self isWorldMorph
+ ifTrue:
+ [self removeProperty: #scriptsToResume.
+ soundKeyList := Set new.
+ (players := self presenter allExtantPlayers)
+ do: [:aPlayer | aPlayer slotInfo
+ associationsDo: [:assoc | assoc value type == #Sound
+ ifTrue: [soundKeyList
+ add: (aPlayer instVarNamed: assoc key)]]].
+ players
+ do: [:p | p allScriptEditors
+ do: [:e | (e allMorphs
+ select: [:m | m isSoundTile])
+ do: [:aTile | soundKeyList add: aTile literal]]].
+ (self allMorphs
+ select: [:m | m isSoundTile])
+ do: [:aTile | soundKeyList add: aTile literal].
+ soundKeyList removeAllFoundIn: SampledSound universalSoundKeys.
+ soundKeyList
+ removeAllSuchThat: [:aKey | (SampledSound soundLibrary includesKey: aKey) not].
+ soundKeyList isEmpty
+ ifFalse: [exportDict := Dictionary new.
+ soundKeyList
+ do: [:aKey | exportDict
+ add: (SampledSound soundLibrary associationAt: aKey)].
+ self setProperty: #soundAdditions toValue: exportDict]]!
Item was added:
+ ----- Method: PasteUpMorph>>prepareToPaint (in category '*Etoys-painting') -----
+ prepareToPaint
+ "We're about to start painting. Do a few preparations that make the system more responsive."
+
+ ^ self prepareToPaint: Preferences keepTickingWhilePainting not!
Item was added:
+ ----- Method: PasteUpMorph>>prepareToPaint: (in category '*Etoys-painting') -----
+ prepareToPaint: stopRunningScripts
+ "We're about to start painting. Do a few preparations that make the system more responsive."
+
+ self hideViewerFlaps. "make room"
+ stopRunningScripts ifTrue:
+ [self setProperty: #scriptsToResume toValue: self presenter allCurrentlyTickingScriptInstantiations. "We'll restart these when painting is done"
+ self stopRunningAll]. "stop scripts"
+ self abandonAllHalos. "no more halos"!
Item was added:
+ ----- Method: PasteUpMorph>>presentCardAndStackMenu (in category '*Etoys-menu & halo') -----
+ presentCardAndStackMenu
+ "Put up a menu holding card/stack-related options."
+
+ | aMenu |
+ aMenu := MenuMorph new defaultTarget: self.
+ aMenu addStayUpItem.
+ aMenu addTitle: 'card and stack' translated.
+ aMenu add: 'add new card' translated action: #insertCard.
+ aMenu add: 'delete this card' translated action: #deleteCard.
+ aMenu add: 'go to next card' translated action: #goToNextCardInStack.
+ aMenu add: 'go to previous card' translated action: #goToPreviousCardInStack.
+ aMenu addLine.
+ aMenu add: 'show foreground objects' translated action: #showForegroundObjects.
+ aMenu add: 'show background objects' translated action: #showBackgroundObjects.
+ aMenu add: 'show designations' translated action: #showDesignationsOfObjects.
+ aMenu add: 'explain designations' translated action: #explainDesignations.
+ aMenu popUpInWorld: (self world ifNil: [self currentWorld])!
Item was added:
+ ----- Method: PasteUpMorph>>presentPlayfieldMenu (in category '*Etoys-menu & halo') -----
+ presentPlayfieldMenu
+
+ self playfieldOptionsMenu popUpForHand: self activeHand in: self world!
Item was added:
+ ----- Method: PasteUpMorph>>presenter (in category '*Etoys-accessing') -----
+ presenter
+ "Normally only the world will have a presenter, but the architecture supports individual localized presenters as well"
+
+ ^ presenter ifNil:
+ [self isWorldMorph
+ ifTrue: [presenter := Presenter defaultPresenterClass new associatedMorph: self]
+ ifFalse: [super presenter]]!
Item was added:
+ ----- Method: PasteUpMorph>>printScriptSummary (in category '*Etoys-world menu') -----
+ printScriptSummary
+ "Put up a window with summaries of all scripts in the world"
+
+ self presenter reportPlayersAndScripts
+
+ "self currentWorld printScriptSummary"!
Item was added:
+ ----- Method: PasteUpMorph>>putUpPenTrailsSubmenu (in category '*Etoys-menu & halo') -----
+ putUpPenTrailsSubmenu
+ "Put up the pen trails menu"
+
+ | aMenu |
+ aMenu := MenuMorph new defaultTarget: self.
+ aMenu title: 'pen trails' translated.
+ aMenu addStayUpItem.
+ self addPenTrailsMenuItemsTo: aMenu.
+ ^ aMenu popUpInWorld: self!
Item was added:
+ ----- Method: PasteUpMorph>>reasonablePaintingExtent (in category '*Etoys-painting') -----
+ reasonablePaintingExtent
+ ^ Preferences unlimitedPaintArea
+ ifTrue:
+ [3000 @ 3000]
+ ifFalse:
+ [Preferences defaultPaintingExtent]!
Item was added:
+ ----- Method: PasteUpMorph>>rectifyCursor (in category '*Etoys-cursor') -----
+ rectifyCursor
+ cursor := ((cursor truncated max: 1) min: submorphs size)
+ !
Item was added:
+ ----- Method: PasteUpMorph>>referencePlayfield (in category '*Etoys-e-toy support') -----
+ referencePlayfield
+ "Answer a pasteup morph to be used as the reference for cartesian coordinates.
+ Do not get fooled by other morphs (like viewers) that happen to be named 'playfield'."
+
+ ^self isWorldMorph
+ ifTrue: [ self submorphThat: [ :s | (s knownName = 'playfield') and: [ s isPlayfieldLike] ] ifNone: [self]]
+ ifFalse: [ super referencePlayfield ]!
Item was added:
+ ----- Method: PasteUpMorph>>referencePool (in category '*Etoys-objects from disk') -----
+ referencePool
+ ^ self
+ valueOfProperty: #References
+ ifAbsentPut: [WeakValueDictionary new]
+ !
Item was added:
+ ----- Method: PasteUpMorph>>releaseViewers (in category '*Etoys-flaps') -----
+ releaseViewers
+ "In preparation for saving, make the flapTabs release their viewers."
+
+ self flapTabs do: [:ft |
+ (ft respondsTo: #hibernate) ifTrue: [ft hibernate]]!
Item was added:
+ ----- Method: PasteUpMorph>>removeAllViewers (in category '*Etoys-world menu') -----
+ removeAllViewers
+ "Delete all the viewers lined up along my right margin."
+
+ (self submorphs select: [:m | m isKindOf: ViewerFlapTab]) do:
+ [:m |
+ m referent ifNotNil: [m referent delete].
+ m delete.]!
Item was added:
+ ----- Method: PasteUpMorph>>restoreBoundsOfSubmorphs (in category '*Etoys-viewing') -----
+ restoreBoundsOfSubmorphs
+ "restores the saved xy-positions and extents"
+
+ submorphs do:
+ [:aSubmorph |
+ aSubmorph valueOfProperty: #savedExtent ifPresentDo:
+ [:anExtent | aSubmorph extent: anExtent].
+ aSubmorph valueOfProperty: #savedPosition ifPresentDo:
+ [:aPosition | aSubmorph position: aPosition]]!
Item was added:
+ ----- Method: PasteUpMorph>>resumeScriptsPausedByPainting (in category '*Etoys-painting') -----
+ resumeScriptsPausedByPainting
+ "If there were any scripts running when painting was initiated, resume them now"
+
+ | aList |
+ (aList := self valueOfProperty: #scriptsToResume) isEmptyOrNil ifFalse:
+ [aList do:
+ [:aScriptInstantiation |
+ aScriptInstantiation player costume isInWorld ifTrue:
+ [aScriptInstantiation startRunningIfPaused]]].
+ self removeProperty: #scriptsToResume!
Item was added:
+ ----- Method: PasteUpMorph>>roundUpStrays (in category '*Etoys-*MorphicExtras-misc') -----
+ roundUpStrays
+ self submorphs
+ reject: [:each | each wantsToBeTopmost]
+ thenDo: [:each | each goHome].
+ super roundUpStrays!
Item was added:
+ ----- Method: PasteUpMorph>>saveBoundsOfSubmorphs (in category '*Etoys-viewing') -----
+ saveBoundsOfSubmorphs
+ "store the current xy-positions and extents of submorphs for future use"
+
+ submorphs do:
+ [:aSubmorph |
+ aSubmorph setProperty: #savedExtent toValue: aSubmorph extent.
+ aSubmorph setProperty: #savedPosition toValue: aSubmorph position]!
Item was added:
+ ----- Method: PasteUpMorph>>selectedRect (in category '*Etoys-cursor') -----
+ selectedRect
+ "Return a rectangle enclosing the morph at the current cursor. Note that the cursor may be a float and may be out of range, so pick the nearest morph. Assume there is at least one submorph."
+
+ | p |
+ p := cursor asInteger.
+ p := p min: submorphs size.
+ p := p max: 1.
+ ^(submorphs at: p) fullBounds expandBy: 2!
Item was added:
+ ----- Method: PasteUpMorph>>sendTextContentsBackToDonor (in category '*Etoys-menu & halo') -----
+ sendTextContentsBackToDonor
+ "Send my string contents back to the Text Morph from whence I came"
+
+ (self valueOfProperty: #donorTextMorph) ifNotNil:
+ [:aDonor | aDonor setCharacters: self assuredPlayer getStringContents]!
Item was added:
+ ----- Method: PasteUpMorph>>showStatusOfAllScripts (in category '*Etoys-world menu') -----
+ showStatusOfAllScripts
+ "Put up a window that shows, and allows you to change, the status of all scripts"
+
+ self presenter toolToViewScriptInstantiations!
Item was added:
+ ----- Method: PasteUpMorph>>showingListView (in category '*Etoys-viewing') -----
+ showingListView
+ "Answer whether the receiver is currently showing a list view"
+
+ ^ self hasProperty: #showingListView
+ !
Item was added:
+ ----- Method: PasteUpMorph>>sortSubmorphsBy: (in category '*Etoys-viewing') -----
+ sortSubmorphsBy: sortOrderSymbol
+ "Sort the receiver's submorphs by the criterion indicated in the provided symbol"
+ self invalidRect: self fullBounds.
+ submorphs := submorphs sorted: [:a :b | (a perform: sortOrderSymbol) <= (b perform: sortOrderSymbol)].
+ self layoutChanged.!
Item was added:
+ ----- Method: PasteUpMorph>>standardPlayerHit (in category '*Etoys-world state') -----
+ standardPlayerHit
+
+ self playSoundNamed: 'peaks'.
+ !
Item was added:
+ ----- Method: PasteUpMorph>>startRunningAll (in category '*Etoys-misc') -----
+ startRunningAll
+ "Start running all scripted morphs. Triggered by user hitting GO button"
+
+ self presenter flushPlayerListCache. "Inefficient, but makes sure things come right whenever GO hit"
+ self presenter allExtantPlayers do: [:aPlayer | aPlayer costume residesInPartsBin ifFalse: [aPlayer startRunning]].
+
+ self world updateStatusForAllScriptEditors!
Item was added:
+ ----- Method: PasteUpMorph>>stepAll (in category '*Etoys-misc') -----
+ stepAll
+ "tick all the paused player scripts in the receiver"
+
+ self presenter allExtantPlayers do:
+ [:aPlayer |
+ aPlayer startRunning; step; stopRunning]!
Item was added:
+ ----- Method: PasteUpMorph>>stopRunningAll (in category '*Etoys-misc') -----
+ stopRunningAll
+ "Reset all ticking scripts to be paused. Triggered by user hitting STOP button"
+
+ self presenter allExtantPlayers do:
+ [:aPlayer |
+ aPlayer stopRunning].
+
+ self world updateStatusForAllScriptEditors!
Item was added:
+ ----- Method: PasteUpMorph>>toggleAutoLineLayout (in category '*Etoys-options') -----
+ toggleAutoLineLayout
+ "Toggle the auto-line-layout setting"
+
+ self autoLineLayout: self autoLineLayout not.
+ self autoLineLayout ifFalse: [self restoreBoundsOfSubmorphs].!
Item was added:
+ ----- Method: PasteUpMorph>>toggleClassicNavigatorIfAppropriate (in category '*Etoys-world menu') -----
+ toggleClassicNavigatorIfAppropriate
+ "If appropriate, toggle the presence of classic navigator"
+
+ Preferences classicNavigatorEnabled ifTrue: [^ Preferences toggle: #showProjectNavigator]!
Item was added:
+ ----- Method: PasteUpMorph>>toggleMouseOverHalos (in category '*Etoys-options') -----
+ toggleMouseOverHalos
+ wantsMouseOverHalos := self wantsMouseOverHalos not!
Item was added:
+ ----- Method: PasteUpMorph>>triggerClosingScripts (in category '*Etoys-world state') -----
+ triggerClosingScripts
+ "If the receiver has any scripts set to run on closing, run them now"
+ | aPlayer |
+ self allMorphsDo:[ :m|
+ (aPlayer := m player) ifNotNil:
+ [aPlayer runAllClosingScripts]]!
Item was added:
+ ----- Method: PasteUpMorph>>triggerOpeningScripts (in category '*Etoys-world state') -----
+ triggerOpeningScripts
+ "If the receiver has any scripts set to run on opening, run them now"
+ | aPlayer |
+ self allMorphsDo:[ :m|
+ (aPlayer := m player) ifNotNil:
+ [aPlayer runAllOpeningScripts]]!
Item was added:
+ ----- Method: PasteUpMorph>>updateStatusForAllScriptEditors (in category '*Etoys-misc') -----
+ updateStatusForAllScriptEditors
+ self allScriptEditors do: [:anEditor | anEditor updateStatus]!
Item was added:
+ ----- Method: PasteUpMorph>>valueAtCursor (in category '*Etoys-cursor') -----
+ valueAtCursor
+ "Answer the submorph of mine indexed by the value of my 'cursor' slot"
+
+ submorphs isEmpty ifTrue: [^ self presenter standardPlayer costume].
+ ^ (submorphs at: ((cursor truncated max: 1) min: submorphs size)) morphRepresented!
Item was added:
+ ----- Method: PasteUpMorph>>valueAtCursor: (in category '*Etoys-cursor') -----
+ valueAtCursor: aMorph
+ submorphs isEmpty ifTrue: [^ self].
+ self rectifyCursor.
+ self replaceSubmorph: self valueAtCursor by: aMorph!
Item was added:
+ ----- Method: PasteUpMorph>>viewingNormally (in category '*Etoys-viewing') -----
+ viewingNormally
+ "Answer whether the receiver is being viewed normally, viz not in list-view or auto-line-layout"
+
+ ^ (self showingListView or: [self autoLineLayout == true]) not
+ !
Item was added:
+ ----- Method: PasteUpMorph>>wantsHaloFor: (in category '*Etoys-halos and balloon help') -----
+ wantsHaloFor: aSubMorph
+ "Answer whether the receiver wishes for a mouse-over halo to be produced for aSubMorph"
+
+ ^ wantsMouseOverHalos == true and:
+ [self visible and:
+ [isPartsBin ~~ true and:
+ [self dropEnabled and:
+ [aSubMorph renderedMorph isLikelyRecipientForMouseOverHalos]]]]!
Item was added:
+ ----- Method: PasteUpMorph>>wantsMouseOverHalos (in category '*Etoys-options') -----
+ wantsMouseOverHalos
+ ^ wantsMouseOverHalos == true!
Item was added:
+ ----- Method: PasteUpMorph>>wantsMouseOverHalos: (in category '*Etoys-options') -----
+ wantsMouseOverHalos: aBoolean
+ wantsMouseOverHalos := aBoolean!
Item was added:
+ ----- Method: PasteUpMorphTest>>testCursorWrapped (in category '*Etoys-tests') -----
+ testCursorWrapped
+ "self debug: #testCursorWrapped"
+ | holder |
+ holder := PasteUpMorph new.
+ self assert: holder cursor = 1.
+ holder cursorWrapped: 2.
+ self assert: holder cursor = 1.
+ holder addMorph: Morph new;
+ addMorph: Morph new;
+ addMorph: Morph new.
+ holder cursorWrapped: 3.
+ self assert: holder cursor = 3.
+ holder cursorWrapped: 5.
+ self assert: holder cursor = 2.
+ holder cursorWrapped: 0.
+ self assert: holder cursor = 3.
+ holder cursorWrapped: -1.
+ self assert: holder cursor = 2.!
Item was added:
+ ----- Method: PasteUpMorphTest>>testCursorWrappedWithFraction (in category '*Etoys-tests') -----
+ testCursorWrappedWithFraction
+ "self debug: #testCursorWrappedWithFraction"
+ | holder |
+ holder := PasteUpMorph new.
+ holder addMorph: Morph new;
+ addMorph: Morph new;
+ addMorph: Morph new.
+ holder cursorWrapped: 3.5.
+ self assert: holder cursor = 3.5.
+ holder cursorWrapped: 5.5.
+ self assert: holder cursor = 2.5.
+ holder cursorWrapped: 0.5.
+ self assert: holder cursor = 3.5.
+ holder cursorWrapped: -0.5.
+ self assert: holder cursor = 2.5.!
Item was added:
+ ----- Method: PasteUpMorphTest>>testGridToGradient (in category '*Etoys-tests') -----
+ testGridToGradient
+ "A trivial test for checking that you can change from a grid to a
+ gradient background. A recent [FIX] will make this pass."
+ | pum |
+ pum := PasteUpMorph new.
+ pum setStandardTexture.
+ "The following should fail without the fix"
+ self
+ shouldnt: [pum gradientFillColor: Color red]
+ raise: MessageNotUnderstood!
Item was added:
+ ----- Method: Player class>>extraExampleCar (in category '*Etoys-*MorphicExtras-examples') -----
+ extraExampleCar
+ "Player extraExampleCar do: #openInWorld"
+
+ | trackMorph wheelMorph carMorph carPlayer alertMorph wheelPlayer parent |
+ trackMorph := SketchMorph withForm: (Form extraCarTrack magnifyBy: RealEstateAgent scaleFactor).
+ trackMorph assuredPlayer; name: 'Track'.
+ carMorph := SketchMorph withForm: (Form extraCar magnifyBy: RealEstateAgent scaleFactor).
+ carPlayer := self newSubclass new
+ costume: (carMorph name: #Car);
+ yourself.
+ wheelMorph := SketchMorph withForm: (Form extraWheel magnifyBy: RealEstateAgent scaleFactor).
+ wheelPlayer := self newSubclass new
+ costume: (wheelMorph name: #Wheel);
+ yourself.
+ alertMorph := RectangleMorph new
+ useRoundedCorners;
+ extent: 90 px @ 50 px;
+ color: Color black;
+ assuredPlayer;
+ name: 'Alert';
+ yourself.
+ {trackMorph. carMorph. wheelMorph. alertMorph} do: [:morph |
+ carPlayer environment at: morph name asSymbol put: morph player].
+ carPlayer environment at: #Wheel put: wheelPlayer.
+
+ Utilities useAuthorInitials: 'Objectland' during: [
+ carPlayer class compile: ((self extraExampleCarSource
+ asString lines allButFirst copyWithFirst: #drive)
+ joinSeparatedBy: Character cr)].
+ (carPlayer class >> #drive) decompile asScriptEditorFor: carPlayer.
+ carPlayer changeScript: #drive toStatus: #ticking.
+ carPlayer presenter stopRunningScripts.
+
+ parent := Morph new
+ color: Color transparent;
+ extent: 700 px @ 700 px;
+ addAllMorphsFront: {carMorph. trackMorph. wheelMorph. alertMorph}
+ yourself.
+ trackMorph position: 19 px @ 25 px.
+ wheelMorph center: (trackMorph pointAtFraction: 0.3 @ 1.15).
+ carMorph
+ center: (trackMorph pointAtFraction: 0.45 @ 0.89);
+ rotationDegrees: 100.
+ alertMorph
+ center: (wheelMorph pointAtFraction: 1.75 @ 0.5);
+ addMorph: ('Alert' asTextMorph
+ backgroundColor: (Color paleYellow alpha: 0.6);
+ center: (alertMorph pointAtFraction: 0.5 @ 1.2);
+ yourself).
+
+ ^ {parent. carPlayer scriptEditorFor: #drive}!
Item was added:
+ ----- Method: Player class>>extraExampleCarSource (in category '*Etoys-*MorphicExtras-examples') -----
+ extraExampleCarSource
+
+ ^ 'extraExampleDrive
+ self forward: 5.
+ self turn: Wheel getHeading // 5'!
Item was added:
+ Morph subclass: #PluggableTabButtonMorph
+ instanceVariableNames: 'active model textSelector arcLengths subMorph'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-Morphic-Pluggable Widgets'!
+
+ !PluggableTabButtonMorph commentStamp: 'KLC 9/17/2004 11:27' prior: 0!
+ This is a specialized pluggable button morph that is meant to represent a tab in a set of tabs arranged horizontally. Each tab will overlap slightly when drawn. All but one tab will be drawn in left to right order in the specified color, but lighter. The active tab will be drawn last in the full color and slightly taller to indicate that it is selected. Clicking the active tab has no effect but clicking any other tab will change the active tab to the clicked tab.
+
+ This morph does not itself accept any events. The parent tab set will grab the mouse clicks and handle notifying the appropriate tabs that they have been activated or deactivated.
+
+ There is a single selector which provides the text for the button label and affects the width of the tab. When the width changes the tab will inform its parent that it has changed and that the layout needs to be updated. The model for the text selector of course should be the client for the tab set.
+
+ The button label can be a String, Text, or Morph. Texts work better than plain Strings.!
Item was added:
+ ----- Method: PluggableTabButtonMorph class>>on:label: (in category '*Etoys-instance creation') -----
+ on: anObject label: getTextSelector
+ | instance |
+ instance := super new.
+ instance model: anObject.
+ instance textSelector: getTextSelector.
+ ^ instance !
Item was added:
+ ----- Method: PluggableTabButtonMorph>>active (in category '*Etoys-access') -----
+ active
+ active ifNil: [ active := false ].
+ ^ active!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>active: (in category '*Etoys-access') -----
+ active: aBoolean
+ active := aBoolean.
+ self changed.!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>arcLengths (in category '*Etoys-private - access') -----
+ arcLengths
+ arcLengths ifNil: [ self calculateArcLengths ].
+ ^ arcLengths!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>arcLengths: (in category '*Etoys-private - access') -----
+ arcLengths: anArrayOfIntegers
+ arcLengths := anArrayOfIntegers
+ !
Item was added:
+ ----- Method: PluggableTabButtonMorph>>calculateArcLengths (in category '*Etoys-precalculations') -----
+ calculateArcLengths
+ | array radius |
+ radius := self cornerRadius.
+ array := Array new: radius.
+
+ 1 to: radius do: [ :i | | x |
+ x := i - 0.5.
+ array at: i
+ put: (radius - ((2 * x * radius) - (x * x)) sqrt) asInteger].
+
+ self arcLengths: array!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>cornerRadius (in category '*Etoys-private - access') -----
+ cornerRadius
+ ^ 5
+ !
Item was added:
+ ----- Method: PluggableTabButtonMorph>>drawOn: (in category '*Etoys-drawing') -----
+ drawOn: aCanvas
+ self drawTabOn: aCanvas.
+ self drawSubMorphOn: aCanvas!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>drawSubMorphOn: (in category '*Etoys-drawing') -----
+ drawSubMorphOn: aCanvas
+ | morphBounds |
+ morphBounds := self bounds insetBy: (self cornerRadius + 3) @ (self topInactiveGap // 2 + 2).
+ morphBounds := morphBounds translateBy: 0@(self topInactiveGap // 2 + 1).
+ self active ifTrue: [
+ morphBounds := morphBounds translateBy: 0@((self topInactiveGap // 2 + 1) negated)].
+ self subMorph bounds height < (morphBounds height)
+ ifTrue: [
+ morphBounds := morphBounds
+ insetBy: 0@((morphBounds height - self subMorph bounds height) // 2)].
+ self subMorph bounds width < (morphBounds width)
+ ifTrue: [
+ morphBounds := morphBounds
+ insetBy: ((morphBounds width - self subMorph bounds width) // 2)@0].
+
+ self subMorph bounds: morphBounds.
+ aCanvas drawMorph: self subMorph!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>drawTabOn: (in category '*Etoys-drawing') -----
+ drawTabOn: aCanvas
+ | top myColor cornerRadius myArcLengths myBounds |
+ cornerRadius := self cornerRadius.
+ myBounds := self bounds.
+ self active
+ ifTrue: [ top := myBounds top.
+ myColor := self color ]
+ ifFalse: [ top := myBounds top + self topInactiveGap.
+ myColor := self color whiter whiter ].
+ aCanvas fillRectangle:
+ ((myBounds left + cornerRadius)
+ @ (top + cornerRadius)
+ corner: (myBounds right - cornerRadius)
+ @ self bottom)
+ color: myColor.
+ aCanvas fillRectangle:
+ ((myBounds left + (cornerRadius * 2)) @ top
+ corner: (myBounds right - (cornerRadius * 2))
+ @ (top + cornerRadius))
+ color: myColor.
+ aCanvas fillOval:
+ ((myBounds left + self cornerRadius) @ top
+ corner: (myBounds left + (self cornerRadius * 3))
+ @ (top + (self cornerRadius * 2)))
+ color: myColor.
+ aCanvas fillOval:
+ ((myBounds right - (self cornerRadius * 3)) @ top
+ corner: (myBounds right - self cornerRadius)
+ @ (top + (self cornerRadius * 2)))
+ color: myColor.
+
+ myArcLengths := self arcLengths.
+ 1 to: myArcLengths size do: [ :i | | length |
+ length := myArcLengths at: i.
+ aCanvas line: (myBounds left + cornerRadius - i) @ (myBounds bottom - 1 )
+ to: (myBounds left + cornerRadius - i) @ (myBounds bottom - length - 1)
+ color: myColor.
+ aCanvas line: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - 1)
+ to: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - length - 1)
+ color: myColor]
+
+ !
Item was added:
+ ----- Method: PluggableTabButtonMorph>>initialize (in category '*Etoys-initialization') -----
+ initialize
+ ^ super initialize
+ !
Item was added:
+ ----- Method: PluggableTabButtonMorph>>innerExtent: (in category '*Etoys-access') -----
+ innerExtent: aPoint
+ "Set the extent based on the primary visible part of the tab. In other words add twice the cornerRadius to this extent"
+ self extent: (aPoint x + (self cornerRadius * 2)) @ (aPoint y)!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>model (in category '*Etoys-access') -----
+ model
+ ^ model
+ !
Item was added:
+ ----- Method: PluggableTabButtonMorph>>model: (in category '*Etoys-access') -----
+ model: anObject
+ model := anObject!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>outerGap (in category '*Etoys-access') -----
+ outerGap
+ "The horizontal distance of the outer left and right edges of the tab excluding the inner visible part"
+ ^ self cornerRadius * 2!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>step (in category '*Etoys-stepping') -----
+ step
+ self subMorph step.
+ self changed.
+ !
Item was added:
+ ----- Method: PluggableTabButtonMorph>>stepTime (in category '*Etoys-stepping') -----
+ stepTime
+ ^ self subMorph stepTime
+ !
Item was added:
+ ----- Method: PluggableTabButtonMorph>>subMorph (in category '*Etoys-private - access') -----
+ subMorph
+ subMorph ifNil: [ self update: self textSelector ].
+ ^ subMorph!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>subMorph: (in category '*Etoys-private - access') -----
+ subMorph: aMorph
+ subMorph := aMorph
+ !
Item was added:
+ ----- Method: PluggableTabButtonMorph>>textSelector (in category '*Etoys-access') -----
+ textSelector
+ ^ textSelector
+ !
Item was added:
+ ----- Method: PluggableTabButtonMorph>>textSelector: (in category '*Etoys-access') -----
+ textSelector: aSymbol
+ textSelector := aSymbol!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>toggle (in category '*Etoys-actions') -----
+ toggle
+ self active: self active not!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>topInactiveGap (in category '*Etoys-private - access') -----
+ topInactiveGap
+ ^ 5!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>update: (in category '*Etoys-updating') -----
+ update: aSelector
+ self textSelector ifNotNil: [
+ aSelector = self textSelector
+ ifTrue: [ | morph |
+ (aSelector isSymbol and: [model notNil])
+ ifTrue: [
+ morph :=
+ (self model perform: aSelector) asMorph]
+ ifFalse: [ morph := aSelector value asMorph].
+ self subMorph: morph]].
+ self changed!
Item was added:
+ ----- Method: PluggableTabButtonMorph>>wantsSteps (in category '*Etoys-stepping') -----
+ wantsSteps
+ ^ self subMorph wantsSteps!
Item was added:
+ ----- Method: PluggableTextMorph>>tileForIt (in category '*Etoys-menu commands') -----
+ tileForIt
+ "Return a tile referring to the object resulting form evaluating my current selection. Not currently threaded in, but useful in earlier demos and possibly still of value."
+
+
+ self handleEdit:
+ [textMorph editor evaluateSelectionAndDo: [:result | self currentHand attachMorph: result tileToRefer]]!
Item was added:
+ ----- Method: PointType>>initialValueForASlotFor: (in category '*Etoys-initialization') -----
+ initialValueForASlotFor: aPlayer
+ "Answer the value to give initially to a newly created slot of the given type in the given player"
+
+ ^ 0@0!
Item was added:
+ ----- Method: Preferences class>>annotationEditingWindow (in category '*Etoys-support - misc') -----
+ annotationEditingWindow
+ "Answer a window affording editing of annotations"
+ | aPanel ins outs current aWindow aButton info standardHeight standardWidth |
+ standardHeight := 200.
+ standardWidth := (2 sqrt reciprocal * standardHeight) rounded.
+ Smalltalk isMorphic
+ ifFalse: [self error: 'annotations can be edited only in morphic'].
+ aPanel := AlignmentMorph newRow extent: 2 * standardWidth @ standardHeight.
+ ins := AlignmentMorph newColumn extent: standardWidth @ standardHeight.
+ ins color: Color green muchLighter.
+ ins enableDrop: true;
+ beSticky.
+ outs := AlignmentMorph newColumn extent: standardWidth @ standardHeight.
+ outs color: Color red muchLighter.
+ outs enableDrop: true;
+ beSticky.
+ aPanel addMorph: outs;
+ addMorphFront: ins.
+ outs position: ins position + (standardWidth @ 0).
+ current := self defaultAnnotationRequests.
+ info := self annotationInfo.
+ current
+ do: [:sym | | pair aMorph |
+ pair := info
+ detect: [:aPair | aPair first == sym].
+ aMorph := StringMorph new contents: pair first.
+ aMorph setBalloonText: pair last.
+ aMorph enableDrag: true.
+ aMorph
+ on: #startDrag
+ send: #startDrag:with:
+ to: aMorph.
+ ins addMorphBack: aMorph].
+ info
+ do: [:aPair | (current includes: aPair first)
+ ifFalse: [| aMorph |
+ aMorph := StringMorph new contents: aPair first.
+ aMorph setBalloonText: aPair last.
+ aMorph enableDrag: true.
+ aMorph
+ on: #startDrag
+ send: #startDrag:with:
+ to: aMorph.
+ outs addMorph: aMorph]].
+ aPanel layoutChanged.
+ aWindow := SystemWindowWithButton new setLabel: 'Annotations'.
+ aButton := SimpleButtonMorph new target: Preferences;
+ actionSelector: #acceptAnnotationsFrom:;
+
+ arguments: (Array with: aWindow);
+ label: 'apply';
+ borderWidth: 0;
+ borderColor: Color transparent;
+ color: Color transparent.
+ aButton submorphs first color: Color blue.
+ aButton setBalloonText: 'After moving all the annotations you want to the left (green) side, and all the ones you do NOT want to the right (pink) side, hit this "apply" button to have your choices take effect.'.
+ aWindow buttonInTitle: aButton;
+ adjustExtraButton.
+ ^ aPanel wrappedInWindow: aWindow"Preferences annotationEditingWindow openInHand"!
Item was added:
+ ----- Method: Preferences class>>automaticViewerPlacement (in category '*Etoys-standard queries') -----
+ automaticViewerPlacement
+ ^ self
+ valueOfFlag: #automaticViewerPlacement
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>batchPenTrails (in category '*Etoys-standard queries') -----
+ batchPenTrails
+ ^ self
+ valueOfFlag: #batchPenTrails
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>capitalizedReferences (in category '*Etoys-standard queries') -----
+ capitalizedReferences
+ ^ self
+ valueOfFlag: #capitalizedReferences
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>cautionBeforeClosing (in category '*Etoys-standard queries') -----
+ cautionBeforeClosing
+ ^ self
+ valueOfFlag: #cautionBeforeClosing
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>chooseEToysFont (in category '*Etoys-prefs - fonts') -----
+ chooseEToysFont
+ "present a menu with the possible fonts for the eToys"
+ self
+ chooseFontWithPrompt: 'eToys font...' translated
+ andSendTo: self
+ withSelector: #setEToysFontTo:
+ highlightSelector: #standardEToysFont!
Item was added:
+ ----- Method: Preferences class>>chooseEToysTitleFont (in category '*Etoys-prefs - fonts') -----
+ chooseEToysTitleFont
+ "present a menu with the possible fonts for the eToys"
+ self
+ chooseFontWithPrompt: 'eToys Title font...' translated
+ andSendTo: self
+ withSelector: #setEToysTitleFontTo:
+ highlightSelector: #standardEToysTitleFont!
Item was added:
+ ----- Method: Preferences class>>classicTilesSettingToggled (in category '*Etoys-updating - system') -----
+ classicTilesSettingToggled
+ "The current value of the largeTiles flag has changed; now react"
+
+ Smalltalk isMorphic ifTrue:
+ [Preferences universalTiles
+ ifFalse:
+ [self inform:
+ 'note that this will only have a noticeable
+ effect if the universalTiles preference is
+ set to true, which it currently is not' translated]
+ ifTrue:
+ [Project current world recreateScripts]]!
Item was added:
+ ----- Method: Preferences class>>compactViewerFlaps (in category '*Etoys-standard queries') -----
+ compactViewerFlaps
+ ^ self
+ valueOfFlag: #compactViewerFlaps
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>debugMenuItemsInvokableFromScripts (in category '*Etoys-prefs - misc') -----
+ debugMenuItemsInvokableFromScripts
+ "If true, then items occurring in an object's debug menu will be included in the alternatives offered as arguments to a doMenuItem: tile in the scripting system"
+ ^ false!
Item was added:
+ ----- Method: Preferences class>>defaultPaintingExtent (in category '*Etoys-prefs - misc') -----
+ defaultPaintingExtent
+ "Answer the preferred size for the onion-skin paint area when launching a new painting within a paste-up morph. Feel free to change the parameters to suit your configuration."
+
+ ^ 800 @ 600!
Item was added:
+ ----- Method: Preferences class>>dropProducesWatcher (in category '*Etoys-standard queries') -----
+ dropProducesWatcher
+ ^ self
+ valueOfFlag: #dropProducesWatcher
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>eToyFriendly (in category '*Etoys-standard queries') -----
+ eToyFriendly
+ ^ self
+ valueOfFlag: #eToyFriendly
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>eToyFriendlyChanged (in category '*Etoys-updating - system') -----
+ eToyFriendlyChanged
+ "The eToyFriendly preference changed; React"
+
+ ScriptingSystem customizeForEToyUsers: Preferences eToyFriendly!
Item was added:
+ ----- Method: Preferences class>>eToyLoginEnabled (in category '*Etoys-standard queries') -----
+ eToyLoginEnabled
+ ^ self
+ valueOfFlag: #eToyLoginEnabled
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>editAnnotations (in category '*Etoys-support - misc') -----
+ editAnnotations
+ "Put up a window that allows the user to edit annotation specifications"
+
+ | aWindow |
+ self currentWorld addMorphCentered: (aWindow := self annotationEditingWindow).
+ aWindow beKeyWindow.
+
+ "Preferences editAnnotations"
+
+ !
Item was added:
+ ----- Method: Preferences class>>enableLocalSave (in category '*Etoys-standard queries') -----
+ enableLocalSave
+ ^ self
+ valueOfFlag: #enableLocalSave
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>expandedPublishing (in category '*Etoys-standard queries') -----
+ expandedPublishing
+ ^ self
+ valueOfFlag: #expandedPublishing
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>fenceEnabled (in category '*Etoys-standard queries') -----
+ fenceEnabled
+ ^ self
+ valueOfFlag: #fenceEnabled
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>fenceSoundEnabled (in category '*Etoys-standard queries') -----
+ fenceSoundEnabled
+ ^ self
+ valueOfFlag: #fenceSoundEnabled
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>fenceSoundEnabled: (in category '*Etoys-standard queries') -----
+ fenceSoundEnabled: aBoolean
+ self setPreference: #fenceSoundEnabled toValue: aBoolean!
Item was added:
+ ----- Method: Preferences class>>haloTransitions (in category '*Etoys-standard queries') -----
+ haloTransitions
+ ^ self
+ valueOfFlag: #haloTransitions
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>includeSoundControlInNavigator (in category '*Etoys-standard queries') -----
+ includeSoundControlInNavigator
+ ^ self
+ valueOfFlag: #includeSoundControlInNavigator
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>keepTickingWhilePainting (in category '*Etoys-standard queries') -----
+ keepTickingWhilePainting
+ ^ self
+ valueOfFlag: #keepTickingWhilePainting
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>largeTilesSettingToggled (in category '*Etoys-updating - system') -----
+ largeTilesSettingToggled
+ "The current value of the largeTiles flag has changed; now react"
+
+ Smalltalk isMorphic ifTrue:
+ [Preferences universalTiles
+ ifFalse:
+ [self inform:
+ 'note that this will only have a noticeable
+ effect if the universalTiles preference is
+ set to true, which it currently is not' translated]
+ ifTrue:
+ [Project current world recreateScripts]]!
Item was added:
+ ----- Method: Preferences class>>magicHalos (in category '*Etoys-standard queries') -----
+ magicHalos
+ ^ self
+ valueOfFlag: #magicHalos
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>menuColorFromWorld (in category '*Etoys-standard queries') -----
+ menuColorFromWorld
+ ^ self
+ valueOfFlag: #menuColorFromWorld
+ ifAbsent: [true
+ "success"]!
Item was added:
+ ----- Method: Preferences class>>menuColorString (in category '*Etoys-support - misc') -----
+ menuColorString
+ ^ ((self valueOfFlag: #menuColorFromWorld)
+ ifTrue: ['stop menu-color-from-world']
+ ifFalse: ['start menu-color-from-world']) translated!
Item was added:
+ ----- Method: Preferences class>>messengersInViewers (in category '*Etoys-prefs - misc') -----
+ messengersInViewers
+ "A coming technology..."
+
+ ^ false!
Item was added:
+ ----- Method: Preferences class>>mouseOverHalos (in category '*Etoys-standard queries') -----
+ mouseOverHalos
+ ^ self
+ valueOfFlag: #mouseOverHalos
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>mouseOverHalosChanged (in category '*Etoys-updating - system') -----
+ mouseOverHalosChanged
+ Project current world wantsMouseOverHalos: self mouseOverHalos!
Item was added:
+ ----- Method: Preferences class>>mvcProjectsAllowed (in category '*Etoys-standard queries') -----
+ mvcProjectsAllowed
+ ^ self
+ valueOfFlag: #mvcProjectsAllowed
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>navigatorOnLeftEdge (in category '*Etoys-standard queries') -----
+ navigatorOnLeftEdge
+ ^ self
+ valueOfFlag: #navigatorOnLeftEdge
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>noviceMode (in category '*Etoys-standard queries') -----
+ noviceMode
+ ^ self
+ valueOfFlag: #noviceMode
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>noviceModeSettingChanged (in category '*Etoys-updating - system') -----
+ noviceModeSettingChanged
+ "The current value of the noviceMode flag has changed;
+ now react"
+ TheWorldMainDockingBar updateInstances.
+ PasteUpMorph allSubInstances
+ select: [:each | each isWorldMorph]
+ thenDo: [:each | each initializeDesktopCommandKeySelectors].
+ Smalltalk at: #ParagraphEditor ifPresent: [:aClass| aClass initialize]!
Item was added:
+ ----- Method: Preferences class>>okToReinitializeFlaps (in category '*Etoys-standard queries') -----
+ okToReinitializeFlaps
+ ^ self
+ valueOfFlag: #okToReinitializeFlaps
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>oliveHandleForScriptedObjects (in category '*Etoys-standard queries') -----
+ oliveHandleForScriptedObjects
+ ^ self
+ valueOfFlag: #oliveHandleForScriptedObjects
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>propertySheetFromHalo (in category '*Etoys-standard queries') -----
+ propertySheetFromHalo
+ ^ self
+ valueOfFlag: #propertySheetFromHalo
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>selectiveHalos (in category '*Etoys-standard queries') -----
+ selectiveHalos
+ ^ self
+ valueOfFlag: #selectiveHalos
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>setEToysFontTo: (in category '*Etoys-prefs - fonts') -----
+ setEToysFontTo: aFont
+ "change the font used in eToys environment"
+
+ UserInterfaceTheme setFont: #eToysFont to: aFont.!
Item was added:
+ ----- Method: Preferences class>>setEToysTitleFontTo: (in category '*Etoys-prefs - fonts') -----
+ setEToysTitleFontTo: aFont
+ "change the font used in eToys environment"
+
+ UserInterfaceTheme setFont: #eToysTitleFont to: aFont.!
Item was added:
+ ----- Method: Preferences class>>showAdvancedNavigatorButtons (in category '*Etoys-standard queries') -----
+ showAdvancedNavigatorButtons
+ ^ self
+ valueOfFlag: #showAdvancedNavigatorButtons
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>showFlapsWhenPublishing (in category '*Etoys-standard queries') -----
+ showFlapsWhenPublishing
+ ^ self
+ valueOfFlag: #showFlapsWhenPublishing
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>simpleMenus (in category '*Etoys-standard queries') -----
+ simpleMenus
+ ^ self
+ valueOfFlag: #simpleMenus
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>standardEToysFont (in category '*Etoys-prefs - fonts') -----
+ standardEToysFont
+
+ ^ (UserInterfaceTheme current get: #eToysFont)
+ ifNil: [self standardButtonFont]!
Item was added:
+ ----- Method: Preferences class>>standardEToysTitleFont (in category '*Etoys-prefs - fonts') -----
+ standardEToysTitleFont
+
+ ^ (UserInterfaceTheme current get: #eToysTitleFont)
+ ifNil: [self standardEToysFont]!
Item was added:
+ ----- Method: Preferences class>>tabAmongFields (in category '*Etoys-standard queries') -----
+ tabAmongFields
+ ^ self
+ valueOfFlag: #tabAmongFields
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>tileTranslucentDrag (in category '*Etoys-standard queries') -----
+ tileTranslucentDrag
+ ^ self
+ valueOfFlag: #tileTranslucentDrag
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>typeCheckingInTileScripting (in category '*Etoys-standard queries') -----
+ typeCheckingInTileScripting
+ ^ self
+ valueOfFlag: #typeCheckingInTileScripting
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>uniTilesClassic (in category '*Etoys-standard queries') -----
+ uniTilesClassic
+ ^ self
+ valueOfFlag: #uniTilesClassic
+ ifAbsent: [ true ]!
Item was added:
+ ----- Method: Preferences class>>universalTiles (in category '*Etoys-standard queries') -----
+ universalTiles
+ ^ self
+ valueOfFlag: #universalTiles
+ ifAbsent: [false]!
Item was added:
+ ----- Method: Preferences class>>universalTilesSettingToggled (in category '*Etoys-updating - system') -----
+ universalTilesSettingToggled
+ "The current value of the universalTiles flag has changed; now react"
+
+ (self preferenceAt: #universalTiles ifAbsent: [^ self]) localToProject ifFalse:
+ [^ self inform:
+ 'This is troubling -- you may regret having done that, because
+ the change will apply to *all projects*, including pre-existing ones. Unfortunately this check is done after the damage is done, so you
+ may be hosed. Fortunately, however, you can simply reverse your choice right now and perhaps no deep damage will have been done.'].
+
+ self universalTiles "User just switched project to classic tiles"
+ ifFalse:
+ [self inform:
+ 'CAUTION -- if you had any scripted objects in
+ this project that already used universal tiles,
+ there is no reasonable way to go back to classic
+ tiles. Recommended course of action in that case:
+ just toggle this preference right back to true.']
+ ifTrue:
+ [Preferences capitalizedReferences ifFalse:
+ [Preferences enable: #capitalizedReferences.
+ self inform:
+ 'Note that the "capitalizedReferences" flag
+ has now been automatically set to true for
+ you, since this is required for the use of
+ universal tiles.'].
+ Project current isMorphic ifTrue:
+ [Project current world recreateScripts]]!
Item was added:
+ ----- Method: Preferences class>>unlimitedPaintArea (in category '*Etoys-standard queries') -----
+ unlimitedPaintArea
+ ^ self
+ valueOfFlag: #unlimitedPaintArea
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>useCategoryListsInViewers (in category '*Etoys-prefs - misc') -----
+ useCategoryListsInViewers
+ "Temporarily hard-coded pending viewer work underway"
+ ^ false!
Item was added:
+ ----- Method: Preferences class>>useVectorVocabulary (in category '*Etoys-standard queries') -----
+ useVectorVocabulary
+ ^ self
+ valueOfFlag: #useVectorVocabulary
+ ifAbsent: [ false ]!
Item was added:
+ ----- Method: Preferences class>>vectorVocabularySettingChanged (in category '*Etoys-updating - system') -----
+ vectorVocabularySettingChanged
+ "The current value of the useVectorVocabulary flag has changed; now react. No senders, but invoked by the Preference object associated with the #useVectorVocabulary preference."
+
+ Smalltalk isMorphic ifFalse: [^ self].
+ Project current world makeVectorUseConformToPreference.!
Item was added:
+ ----- Method: Preferences class>>viewersInFlaps (in category '*Etoys-standard queries') -----
+ viewersInFlaps
+ ^ self
+ valueOfFlag: #viewersInFlaps
+ ifAbsent: [ true ]!
Item was added:
+ Object subclass: #Presenter
+ instanceVariableNames: ''
+ classVariableNames: 'DefaultPresenterClass'
+ poolDictionaries: ''
+ category: 'Etoys-Morphic-Worlds'!
+
+ !Presenter commentStamp: '<historical>' prior: 0!
+ Optionally associated with a PasteUpMorph, provides a local scope for the running of scripts.
+
+ Once more valuable, may be again, but at present occupies primarily a historical niche.
+
+ Maintains a playerList cache.
+
+ Holds, optionally three 'standard items' -- standardPlayer standardPlayfield standardPalette -- originally providing idiomatic support of ongoing squeak-team internal work, but now extended to more general applicability.
+
+ !
Item was added:
+ ----- Method: Presenter class>>defaultPresenterClass (in category '*Etoys-accessing') -----
+ defaultPresenterClass
+ "The default presenter class to use"
+ ^DefaultPresenterClass ifNil:[self]!
Item was added:
+ ----- Method: Presenter class>>defaultPresenterClass: (in category '*Etoys-accessing') -----
+ defaultPresenterClass: aPresenterClass
+ "The default presenter class to use"
+ DefaultPresenterClass := aPresenterClass!
Item was added:
+ ----- Method: Presenter>>allCurrentlyTickingScriptInstantiations (in category '*Etoys-stubs') -----
+ allCurrentlyTickingScriptInstantiations
+ "Answer a list of ScriptInstantiation objects representing all the scripts within the scope of the receiver which are currently ticking."
+
+ ^ Array streamContents:
+ [:aStream |
+ self allExtantPlayers do:
+ [:aPlayer | aPlayer instantiatedUserScriptsDo:
+ [:aScriptInstantiation |
+ aScriptInstantiation status == #ticking ifTrue:
+ [aStream nextPut: aScriptInstantiation]]]]!
Item was added:
+ ----- Method: Presenter>>allExtantPlayers (in category '*Etoys-stubs') -----
+ allExtantPlayers
+ ^#()!
Item was added:
+ ----- Method: Presenter>>associatedMorph: (in category '*Etoys-accessing') -----
+ associatedMorph: m!
Item was added:
+ ----- Method: Presenter>>browseAllScriptsTextually (in category '*Etoys-stubs') -----
+ browseAllScriptsTextually
+ "Open a method-list browser on all the scripts in the project"
+
+ | aList aMethodList |
+ self flushPlayerListCache. "Just to be certain we get everything"
+
+ (aList := self uniclassesAndCounts) size == 0 ifTrue: [^ self inform: 'there are no scripted players' translated].
+ aMethodList := OrderedCollection new.
+ aList do:
+ [:aPair | aPair first addMethodReferencesTo: aMethodList].
+ aMethodList size > 0 ifFalse: [^ self inform: 'there are no scripts in this project!!' translated].
+
+ SystemNavigation new
+ browseMessageList: aMethodList
+ name: 'All scripts in this project'
+ autoSelect: nil
+
+ "
+ ActiveWorld presenter browseAllScriptsTextually
+ "!
Item was added:
+ ----- Method: Presenter>>currentlyViewing: (in category '*Etoys-stubs') -----
+ currentlyViewing: aPlayer
+ ^false!
Item was added:
+ ----- Method: Presenter>>drawingJustCompleted: (in category '*Etoys-stubs') -----
+ drawingJustCompleted: aSketch!
Item was added:
+ ----- Method: Presenter>>flushPlayerListCache (in category '*Etoys-stubs') -----
+ flushPlayerListCache!
Item was added:
+ ----- Method: Presenter>>morph:droppedIntoPasteUpMorph: (in category '*Etoys-stubs') -----
+ morph: aMorph droppedIntoPasteUpMorph: aPasteUpMorph!
Item was added:
+ ----- Method: Presenter>>ownStandardPalette (in category '*Etoys-stubs') -----
+ ownStandardPalette
+ ^nil!
Item was added:
+ ----- Method: Presenter>>positionStandardPlayer (in category '*Etoys-stubs') -----
+ positionStandardPlayer!
Item was added:
+ ----- Method: Presenter>>viewMorph: (in category '*Etoys-stubs') -----
+ viewMorph: aMorph
+ aMorph inspect.
+ !
Item was added:
+ ----- Method: Presenter>>viewObjectDirectly: (in category '*Etoys-stubs') -----
+ viewObjectDirectly: aMorph
+ aMorph inspect.
+ !
Item was added:
+ ----- Method: Project class>>publishInSexp (in category '*Etoys-preferences') -----
+ publishInSexp
+
+ ^ (Smalltalk classNamed: 'SISSDictionaryForScanning')
+ ifNil: [false]
+ ifNotNil: [:siss | siss publishInSexp]!
Item was added:
+ ----- Method: Project>>restoreReferences (in category '*Etoys-file in/out') -----
+ restoreReferences
+
+ | refs newPool |
+ refs := world valueOfProperty: #References ifAbsent: [nil].
+ (refs isMemberOf: OrderedCollection) ifTrue: [
+ world removeProperty: #References.
+ newPool := world referencePool.
+ refs do: [:assoc | newPool add: assoc].
+ ].
+ !
Item was added:
+ ----- Method: ProjectLauncher>>cancelLogin (in category '*Etoys-eToy login') -----
+ cancelLogin
+ "This is fine - we just proceed here. Later we may do something utterly different ;-)"
+ ^self proceedWithLogin!
Item was added:
+ ----- Method: ProjectLauncher>>doEtoyLogin (in category '*Etoys-eToy login') -----
+ doEtoyLogin
+ "Pop up the eToy login if we have a server that provides us with a known user list"
+
+ "Find us a server who could do eToy authentification for us"
+ eToyAuthentificationServer :=
+ (ServerDirectory localProjectDirectories, ServerDirectory servers values)
+ detect:[:any| any hasEToyUserList]
+ ifNone:[nil].
+ eToyAuthentificationServer "no server provides user information"
+ ifNil:[^self startUpAfterLogin].
+ self prepareForLogin.
+ (Smalltalk at: #EtoyLoginMorph ifAbsent:[^self cancelLogin])
+ loginAndDo:[:userName| self loginAs: userName]
+ ifCanceled:[self cancelLogin].
+ !
Item was added:
+ ----- Method: ProjectLauncher>>loginAs: (in category '*Etoys-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 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.
+ ^false].
+ "case insensitive search"
+ actualName := userList detect:[:any| any sameAs: userName] ifNone:[nil].
+ actualName isNil ifTrue:[
+ self inform: 'Unknown user: ' translated ,userName.
+ ^false].
+ Utilities authorName: actualName.
+ eToyAuthentificationServer eToyUserName: actualName.
+ self proceedWithLogin.
+ ^true!
Item was added:
+ ----- Method: ProjectLauncher>>prepareForLogin (in category '*Etoys-eToy login') -----
+ prepareForLogin
+ "Prepare for login - e.g., hide everything so only the login morph is visible."
+ | world |
+ world := Project current world.
+ world submorphsDo:[:m|
+ m isLocked ifFalse:[m hide]]. "hide all those guys"
+ world displayWorldSafely.
+ !
Item was added:
+ ----- Method: ProjectLauncher>>proceedWithLogin (in category '*Etoys-eToy login') -----
+ proceedWithLogin
+ eToyAuthentificationServer := nil.
+ Project current world submorphsDo:[:m| m show].
+ WorldState addDeferredUIMessage: [self startUpAfterLogin].!
Item was added:
+ ----- Method: ProjectLauncher>>startUpAfterLogin (in category '*Etoys-running') -----
+ startUpAfterLogin
+ | scriptName loader isUrl |
+ self setupFlaps.
+ Smalltalk firstArgMightBeDocument
+ ifTrue: [scriptName := Smalltalk documentPath.
+ scriptName := scriptName convertFromSystemString.
+ scriptName isEmpty
+ ifFalse: ["figure out if script name is a URL by itself"
+ isUrl := (scriptName asLowercase beginsWith: 'http://')
+ or: [(scriptName asLowercase beginsWith: 'file://')
+ or: [scriptName asLowercase beginsWith: 'ftp://']].
+ isUrl
+ ifFalse: [| encodedPath pathTokens |
+ "Allow for ../dir/scriptName arguments"
+ pathTokens := scriptName splitBy: FileDirectory slash.
+ pathTokens := pathTokens
+ collect: [:s | s encodeForHTTP].
+ encodedPath := pathTokens
+ reduce: [:acc :each | acc , FileDirectory slash , each].
+ scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]]
+ ifFalse: [scriptName := ''].
+ scriptName isEmptyOrNil
+ ifTrue: [^ Preferences eToyFriendly
+ ifTrue: [self currentWorld addGlobalFlaps]].
+ loader := CodeLoader new.
+ loader
+ loadSourceFiles: (Array with: scriptName).
+ (scriptName asLowercase endsWith: '.pr')
+ ifTrue: [self installProjectFrom: loader]
+ ifFalse: [loader installSourceFiles]!
Item was added:
+ ----- Method: ProjectNavigationMorph>>buttonPaint (in category '*Etoys-the buttons') -----
+ buttonPaint
+
+ | pb oldArgs brush myButton m |
+
+ myButton := self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting.
+ pb := PaintBoxMorph new submorphNamed: #paint:.
+ pb ifNil: [
+ (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.
+ ].
+ 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')."
+
+ !
Item was added:
+ ----- Method: ProjectNavigationMorph>>doNewPainting (in category '*Etoys-the actions') -----
+ doNewPainting
+
+ | w f |
+
+ w := self world.
+ w assureNotPaintingElse: [^ self].
+ (f := self owner flapTab) ifNotNil: [f hideFlap].
+ w makeNewDrawing: (self primaryHand lastEvent translatedTo: w center)
+ !
Item was added:
+ ----- Method: ProjectNavigationMorph>>editProjectInfo (in category '*Etoys-the actions') -----
+ editProjectInfo
+
+ Smalltalk at: #EToyProjectDetailsMorph ifPresent:[:aClass|
+ aClass
+ getFullInfoFor: (self world ifNil: [^self]) project
+ ifValid: []
+ expandedFormat: true
+ ].!
Item was added:
+ ----- Method: ProjectNavigationMorph>>makeTheSimpleButtons (in category '*Etoys-buttons') -----
+ makeTheSimpleButtons
+
+ ^{
+ self buttonNewProject.
+
+ self buttonPrev.
+ self buttonNext.
+ self buttonPublish.
+ self buttonFind.
+ self buttonFullScreen.
+
+ self buttonPaint.
+ },
+ (
+ Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()]
+ ),
+ {
+ self buttonLanguage.
+ self buttonUndo.
+ self buttonQuit.
+ }
+ !
Item was added:
+ ----- Method: Quadrangle class>>exampleInViewer (in category '*Etoys-instance creation') -----
+ exampleInViewer
+ "Create a sample Quadrangle and open a Viewer on it"
+
+ (self region: (100@100 extent: 100@50) borderWidth: (1 + (6 atRandom)) borderColor: Color black insideColor: (Color perform: #(green red blue yellow) atRandom)) beViewed
+
+ "Quadrangle exampleInViewer"!
Item was added:
+ ----- Method: ReleaseBuilder class>>beautifyEtoys (in category '*Etoys-scripts - ui') -----
+ beautifyEtoys
+ "If users invoke Etoys features without preparing the system's look-and-feel via #setEtoysMode, some icons look strange. Fix that to improve the first impression."
+
+ (self environment classNamed: #ReleaseBuilderSqueakland)
+ ifNotNil: [:builder | builder loadMostUsedEtoysForms].!
Item was added:
+ ----- Method: ScreenController>>standardGraphicsLibrary (in category '*Etoys-menu messages') -----
+ standardGraphicsLibrary
+ "Open a standard, throwaway window chock full of useful expressions. 1/17/96 sw"
+
+ ScriptingSystem inspectFormDictionary!
Item was added:
+ ----- Method: ScrollableField>>cursorWrapped: (in category '*Etoys-accessing') -----
+ cursorWrapped: aNumber
+ "Set the cursor as indicated"
+ textMorph cursorWrapped: aNumber!
Item was added:
+ ----- Method: ScrollableField>>getAllButFirstCharacter (in category '*Etoys-accessing') -----
+ getAllButFirstCharacter
+ "Obtain all but the first character from the receiver; if that
+ would be empty, return a black dot"
+ ^ textMorph getAllButFirstCharacter !
Item was added:
+ ----- Method: ScrollableField>>getNumericValue (in category '*Etoys-accessing') -----
+ getNumericValue
+ "Obtain a numeric value from the receiver; if no digits, return
+ zero"
+ ^ textMorph getNumericValue !
Item was added:
+ ----- Method: ScrollableField>>insertCharacters: (in category '*Etoys-accessing') -----
+ insertCharacters: aString
+ "Insert the characters from the given source at my current
+ cursor position"
+ textMorph insertCharacters: aString !
Item was added:
+ ----- Method: ScrollableField>>insertContentsOf: (in category '*Etoys-accessing') -----
+ insertContentsOf: aPlayer
+ "Insert the characters from the given player at my current
+ cursor position"
+ textMorph insertContentsOf: aPlayer !
Item was added:
+ ----- Method: ScrollableField>>setNumericValue: (in category '*Etoys-accessing') -----
+ setNumericValue: aValue
+ "Set the contents of the receiver to be a string obtained from
+ aValue"
+ textMorph setNumericValue: aValue !
Item was added:
+ ----- Method: SelectionMorph>>couldMakeSibling (in category '*Etoys-testing') -----
+ couldMakeSibling
+ "Answer whether it is appropriate to ask the receiver to make a sibling"
+
+ ^ false!
Item was added:
+ ----- Method: SelectionMorph>>preferredDuplicationHandleSelector (in category '*Etoys-testing') -----
+ preferredDuplicationHandleSelector
+ "Answer the selector, to be offered as the default in a halo open on me"
+
+ ^ #addDupHandle:!
Item was added:
+ ----- Method: SimpleButtonMorph>>adaptToWorld: (in category '*Etoys-*MorphicExtras-e-toy support') -----
+ adaptToWorld: aWorld
+ super adaptToWorld: aWorld.
+ target := target adaptedToWorld: aWorld.!
Item was added:
+ ----- Method: SimpleHaloMorph>>isMagicHalo (in category '*Etoys-testing') -----
+ isMagicHalo
+
+ ^ false!
Item was added:
+ ----- Method: SimpleHaloMorph>>popUpMagicallyFor:hand: (in category '*Etoys-pop up') -----
+ popUpMagicallyFor: morph hand: hand
+
+ self
+ popUpFor: morph
+ hand: hand.!
Item was added:
+ ----- Method: SimpleHierarchicalListMorph class>>submorphsExample (in category '*Etoys-examples') -----
+ submorphsExample
+ "display a hierarchical list of the current world plus its submorphs plus its submorphs' submorphs etc."
+ "SimpleHierarchicalListMorph submorphsExample"
+ | morph |
+ morph :=
+ SimpleHierarchicalListMorph
+ on: [ Array with: (MorphWithSubmorphsWrapper with: Project current world) ]
+ list: #value
+ selected: nil
+ changeSelected: nil
+ menu: nil
+ keystroke: nil.
+
+ morph openInWindow!
Item was added:
+ ----- Method: SimpleSliderMorph>>isLikelyRecipientForMouseOverHalos (in category '*Etoys-e-toy support') -----
+ isLikelyRecipientForMouseOverHalos
+
+ self player ifNil: [^ false].
+ self player getHeading = 0.0 ifTrue: [^ false].
+ ^ true.
+ !
Item was added:
+ ----- Method: SketchEditorMorph>>wantsHaloFromClick (in category '*Etoys-e-toy support') -----
+ wantsHaloFromClick
+
+ ^ Preferences eToyFriendly not.
+ !
Item was added:
+ ----- Method: SketchMorph>>firstIntersectionWithLineFrom:to: (in category '*Etoys-geometry') -----
+ firstIntersectionWithLineFrom: start to: end
+ | intersections last |
+ intersections := self fullBounds extrapolatedIntersectionsWithLineFrom: start to: end.
+ intersections size = 1 ifTrue: [ ^intersections anyOne ].
+ intersections isEmpty ifTrue: [ ^nil ].
+ intersections := intersections sorted: [ :a :b | (start dist: a) < (start dist: b) ].
+ last := intersections first rounded.
+ last pointsTo: intersections last rounded do: [ :pt |
+ (self rotatedForm isTransparentAt: (pt - bounds origin)) ifFalse: [ ^last ].
+ last := pt.
+ ].
+ ^intersections first rounded!
Item was added:
+ ----- Method: SoundType>>initialValueForASlotFor: (in category '*Etoys-initial value') -----
+ initialValueForASlotFor: aPlayer
+ "Answer the value to give initially to a newly created slot of the given type in the given player"
+
+ ^ 'croak'!
Item was added:
+ ----- Method: SqueakFurtherCorePackagesHelp class>>etoys (in category '*Etoys-pages') -----
+ etoys
+ "This method was automatically generated. Edit it using:"
+ "SqueakFurtherCorePackagesHelp edit: #etoys"
+ ^HelpTopic
+ title: 'Etoys'
+ contents:
+ 'The Etoys package includes all of the Etoys system with extended Morphs, a tile-based scripting language user interface and interpreter, and several applications based upon that.
+
+ This package also includes the Kedama project which provides means to create simulations with large numbers of objects based on a columnar storage.!!' readStream nextChunkText!
Item was added:
+ Object subclass: #StandardScriptingSystem
+ instanceVariableNames: ''
+ classVariableNames: 'ClassVarNamesInUse FormDictionary HelpStrings StandardPartsBin'
+ poolDictionaries: ''
+ category: 'Etoys-Morphic-Worlds'!
+
+ !StandardScriptingSystem commentStamp: '<historical>' prior: 0!
+ An instance of this is installed as the value of the global variable "ScriptingSystem". Client subclasses are invited, such as one used internally by squeak team for ongoing internal work.!
Item was added:
+ ----- Method: StandardScriptingSystem class>>cleanUp: (in category '*Etoys-class initialization') -----
+ cleanUp: agressive
+ "Clean up unreferenced players. If agressive, reinitialize and nuke players"
+
+ self removeUnreferencedPlayers.
+ agressive ifTrue:[
+ References keys do: [:k | References removeKey: k].
+ ClassVarNamesInUse := nil.
+ self initialize.
+ ].!
Item was added:
+ ----- Method: StandardScriptingSystem class>>initialize (in category '*Etoys-class initialization') -----
+ initialize
+ "Initialize the scripting system. Sometimes this method is vacuously changed just to get it in a changeset so that its invocation will occur as part of an update"
+
+ (self environment at: #ScriptingSystem ifAbsent: [nil]) ifNil:
+ [self environment at: #ScriptingSystem put: self new].
+
+ ScriptingSystem
+ initializeHelpStrings.
+
+ self registerInFlapsRegistry.
+
+ "StandardScriptingSystem initialize"!
Item was added:
+ ----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*Etoys-*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}
+ forFlapNamed: 'PlugIn Supplies'.
+ cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}
+ forFlapNamed: 'Supplies'.
+ cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}
+ forFlapNamed: 'Widgets'.
+ cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop}
+ forFlapNamed: 'Widgets'.]!
Item was added:
+ ----- Method: StandardScriptingSystem class>>removeUnreferencedPlayers (in category '*Etoys-class initialization') -----
+ removeUnreferencedPlayers
+ "Remove existing but unreferenced player references"
+ "StandardScriptingSystem removeUnreferencedPlayers"
+ References keys do:
+ [ : key | | ref |
+ ref := References at: key.
+ ((ref respondsTo: #costume) and: [ ref costume pasteUpMorph isNil ]) ifTrue: [ References removeKey: key ] ]!
Item was added:
+ ----- Method: StandardScriptingSystem class>>unload (in category '*Etoys-*MorphicExtras-class initialization') -----
+ unload
+ "Unload the receiver from global registries"
+
+ self environment at: #Flaps ifPresent: [:cl |
+ cl unregisterQuadsWithReceiver: ScriptingSystem] !
Item was added:
+ ----- Method: StandardScriptingSystem>>allClassVarNamesInSystem (in category '*Etoys-utilities') -----
+ allClassVarNamesInSystem
+ "Compute and answer a set of all the class variable names known to the sytem from any class"
+
+ | aList |
+ aList := OrderedCollection new.
+ Object withAllSubclasses do:
+ [:c | aList addAll: c allClassVarNames].
+ ^ aList asSet
+
+ "ScriptingSystem allClassVarNamesInSystem"
+ !
Item was added:
+ ----- Method: StandardScriptingSystem>>customizeForEToyUsers: (in category '*Etoys-utilities') -----
+ customizeForEToyUsers: aBoolean
+ "If aBoolean is true, set things up for etoy users. If it's false, unset some of those things. Some things are set when switching into etoy mode but not reversed when switching out of etoy mode."
+
+ #(
+ (allowEtoyUserCustomEvents no reverse)
+ (balloonHelpEnabled yes dontReverse)
+ (debugHaloHandle no reverse)
+ (modalColorPickers yes dontReverse)
+ (oliveHandleForScriptedObjects no dontReverse)
+ (uniqueNamesInHalos yes reverse)
+ (useUndo yes dontReverse)
+ (infiniteUndo no dontReverse)
+ (warnIfNoChangesFile no reverse)
+ (warnIfNoSourcesFile no reverse)) do:
+ [:trip |
+ (aBoolean or: [trip third == #reverse]) ifTrue:
+ [Preferences setFlag: trip first toValue:
+ ((trip second == #yes) & aBoolean) | ((trip second == #no) & aBoolean not)]]!
Item was added:
+ ----- Method: StandardScriptingSystem>>deletePrivateGraphics (in category '*Etoys-form dictionary') -----
+ deletePrivateGraphics
+ "ScriptingSystem deletePrivateGraphics"
+ self deletePrivateGraphics: self privateGraphics
+ afterStoringToFileNamed: 'disGraphics'!
Item was added:
+ ----- Method: StandardScriptingSystem>>deletePrivateGraphics:afterStoringToFileNamed: (in category '*Etoys-form dictionary') -----
+ deletePrivateGraphics: nameList afterStoringToFileNamed: aFileName
+ "This method is used to strip private graphics from the FormDictionary and store them on a file of the given name"
+
+ | replacement toRemove aReferenceStream |
+ toRemove := Dictionary new.
+ replacement := FormDictionary at: #Gets.
+
+ nameList do:
+ [:aKey |
+ | keySymbol |
+ keySymbol := aKey asSymbol.
+ (toRemove at: keySymbol put: (self formAtKey: keySymbol)).
+ FormDictionary at: keySymbol put: replacement].
+
+ aReferenceStream := ReferenceStream fileNamed: aFileName.
+ aReferenceStream nextPut: toRemove.
+ aReferenceStream close!
Item was added:
+ ----- Method: StandardScriptingSystem>>formAtKey: (in category '*Etoys-form dictionary') -----
+ formAtKey: aString
+ "Answer the form saved under the given key"
+
+ ^((Symbol lookup: aString)
+ ifNotNil: [ :aKey | FormDictionary at: aKey ifAbsent: [ FormDictionary at: #Cat ] ]
+ ifNil: [ FormDictionary at: #Cat ])
+ magnifyBy: RealEstateAgent scaleFactor!
Item was added:
+ ----- Method: StandardScriptingSystem>>formAtKey:extent:depth: (in category '*Etoys-form dictionary') -----
+ formAtKey: aKey extent: extent depth: depth
+ "ScriptingSystem saveForm: (TileMorph downPicture) atKey: 'downArrow'"
+ ^ FormDictionary at: aKey asSymbol ifAbsent: [Form extent: extent depth: depth]!
Item was added:
+ ----- Method: StandardScriptingSystem>>formDictionary (in category '*Etoys-form dictionary') -----
+ formDictionary
+ ^FormDictionary!
Item was added:
+ ----- Method: StandardScriptingSystem>>helpStringOrNilFor: (in category '*Etoys-help dictionary') -----
+ helpStringOrNilFor: aSymbol
+ "If my HelpStrings dictionary has an entry at the given symbol,
+ answer that entry's value, else answer nil"
+ HelpStrings
+ at: aSymbol
+ ifPresent:[:string | ^ string translated].
+ ^ nil!
Item was added:
+ ----- Method: StandardScriptingSystem>>initializeHelpStrings (in category '*Etoys-help dictionary') -----
+ initializeHelpStrings
+ "Initialize the data structure that determines, for the etoy system, help messages for various scripting elements. The structure is built up by letting every Morph subclass contribute elements simply by implementing method #helpContributions. Consult implementors of #helpContributions for examples of how this goes."
+
+ "ScriptingSystem initializeHelpStrings"
+
+ | aDictionary |
+ aDictionary := IdentityDictionary new.
+ "For safety, the new copy is built up in this temp first, so that if an error occurs during the creation of the structure, the old version will remain remain in place"
+
+ Morph withAllSubclasses do:
+ [:aClass | (aClass class includesSelector: #helpContributions)
+ ifTrue:
+ [aClass helpContributions do:
+ [:pair | aDictionary at: pair first put: pair second]]].
+
+ HelpStrings := aDictionary!
Item was added:
+ ----- Method: StandardScriptingSystem>>inspectFormDictionary (in category '*Etoys-form dictionary') -----
+ inspectFormDictionary
+ "ScriptingSystem inspectFormDictionary"
+
+ GraphicalDictionaryMenu openOn: FormDictionary withLabel: 'Testing One Two Three'!
Item was added:
+ ----- Method: StandardScriptingSystem>>privateGraphics (in category '*Etoys-form dictionary') -----
+ privateGraphics
+ "ScriptingSystem deletePrivateGraphics"
+ ^#(#BadgeMiniPic #BadgePic #Broom #CedarPic #CollagePic #CoverMain #CoverSpiral #CoverTexture #Fred #ImagiPic #KayaPic #StudioPic)!
Item was added:
+ ----- Method: StandardScriptingSystem>>saveForm:atKey: (in category '*Etoys-form dictionary') -----
+ saveForm: aForm atKey: aKey
+ FormDictionary at: aKey asSymbol put: aForm!
Item was added:
+ ----- Method: StandardScriptingSystem>>soundNamesToSuppress (in category '*Etoys-utilities') -----
+ soundNamesToSuppress
+ "Answer a list of sound-names that are not to be offered in sound-choice pop-ups unless they are the current choice"
+
+ ^ #('scrape' 'scritch' 'peaks')!
Item was added:
+ ----- Method: StandardScriptingSystem>>squeakyMouseForm (in category '*Etoys-form dictionary') -----
+ squeakyMouseForm
+ ^ self formAtKey: 'squeakyMouse'
+
+ "
+ ScriptingSystem saveForm: (Form
+ extent: 30@29
+ depth: 16
+ fromArray: #( 1811114995 1878286257 2012637171 1811180532 1811180533 1811179508 1811180532 1811179508 1744006133 1878289396 1811180533 1878289396 1744007156 1674736630 1744006132 1811114995 1811181556 1744006131 1811246068 1811180532 1811179508 1811180532 1744071668 1811113972 1811180532 1811180532 1811179507 1878288338 1945529332 1744071668 1743941620 1811112945 1811179506 1811114995 1744006131 1744006130 1744005106 1811048434 1811113969 1743939570 1811179506 1743939571 1676833782 1676765171 1811047410 1744006131 1811048435 1811116020 1811180531 1743939571 1811048435 1743939570 1743939570 1743939570 1743940594 1744005106 1811181556 1811180532 1676766196 1743939570 1878420468 1676963830 1189896082 1811245044 1744137204 1744070644 1811179508 1811113971 1743939571 1811179508 1811246070 1811309524 1811302093 1811310580 1811246068 1674867703 1744049472 1120606594 1118465013 1744137205 1811179508 1811180532 1744071667 1744006132 1811112947 1811247095 1605584589 358761132 289435638 1676
830707 1741975543 1462778473 1811312631 702891724 1811310548 1945528308 1811178450 1945528307 1878288372 1878353875 1878421494 1051471335 1809213397 1118524175 1811246068 1945659348 1185698607 1878486005 1672694510 1118531574 1607626741 1878420467 1811180533 1743942645 1744072693 1811301035 1185770487 1878486006 1324239597 1811180533 1811116019 1120623438 1878352818 1945462739 704868339 1878289395 1811049459 1878221808 1878223859 1743876083 1811162563 1945463796 1811181556 1464746666 1811116018 1809019893 1120551562 1945464821 1741844468 1466842760 1878289395 1811048434 1811050483 1811050483 1878223859 1049188174 1741910004 1811181556 1256998634 1811114994 1878289396 1466840647 1744007156 1744006131 1676877216 1743940596 1878222835 1743938545 1878351792 1676833781 358641652 1743940596 1811050484 845566798 1811113970 1811114995 1811163652 1811112913 1878420468 1878282028 1811179506 1607560178 1878289395 1676900342 1878351825 1466853330 1811113971 1811116019 635659217 1811179506 18112
45045 1676942754 1744137206 1744201717 1676962806 1676962805 1811310581 1676896245 1744199635 1811376117 1744072695 1744005109 1811244019 499279861 1811310581 1811244020 1811293668 1399943159 1605528567 1744136181 982063522 986342388 1744070645 1744189066 430063308 1744071669 1744070644 1744067504 566519797 1744136181 1744137205 1743999854 912813044 1811311606 1742162607 4195488 283139922 1945531382 1253113857 144710948 1601400791 1811246069 1811167879 1464821747 1744136180 1674799094 1811178482 843473875 1811311606 1878533542 2106790 2080066222 1876193270 696845376 627472380 1185772536 1878355957 1743990309 1744007157 1676898294 1744006132 1811114996 1743941620 1811180533 1809204941 4194368 4217681 1878290421 1252982848 4194336 1670540278 1739811795 1878353906 1744006131 1811179506 1744007157 1744005106 1945462771 1811182582 1811311574 1393641133 1462856629 2012638196 1876382449 1112301394 1742041045 1945596917 1676833781 1811113970 1811179507 1811180532 1672705014 1674735606 16726
97648 1945725943 1878551479 1809215479 1811312629 1809216504 1809215479 1809215478 1462853490 1878487029 1744007158 1744005075 1811239726 704979363 495004132 700789287 562372997 631646663 1739998892 4194400 1116497846 698688932 562375109 770124262 633609569 495070758 1257010166 562315916 1809279958 2012894002 1047280171 980237901 910966381 1668677696 4194400 6314867 1047281260 908804749 910968495 1393719290 1809279959 1185750370 1809214455 1878469062 423836236 1532188466 1601592148 1462986647 1672937568 4194368 6319062 1603622706 1601525554 1601522417 1047336194 770206679 1878487031 1878409899 977955830 1809145716 1118586509 980105834 980045584 1811372914 980104778 1605526483 1395605131 910769804 1118651052 1534358520 1809136234 1118596053 1532059506 1878485973 1326456163 1945660374 1742106615 1811311607 1945725942 1742107641 1744072693 1811311605 1744203767 1878551543 564478604 1878553591 1603428242 1811048433 1811049459 1051290611 1744006131 1811049459 1878156273 1743874034 174400
7156 1743874033 1811048434 1811113970 1743939571 1743933228 1603301363 1743875059 1811049458 1945461745 1811181556 1811113971 1811049458 1811048434 1811116020 1878287346 1878223857 1743940594 1744006130 1744007157 1945395153 1945400309 1811048434 1743810547 1676765170 1878353906 1811113970 1743874032 1810983921 1743874033 1811113971 1676765169 1743874034 1743940593 1743939569 1811047409 1676765168 1743940595 1810981872 1945397235 1607560179 1743941620 1810982897 1810983921 1811048433 1744007155 1743875059 1811048434 1743875058 1743939568 1676832754 1811116019 1811114994 1811244019 1676962805 1677029367 1811244020 1744005106 1743940594 1811246068 1744070645 1676961781 1744004084 1676897269 1811180533 1878353908 1744004083 1744070645)
+ offset: 0@0) atKey: 'squeakyMouse'"!
Item was added:
+ ----- Method: StandardScriptingSystem>>stripGraphicsForExternalRelease (in category '*Etoys-utilities') -----
+ stripGraphicsForExternalRelease
+ "ScriptingSystem stripGraphicsForExternalRelease"
+
+ | replacement |
+ replacement := FormDictionary at: #Gets.
+
+ #('BadgeMiniPic' 'BadgePic' 'Broom' 'CedarPic' 'CollagePic' 'CoverMain' 'CoverSpiral' 'CoverTexture' 'Fred' 'ImagiPic' 'KayaPic' 'StudioPic')
+ do:
+ [:aKey | FormDictionary at: aKey asSymbol put: replacement]!
Item was added:
+ ----- Method: StringButtonMorph>>adaptToWorld: (in category '*Etoys-e-toy support') -----
+ adaptToWorld: aWorld
+ super adaptToWorld: aWorld.
+ target := target adaptedToWorld: aWorld.!
Item was added:
+ ----- Method: StringType>>initialValueForASlotFor: (in category '*Etoys-initial value') -----
+ initialValueForASlotFor: aPlayer
+ "Answer the value to give initially to a newly created slot of the given type in the given player"
+
+ ^ 'abc'!
Item was added:
+ ----- Method: SuperSwikiServer>>matchingEntries: (in category '*Etoys-for real') -----
+ matchingEntries: criteria
+ | result |
+ eToyUserListUrl ifNil:[^self entries].
+ result := self sendToSwikiProjectServer: {
+ 'action: listmatchingprojects'.
+ } , criteria.
+ (result beginsWith: 'OK')
+ ifFalse: [^self entries]. "If command not supported"
+ ^self parseListEntries: result!
Item was added:
+ ----- Method: SymbolListType>>initialValueForASlotFor: (in category '*Etoys-initial value') -----
+ initialValueForASlotFor: aPlayer
+ "Answer the value to give initially to a newly created slot of the given type in the given player"
+
+ ^ self choices first!
Item was added:
+ ----- Method: SystemWindow>>extantSketchEditor (in category '*Etoys-top window') -----
+ extantSketchEditor
+ "If my world has an extant SketchEditorMorph associated with anything
+ in this window, return that SketchEditor, else return nil"
+ | w sketchEditor pasteUp |
+ (w := self world) isNil ifTrue: [^ nil].
+ (sketchEditor := w sketchEditorOrNil) isNil ifTrue: [^ nil].
+ (pasteUp := sketchEditor enclosingPasteUpMorph) isNil ifTrue: [^ nil].
+ self findDeepSubmorphThat: [:m | m = pasteUp]
+ ifAbsent: [^ nil].
+ ^ sketchEditor!
Item was added:
+ ----- Method: SystemWindow>>wantsExpandBox (in category '*Etoys-resize/collapse') -----
+ wantsExpandBox
+ "Answer whether I'd like an expand box"
+
+ ^ Preferences alwaysHideExpandButton not!
Item was added:
+ ----- Method: SystemWindow>>wantsHalo (in category '*Etoys-events') -----
+ wantsHalo
+ ^ false!
Item was added:
+ ----- Method: TabbedPalette>>becomeStandardPalette (in category '*Etoys-misc menu items') -----
+ becomeStandardPalette
+ self presenter standardPalette: self!
Item was added:
+ RectangleMorph subclass: #TextFieldMorph
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-Morphic-Text Support'!
+
+ !TextFieldMorph commentStamp: '<historical>' prior: 0!
+ Act as a field in a HyperCard-like setting. Has both properties of a Rectangle, and exposes some proteries of the TextMorph it owns.
+
+ !
Item was added:
+ ----- Method: TextFieldMorph class>>authoringPrototype (in category '*Etoys-scripting') -----
+ authoringPrototype
+ "Answer an instance of the receiver that can serve as a prototype for authoring"
+
+ | proto |
+ proto := super authoringPrototype.
+ proto setProperty: #shared toValue: true.
+ proto extent: 170 @ 30.
+ proto color: Color veryLightGray lighter.
+ proto contents: 'on a clear day you can...'.
+ ^ proto
+ !
Item was added:
+ ----- Method: TextFieldMorph class>>initialize (in category '*Etoys-class initialization') -----
+ initialize
+
+ self registerInFlapsRegistry. !
Item was added:
+ ----- Method: TextFieldMorph class>>registerInFlapsRegistry (in category '*Etoys-class initialization') -----
+ registerInFlapsRegistry
+ "Register the receiver in the system's flaps registry"
+ self environment
+ at: #Flaps
+ ifPresent: [:cl | cl registerQuad: {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}
+ forFlapNamed: 'Scripting'.]!
Item was added:
+ ----- Method: TextFieldMorph class>>unload (in category '*Etoys-class initialization') -----
+ unload
+ "Unload the receiver from global registries"
+
+ self environment at: #Flaps ifPresent: [:cl |
+ cl unregisterQuadsWithReceiver: self] !
Item was added:
+ ----- Method: TextFieldMorph>>append: (in category '*Etoys-just like textMorph') -----
+ append: stringOrText
+ "add to my text"
+ | tm |
+
+ (tm := self findA: TextMorph) ifNil: [^ nil].
+ tm contents append: stringOrText.
+ tm releaseParagraph; paragraph.
+
+
+ !
Item was added:
+ ----- Method: TextFieldMorph>>contents (in category '*Etoys-just like textMorph') -----
+ contents
+ | tm |
+ "talk to my text"
+
+ (tm := self findA: TextMorph) ifNil: [^ nil].
+ ^ tm contents!
Item was added:
+ ----- Method: TextFieldMorph>>contents: (in category '*Etoys-just like textMorph') -----
+ contents: textOrString
+ "talk to my text"
+ | tm newText atts |
+
+ (tm := self findA: TextMorph) ifNil: [^ nil].
+ textOrString isString ifTrue: [
+ tm contents ifNotNil: ["Keep previous properties of the field"
+ newText := textOrString asText.
+ atts := tm contents attributesAt: 1.
+ atts do: [:each | newText addAttribute: each].
+ ^ tm contents: newText]].
+
+ ^ tm contents: textOrString!
Item was added:
+ ----- Method: TextFieldMorph>>defaultColor (in category '*Etoys-initialization') -----
+ defaultColor
+ "answer the default color/fill style for the receiver"
+ ^ Color veryLightGray lighter!
Item was added:
+ ----- Method: TextFieldMorph>>fit (in category '*Etoys-just like textMorph') -----
+ fit
+ "tell my text to recompute its looks"
+ | tm |
+
+ (tm := self findA: TextMorph) ifNil: [^ nil].
+ tm releaseParagraph; paragraph.!
Item was added:
+ ----- Method: TextFieldMorph>>fontName:size: (in category '*Etoys-just like textMorph') -----
+ fontName: fontName size: fontSize
+ | tm |
+ "talk to my text"
+
+ (tm := self findA: TextMorph) ifNil: [^ nil].
+ ^ tm fontName: fontName size: fontSize
+ !
Item was added:
+ ----- Method: TextFieldMorph>>initialize (in category '*Etoys-initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ | tm |
+ super initialize.
+ ""
+
+ self addMorph: (tm := TextMorph new).
+ tm fillingOnOff!
Item was added:
+ ----- Method: TextFieldMorph>>lineCount (in category '*Etoys-just like textMorph') -----
+ lineCount
+ | tm |
+ "how many lines in my text"
+
+ (tm := self findA: TextMorph) ifNil: [^ nil].
+ ^ tm contents string lineCount!
Item was added:
+ ----- Method: TextFieldMorph>>prepend: (in category '*Etoys-just like textMorph') -----
+ prepend: stringOrText
+ "add to my text"
+ | tm |
+
+ (tm := self findA: TextMorph) ifNil: [^ nil].
+ tm contents prepend: stringOrText.
+ tm releaseParagraph; paragraph.
+
+
+ !
Item was added:
+ ----- Method: TextMorph>>cursor (in category '*Etoys-accessing') -----
+ cursor
+ "Answer the receiver's logical cursor position"
+
+ | loc |
+ loc := self valueOfProperty: #textCursorLocation ifAbsentPut: [1].
+ loc := loc min: text string size.
+ ^ loc rounded
+ !
Item was added:
+ ----- Method: TextMorph>>cursorWrapped: (in category '*Etoys-accessing') -----
+ cursorWrapped: aNumber
+ "Set the cursor as indicated"
+
+ self setProperty: #textCursorLocation toValue: (((aNumber rounded - 1) \\ text string size) + 1)
+
+ !
Item was added:
+ ----- Method: TextMorph>>getAllButFirstCharacter (in category '*Etoys-scripting access') -----
+ getAllButFirstCharacter
+ "Obtain all but the first character from the receiver; if that would be empty, return a black dot"
+
+ | aString |
+ ^ (aString := text string) size > 1
+ ifTrue: [aString copyFrom: 2 to: aString size]
+ ifFalse: ['·']!
Item was added:
+ ----- Method: TextMorph>>holderForCharacters (in category '*Etoys-menu') -----
+ holderForCharacters
+ "Hand the user a Holder that is populated with individual text morphs representing my characters"
+
+ | aHolder |
+ aHolder := ScriptingSystem prototypicalHolder.
+ aHolder setNameTo: 'H', self externalName.
+ text string do:
+ [:aChar |
+ aHolder addMorphBack: (TextMorph new contents: aChar asText)].
+ aHolder setProperty: #donorTextMorph toValue: self.
+ aHolder fullBounds.
+ aHolder openInHand!
Item was added:
+ ----- Method: TextMorph>>insertCharacters: (in category '*Etoys-scripting access') -----
+ insertCharacters: aString
+ "Insert the characters from the given source at my current cursor position"
+
+ | aLoc aText attributes |
+ aLoc := self cursor max: 1.
+ aText := aLoc > text size
+ ifTrue: [aString asText]
+ ifFalse: [
+ attributes := (text attributesAt: aLoc)
+ select: [:attr | attr mayBeExtended].
+ Text string: aString attributes: attributes].
+ paragraph replaceFrom: aLoc to: (aLoc - 1) with: aText displaying: true.
+ self updateFromParagraph !
Item was added:
+ ----- Method: TextMorph>>insertContentsOf: (in category '*Etoys-scripting access') -----
+ insertContentsOf: aPlayer
+ "Insert the characters from the given player at my current cursor position"
+
+ | aLoc |
+ aLoc := self cursor.
+ paragraph replaceFrom: aLoc to: (aLoc - 1) with: aPlayer getStringContents displaying: true.
+ self updateFromParagraph !
Item was added:
+ ----- Method: TextMorph>>setAllButFirstCharacter: (in category '*Etoys-scripting access') -----
+ setAllButFirstCharacter: source
+ "Set all but the first char of the receiver to the source"
+ | chars |
+ (chars := self getCharacters) isEmpty
+ ifTrue: [self newContents: '·' , source asString]
+ ifFalse: [self newContents: (String
+ streamContents: [:aStream |
+ aStream nextPut: chars first.
+ aStream nextPutAll: source])]!
Item was added:
+ ----- Method: TextMorph>>wouldAcceptKeyboardFocusUponTab (in category '*Etoys-event handling') -----
+ wouldAcceptKeyboardFocusUponTab
+ "Answer whether the receiver might accept keyboard focus if
+ tab were hit in some container playfield"
+ ^ self inPartsBin not!
Item was added:
+ ----- Method: TextMorphForEditView>>wouldAcceptKeyboardFocusUponTab (in category '*Etoys-event handling') -----
+ wouldAcceptKeyboardFocusUponTab
+ "Answer whether the receiver would be a happy inheritor of keyboard focus if tab were hit in an enclosing playfield under propitious circumstances. Does not make sense for this kind of morph, which is encased in a window"
+
+ ^ false!
Item was added:
+ ----- Method: TheWorldMenu>>adaptToWorld: (in category '*Etoys-*MorphicExtras-mechanics') -----
+ adaptToWorld: aWorld
+
+ myWorld := aWorld.
+ myProject := nil. "figure it out if and when needed. maybe make it easier to find"
+ myHand := aWorld primaryHand.!
Item was added:
+ ----- Method: TheWorldMenu>>menuColorString (in category '*Etoys-action') -----
+ menuColorString
+
+ ^ Preferences menuColorString!
Item was added:
+ ----- Method: TheWorldMenu>>mvcProjectsAllowed (in category '*Etoys-commands') -----
+ mvcProjectsAllowed
+
+ ^Preferences mvcProjectsAllowed and: [Smalltalk includesKey: #StandardSystemView]!
Item was added:
+ ----- Method: TheWorldMenu>>roundedCornersString (in category '*Etoys-action') -----
+ roundedCornersString
+
+ ^ (((SystemWindow roundedWindowCorners)
+ ifTrue: ['stop']
+ ifFalse: ['start']) , ' rounding window corners') translated!
Item was added:
+ ----- Method: TheWorldMenu>>toggleMenuColorPolicy (in category '*Etoys-action') -----
+ toggleMenuColorPolicy
+
+ Preferences toggle: #menuColorFromWorld.!
Item was added:
+ ----- Method: ThreePhaseButtonMorph>>adaptToWorld: (in category '*Etoys-*MorphicExtras-e-toy support') -----
+ adaptToWorld: aWorld
+ super adaptToWorld: aWorld.
+ self target: (target adaptedToWorld: aWorld).!
Item was added:
+ ----- Method: ThumbnailMorph>>isEtoyReadout (in category '*Etoys-scripting') -----
+ isEtoyReadout
+ "Answer whether the receiver can serve as an etoy readout"
+
+ ^ true!
Item was added:
+ MorphicModel subclass: #TwoWayScrollPane
+ instanceVariableNames: 'getMenuSelector getMenuTitleSelector xScrollBar yScrollBar scroller'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-MorphicExtras-Obsolete'!
+
+ !TwoWayScrollPane commentStamp: '<historical>' prior: 0!
+ TwoWayScrollPane is now obsolete. You should be able to use ScrollPane to do both vertical and horizontal scrolling.
+
+ As an example, see Morph>>inATwoWayScrollPane and change the first line to create a ScrollPane instead of a TwoWayScrollPane. It will still work.
+
+ (EllipseMorph new extent: 200@150) inATwoWayScrollPane openInWorld
+
+ Note that user preferences for ScrollPane may be geared toward text scrolling, so that the horizontal scrollbar may be hidden when not needed, while the vertical scrollbar is always shown. Use ScrollPane>>alwaysShowHScrollbar: or its variants to adjust this if you want the vertical & horizontal scrollbars to be shown consistently.
+ !
Item was added:
+ ----- Method: TwoWayScrollPane class>>includeInNewMorphMenu (in category '*Etoys-new-morph participation') -----
+ includeInNewMorphMenu
+ "OK to instantiate"
+ ^ true!
Item was added:
+ ----- Method: TwoWayScrollPane>>colorForInsets (in category '*Etoys-accessing') -----
+ colorForInsets
+ "My submorphs use the surrounding color"
+ owner notNil and:
+ [ owner color isColor ifTrue: [ ^ owner color ] ].
+ ^ Color white!
Item was added:
+ ----- Method: TwoWayScrollPane>>containsPoint: (in category '*Etoys-geometry testing') -----
+ containsPoint: aPoint
+ (super containsPoint: aPoint) ifTrue: [^ true].
+ "Also include scrollbar when it is extended..."
+ "used to handle retractable scrolbar"
+ ^ false!
Item was added:
+ ----- Method: TwoWayScrollPane>>createScrollBarNamed: (in category '*Etoys-initialization') -----
+ createScrollBarNamed: aString
+ "creates a scroll bar named as aString"
+ | result |
+ result := ScrollBar new model: self slotName: aString.
+ result borderStyle: (BorderStyle inset width: 2).
+ ^ result!
Item was added:
+ ----- Method: TwoWayScrollPane>>createScroller (in category '*Etoys-initialization') -----
+ createScroller
+ "create a scroller"
+ | result |
+ result := TransformMorph new color: Color transparent.
+ result offset: 0 @ 0.
+ ^ result!
Item was added:
+ ----- Method: TwoWayScrollPane>>defaultBorderColor (in category '*Etoys-initialization') -----
+ defaultBorderColor
+ ^ Color transparent!
Item was added:
+ ----- Method: TwoWayScrollPane>>defaultBorderStyle (in category '*Etoys-initialization') -----
+ defaultBorderStyle
+ ^ BorderStyle inset!
Item was added:
+ ----- Method: TwoWayScrollPane>>doLayoutIn: (in category '*Etoys-layout') -----
+ doLayoutIn: layoutBounds
+ "layout has changed. update scroll deltas or whatever else"
+
+ (owner notNil and: [owner hasProperty: #autoFitContents])
+ ifTrue: [self fitContents].
+ super doLayoutIn: layoutBounds.!
Item was added:
+ ----- Method: TwoWayScrollPane>>extent: (in category '*Etoys-geometry') -----
+ extent: newExtent
+ bounds extent = newExtent ifTrue: [^ self].
+ super extent: (newExtent max: 36@32).
+ self resizeScrollBar; resizeScroller; setScrollDeltas.
+ !
Item was added:
+ ----- Method: TwoWayScrollPane>>fitContents (in category '*Etoys-layout') -----
+ fitContents
+ "Adjust my size to fit my contents reasonably snugly"
+
+ self extent: scroller submorphBounds extent
+ + (yScrollBar width @ xScrollBar height)
+ + (self borderWidth*2)
+ !
Item was added:
+ ----- Method: TwoWayScrollPane>>getMenu: (in category '*Etoys-menu') -----
+ getMenu: shiftKeyState
+ "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key."
+
+ | menu aMenu aTitle |
+ getMenuSelector isNil ifTrue: [^nil].
+ menu := MenuMorph new defaultTarget: model.
+ aTitle := getMenuTitleSelector
+ ifNotNil: [model perform: getMenuTitleSelector].
+ getMenuSelector numArgs = 1
+ ifTrue:
+ [aMenu := model perform: getMenuSelector with: menu.
+ aTitle ifNotNil: [aMenu addTitle: aTitle].
+ ^aMenu].
+ getMenuSelector numArgs = 2
+ ifTrue:
+ [aMenu := model
+ perform: getMenuSelector
+ with: menu
+ with: shiftKeyState.
+ aTitle ifNotNil: [aMenu addTitle: aTitle].
+ ^aMenu].
+ ^self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'!
Item was added:
+ ----- Method: TwoWayScrollPane>>handlesMouseDown: (in category '*Etoys-event handling') -----
+ handlesMouseDown: evt
+ ^ true!
Item was added:
+ ----- Method: TwoWayScrollPane>>handlesMouseOver: (in category '*Etoys-event handling') -----
+ handlesMouseOver: evt
+ ^ true!
Item was added:
+ ----- Method: TwoWayScrollPane>>hideOrShowScrollBar (in category '*Etoys-retractable scroll bar') -----
+ hideOrShowScrollBar
+
+ ^self "we don't support retractable at the moment"!
Item was added:
+ ----- Method: TwoWayScrollPane>>hideOrShowScrollBar:forRange: (in category '*Etoys-retractable scroll bar') -----
+ hideOrShowScrollBar: scrollBar forRange: range
+
+ (self hasProperty: #hideUnneededScrollbars) ifFalse: [^ self].
+ (submorphs includes: scrollBar)
+ ifTrue: [range <= 0 ifTrue: [scrollBar model: nil; delete]]
+ ifFalse: [range > 0 ifTrue: [scrollBar model: self. self resizeScrollBar; addMorph: scrollBar]]
+ !
Item was added:
+ ----- Method: TwoWayScrollPane>>initialize (in category '*Etoys-initialization') -----
+ initialize
+ "initialize the state of the receiver"
+ super initialize.
+ ""
+ self addMorph: (yScrollBar := self createScrollBarNamed: 'yScrollBar');
+ addMorph: (xScrollBar := self createScrollBarNamed: 'xScrollBar');
+ addMorph: (scroller := self createScroller).
+ ""
+ self extent: 150 @ 120!
Item was added:
+ ----- Method: TwoWayScrollPane>>keyStroke: (in category '*Etoys-event handling') -----
+ keyStroke: evt
+ "If pane is not full, pass the event to the last submorph,
+ assuming it is the most appropriate recipient (!!)"
+
+ scroller submorphs last keyStroke: evt!
Item was added:
+ ----- Method: TwoWayScrollPane>>leftOrRight (in category '*Etoys-menu') -----
+ leftOrRight "Change scroll bar location"
+
+ "used to handle left vs right scrollbar"!
Item was added:
+ ----- Method: TwoWayScrollPane>>leftoverScrollRange (in category '*Etoys-geometry') -----
+ leftoverScrollRange
+ "Return the entire scrolling range minus the currently viewed area."
+ ^ self totalScrollRange - (self innerBounds extent * 3 // 4) max: 0@0
+ !
Item was added:
+ ----- Method: TwoWayScrollPane>>menuSelector: (in category '*Etoys-menu') -----
+ menuSelector: aSelector
+ getMenuSelector := aSelector!
Item was added:
+ ----- Method: TwoWayScrollPane>>menuTitleSelector: (in category '*Etoys-menu') -----
+ menuTitleSelector: aSelector
+ getMenuTitleSelector := aSelector!
Item was added:
+ ----- Method: TwoWayScrollPane>>mouseDown: (in category '*Etoys-event handling') -----
+ mouseDown: evt
+ evt yellowButtonPressed "First check for option (menu) click"
+ ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
+ "If pane is not full, pass the event to the last submorph,
+ assuming it is the most appropriate recipient (!!)"
+ scroller hasSubmorphs ifTrue:
+ [scroller submorphs last mouseDown: (evt transformedBy: (scroller transformFrom: self))]!
Item was added:
+ ----- Method: TwoWayScrollPane>>mouseEnter: (in category '*Etoys-event handling') -----
+ mouseEnter: event
+
+ "used to handle retractable scrolbar"!
Item was added:
+ ----- Method: TwoWayScrollPane>>mouseLeave: (in category '*Etoys-event handling') -----
+ mouseLeave: event
+
+ "used to handle retractable scrolbar"!
Item was added:
+ ----- Method: TwoWayScrollPane>>mouseMove: (in category '*Etoys-event handling') -----
+ mouseMove: evt
+ "If pane is not full, pass the event to the last submorph,
+ assuming it is the most appropriate recipient (!!)"
+ scroller hasSubmorphs ifTrue:
+ [scroller submorphs last mouseMove: (evt transformedBy: (scroller transformFrom: self))]!
Item was added:
+ ----- Method: TwoWayScrollPane>>mouseUp: (in category '*Etoys-event handling') -----
+ mouseUp: evt
+ "If pane is not full, pass the event to the last submorph,
+ assuming it is the most appropriate recipient (!!)"
+ scroller hasSubmorphs ifTrue:
+ [scroller submorphs last mouseUp: (evt transformedBy: (scroller transformFrom: self))]!
Item was added:
+ ----- Method: TwoWayScrollPane>>rejectsEvent: (in category '*Etoys-events-processing') -----
+ rejectsEvent: anEvent
+
+ scroller submorphs isEmpty ifTrue: [^true]. "something messed up here"
+ scroller firstSubmorph isSyntaxMorph ifTrue: [^ super rejectsEvent: anEvent].
+ ^self visible not "ignore locked status"!
Item was added:
+ ----- Method: TwoWayScrollPane>>resizeScrollBar (in category '*Etoys-geometry') -----
+ resizeScrollBar
+ "used to handle left vs right scrollbar"
+ yScrollBar bounds: (bounds topLeft extent: 16 @ (bounds height - 16)).
+ xScrollBar bounds: ((bounds left + 16) @ (bounds bottom - 16) extent: (bounds width - 16) @ 16).
+ !
Item was added:
+ ----- Method: TwoWayScrollPane>>resizeScroller (in category '*Etoys-geometry') -----
+ resizeScroller
+ | inner |
+ "used to handle left vs right scrollbar"
+ inner := self innerBounds.
+ scroller bounds: (inner topLeft + (yScrollBar width@0) corner: (inner bottomRight - (0@xScrollBar height)))!
Item was added:
+ ----- Method: TwoWayScrollPane>>retractableOrNot (in category '*Etoys-menu') -----
+ retractableOrNot "Change scroll bar operation"
+
+ "used to handle retractable scrolbar"!
Item was added:
+ ----- Method: TwoWayScrollPane>>scrollBarFills: (in category '*Etoys-geometry') -----
+ scrollBarFills: aRectangle
+ "Return true if a flop-out scrollbar fills the rectangle"
+ "used to handle retractable scrolbar"
+ ^ false!
Item was added:
+ ----- Method: TwoWayScrollPane>>scrollBarMenuButtonPressed: (in category '*Etoys-scroll bar events') -----
+ scrollBarMenuButtonPressed: event
+ ^ self yellowButtonActivity: event shiftPressed!
Item was added:
+ ----- Method: TwoWayScrollPane>>scrollBarOnLeft: (in category '*Etoys-menu') -----
+ scrollBarOnLeft: aBoolean
+
+ "used to handle left vs right scrollbar"!
Item was added:
+ ----- Method: TwoWayScrollPane>>scrollBy: (in category '*Etoys-geometry') -----
+ scrollBy: delta
+ "Move the contents in the direction delta."
+ "For now, delta is assumed to have a zero x-component. Used by scrollIntoView:"
+ | r newOffset |
+
+ newOffset := (scroller offset - delta max: 0@0) min: self leftoverScrollRange.
+ scroller offset: newOffset.
+
+ r := self leftoverScrollRange.
+ r y = 0
+ ifTrue: [yScrollBar value: 0.0]
+ ifFalse: [yScrollBar value: newOffset y asFloat / r y].
+ r x = 0
+ ifTrue: [xScrollBar value: 0.0]
+ ifFalse: [xScrollBar value: newOffset x asFloat / r x].
+ !
Item was added:
+ ----- Method: TwoWayScrollPane>>scrollIntoView:extra: (in category '*Etoys-geometry') -----
+ scrollIntoView: desiredRectangle extra: anumber
+ | shift |
+
+ shift := desiredRectangle deltaToEnsureInOrCentered: (
+ scroller offset extent: scroller bounds extent
+ ) extra: anumber.
+ shift = (0 @ 0) ifFalse: [self scrollBy: (0@0) - shift].
+ !
Item was added:
+ ----- Method: TwoWayScrollPane>>scroller (in category '*Etoys-access') -----
+ scroller
+ ^ scroller!
Item was added:
+ ----- Method: TwoWayScrollPane>>setScrollDeltas (in category '*Etoys-geometry') -----
+ setScrollDeltas
+ | range scrollDelta totalRange innerBounds |
+ totalRange := self totalScrollRange ifNil: [^ self].
+ range := self leftoverScrollRange.
+ innerBounds := self innerBounds.
+ scrollDelta := 10 @ 10.
+
+ self hideOrShowScrollBar: xScrollBar
+ forRange: totalRange x - (innerBounds width - yScrollBar width).
+ range x <= 0
+ ifTrue: [xScrollBar scrollDelta: 0.02 pageDelta: 0.2.
+ xScrollBar interval: 1.0]
+ ifFalse: [xScrollBar scrollDelta: (scrollDelta x / range x) asFloat
+ pageDelta: (innerBounds width - scrollDelta x / range x) asFloat.
+ xScrollBar interval: (innerBounds width - scrollDelta x / totalRange x) asFloat].
+
+ self hideOrShowScrollBar: yScrollBar
+ forRange: totalRange y - (innerBounds height - xScrollBar height).
+ range y <= 0
+ ifTrue: [yScrollBar scrollDelta: 0.02 pageDelta: 0.2.
+ yScrollBar interval: 1.0]
+ ifFalse: [yScrollBar scrollDelta: (scrollDelta y / range y) asFloat
+ pageDelta: (innerBounds height - scrollDelta y / range y) asFloat.
+ yScrollBar interval: (innerBounds height - scrollDelta y / totalRange y) asFloat]!
Item was added:
+ ----- Method: TwoWayScrollPane>>shiftedYellowButtonActivity (in category '*Etoys-scroll bar events') -----
+ shiftedYellowButtonActivity
+ ^ self yellowButtonActivity: true!
Item was added:
+ ----- Method: TwoWayScrollPane>>totalScrollRange (in category '*Etoys-geometry') -----
+ totalScrollRange
+
+ "Return the entire scrolling range."
+ ^ ((scroller localSubmorphBounds ifNil: [^nil]) encompass: 0@0) extent
+
+ !
Item was added:
+ ----- Method: TwoWayScrollPane>>unshiftedYellowButtonActivity (in category '*Etoys-scroll bar events') -----
+ unshiftedYellowButtonActivity
+ ^ self yellowButtonActivity: false!
Item was added:
+ ----- Method: TwoWayScrollPane>>wantsSlot (in category '*Etoys-access') -----
+ wantsSlot
+ "For now do it the old way, until we sort this out"
+ ^ true!
Item was added:
+ ----- Method: TwoWayScrollPane>>wantsYellowButtonMenu (in category '*Etoys-menu') -----
+ wantsYellowButtonMenu
+ "Answer true if the receiver wants a yellow button menu"
+ ^ getMenuSelector notNil!
Item was added:
+ ----- Method: TwoWayScrollPane>>xScrollBarMenuButtonPressed: (in category '*Etoys-scroll bar events') -----
+ xScrollBarMenuButtonPressed: event
+ ^ self yellowButtonActivity: event shiftPressed!
Item was added:
+ ----- Method: TwoWayScrollPane>>xScrollBarValue: (in category '*Etoys-scroll bar events') -----
+ xScrollBarValue: scrollValue
+
+ "although there appear to be no senders, see Slider>>setValue:"
+
+ scroller hasSubmorphs ifFalse: [^ self].
+ scroller offset: self leftoverScrollRange x * scrollValue @ scroller offset y!
Item was added:
+ ----- Method: TwoWayScrollPane>>xScrollerHeight (in category '*Etoys-retractable scroll bar') -----
+ xScrollerHeight
+
+ (submorphs includes: xScrollBar) "Sorry the logic is reversed :( "
+ ifFalse: [^ 0 @ 0] "already included"
+ ifTrue: [^ 0 @ xScrollBar height] "leave space for it"
+ !
Item was added:
+ ----- Method: TwoWayScrollPane>>yScrollBarMenuButtonPressed: (in category '*Etoys-scroll bar events') -----
+ yScrollBarMenuButtonPressed: event
+ ^ self yellowButtonActivity: event shiftPressed!
Item was added:
+ ----- Method: TwoWayScrollPane>>yScrollBarValue: (in category '*Etoys-scroll bar events') -----
+ yScrollBarValue: scrollValue
+
+ "although there appear to be no senders, see Slider>>setValue:"
+
+ scroller hasSubmorphs ifFalse: [^ self].
+ scroller offset: scroller offset x @ (self leftoverScrollRange y * scrollValue)!
Item was added:
+ ----- Method: TwoWayScrollPane>>yellowButtonActivity: (in category '*Etoys-scroll bar events') -----
+ yellowButtonActivity: shiftKeyState
+ | menu |
+ (menu := self getMenu: shiftKeyState) ifNotNil:
+ [menu setInvokingView: self.
+ menu popUpEvent: self activeHand lastEvent in: self world]!
Item was added:
+ ----- Method: UpdatingMenuItemMorph>>adaptToWorld: (in category '*Etoys-*MorphicExtras-e-toy support') -----
+ adaptToWorld: aWorld
+ super adaptToWorld: aWorld.
+ wordingProvider := wordingProvider adaptedToWorld: aWorld.!
Item was added:
+ ----- Method: UpdatingRectangleMorph>>isEtoyReadout (in category '*Etoys-accessing') -----
+ isEtoyReadout
+ "Answer whether the receiver can serve as an etoy readout"
+
+ ^ true!
Item was added:
+ ----- Method: UpdatingStringMorph>>isEtoyReadout (in category '*Etoys-target access') -----
+ isEtoyReadout
+ "Answer whether the receiver can serve as an etoy readout"
+
+ ^ true!
Item was added:
+ FlapTab subclass: #ViewerFlapTab
+ instanceVariableNames: 'scriptedPlayer'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Etoys-MorphicExtras-Flaps'!
+
+ !ViewerFlapTab commentStamp: 'kfr 10/28/2003 06:31' prior: 0!
+ ViewerFlapTab are flap tabs for etoy scripting viewers.!
Item was added:
+ ----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category '*Etoys-printing') -----
+ defaultNameStemForInstances
+ ^ 'viewerFlapTab' translatedNoop!
Item was added:
+ ----- Method: ViewerFlapTab class>>includeInNewMorphMenu (in category '*Etoys-new-morph participation') -----
+ includeInNewMorphMenu
+ "Not to be instantiated from the menu"
+ ^ false!
Item was added:
+ ----- Method: ViewerFlapTab>>addCustomMenuItems:hand: (in category '*Etoys-menu') -----
+ addCustomMenuItems: aMenu hand: aHandMorph
+ "Add further items to the menu as appropriate. NB: Cannot call super here."
+
+ aMenu add: 'flap color...' translated target: self action: #changeFlapColor.
+ aMenu addLine.
+ aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo.
+ aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior.
+ aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior.
+ aMenu addLine.
+ aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap.
+
+ aMenu add: 'destroy this flap' translated action: #destroyFlap!
Item was added:
+ ----- Method: ViewerFlapTab>>adjustPositionAfterHidingFlap (in category '*Etoys-show & hide') -----
+ adjustPositionAfterHidingFlap
+ "we add the width of flap itself to our referent, to reflect the actual width from the edge of the screen, including the space we leave for other flaps. see also ViewerFlapTab>>fitOnScreen"
+ self flag: #todo.
+ self referent width: self referent width + self width.
+ super adjustPositionAfterHidingFlap.!
Item was added:
+ ----- Method: ViewerFlapTab>>allNonSubmorphMorphs (in category '*Etoys-submorphs - accessing') -----
+ allNonSubmorphMorphs
+ "Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy. Especially the non-showing pages in BookMorphs."
+
+ ^ flapShowing
+ ifTrue: [#()]
+ ifFalse: [Array with: referent]!
Item was added:
+ ----- Method: ViewerFlapTab>>changeCompactFlap (in category '*Etoys-compact') -----
+ changeCompactFlap
+ self makeFlapCompact: self isFlapCompact not.!
Item was added:
+ ----- Method: ViewerFlapTab>>compactFlapString (in category '*Etoys-compact') -----
+ compactFlapString
+ ^ (self isFlapCompact
+ ifTrue: ['<on>compact flap']
+ ifFalse: ['<off>']), 'compact flap' translated!
Item was added:
+ ----- Method: ViewerFlapTab>>fitOnScreen (in category '*Etoys-positioning') -----
+ fitOnScreen
+ | constrainer |
+ super fitOnScreen.
+ "We want to leave a margin for the flaps on the side and for the global flaps at the top (like the Sugar navbar) so we reduce the referents top and its width. We undo this before hiding the flap in ViewerFlapTab>>adjustPositionAfterHidingFlap"
+ self flag: #todo.
+ constrainer := (owner ifNil: [self]) clearArea.
+ self flapShowing ifTrue: [
+ Flaps globalFlapTabsIfAny
+ do: [:each |
+ (each edgeToAdhereTo = #top and: [each bottom > self referent top])
+ ifTrue: [self referent top: each bottom].
+ (each edgeToAdhereTo = #top and: [each bottom > self top])
+ ifTrue: [self top: each bottom]].
+ self referent width: constrainer right - self width - self right].!
Item was added:
+ ----- Method: ViewerFlapTab>>graphicalMorphForTab (in category '*Etoys-menu') -----
+ graphicalMorphForTab
+ "Answer a graphical morph to serve as my tab's display"
+
+ ^ ThumbnailMorph new objectToView: scriptedPlayer viewSelector: #graphicForViewerTab!
Item was added:
+ ----- Method: ViewerFlapTab>>hibernate (in category '*Etoys-transition') -----
+ hibernate
+ "drop my viewer to save space when writing to the disk."
+
+ referent submorphs do:
+ [:m | (m isViewer) ifTrue: [m delete]]!
Item was added:
+ ----- Method: ViewerFlapTab>>initializeFor:topAt: (in category '*Etoys-transition') -----
+ initializeFor: aPlayer topAt: aTop
+
+ scriptedPlayer := aPlayer.
+ self useGraphicalTab.
+ self top: aTop!
Item was added:
+ ----- Method: ViewerFlapTab>>isCurrentlyGraphical (in category '*Etoys-accessing') -----
+ isCurrentlyGraphical
+ ^ true!
Item was added:
+ ----- Method: ViewerFlapTab>>isFlapCompact (in category '*Etoys-compact') -----
+ isFlapCompact
+ "Return true if the referent of the receiver represents a 'compact' flap"
+ referent layoutPolicy ifNil:[^false].
+ referent layoutPolicy isTableLayout ifFalse:[^false].
+ referent vResizing == #shrinkWrap ifFalse:[^false].
+ ^true!
Item was added:
+ ----- Method: ViewerFlapTab>>makeFlapCompact: (in category '*Etoys-compact') -----
+ makeFlapCompact: aBool
+ "Return true if the referent of the receiver represents a 'compact' flap"
+ aBool ifTrue:[
+ referent
+ layoutPolicy: TableLayout new;
+ vResizing: #shrinkWrap;
+ useRoundedCorners.
+ ] ifFalse:[
+ referent
+ layoutPolicy: nil;
+ vResizing: #rigid;
+ useSquareCorners.
+ ].!
Item was added:
+ ----- Method: ViewerFlapTab>>scriptedPlayer (in category '*Etoys-access') -----
+ scriptedPlayer
+ ^ scriptedPlayer!
Item was added:
+ ----- Method: ViewerFlapTab>>unhibernate (in category '*Etoys-transition') -----
+ unhibernate
+ "recreate my viewer"
+
+ | wasShowing viewer |
+ referent ifNotNil: [referent isViewer ifTrue: [^self]].
+ wasShowing := flapShowing.
+ "guard against not-quite-player-players"
+ viewer := ((scriptedPlayer respondsTo: #costume)
+ and: [scriptedPlayer costume isMorph])
+ ifTrue: [self presenter viewMorph: scriptedPlayer costume]
+ ifFalse: [self presenter viewObjectDirectly: scriptedPlayer].
+ wasShowing ifFalse: [self hideFlap].
+ ^viewer!
Item was added:
+ ----- Method: Vocabulary>>isEToyVocabulary (in category '*Etoys-queries') -----
+ isEToyVocabulary
+ ^false!
Item was added:
+ ----- Method: WebCamMorph class>>additionsToViewerCategories (in category '*Etoys-scripting') -----
+ additionsToViewerCategories
+ "Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories."
+ ^ #(
+
+ (#'camera' (
+ (slot resolution '160x120, 320x240, 640x480 or 1280x960'
+ WebCamResolution readWrite Player getWebCamResolution Player setWebCamResolution:)
+ (slot orientation 'Natural (mirrored) or navtive (as from the camera'
+ WebCamOrientation readWrite Player getWebCamOrientation Player setWebCamOrientation:)
+ (slot cameraIsOn 'Whether the camera is on/off' Boolean readWrite Player getWebCamIsOn Player setWebCamIsOn:)
+ (slot useFrameSize 'Resize the player to match the camera''s frame size'
+ Boolean readWrite Player getUseFrameSize Player setUseFrameSize:)
+ (slot lastFrame 'A player with the last frame' Player readOnly Player getLastFrame unused unused)
+ (slot showFPS 'Whether to show the samera''s frames per second' Boolean readWrite Player getShowFPS Player setShowFPS:)
+ ))
+ )
+ !
1
0
David T. Lewis uploaded a new version of Graphics to project The Trunk:
http://source.squeak.org/trunk/Graphics-dtl.548.mcz
==================== Summary ====================
Name: Graphics-dtl.548
Author: dtl
Time: 25 November 2023, 2:53:54.464042 pm
UUID: 4b57488c-75bd-4f20-9472-67acb703e6f4
Ancestors: Graphics-ct.547
Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script.
Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
=============== Diff against Graphics-ct.547 ===============
Item was removed:
- ----- Method: Quadrangle class>>exampleInViewer (in category 'instance creation') -----
- exampleInViewer
- "Create a sample Quadrangle and open a Viewer on it"
-
- (self region: (100@100 extent: 100@50) borderWidth: (1 + (6 atRandom)) borderColor: Color black insideColor: (Color perform: #(green red blue yellow) atRandom)) beViewed
-
- "Quadrangle exampleInViewer"!
1
0
David T. Lewis uploaded a new version of Help-Squeak-CorePackages to project The Trunk:
http://source.squeak.org/trunk/Help-Squeak-CorePackages-dtl.6.mcz
==================== Summary ====================
Name: Help-Squeak-CorePackages-dtl.6
Author: dtl
Time: 25 November 2023, 2:54:28.774751 pm
UUID: 8aef30fd-c83a-4162-9812-a7cfc0410feb
Ancestors: Help-Squeak-CorePackages-tpr.5
Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script.
Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
=============== Diff against Help-Squeak-CorePackages-tpr.5 ===============
Item was removed:
- ----- Method: SqueakFurtherCorePackagesHelp class>>etoys (in category 'pages') -----
- etoys
- "This method was automatically generated. Edit it using:"
- "SqueakFurtherCorePackagesHelp edit: #etoys"
- ^HelpTopic
- title: 'Etoys'
- contents:
- 'The Etoys package includes all of the Etoys system with extended Morphs, a tile-based scripting language user interface and interpreter, and several applications based upon that.
-
- This package also includes the Kedama project which provides means to create simulations with large numbers of objects based on a columnar storage.!!' readStream nextChunkText!
1
0
David T. Lewis uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-dtl.1537.mcz
==================== Summary ====================
Name: Kernel-dtl.1537
Author: dtl
Time: 25 November 2023, 2:55:01.075199 pm
UUID: f749c283-2e40-4db8-978d-c518f827cc37
Ancestors: Kernel-eem.1536
Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script.
Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
=============== Diff against Kernel-eem.1536 ===============
Item was removed:
- ----- Method: Object>>adaptedToWorld: (in category 'scripting') -----
- adaptedToWorld: aWorld
- "If I refer to a world or a hand, return the corresponding items in the new world."
- ^self!
Item was removed:
- ----- Method: Object>>beViewed (in category 'testing') -----
- beViewed
- "Open up a viewer on the receiver. The Presenter is invited to decide just how to present this viewer"
-
- self uniqueNameForReference. "So the viewer will have something nice to refer to"
- self presenter viewObject: self!
Item was removed:
- ----- Method: Object>>belongsToUniClass (in category 'testing') -----
- belongsToUniClass
- "Answer whether the receiver belongs to a uniclass. For the moment (this is not entirely satisfactory) this is precisely equated with the classname ending in a digit"
-
- ^ self class isUniClass!
Item was removed:
- ----- Method: Object>>costumes (in category 'testing') -----
- costumes
- "Answer a list of costumes associated with the receiver. The appearance of this method in class Object serves only as a backstop, probably only transitionally"
-
- ^ nil!
Item was removed:
- ----- Method: Object>>defaultFloatPrecisionFor: (in category 'scripting') -----
- defaultFloatPrecisionFor: aGetSelector
- "Answer a number indicating the default float precision to be used in a numeric readout for which the receiver is the model."
-
- ^ 1!
Item was removed:
- ----- Method: Object>>evaluateUnloggedForSelf: (in category 'scripting') -----
- evaluateUnloggedForSelf: aCodeString
-
- ^Compiler evaluate:
- aCodeString
- for: self!
Item was removed:
- ----- Method: Object>>isPlayer (in category 'testing') -----
- isPlayer
- ^false!
Item was removed:
- ----- Method: Object>>isPrimitiveCostume (in category 'testing') -----
- isPrimitiveCostume
- "True for primitive costumes in Tweak. Added here because a Tweak override in DisplayScanner was merged into trunk for maintainability"
- ^false!
Item was removed:
- ----- Method: Object>>isScriptEditorMorph (in category 'testing') -----
- isScriptEditorMorph
- ^false!
Item was removed:
- ----- Method: Object>>isUniversalTiles (in category 'macpal') -----
- isUniversalTiles
- "Return true if I (my world) uses universal tiles. This message can be called in places where the current World is not known, such as when writing out a project. For more information about the project-writing subtlety addressed by this protocol, kindly contact Ted Kaehler."
-
- ^ Preferences universalTiles!
Item was removed:
- ----- Method: Object>>methodInterfacesForCategory:inVocabulary:limitClass: (in category 'scripting') -----
- methodInterfacesForCategory: aCategorySymbol inVocabulary: aVocabulary limitClass: aLimitClass
- "Return a list of methodInterfaces for the receiver in the given category, given a vocabulary. aCategorySymbol is the inherent category symbol, not necessarily the wording as expressed in the vocabulary."
-
- | categorySymbol |
- categorySymbol := aCategorySymbol asSymbol.
-
- (categorySymbol == ScriptingSystem nameForInstanceVariablesCategory) ifTrue: [
- "user-defined instance variables"
- ^ self methodInterfacesForInstanceVariablesCategoryIn: aVocabulary].
- (categorySymbol == ScriptingSystem nameForScriptsCategory) ifTrue: [
- "user-defined scripts"
- ^ self methodInterfacesForScriptsCategoryIn: aVocabulary].
- "all others"
- ^ self usableMethodInterfacesIn: (aVocabulary methodInterfacesInCategory: categorySymbol
- forInstance: self
- ofClass: self class
- limitClass: aLimitClass)
- !
Item was removed:
- ----- Method: Object>>methodInterfacesForInstanceVariablesCategoryIn: (in category 'scripting') -----
- methodInterfacesForInstanceVariablesCategoryIn: aVocabulary
- "Return a collection of methodInterfaces for the instance-variables category. The vocabulary parameter, at present anyway, is not used. And for non-players, the method is at present vacuous in any case"
-
- ^ OrderedCollection new!
Item was removed:
- ----- Method: Object>>methodInterfacesForScriptsCategoryIn: (in category 'scripting') -----
- methodInterfacesForScriptsCategoryIn: aVocabulary
- "Answer a list of method interfaces for the category #scripts, as seen in a viewer or other tool. The vocabulary argument is not presently used. Also, at present, only Players really do anyting interesting here."
-
- ^ OrderedCollection new!
Item was removed:
- ----- Method: Object>>presenter (in category 'accessing') -----
- presenter
- "Answer the presenter object associated with the receiver. For morphs, there is in effect a clear containment hierarchy of presenters (accessed via their association with PasteUpMorphs); for arbitrary objects the hook is simply via the current world, at least at present."
-
- ^ self currentWorld presenter!
Item was removed:
- ----- Method: Object>>renameInternal: (in category 'testing') -----
- renameInternal: newName
- "Change the internal name (because of a conflict) but leave the external name unchanged. Change Player class name, but do not change the names that appear in tiles. Any object that might be pointed to in the References dictionary might get this message sent to it upon reload"
-
- ^ nil "caller will renameTo:. new name may be different"!
Item was removed:
- ----- Method: Object>>scriptPerformer (in category 'macpal') -----
- scriptPerformer
-
- ^ self
- !
Item was removed:
- ----- Method: Object>>selfWrittenAsIll (in category 'scripting') -----
- selfWrittenAsIll
-
- ^self!
Item was removed:
- ----- Method: Object>>selfWrittenAsIm (in category 'scripting') -----
- selfWrittenAsIm
-
- ^self!
Item was removed:
- ----- Method: Object>>selfWrittenAsMe (in category 'scripting') -----
- selfWrittenAsMe
-
- ^self!
Item was removed:
- ----- Method: Object>>selfWrittenAsMy (in category 'scripting') -----
- selfWrittenAsMy
-
- ^self!
Item was removed:
- ----- Method: Object>>selfWrittenAsThis (in category 'scripting') -----
- selfWrittenAsThis
-
- ^self!
Item was removed:
- ----- Method: Object>>slotInfo (in category 'macpal') -----
- slotInfo
- "Answer a list of slot-information objects. Initally only provides useful info for players"
-
- ^ Dictionary new!
Item was removed:
- ----- Method: Object>>veryDeepCopySibling (in category 'copying') -----
- veryDeepCopySibling
- "Do a complete tree copy using a dictionary. Substitute a clone of oldPlayer for the root. Normally, a Player or non systemDefined object would have a new class. We do not want one this time. An object in the tree twice, is only copied once. All references to the object in the copy of the tree will point to the new copy."
-
- | copier new |
- copier := DeepCopier new: self initialDeepCopierSize.
- copier newUniClasses: false.
- new := self veryDeepCopyWith: copier.
- copier mapUniClasses.
- copier references associationsDo: [:assoc |
- assoc value veryDeepFixupWith: copier].
- copier fixDependents.
- ^ new!
1
0
David T. Lewis uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-dtl.2142.mcz
==================== Summary ====================
Name: Morphic-dtl.2142
Author: dtl
Time: 25 November 2023, 2:55:39.560759 pm
UUID: 24340daa-89b7-422e-a886-8ddeefbe67df
Ancestors: Morphic-ct.2141
Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script.
Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond)
=============== Diff against Morphic-ct.2141 ===============
Item was removed:
- PluggableTextMorph subclass: #AcceptableCleanTextMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
Item was removed:
- ----- Method: AcceptableCleanTextMorph>>accept (in category 'menu commands') -----
- accept
- "Overridden to allow accept of clean text"
-
- | textToAccept ok |
- textToAccept := textMorph text.
- ok := setTextSelector isNil or:
- [setTextSelector numArgs = 2
- ifTrue:
- [model
- perform: setTextSelector
- with: textToAccept
- with: self]
- ifFalse: [model perform: setTextSelector with: textToAccept]].
- ok
- ifTrue:
- [self setText: self getText.
- self hasUnacceptedEdits: false]!
Item was removed:
- BorderedMorph subclass: #BorderedSubpaneDividerMorph
- instanceVariableNames: 'resizingEdge'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Windows'!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph class>>forBottomEdge (in category 'instance creation') -----
- forBottomEdge
- ^self new horizontal resizingEdge: #bottom!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph class>>forTopEdge (in category 'instance creation') -----
- forTopEdge
- ^self new horizontal resizingEdge: #top!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph class>>horizontal (in category 'instance creation') -----
- horizontal
- ^self new horizontal!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph class>>vertical (in category 'instance creation') -----
- vertical
- ^self new vertical!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>defaultBorderWidth (in category 'initialization') -----
- defaultBorderWidth
- "answer the default border width for the receiver"
- ^ 0!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color black!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>firstEnter: (in category 'private') -----
- firstEnter: evt
- "The first time this divider is activated, find its window and redirect further interaction there."
- | window |
-
- window := self firstOwnerSuchThat: [:m | m respondsTo: #secondaryPaneTransition:divider:].
- window ifNil: [ self suspendEventHandler. ^ self ]. "not working out"
- window secondaryPaneTransition: evt divider: self.
- self on: #mouseEnter send: #secondaryPaneTransition:divider: to: window.
- !
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>horizontal (in category 'layout') -----
- horizontal
-
- self hResizing: #spaceFill.!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- super initialize.
- ""
- self extent: 1 @ 1!
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>resizingEdge (in category 'accessing') -----
- resizingEdge
-
- ^resizingEdge
- !
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>resizingEdge: (in category 'accessing') -----
- resizingEdge: edgeSymbol
-
- (#(top bottom) includes: edgeSymbol) ifFalse:
- [ self error: 'resizingEdge must be #top or #bottom' ].
- resizingEdge := edgeSymbol.
- self on: #mouseEnter send: #firstEnter: to: self.
- !
Item was removed:
- ----- Method: BorderedSubpaneDividerMorph>>vertical (in category 'layout') -----
- vertical
-
- self vResizing: #spaceFill.!
Item was removed:
- ----- Method: ColorPickerMorph>>delete (in category 'submorphs - add/remove') -----
- delete
- "The moment of departure has come.
- If the receiver has an affiliated command, finalize it and have the system remember it.
- In any case, delete the receiver"
-
- (selector isNil or: [ target isNil ]) ifFalse: [
- self rememberCommand:
- (Command new
- cmdWording: 'color change' translated;
- undoTarget: target selector: selector arguments: (self argumentsWith: originalColor);
- redoTarget: target selector: selector arguments: (self argumentsWith: selectedColor)).
- ].
- super delete!
Item was removed:
- ----- Method: ColorPickerMorph>>getColorFromKedamaWorldIfPossible: (in category 'kedama') -----
- getColorFromKedamaWorldIfPossible: aGlobalPoint
-
- self world submorphs do: [:sub |
- (sub isKedamaMorph) ifTrue: [
- sub morphsAt: aGlobalPoint unlocked: false do: [:e |
- ^ e colorAt: (aGlobalPoint - e topLeft).
- ].
- ].
- ].
- ^ nil.
- !
Item was removed:
- ----- Method: DockingBarMorph>>isSticky (in category 'accessing') -----
- isSticky
- "answer whether the receiver is Sticky"
- ^ Preferences noviceMode
- or: [super isSticky] !
Item was removed:
- ----- Method: DockingBarMorph>>resistsRemoval (in category 'accessing') -----
- resistsRemoval
- "Answer whether the receiver is marked as resisting removal"
- ^ Preferences noviceMode
- or: [super resistsRemoval]!
Item was removed:
- ----- Method: HaloMorph>>addChooseGraphicHandle: (in category 'handles') -----
- addChooseGraphicHandle: haloSpec
- "If the target is a sketch morph, and if the governing preference is set, add a halo handle allowing the user to select a new graphic"
-
- (Preferences showChooseGraphicHaloHandle and: [innerTarget isSketchMorph]) ifTrue:
- [self addHandle: haloSpec
- on: #mouseDown send: #chooseNewGraphicFromHalo to: innerTarget]
- !
Item was removed:
- ----- Method: HaloMorph>>addMakeSiblingHandle: (in category 'handles') -----
- addMakeSiblingHandle: haloSpec
- "Add the halo handle that allows a sibling instance to be torn off, or, if the shift key is down, for a deep-copy duplicate to be made."
-
- self addHandle: haloSpec on: #mouseDown send: #doMakeSiblingOrDup:with: to: self
-
- !
Item was removed:
- ----- Method: HaloMorph>>addPaintBgdHandle: (in category 'handles') -----
- addPaintBgdHandle: haloSpec
- (innerTarget isKindOf: PasteUpMorph) ifTrue:
- [self addHandle: haloSpec
- on: #mouseDown send: #paintBackground to: innerTarget].
- !
Item was removed:
- ----- Method: HaloMorph>>addPoohHandle: (in category 'handles') -----
- addPoohHandle: handleSpec
- (innerTarget isKindOf: (Smalltalk at: #WonderlandCameraMorph ifAbsent:[nil])) ifTrue:
- [self addHandle: handleSpec on: #mouseDown send: #strokeMode to: innerTarget]
- !
Item was removed:
- ----- Method: HaloMorph>>addRepaintHandle: (in category 'handles') -----
- addRepaintHandle: haloSpec
- (innerTarget isSketchMorph) ifTrue:
- [self addHandle: haloSpec
- on: #mouseDown send: #editDrawing to: innerTarget]
- !
Item was removed:
- ----- Method: HaloMorph>>addScriptHandle: (in category 'handles') -----
- addScriptHandle: haloSpec
- "If the halo's innerTarget claims it wants a Script handle, add one to the receiver, forming it as per haloSpec"
-
- innerTarget wantsScriptorHaloHandle ifTrue:
- [self addHandle: haloSpec
- on: #mouseUp send: #editButtonsScript to: innerTarget]
- !
Item was removed:
- ----- Method: HaloMorph>>addTileHandle: (in category 'handles') -----
- addTileHandle: haloSpec
- "Add the 'tear-off-tile' handle from the spec"
-
- self addHandle: haloSpec on: #mouseDown send: #tearOffTileForTarget:with: to: self
- !
Item was removed:
- ----- Method: HaloMorph>>addViewHandle: (in category 'handles') -----
- addViewHandle: haloSpec
- "Add the 'open viewer' handle from the halo spec"
-
- self addHandle: haloSpec
- on: #mouseDown send: #openViewerForTarget:with: to: self
-
-
- !
Item was removed:
- ----- Method: HaloMorph>>addViewingHandle: (in category 'handles') -----
- addViewingHandle: haloSpec
- "If appropriate, add a special Viewing halo handle to the receiver. On 26 Sept 07, we decided to eliminate this item from the UI, so the code of is method is now commented out...
-
- (innerTarget isKindOf: PasteUpMorph) ifTrue:
- [self addHandle: haloSpec
- on: #mouseDown send: #presentViewMenu to: innerTarget].
- "
- !
Item was removed:
- ----- Method: HaloMorph>>doDupOrMakeSibling:with: (in category 'handles') -----
- doDupOrMakeSibling: evt with: dupHandle
- "Ask hand to duplicate my target, if shift key *not* pressed, or make a sibling if shift key *is* pressed"
-
- ^ (evt shiftPressed and: [target couldMakeSibling])
- ifTrue:
- [dupHandle color: Color green muchDarker.
- self doMakeSibling: evt with: dupHandle]
- ifFalse:
- [self doDup: evt with: dupHandle]!
Item was removed:
- ----- Method: HaloMorph>>doMakeSibling:with: (in category 'private') -----
- doMakeSibling: evt with: dupHandle
- "Ask hand to make a sibling of my target. Only reachable if target is of a uniclass"
-
- target couldMakeSibling ifFalse: [^ self].
-
- target assuredPlayer assureUniClass.
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: dupHandle.
- self setTarget: (target makeSiblings: 1) first.
- evt hand grabMorph: target.
- self step. "update position if necessary"
- evt hand addMouseListener: self. "Listen for the drop"!
Item was removed:
- ----- Method: HaloMorph>>doMakeSiblingOrDup:with: (in category 'handles') -----
- doMakeSiblingOrDup: evt with: dupHandle
- "Ask hand to duplicate my target, if shift key *is* pressed, or make a sibling if shift key *not* pressed"
-
- ^ (evt shiftPressed or: [target couldMakeSibling not])
- ifFalse:
- [self doMakeSibling: evt with: dupHandle]
- ifTrue:
- [dupHandle color: Color green.
- self doDup: evt with: dupHandle]!
Item was removed:
- ----- Method: HaloMorph>>fadeIn (in category 'stepping') -----
- fadeIn
- self magicAlpha >= 1.0 ifTrue:[self stopSteppingSelector: #fadeIn].
- self magicAlpha: ((self magicAlpha + 0.1) min: 1.0)
- !
Item was removed:
- ----- Method: HaloMorph>>fadeInInitially (in category 'stepping') -----
- fadeInInitially
- | max |
- max := self isMagicHalo ifTrue:[0.3] ifFalse:[1.0].
- self magicAlpha >= max ifTrue:[self stopSteppingSelector: #fadeInInitially].
- self magicAlpha: ((self magicAlpha + (max * 0.1)) min: max)
- !
Item was removed:
- ----- Method: HaloMorph>>fadeOut (in category 'stepping') -----
- fadeOut
- self magicAlpha <= 0.3 ifTrue:[self stopSteppingSelector: #fadeOut].
- self magicAlpha: ((self magicAlpha - 0.1) max: 0.3)
- !
Item was removed:
- ----- Method: HaloMorph>>fadeOutFinally (in category 'stepping') -----
- fadeOutFinally
- self magicAlpha <= 0.05 ifTrue:[^super delete].
- self magicAlpha <= 0.3 ifTrue:[
- ^self magicAlpha: (self magicAlpha - 0.03 max: 0.0)].
- self magicAlpha: ((self magicAlpha * 0.5) max: 0.0)
- !
Item was removed:
- ----- Method: HaloMorph>>handleEntered (in category 'stepping') -----
- handleEntered
- self isMagicHalo ifFalse:[^self].
- self stopStepping; startStepping.
- self startSteppingSelector: #fadeIn.
- !
Item was removed:
- ----- Method: HaloMorph>>handleLeft (in category 'stepping') -----
- handleLeft
- self isMagicHalo ifFalse:[^self].
- self stopStepping; startStepping.
- self startSteppingSelector: #fadeOut.!
Item was removed:
- ----- Method: HaloMorph>>isMagicHalo (in category 'accessing') -----
- isMagicHalo
- ^self valueOfProperty: #isMagicHalo ifAbsent:[false].!
Item was removed:
- ----- Method: HaloMorph>>isMagicHalo: (in category 'accessing') -----
- isMagicHalo: aBool
- self setProperty: #isMagicHalo toValue: aBool.
- aBool
- ifTrue: [
- self on: #mouseEnter send: #handleEntered to: self.
- self on: #mouseLeave send: #handleLeft to: self]
- ifFalse:[
- "Reset everything"
- self eventHandler ifNotNil: [:eh |
- eh forgetDispatchesTo: #handleEntered;
- forgetDispatchesTo: #handleLeft].
- self stopStepping. "get rid of all"
- self startStepping. "only those of interest"].!
Item was removed:
- ----- Method: HaloMorph>>mouseDown: (in category 'events') -----
- mouseDown: event
-
- self isMagicHalo ifTrue: [
- self isMagicHalo: false.
- self magicAlpha: 1.0].
-
- super mouseDown: event.!
Item was removed:
- ----- Method: HaloMorph>>openViewerForTarget:with: (in category 'handles') -----
- openViewerForTarget: evt with: aHandle
- "Open a viewer for my inner target or if shift pressed make a snapshot of morph."
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
- evt shiftPressed
- ifTrue: [target duplicateMorphImage: evt]
- ifFalse: [innerTarget openViewerForArgument]!
Item was removed:
- ----- Method: HaloMorph>>popUpMagicallyFor:hand: (in category 'pop up') -----
- popUpMagicallyFor: aMorph hand: aHand
- "Programatically pop up a halo for a given hand."
-
- super
- popUpMagicallyFor: aMorph
- hand: aHand.
-
- Preferences magicHalos
- ifTrue: [self isMagicHalo: true].
- (Preferences haloTransitions not and: [self isMagicHalo])
- ifTrue: [self magicAlpha: 0.2].
- !
Item was removed:
- ----- Method: HaloMorph>>tearOffTileForTarget:with: (in category 'handles') -----
- tearOffTileForTarget: evt with: aHandle
- "Tear off a tile representing my inner target. If shift key is down, open up an instance browser on the morph itself, not the player, with tiles showing, instead"
-
- self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
- innerTarget tearOffTile!
Item was removed:
- ----- Method: HandMorph>>removePendingHaloFor: (in category 'halo handling') -----
- removePendingHaloFor: aMorph
- "Get rid of pending balloon help or halo actions."
- self removeAlarm: #spawnMagicHaloFor:.!
Item was removed:
- ----- Method: HandMorph>>spawnMagicHaloFor: (in category 'halo handling') -----
- spawnMagicHaloFor: aMorph
-
- self halo ifNotNil: [ :halo |
- halo target == aMorph ifTrue:[ ^self ] ].
- aMorph addMagicHaloFor: self.!
Item was removed:
- ----- Method: HandMorph>>triggerHaloFor:after: (in category 'halo handling') -----
- triggerHaloFor: aMorph after: timeOut
- "Trigger automatic halo after the given time out for some morph"
- self addAlarm: #spawnMagicHaloFor: with: aMorph after: timeOut!
Item was removed:
- ----- Method: ImageMorph class>>descriptionForPartsBin (in category 'parts bin') -----
- descriptionForPartsBin
- ^ self partName: 'Image' translatedNoop
- categories: #('Graphics' 'Basic')
- documentation: 'A non-editable picture. If you use the Paint palette to make a picture, you can edit it afterwards.' translatedNoop!
Item was removed:
- Object subclass: #KeyboardBuffer
- instanceVariableNames: 'event eventUsed'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
Item was removed:
- ----- Method: KeyboardBuffer>>commandKeyPressed (in category 'testing') -----
- commandKeyPressed
- ^ event commandKeyPressed!
Item was removed:
- ----- Method: KeyboardBuffer>>controlKeyPressed (in category 'testing') -----
- controlKeyPressed
- ^ event controlKeyPressed!
Item was removed:
- ----- Method: KeyboardBuffer>>flushKeyboard (in category 'keyboard control') -----
- flushKeyboard
- eventUsed ifFalse: [^ eventUsed := true].!
Item was removed:
- ----- Method: KeyboardBuffer>>keyboard (in category 'keyboard control') -----
- keyboard
- eventUsed ifFalse: [eventUsed := true. ^ event keyCharacter].
- ^ nil!
Item was removed:
- ----- Method: KeyboardBuffer>>keyboardPeek (in category 'keyboard control') -----
- keyboardPeek
- eventUsed ifFalse: [^ event keyCharacter].
- ^ nil!
Item was removed:
- ----- Method: KeyboardBuffer>>keyboardPressed (in category 'testing') -----
- keyboardPressed
- ^eventUsed not!
Item was removed:
- ----- Method: KeyboardBuffer>>leftShiftDown (in category 'testing') -----
- leftShiftDown
- ^ event shiftPressed!
Item was removed:
- ----- Method: KeyboardBuffer>>startingEvent: (in category 'private') -----
- startingEvent: evt
- event := evt.
- eventUsed := false!
Item was removed:
- ----- Method: MenuItemMorph>>adaptToWorld: (in category 'accessing') -----
- adaptToWorld: aWorld
-
- super adaptToWorld: aWorld.
- target := target adaptedToWorld: aWorld.!
Item was removed:
- ----- Method: MenuItemMorph>>allWordingsNotInSubMenus: (in category 'accessing') -----
- allWordingsNotInSubMenus: verbotenSubmenuContentsList
- "Answer a collection of the wordings of all items and subitems, but omit the stay-up item, and also any items in any submenu whose tag is in verbotenSubmenuContentsList"
-
- self isStayUpItem ifTrue:[^ #()].
- subMenu ifNotNil:
- [^ (verbotenSubmenuContentsList includes: self contents asString)
- ifTrue:
- [#()]
- ifFalse:
- [subMenu allWordingsNotInSubMenus: verbotenSubmenuContentsList]].
-
- ^ Array with: self contents asString!
Item was removed:
- ----- Method: MenuMorph>>undoGrabCommand (in category 'dropping/grabbing') -----
- undoGrabCommand
- ^nil!
Item was removed:
- ----- Method: Morph class>>selectionBackground (in category 'defaults') -----
- selectionBackground
- "The background for selected items in lists and tree-list thingies."
- ^ self subduedHilites ifTrue: [
- TranslucentColor r: 0.0 g: 0.0 b: 0.8 alpha: 0.2
- ] ifFalse: [
- "This is tuned so the red-foreground used for list texts stays somewhat legible."
- Color r: 0.8 g:0.8 b: 0.81 alpha: 0.85
- ].
- !
Item was removed:
- ----- Method: Morph>>adaptToWorld: (in category 'e-toy support') -----
- adaptToWorld: aWorld
- "The receiver finds itself operating in a possibly-different new world. If any of the receiver's parts are world-dependent (such as a target of a SimpleButtonMorph, etc.), then have them adapt accordingly"
- submorphs do: [:m | m adaptToWorld: aWorld].
- self eventHandler ifNotNil:
- [self eventHandler adaptToWorld: aWorld]!
Item was removed:
- ----- Method: Morph>>addMagicHaloFor: (in category 'halos and balloon help') -----
- addMagicHaloFor: aHand
-
- aHand halo ifNotNil: [:halo |
- halo target == self ifTrue:[^self].
- halo isMagicHalo ifFalse:[^self]].
-
- self createHalo
- popUpMagicallyFor: self hand: aHand!
Item was removed:
- ----- Method: Morph>>addMorphNearBack: (in category 'submorphs - misc') -----
- addMorphNearBack: aMorph
- | bg |
- (submorphs notEmpty and: [submorphs last mustBeBackmost])
- ifTrue:
- [bg := submorphs last.
- bg privateDelete].
- self addMorphBack: aMorph.
- bg ifNotNil: [self addMorphBack: bg]!
Item was removed:
- ----- Method: Morph>>addPaintingItemsTo:hand: (in category 'menus') -----
- addPaintingItemsTo: aMenu hand: aHandMorph
- | subMenu movies |
- subMenu := MenuMorph new defaultTarget: self.
- subMenu
- add: 'repaint' translated action: #editDrawing;
- add: 'set rotation center' translated action: #setRotationCenter;
- add: 'reset forward-direction' translated action: #resetForwardDirection;
- add: 'set rotation style' translated action: #setRotationStyle;
- add: 'erase pixels of color' translated action: #erasePixelsUsing:;
- add: 'recolor pixels of color' translated action: #recolorPixelsUsing:;
- add: 'reduce color palette' translated action: #reduceColorPalette:;
- add: 'detect edges' translated action: #edgeDetect;
- add: 'sharpen' translated action: #sharpen;
- add: 'blur' translated action: #blur;
- add: 'emboss' translated action: #emboss;
- add: 'add a border around this shape...' translated action: #addBorderToShape:.
- movies := (self world rootMorphsAt: aHandMorph targetPoint)
- select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]].
- movies size > 1
- ifTrue:
- [subMenu add: 'insert into movie' translated action: #insertIntoMovie:].
- aMenu add: 'painting...' translated subMenu: subMenu!
Item was removed:
- ----- Method: Morph>>allMenuWordings (in category 'menus') -----
- allMenuWordings
- | tempMenu |
- tempMenu := self buildHandleMenu: self currentHand.
- tempMenu allMorphsDo: [:m | m step]. "Get wordings current"
- ^ tempMenu allWordings!
Item was removed:
- ----- Method: Morph>>allMorphsAndBookPagesInto: (in category 'e-toy support') -----
- allMorphsAndBookPagesInto: aSet
- "Return a set of all submorphs. Don't forget the hidden ones like BookMorph pages that are not showing. Consider only objects that are in memory (see allNonSubmorphMorphs)."
-
- submorphs do: [:m | m allMorphsAndBookPagesInto: aSet].
- self allNonSubmorphMorphs do: [:m |
- (aSet includes: m) ifFalse: ["Stop infinite recursion"
- m allMorphsAndBookPagesInto: aSet]].
- aSet add: self.
- self player ifNotNil:
- [self player allScriptEditors do: [:e | e allMorphsAndBookPagesInto: aSet]].
- ^ aSet!
Item was removed:
- ----- Method: Morph>>allMorphsWithPlayersDo: (in category 'submorphs - misc') -----
- allMorphsWithPlayersDo: aTwoArgumentBlock
- "Evaluate the given block for all morphs in this composite morph that have non-nil players.
- Also evaluate the block for the receiver if it has a player."
-
- submorphs do: [:m | m allMorphsWithPlayersDo: aTwoArgumentBlock ].
- self playerRepresented ifNotNil: [ :p | aTwoArgumentBlock value: self value: p ].
- !
Item was removed:
- ----- Method: Morph>>applyStatusToAllSiblings: (in category 'meta-actions') -----
- applyStatusToAllSiblings: evt
- "Apply the statuses of all my scripts to the script status of all my siblings"
-
- | aPlayer |
- (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
- aPlayer instantiatedUserScriptsDo:
- [:aScriptInstantiation | aScriptInstantiation assignStatusToAllSiblings]!
Item was removed:
- ----- Method: Morph>>asNumber: (in category 'e-toy support') -----
- asNumber: aPointOrNumber
- "Support for e-toy demo."
-
- aPointOrNumber class = Point
- ifTrue: [^ aPointOrNumber r]
- ifFalse: [^ aPointOrNumber].
- !
Item was removed:
- ----- Method: Morph>>automaticViewing (in category 'e-toy support') -----
- automaticViewing
- "Backstop, in case this message gets sent to an owner that is not a playfield"
- ^ false!
Item was removed:
- ----- Method: Morph>>bringAllSiblingsToMe: (in category 'meta-actions') -----
- bringAllSiblingsToMe: evt
- "bring all siblings of the receiver's player found in the same container to the receiver's location."
-
- | aPlayer aPosition aContainer |
- (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
- aPosition := self topRendererOrSelf position.
- aContainer := self topRendererOrSelf owner.
- (aPlayer class allInstances copyWithout: aPlayer) do:
- [:each |
- (aContainer submorphs includes: each costume) ifTrue:
- [each costume position: aPosition]]!
Item was removed:
- ----- Method: Morph>>chooseNewGraphic (in category 'menus') -----
- chooseNewGraphic
- "Used by any morph that can be represented by a graphic"
- self chooseNewGraphicCoexisting: false
- !
Item was removed:
- ----- Method: Morph>>chooseNewGraphicCoexisting: (in category 'menus') -----
- chooseNewGraphicCoexisting: aBoolean
- "Allow the user to choose a different form for her form-based morph"
-
- | replacee aGraphicalMenu |
- self isInWorld ifFalse: "menu must have persisted for a not-in-world object."
- [aGraphicalMenu := Project current world submorphThat:
- [:m | (m isKindOf: GraphicalMenu) and: [m target == self]]
- ifNone:
- [^ self].
- ^ aGraphicalMenu show; flashBounds].
- aGraphicalMenu := GraphicalMenu new
- initializeFor: self
- withForms: self reasonableForms
- coexist: aBoolean.
- aBoolean
- ifTrue: [self primaryHand attachMorph: aGraphicalMenu]
- ifFalse: [replacee := self topRendererOrSelf.
- replacee owner replaceSubmorph: replacee by: aGraphicalMenu]!
Item was removed:
- ----- Method: Morph>>chooseNewGraphicFromHalo (in category 'menus') -----
- chooseNewGraphicFromHalo
- "Allow the user to select a changed graphic to replace the one in the receiver"
-
- self currentWorld abandonAllHalos.
- self chooseNewGraphicCoexisting: true
- !
Item was removed:
- ----- Method: Morph>>couldMakeSibling (in category 'testing') -----
- couldMakeSibling
- "Answer whether it is appropriate to ask the receiver to make a sibling"
-
- ^ true!
Item was removed:
- ----- Method: Morph>>currentPlayerDo: (in category 'e-toy support') -----
- currentPlayerDo: aBlock
- "If the receiver is a viewer/scriptor associated with a current Player object, evaluate the given block against that object"!
Item was removed:
- ----- Method: Morph>>cursor (in category 'e-toy support') -----
- cursor
- "vacuous backstop in case it gets sent to a morph that doesn't know what to do with it"
-
- ^ 1!
Item was removed:
- ----- Method: Morph>>cursor: (in category 'e-toy support') -----
- cursor: aNumber
- "vacuous backstop in case it gets sent to a morph that doesn't know what to do with it"
- !
Item was removed:
- ----- Method: Morph>>decimalPlacesForGetter: (in category 'e-toy support') -----
- decimalPlacesForGetter: aGetter
- "Answer the decimal places I prefer for showing a slot with the given getter, or nil if none"
-
- | decimalPrefs |
- decimalPrefs := self renderedMorph valueOfProperty: #decimalPlacePreferences ifAbsent: [^ nil].
- ^ decimalPrefs at: aGetter ifAbsent: [nil]!
Item was removed:
- ----- Method: Morph>>defaultValueOrNil (in category 'e-toy support') -----
- defaultValueOrNil
- "If the receiver has a property named #defaultValue, return that property's value, else return nil"
-
- ^ self valueOfProperty: #defaultValue ifAbsent: [nil]!
Item was removed:
- ----- Method: Morph>>demandsBoolean (in category 'classification') -----
- demandsBoolean
- "Answer whether the receiver will only accept a drop if it is boolean-valued. Particular to tile-scripting."
-
- ^ self hasProperty: #demandsBoolean!
Item was removed:
- ----- Method: Morph>>demandsThumbnailing (in category 'thumbnail') -----
- demandsThumbnailing
- "Answer whether the receiver, if in a thumbnailable parts bin, wants to be thumbnailed whether or not size requires it"
-
- ^ false!
Item was removed:
- ----- Method: Morph>>doMenuItem: (in category 'menus') -----
- doMenuItem: menuString
- | aMenu anItem aNominalEvent aHand |
- aMenu := self buildHandleMenu: (aHand := self currentHand).
- aMenu allMorphsDo: [:m | m step]. "Get wordings current"
- anItem := aMenu itemWithWording: menuString.
- anItem ifNil:
- [^ self player scriptingError: 'Menu item not found: ', menuString].
- aNominalEvent := MouseButtonEvent new
- setType: #mouseDown
- position: anItem bounds center
- which: 4 "red"
- buttons: 4 "red"
- hand: aHand
- stamp: nil.
- anItem invokeWithEvent: aNominalEvent!
Item was removed:
- ----- Method: Morph>>embedInWindow (in category 'e-toy support') -----
- embedInWindow
-
- | window worldToUse |
-
- worldToUse := self world. "I'm assuming we are already in a world"
- window := (SystemWindow labelled: self defaultLabelForInspector) model: nil.
- window bounds: ((self position - ((0@window labelHeight) + window borderWidth))
- corner: self bottomRight + window borderWidth).
- window addMorph: self frame: (0@0 extent: 1@1).
- window updatePaneColors.
- worldToUse addMorph: window.
- window beKeyWindow.!
Item was removed:
- ----- Method: Morph>>embeddedInMorphicWindowLabeled: (in category 'e-toy support') -----
- embeddedInMorphicWindowLabeled: labelString
- | window |
- window := (SystemWindow labelled: labelString) model: nil.
- window setStripeColorsFrom: Color white.
- window addMorph: self frame: (0@0 extent: 1@1).
- ^ window!
Item was removed:
- ----- Method: Morph>>getNumericValue (in category 'e-toy support') -----
- getNumericValue
- "Only certain kinds of morphs know how to deal with this frontally; here we provide support for a numeric property of any morph"
-
- ^ self valueOfProperty: #numericValue ifAbsent: [0]!
Item was removed:
- ----- Method: Morph>>gridFormOrigin:grid:background:line: (in category 'e-toy support') -----
- gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor
-
- | bigGrid gridForm gridOrigin |
- gridOrigin := origin \\ smallGrid.
- bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y).
- gridForm := Form extent: bigGrid depth: Display depth.
- backColor ifNotNil: [gridForm fillWithColor: backColor].
- gridOrigin x to: gridForm width by: smallGrid x do:
- [:x | gridForm fill: (x@0 extent: 1@gridForm height) fillColor: lineColor].
- gridOrigin y to: gridForm height by: smallGrid y do:
- [:y | gridForm fill: (0@y extent: gridForm width@1) fillColor: lineColor].
- ^ InfiniteForm with: gridForm
- !
Item was removed:
- ----- Method: Morph>>handUserASibling (in category 'e-toy support') -----
- handUserASibling
- "Make and hand the user a sibling instance. Force the creation of a uniclass at this point if one does not already exist for the receiver."
-
- | topRend |
- topRend := self topRendererOrSelf.
- topRend couldMakeSibling ifFalse: [^ Beeper beep].
-
- topRend assuredPlayer assureUniClass.
- (topRend makeSiblings: 1) first openInHand!
Item was removed:
- ----- Method: Morph>>indicateAllSiblings (in category 'meta-actions') -----
- indicateAllSiblings
- "Indicate all the receiver and all its siblings by flashing momentarily."
-
- | aPlayer allBoxes |
- (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [^ self "error: 'not uniclass'"].
- allBoxes := aPlayer class allInstances
- select: [:m | m costume world == self currentWorld]
- thenCollect: [:m | m costume boundsInWorld].
-
- 5 timesRepeat:
- [Display flashAll: allBoxes andWait: 120].!
Item was removed:
- ----- Method: Morph>>inspectArgumentsPlayerInMorphic: (in category 'debug and other') -----
- inspectArgumentsPlayerInMorphic: evt
- evt hand attachMorph: ((Inspector openOn: self player) extent: 300@200)!
Item was removed:
- ----- Method: Morph>>isAViewer (in category 'e-toy support') -----
- isAViewer
- ^ false!
Item was removed:
- ----- Method: Morph>>isCompoundTileMorph (in category 'classification') -----
- isCompoundTileMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isKedamaMorph (in category 'classification') -----
- isKedamaMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isLikelyRecipientForMouseOverHalos (in category 'halos and balloon help') -----
- isLikelyRecipientForMouseOverHalos
- ^self player notNil!
Item was removed:
- ----- Method: Morph>>isModalShell (in category 'classification') -----
- isModalShell
- ^false!
Item was removed:
- ----- Method: Morph>>isNumericReadoutTile (in category 'classification') -----
- isNumericReadoutTile
- ^false!
Item was removed:
- ----- Method: Morph>>isPhraseTileMorph (in category 'classification') -----
- isPhraseTileMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isPlayfieldLike (in category 'classification') -----
- isPlayfieldLike
- ^ false!
Item was removed:
- ----- Method: Morph>>isSoundTile (in category 'classification') -----
- isSoundTile
- ^false!
Item was removed:
- ----- Method: Morph>>isStandardViewer (in category 'classification') -----
- isStandardViewer
- ^false!
Item was removed:
- ----- Method: Morph>>isStickySketchMorph (in category 'classification') -----
- isStickySketchMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isSyntaxMorph (in category 'classification') -----
- isSyntaxMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isTileEditor (in category 'e-toy support') -----
- isTileEditor
- "No, I'm not"
- ^false!
Item was removed:
- ----- Method: Morph>>isTileMorph (in category 'classification') -----
- isTileMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isTilePadMorph (in category 'classification') -----
- isTilePadMorph
- ^false!
Item was removed:
- ----- Method: Morph>>isViewer (in category 'classification') -----
- isViewer
- ^false!
Item was removed:
- ----- Method: Morph>>makeGraphPaper (in category 'e-toy support') -----
- makeGraphPaper
- | smallGrid backColor lineColor |
- smallGrid := Compiler evaluate: (UIManager default request: 'Enter grid size' translated initialAnswer: '16').
- smallGrid ifNil: [^ self].
- UIManager default informUser: 'Choose a background color' translated during: [backColor := Color fromUser].
- UIManager default informUser: 'Choose a line color' translated during: [lineColor := Color fromUser].
- self makeGraphPaperGrid: smallGrid background: backColor line: lineColor.!
Item was removed:
- ----- Method: Morph>>makeGraphPaperGrid:background:line: (in category 'e-toy support') -----
- makeGraphPaperGrid: smallGrid background: backColor line: lineColor
-
- | gridForm |
- gridForm := self gridFormOrigin: 0@0 grid: smallGrid asPoint background: backColor line: lineColor.
- self color: gridForm.
- self world ifNotNil: [self world fullRepaintNeeded].
- self changed: #newColor. "propagate to view"
- !
Item was removed:
- ----- Method: Morph>>makeMultipleSiblings: (in category 'meta-actions') -----
- makeMultipleSiblings: evt
- "Make multiple siblings, first prompting the user for how many"
-
- | result |
- self topRendererOrSelf couldMakeSibling ifFalse: [^ Beeper beep].
- result := UIManager default request: 'how many siblings do you want?' translated initialAnswer: '2'.
- result isEmptyOrNil ifTrue: [^ self].
- result first isDigit ifFalse: [^ Beeper beep].
- self topRendererOrSelf makeSiblings: result asInteger.!
Item was removed:
- ----- Method: Morph>>makeNascentScript (in category 'menus') -----
- makeNascentScript
- ^ self notYetImplemented!
Item was removed:
- ----- Method: Morph>>makeNewPlayerInstance: (in category 'meta-actions') -----
- makeNewPlayerInstance: evt
- "Make a duplicate of the receiver's argument. This is called only where the argument has an associated Player as its costumee, and the intent here is to make another instance of the same uniclass as the donor Player itself. Much works, but there are flaws so this shouldn't be used without recognizing the risks"
-
- evt hand attachMorph: self usableSiblingInstance!
Item was removed:
- ----- Method: Morph>>makeSiblings: (in category 'meta-actions') -----
- makeSiblings: count
- "Make multiple sibling, and return the list"
-
- | listOfNewborns aPosition |
- aPosition := self position.
- listOfNewborns := (1 to: count asInteger) asArray collect:
- [:anIndex | | anInstance |
- anInstance := self usableSiblingInstance.
- owner addMorphFront: anInstance.
- aPosition := aPosition + (10@10).
- anInstance position: aPosition.
- anInstance].
- self currentWorld startSteppingSubmorphsOf: self topRendererOrSelf owner.
- ^ listOfNewborns!
Item was removed:
- ----- Method: Morph>>makeSiblingsLookLikeMe: (in category 'meta-actions') -----
- makeSiblingsLookLikeMe: evt
- "Make all my siblings wear the same costume that I am wearing."
-
- | aPlayer |
- (aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
- aPlayer class allInstancesDo:
- [:anInstance | anInstance == aPlayer ifFalse:
- [anInstance wearCostumeOf: aPlayer]]!
Item was removed:
- ----- Method: Morph>>menuItemAfter: (in category 'menus') -----
- menuItemAfter: menuString
- | allWordings |
- allWordings := self allMenuWordings.
- ^ allWordings atWrap: ((allWordings indexOf: menuString) + 1)!
Item was removed:
- ----- Method: Morph>>menuItemBefore: (in category 'menus') -----
- menuItemBefore: menuString
- | allWordings |
- allWordings := self allMenuWordings.
- ^ allWordings atWrap: ((allWordings indexOf: menuString) - 1)!
Item was removed:
- ----- Method: Morph>>methodCommentAsBalloonHelp (in category 'accessing') -----
- methodCommentAsBalloonHelp
- "Given that I am a morph that is associated with an object and a method, answer a suitable method comment relating to that object & method if possible"
-
- | inherentSelector actual |
- (inherentSelector := self valueOfProperty: #inherentSelector)
- ifNotNil:
- [(actual := (self firstOwnerSuchThat:[:m| m isPhraseTileMorph or:[m isSyntaxMorph]]) actualObject) ifNotNil:
- [^ actual class precodeCommentOrInheritedCommentFor: inherentSelector]].
- ^ nil!
Item was removed:
- ----- Method: Morph>>mustBeBackmost (in category 'e-toy support') -----
- mustBeBackmost
- "Answer whether the receiver needs to be the backmost morph in its owner's submorph list"
-
- ^ false!
Item was removed:
- ----- Method: Morph>>noteDecimalPlaces:forGetter: (in category 'e-toy support') -----
- noteDecimalPlaces: aNumber forGetter: aGetter
- "Make a mental note of the user's preference for a particular number of decimal places to be associated with the slot with the given getter"
-
- (self renderedMorph valueOfProperty: #decimalPlacePreferences ifAbsentPut: [IdentityDictionary new])
- at: aGetter put: aNumber!
Item was removed:
- ----- Method: Morph>>objectViewed (in category 'e-toy support') -----
- objectViewed
- "Answer the morph associated with the player that the structure the receiver currently finds itself within represents."
-
- ^ (self outermostMorphThat: [:o | o isViewer or:[ o isScriptEditorMorph]]) objectViewed
- !
Item was removed:
- ----- Method: Morph>>offerCostumeViewerMenu: (in category 'menu') -----
- offerCostumeViewerMenu: aMenu
- "do nothing"!
Item was removed:
- ----- Method: Morph>>openAPropertySheet (in category 'meta-actions') -----
- openAPropertySheet
-
- Smalltalk at: #ObjectPropertiesMorph ifPresent:[:aClass|
- ^aClass basicNew
- targetMorph: self;
- initialize;
- openNearTarget
- ].
- Beeper beep.!
Item was removed:
- ----- Method: Morph>>openViewerForArgument (in category 'player viewer') -----
- openViewerForArgument
- "Open up a viewer for a player associated with the morph in question. "
- self presenter viewMorph: self!
Item was removed:
- ----- Method: Morph>>overlapsShadowForm:bounds: (in category 'geometry - etoys') -----
- overlapsShadowForm: itsShadow bounds: itsBounds
- "Answer true if itsShadow and my shadow overlap at all"
- | overlapExtent overlap myRect myShadow goalRect goalShadow bb |
- overlap := self fullBounds intersect: itsBounds.
- overlapExtent := overlap extent.
- overlapExtent > (0 @ 0)
- ifFalse: [^ false].
- myRect := overlap translateBy: 0 @ 0 - self topLeft.
- myShadow := (self imageForm contentsOfArea: myRect) stencil.
- goalRect := overlap translateBy: 0 @ 0 - itsBounds topLeft.
- goalShadow := (itsShadow contentsOfArea: goalRect) stencil.
-
- "compute a pixel-by-pixel AND of the two stencils. Result will be black
- (pixel value = 1) where black parts of the stencils overlap"
- bb := BitBlt toForm: myShadow.
- bb
- copyForm: goalShadow
- to: 0 @ 0
- rule: Form and.
-
- ^(bb destForm tallyPixelValues second) > 0 !
Item was removed:
- ----- Method: Morph>>pasteUpMorphHandlingTabAmongFields (in category 'structure') -----
- pasteUpMorphHandlingTabAmongFields
- "Answer the nearest PasteUpMorph in my owner chain that has the tabAmongFields property, or nil if none"
-
- | aPasteUp |
- aPasteUp := self owner.
- [aPasteUp notNil] whileTrue:
- [aPasteUp tabAmongFields ifTrue:
- [^ aPasteUp].
- aPasteUp := aPasteUp owner].
- ^ nil!
Item was removed:
- ----- Method: Morph>>player (in category 'accessing') -----
- player
- "answer the receiver's player"
- ^ extension ifNotNil: [extension player]!
Item was removed:
- ----- Method: Morph>>player: (in category 'accessing') -----
- player: anObject
- "change the receiver's player"
- self assureExtension player: anObject!
Item was removed:
- ----- Method: Morph>>playerRepresented (in category 'accessing') -----
- playerRepresented
- "Answer the player represented by the receiver. Morphs that serve as references to other morphs reimplement this; be default a morph represents its own player."
-
- ^ self player!
Item was removed:
- ----- Method: Morph>>preferredDuplicationHandleSelector (in category 'halos and balloon help') -----
- preferredDuplicationHandleSelector
- "Answer the selector, either #addMakeSiblingHandle: or addDupHandle:, to be offered as the default in a halo open on me"
-
- Preferences oliveHandleForScriptedObjects ifFalse:
- [^ #addDupHandle:].
- ^ self renderedMorph valueOfProperty: #preferredDuplicationHandleSelector ifAbsent:
- [self player class isUniClass
- ifTrue:
- [#addMakeSiblingHandle:]
- ifFalse:
- [#addDupHandle:]]!
Item was removed:
- ----- Method: Morph>>presenter (in category 'accessing') -----
- presenter
- ^ owner ifNotNil: [owner presenter] ifNil: [self currentWorld presenter]!
Item was removed:
- ----- Method: Morph>>readoutForField: (in category 'thumbnail') -----
- readoutForField: fieldSym
- "Provide a readout that will show the value of the slot/pseudoslot of the receiver generated by sending fieldSym to the receiver"
-
- | aContainer |
- "still need to get this right"
- aContainer := AlignmentMorph newColumn.
- aContainer layoutInset: 0; hResizing: #rigid; vResizing: #shrinkWrap.
- aContainer addMorphBack: (StringMorph new contents: (self perform: fieldSym) asString).
- ^ aContainer!
Item was removed:
- ----- Method: Morph>>referencePlayfield (in category 'e-toy support') -----
- referencePlayfield
- "Answer the PasteUpMorph to be used for cartesian-coordinate reference"
-
- | former |
- owner ifNotNil:
- [(self topRendererOrSelf owner isHandMorph and: [(former := self formerOwner) notNil])
- ifTrue:
- [former := former renderedMorph.
- ^ former isPlayfieldLike
- ifTrue: [former]
- ifFalse: [former referencePlayfield]]].
-
- self allOwnersDo: [:o | o isPlayfieldLike ifTrue: [^ o]].
- ^ Project current world!
Item was removed:
- ----- Method: Morph>>renameInternal: (in category 'testing') -----
- renameInternal: aName
- "Change the internal name (because of a conflict) but leave the external name unchanged. Change Player class name, but do not change the names that appear in tiles. When coming in from disk, and have name conflict, References will already have the new name. "
-
- self knownName = aName ifTrue: [^ aName].
- self topRendererOrSelf setNameTo: aName.
-
- "References dictionary already has key aName"
-
- "If this player has a viewer flap, it will remain present"
-
- "Tiles in scripts all stay the same"
-
- "Compiled methods for scripts have been fixed up because the same association was reused"
-
- ^ aName!
Item was removed:
- ----- Method: Morph>>rotationStyle (in category 'e-toy support') -----
- rotationStyle
- "Return the 'rotation style' of the receiver"
- ^#normal!
Item was removed:
- ----- Method: Morph>>rotationStyle: (in category 'e-toy support') -----
- rotationStyle: aSymbol
- "Set the 'rotation style' of the receiver; this is ignored for non-sketches"!
Item was removed:
- ----- Method: Morph>>roundUpStrays (in category 'miscellaneous') -----
- roundUpStrays
- "Bring submorphs of playfieldlike structures in the receiver's interior back within view."
-
- self submorphsDo:
- [:m | m isPlayfieldLike ifTrue: [m roundUpStrays]]!
Item was removed:
- ----- Method: Morph>>saveDocPane (in category 'fileIn/out') -----
- saveDocPane
-
- Smalltalk at: #DocLibrary ifPresent:[:dl| dl external saveDocCheck: self]!
Item was removed:
- ----- Method: Morph>>screenLocation (in category 'geometry - etoys') -----
- screenLocation
- "For compatibility only"
-
- ^ self fullBounds origin!
Item was removed:
- ----- Method: Morph>>screenRectangle (in category 'geometry - etoys') -----
- screenRectangle
- "For compatibility only"
-
- ^ self fullBounds!
Item was removed:
- ----- Method: Morph>>setAsActionInButtonProperties: (in category 'e-toy support') -----
- setAsActionInButtonProperties: buttonProperties
-
- ^false "means I don't know how to be set as a button action"!
Item was removed:
- ----- Method: Morph>>setNumericValue: (in category 'e-toy support') -----
- setNumericValue: aValue
- "Set the receiver's contents to reflect the given numeric value. Only certain kinds of morphs know what to do with this, the rest, for now, stash the number in a property, where it may not be visible but at least it won't be lost, and can be retrieved by the companion getter. This code is never reached under normal circumstances, because the #numericValue slot is not shown in Viewers for most kinds of morphs, and those kinds of morphs that do show it also reimplement this method. However, this code *could* be reached via a user script which sends #setNumericValue: but whose receiver has been changed, via tile-scripting drag and drop for example, to one that doesn't directly handle numbers"
-
- ScriptingSystem informScriptingUser: 'an unusual setNumericValue: call was made'.
- self renderedMorph setProperty: #numericValue toValue: aValue
- !
Item was removed:
- ----- Method: Morph>>setStandardTexture (in category 'e-toy support') -----
- setStandardTexture
- | parms |
- parms := self textureParameters.
- self makeGraphPaperGrid: parms first
- background: parms second
- line: parms third!
Item was removed:
- ----- Method: Morph>>shouldRememberCostumes (in category 'player') -----
- shouldRememberCostumes
- ^true!
Item was removed:
- ----- Method: Morph>>shuffleSubmorphs (in category 'submorphs - misc') -----
- shuffleSubmorphs
- "Randomly shuffle the order of my submorphs. Don't call this method lightly!!"
-
- | bg |
- self invalidRect: self fullBounds.
- (submorphs notEmpty and: [submorphs last mustBeBackmost])
- ifTrue:
- [bg := submorphs last.
- bg privateDelete].
- submorphs := submorphs shuffled.
- bg ifNotNil: [self addMorphBack: bg].
- self layoutChanged!
Item was removed:
- ----- Method: Morph>>standardPalette (in category 'initialization') -----
- standardPalette
- "Answer a standard palette forced by some level of enclosing presenter, or nil if none"
- | pal aPresenter itsOwner |
- (aPresenter := self presenter) ifNil: [^ nil].
- ^ (pal := aPresenter ownStandardPalette)
- ifNotNil: [pal]
- ifNil: [(itsOwner := aPresenter associatedMorph owner)
- ifNotNil:
- [itsOwner standardPalette]
- ifNil:
- [nil]]!
Item was removed:
- ----- Method: Morph>>tabAmongFields (in category 'event handling') -----
- tabAmongFields
- ^ Preferences tabAmongFields
- or: [self hasProperty: #tabAmongFields] !
Item was removed:
- ----- Method: Morph>>textureParameters (in category 'e-toy support') -----
- textureParameters
- "Answer a triplet giving the preferred grid size, background color, and line color. The choices here are as suggested by Alan, 9/13/97"
-
- ^ Array with: 16 with: Color lightYellow with: Color lightGreen lighter lighter!
Item was removed:
- ----- Method: Morph>>unlockOneSubpart (in category 'e-toy support') -----
- unlockOneSubpart
- | unlockables reply |
- unlockables := self submorphs select:
- [:m | m isLocked].
- unlockables size <= 1 ifTrue: [^ self unlockContents].
- reply := UIManager default
- chooseFrom: (unlockables collect: [:m | m externalName])
- values: unlockables
- title: 'Who should be be unlocked?' translated.
- reply isNil ifTrue: [^ self].
- reply unlock!
Item was removed:
- ----- Method: Morph>>updateAllScriptingElements (in category 'naming') -----
- updateAllScriptingElements
- "A sledge-hammer sweep from the world down to make sure that all live scripting elements are up to date. Presently in eclipse, not sent at the moment."
-
- | aPasteUp |
- (aPasteUp := self topPasteUp) ifNotNil:
- [aPasteUp allTileScriptingElements do: [:m | m bringUpToDate]]!
Item was removed:
- ----- Method: Morph>>updateCachedThumbnail (in category 'e-toy support') -----
- updateCachedThumbnail
- "If I have a cached thumbnail, then update it. Copied up from Dan's original version in PasteUpMorph so it can be used by all morphs."
- | cachedThumbnail |
-
- (cachedThumbnail := self valueOfProperty: #cachedThumbnail) ifNotNil:
- [(cachedThumbnail respondsTo: #computeThumbnail)
- ifTrue: [cachedThumbnail computeThumbnail]
- ifFalse: [self removeProperty: #computeThumbnail]].
- "Test and removal are because the thumbnail is being replaced by another Morph. We don't know why. Need to fix that at the source."!
Item was removed:
- ----- Method: Morph>>usableSiblingInstance (in category 'copying') -----
- usableSiblingInstance
- "Return another similar morph whose Player is of the same class as mine.
- Do not open it in the world."
-
- | aName newPlayer newMorph topRenderer counter world |
- (topRenderer := self topRendererOrSelf) == self
- ifFalse: [^topRenderer usableSiblingInstance].
- self assuredPlayer assureUniClass.
- newMorph := self veryDeepCopySibling.
- newPlayer := newMorph player.
- newPlayer resetCostumeList.
- (aName := self knownName) isNil
- ifTrue: [self player notNil ifTrue: [aName := newMorph innocuousName]].
- "Force a difference here"
-
- aName := aName stemAndNumericSuffix at: 1.
-
- world := self world ifNil: [Project current world].
- (world hasProperty: #nameCounter) ifFalse: [
- (world setProperty: #nameCounter toValue: Dictionary new)
- ].
-
- counter := (world valueOfProperty: #nameCounter) at: aName ifAbsent: [1].
- newMorph setNameTo: aName, counter.
- (world valueOfProperty: #nameCounter) at: aName put: counter + 1.
-
- newMorph privateOwner: nil.
- newPlayer assureEventHandlerRepresentsStatus.
- self presenter flushPlayerListCache.
- ^newMorph!
Item was removed:
- ----- Method: Morph>>viewMorphDirectly (in category 'debug and other') -----
- viewMorphDirectly
- "Open a Viewer directly on the Receiver, i.e. no Player involved"
-
- self presenter viewObjectDirectly: self renderedMorph
-
- !
Item was removed:
- ----- Method: Morph>>wantsHalo (in category 'halos and balloon help') -----
- wantsHalo
- | topOwner |
- ^(topOwner := self topRendererOrSelf owner) notNil
- and: [topOwner wantsHaloFor: self]!
Item was removed:
- ----- Method: Morph>>wantsHaloFor: (in category 'halos and balloon help') -----
- wantsHaloFor: aSubMorph
- ^ false!
Item was removed:
- ----- Method: Morph>>wantsScriptorHaloHandle (in category 'halos and balloon help') -----
- wantsScriptorHaloHandle
- "Answer whether the receiver would like to have a Scriptor halo handle put up on its behalf. Initially, only the ScriptableButton says yes"
-
- ^ false!
Item was removed:
- ----- Method: Morph>>wouldAcceptKeyboardFocusUponTab (in category 'event handling') -----
- wouldAcceptKeyboardFocusUponTab
- "Answer whether the receiver is in the running as the new keyboard focus if the tab key were hit at a meta level. This provides the leverage for tabbing among fields of a card, for example."
-
- ^ false!
Item was removed:
- ----- Method: Morph>>wrappedInWindow: (in category 'e-toy support') -----
- wrappedInWindow: aSystemWindow
- | aWindow |
- aWindow := aSystemWindow model: Model new.
- aWindow addMorph: self frame: (0@0 extent: 1@1).
- aWindow extent: self extent.
- ^ aWindow!
Item was removed:
- ----- Method: Morph>>wrappedInWindowWithTitle: (in category 'e-toy support') -----
- wrappedInWindowWithTitle: aTitle
- | aWindow w2 |
- aWindow := (SystemWindow labelled: aTitle) model: Model new.
- aWindow addMorph: self frame: (0@0 extent: 1@1).
- w2 := aWindow borderWidth * 2.
- w2 := 3. "oh, well"
- aWindow extent: self fullBounds extent + (0 @ aWindow labelHeight) + (w2 @ w2).
- ^ aWindow!
Item was removed:
- ----- Method: MorphExtension>>player (in category 'accessing') -----
- player
- "answer the receiver's player"
- ^ player!
Item was removed:
- ----- Method: MorphExtension>>player: (in category 'accessing') -----
- player: anObject
- "change the receiver's player"
- player := anObject !
Item was removed:
- ListItemWrapper subclass: #MorphWithSubmorphsWrapper
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Explorer'!
-
- !MorphWithSubmorphsWrapper commentStamp: 'ls 3/1/2004 17:32' prior: 0!
- Display a morph in a SimpleHierarchicalListMorph, and arrange to recursively display the morph's submorphs. The "item" that is wrapped is the morph to display.!
Item was removed:
- ----- Method: MorphWithSubmorphsWrapper>>contents (in category 'hierarchy') -----
- contents
- ^item submorphs collect: [ :m |
- self class with: m ]!
Item was removed:
- ----- Method: MorphicModel>>addModelYellowButtonMenuItemsTo:forMorph:hand: (in category 'graph model') -----
- addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph
-
- Preferences noviceMode ifFalse: [
- super addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph].
- ^ aCustomMenu!
Item was removed:
- ----- Method: MorphicProject>>exportSegmentInSexpWithChangeSet:fileName:directory:withoutInteraction: (in category 'file in/out') -----
- exportSegmentInSexpWithChangeSet: aChangeSetOrNil fileName: aFileName directory: aDirectory withoutInteraction: noInteraction
-
- | fd sexp actualName |
-
- world ifNil: [^ false].
- world presenter ifNil: [^ false].
- (world respondsTo: #sissScanObjectsAsEtoysProject) ifFalse: [^ false].
-
- Command initialize.
- world clearCommandHistory.
- world cleanseStepList.
- world localFlapTabs size = world flapTabs size ifFalse: [
- noInteraction ifTrue: [^ false].
- self error: 'Still holding onto Global flaps'].
-
- fd := aDirectory directoryNamed: self resourceDirectoryName.
- fd assureExistence.
-
- "Must activate old world because this is run at #armsLength.
- Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
- will not be captured correctly if referenced from blocks or user code."
- world becomeActiveDuring:[
- sexp := world sissScanObjectsAsEtoysProject.
- ].
- (aFileName endsWith: '.pr') ifTrue: [
- actualName := (aFileName copyFrom: 1 to: aFileName size - 3), '.sexp'.
- ] ifFalse: [
- actualName := aFileName
- ].
-
- self
- writeForExportInSexp: sexp withSources: actualName
- inDirectory: fd
- changeSet: aChangeSetOrNil.
- SecurityManager default signFile: actualName directory: fd.
- self storeHtmlPageIn: fd.
- (world valueOfProperty: #ProjectDetails ifAbsent: [Dictionary new])
- at: 'Project-Format' put: 'S-Expression'.
- self storeManifestFileIn: fd.
- self compressFilesIn: fd to: aFileName in: aDirectory.
-
- ^ true
- !
Item was removed:
- ----- Method: MorphicProject>>initMorphic (in category 'initialize') -----
- initMorphic
- "Written so that Morphic can still be removed. Note that #initialize is never actually called for a morphic project -- see the senders of this method."
-
- self flag: #toRemove. "check if this method still used by Etoys"
- Smalltalk verifyMorphicAvailability ifFalse: [^ nil].
- changeSet := ChangeSet new.
- transcript := TranscriptStream new.
- displayDepth := Display depth.
- parentProject := CurrentProject.
- world := PasteUpMorph newWorldForProject: self.
- Locale switchToID: CurrentProject localeID.
- self initializeProjectPreferences. "Do this *after* a world is installed so that the project will be recognized as a morphic one."
- Preferences useVectorVocabulary ifTrue: [world installVectorVocabulary]!
Item was removed:
- ----- Method: MorphicProject>>myPlayerClasses (in category 'release') -----
- myPlayerClasses
- "Answer all my (non-systemDefined) player classes"
- | classes presenter |
- classes := Set new.
- presenter := self world presenter.
- presenter ifNotNil: [
- presenter flushPlayerListCache. "old and outside guys"
- presenter allExtantPlayers do:
- [:p | p class isSystemDefined ifFalse: [classes add: p class]]].
- ^classes!
Item was removed:
- ----- Method: MorphicProject>>setFlaps (in category 'flaps support') -----
- setFlaps
-
- | flapTabs flapIDs sharedFlapTabs navigationMorph |
- self flag: #toRemove. "check if this method still used by Etoys"
-
- flapTabs := self world flapTabs.
- flapIDs := flapTabs collect: [:tab | tab knownName].
- flapTabs
- do: [:tab | (tab isMemberOf: ViewerFlapTab)
- ifFalse: [tab isGlobalFlap
- ifTrue: [Flaps removeFlapTab: tab keepInList: false.
- tab currentWorld reformulateUpdatingMenus]
- ifFalse: [| referent |
- referent := tab referent.
- referent isInWorld
- ifTrue: [referent delete].
- tab delete]]].
- sharedFlapTabs := Flaps classPool at: #SharedFlapTabs.
- flapIDs
- do: [:id |
- id = 'Navigator' translated
- ifTrue: [sharedFlapTabs add: Flaps newNavigatorFlap].
- id = 'Widgets' translated
- ifTrue: [sharedFlapTabs add: Flaps newWidgetsFlap].
- id = 'Tools' translated
- ifTrue: [sharedFlapTabs add: Flaps newToolsFlap].
- id = 'Squeak' translated
- ifTrue: [sharedFlapTabs add: Flaps newSqueakFlap].
- id = 'Supplies' translated
- ifTrue: [sharedFlapTabs add: Flaps newSuppliesFlap].
- id = 'Stack Tools' translated
- ifTrue: [sharedFlapTabs add: Flaps newStackToolsFlap].
- id = 'Painting' translated
- ifTrue: [sharedFlapTabs add: Flaps newPaintingFlap].
- id = 'Objects' translated
- ifTrue: [sharedFlapTabs add: Flaps newObjectsFlap ]].
- 2 timesRepeat: [flapIDs do: [:id | Flaps enableDisableGlobalFlapWithID: id]].
- self world flapTabs
- do: [:flapTab | flapTab isCurrentlyTextual
- ifTrue: [flapTab changeTabText: flapTab knownName]].
- Flaps positionNavigatorAndOtherFlapsAccordingToPreference.
- navigationMorph := self currentWorld findDeeplyA: ProjectNavigationMorph preferredNavigator.
- navigationMorph isNil
- ifTrue: [^ self].
- navigationMorph allMorphs
- do: [:morph | morph class == SimpleButtonDelayedMenuMorph
- ifTrue: [(morph findA: ImageMorph) isNil
- ifTrue: [| label |
- label := morph label.
- label isNil
- ifFalse: [| name |
- name := morph knownName.
- name isNil
- ifTrue: [morph name: label.
- name := label].
- morph label: name translated]]]]!
Item was removed:
- ----- Method: PasteUpMorph>>abandonCostumeHistory (in category 'misc') -----
- abandonCostumeHistory
- self allMorphsDo:
- [:m | m player ifNotNil: [m player forgetOtherCostumes]]!
Item was removed:
- ----- Method: PasteUpMorph>>adaptedToWorld: (in category 'initialization') -----
- adaptedToWorld: aWorld
- "If I refer to a world or a hand, return the corresponding items in the new world."
- self isWorldMorph ifTrue:[^aWorld].!
Item was removed:
- ----- Method: PasteUpMorph>>addPenMenuItems:hand: (in category 'menu & halo') -----
- addPenMenuItems: menu hand: aHandMorph
- "Add a pen-trails-within submenu to the given menu"
-
- menu add: 'pen trails...' translated target: self selector: #putUpPenTrailsSubmenu.
- menu balloonTextForLastItem: 'its governing pen trails drawn within' translated!
Item was removed:
- ----- Method: PasteUpMorph>>addPenTrailsMenuItemsTo: (in category 'menu & halo') -----
- addPenTrailsMenuItemsTo: aMenu
- "Add items relating to pen trails to aMenu"
-
- | oldTarget |
- oldTarget := aMenu defaultTarget.
- aMenu defaultTarget: self.
- aMenu add: 'clear pen trails' translated action: #clearTurtleTrails.
- aMenu addLine.
- aMenu add: 'all pens up' translated action: #liftAllPens.
- aMenu add: 'all pens down' translated action: #lowerAllPens.
- aMenu addLine.
- aMenu add: 'all pens show lines' translated action: #linesForAllPens.
- aMenu add: 'all pens show arrowheads' translated action: #arrowsForAllPens.
- aMenu add: 'all pens show arrows' translated action: #linesAndArrowsForAllPens.
- aMenu add: 'all pens show dots' translated action: #dotsForAllPens.
- aMenu addLine.
- aMenu addUpdating: #batchPenTrailsString action: #toggleBatchPenTrails.
- aMenu balloonTextForLastItem: 'if true, detailed movement of pens between display updates is ignored. Thus multiple line segments drawn within a script may not be seen individually.' translated.
-
- aMenu defaultTarget: oldTarget!
Item was removed:
- ----- Method: PasteUpMorph>>addPlayfieldMenuItems:hand: (in category 'menu & halo') -----
- addPlayfieldMenuItems: menu hand: aHandMorph
- "Add playfield-related items to the menu"
-
- menu add: 'playfield options...' translated target: self action: #presentPlayfieldMenu.
- (self hasProperty: #donorTextMorph) ifTrue:
- [menu add: 'send contents back to donor' translated action: #sendTextContentsBackToDonor]!
Item was removed:
- ----- Method: PasteUpMorph>>addStackMenuItems:hand: (in category 'menu & halo') -----
- addStackMenuItems: menu hand: aHandMorph
- "Add appropriate stack-related items to the given menu"
-
- self isStackBackground
- ifTrue:
- [menu add: 'card & stack...' target: self action: #presentCardAndStackMenu]!
Item was removed:
- ----- Method: PasteUpMorph>>allScriptEditors (in category 'misc') -----
- allScriptEditors
- ^ self allMorphs select:
- [:s | s isScriptEditorMorph]!
Item was removed:
- ----- Method: PasteUpMorph>>allScriptors (in category 'misc') -----
- allScriptors
- "Answer a list of all active scriptors running on behalf of the receiver. This is a hook used in past demos and with a future life which however presently is vacuous"
-
- ^ #()
- "
- ^ self allMorphs select: [:m | m isKindOf: Scriptor]"!
Item was removed:
- ----- Method: PasteUpMorph>>allTileScriptingElements (in category 'scripting') -----
- allTileScriptingElements
- "Answer a list of all the morphs that pertain to tile-scripting. A sledge-hammer"
-
- | all morphs |
- morphs := IdentitySet new: 400.
- self allMorphsAndBookPagesInto: morphs.
- all := morphs select: [:s | s isTileScriptingElement].
- " self closedViewerFlapTabs do:
- [:aTab | all addAll: aTab referent allTileScriptingElements].
- "
- ^ all asOrderedCollection!
Item was removed:
- ----- Method: PasteUpMorph>>assureNotPaintingEvent: (in category 'world state') -----
- assureNotPaintingEvent: evt
- "If painting is already underway
- in the receiver, put up an informer to that effect and evalute aBlock"
- | editor |
- (editor := self sketchEditorOrNil) ifNotNil:[
- editor save: evt.
- Cursor normal show.
- ].!
Item was removed:
- ----- Method: PasteUpMorph>>automaticPhraseExpansion (in category 'dropping/grabbing') -----
- automaticPhraseExpansion
- ^ self hasProperty: #automaticPhraseExpansion!
Item was removed:
- ----- Method: PasteUpMorph>>automaticViewing (in category 'e-toy support') -----
- automaticViewing
- ^ self hasProperty: #automaticViewing!
Item was removed:
- ----- Method: PasteUpMorph>>behaveLikeHolder (in category 'options') -----
- behaveLikeHolder
-
- self vResizeToFit: true; autoLineLayout: true; indicateCursor: true!
Item was removed:
- ----- Method: PasteUpMorph>>behaveLikeHolder: (in category 'options') -----
- behaveLikeHolder: aBoolean
- "Change the receiver's viewing properties such that they conform to what we commonly call a Holder, viz: resize-to-fit, do auto-line-layout, and indicate the 'cursor'"
-
- self vResizeToFit: aBoolean; autoLineLayout: aBoolean; indicateCursor: aBoolean
- !
Item was removed:
- ----- Method: PasteUpMorph>>behavingLikeAHolder (in category 'options') -----
- behavingLikeAHolder
- "Answer whether the receiver is currently behaving like a Holder"
-
- ^ self resizeToFit and: [self indicateCursor and: [self autoLineLayout]]!
Item was removed:
- ----- Method: PasteUpMorph>>browseAllScriptsTextually (in category 'world menu') -----
- browseAllScriptsTextually
- "Put up a browser showing all scripts in the project textually"
-
- self presenter browseAllScriptsTextually
-
- "ActiveWorld browseAllScriptsTextually"!
Item was removed:
- ----- Method: PasteUpMorph>>buildDebugMenu: (in category 'menu & halo') -----
- buildDebugMenu: aHandMorph
- | aMenu |
- aMenu := super buildDebugMenu: aHandMorph.
- aMenu add: 'abandon costume history' translated target: self action: #abandonCostumeHistory.
- ^ aMenu!
Item was removed:
- ----- Method: PasteUpMorph>>closedViewerFlapTabs (in category 'misc') -----
- closedViewerFlapTabs
- "Answer all the viewer flap tabs in receiver that are closed"
-
- ^ self submorphs select:
- [:m | (m isKindOf: ViewerFlapTab) and: [m flapShowing not]]!
Item was removed:
- ----- Method: PasteUpMorph>>couldMakeSibling (in category 'classification') -----
- couldMakeSibling
-
- ^ self isWorldMorph not!
Item was removed:
- ----- Method: PasteUpMorph>>cursor (in category 'e-toy support') -----
- cursor
- ^ cursor
- !
Item was removed:
- ----- Method: PasteUpMorph>>cursor: (in category 'e-toy support') -----
- cursor: aNumber
- "for backward compatibility"
-
- self cursorWrapped: aNumber!
Item was removed:
- ----- Method: PasteUpMorph>>cursorWrapped: (in category 'cursor') -----
- cursorWrapped: aNumber
- "Set the cursor to the given number, modulo the number of items I
- contain. Fractional cursor values are allowed."
- | oldRect newRect offset |
- cursor = aNumber
- ifTrue: [^ self].
- self hasSubmorphs
- ifFalse: [cursor := 1.
- ^ self].
- oldRect := self selectedRect.
- offset := (self asNumber: aNumber) - 1 \\ submorphs size.
- cursor := offset + 1.
- newRect := self selectedRect.
- self indicateCursor
- ifTrue: [self invalidRect: oldRect;
- invalidRect: newRect]!
Item was removed:
- ----- Method: PasteUpMorph>>detachableScriptingSpace (in category 'world menu') -----
- detachableScriptingSpace
- ScriptingSystem newScriptingSpace openInWorld: self!
Item was removed:
- ----- Method: PasteUpMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- "Draw in order:
- - background color
- - Update and draw the turtleTrails form. See the comment in updateTrailsForm.
- - cursor box if any
-
- Later (in drawSubmorphsOn:) I will skip drawing the background sketch."
-
- "draw background fill"
- super drawOn: aCanvas.
-
- "draw turtle trails"
- (lastTurtlePositions isNil or: [lastTurtlePositions isEmpty]) ifFalse:[
- self updateTrailsForm.
- ].
- turtleTrailsForm
- ifNotNil: [aCanvas paintImage: turtleTrailsForm at: self position].
-
- "draw cursor"
- (submorphs notEmpty and: [self indicateCursor])
- ifTrue:
- [aCanvas
- frameRectangle: self selectedRect
- width: 2
- color: Color black]!
Item was removed:
- ----- Method: PasteUpMorph>>dumpPresenter (in category 'accessing') -----
- dumpPresenter
- "Dump my current presenter"
- presenter := nil.!
Item was removed:
- ----- Method: PasteUpMorph>>hideViewerFlaps (in category 'misc') -----
- hideViewerFlaps
- self flapTabs do:[:aTab |
- (aTab isKindOf: ViewerFlapTab) ifTrue:[aTab hideFlap]]!
Item was removed:
- ----- Method: PasteUpMorph>>hideViewerFlapsOtherThanFor: (in category 'misc') -----
- hideViewerFlapsOtherThanFor: aPlayer
- self flapTabs do:
- [:aTab | (aTab isKindOf: ViewerFlapTab)
- ifTrue:
- [aTab scriptedPlayer == aPlayer
- ifFalse:
- [aTab hideFlap]]]!
Item was removed:
- ----- Method: PasteUpMorph>>indicateCursor (in category 'options') -----
- indicateCursor
- ^ indicateCursor == true!
Item was removed:
- ----- Method: PasteUpMorph>>indicateCursor: (in category 'options') -----
- indicateCursor: aBoolean
- indicateCursor := aBoolean.
- self changed.!
Item was removed:
- ----- Method: PasteUpMorph>>indicateCursorString (in category 'menu & halo') -----
- indicateCursorString
- "Answer the string to be shown in a menu to represent the
- whether-to-indicate-cursor status"
- ^ (self indicateCursor
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'indicate cursor' translated!
Item was removed:
- ----- Method: PasteUpMorph>>isPlayfieldLike (in category 'classification') -----
- isPlayfieldLike
- ^ true!
Item was removed:
- ----- Method: PasteUpMorph>>makeNewDrawing: (in category 'world menu') -----
- makeNewDrawing: evt
- ^self makeNewDrawing: evt at: evt position!
Item was removed:
- ----- Method: PasteUpMorph>>makeNewDrawing:at: (in category 'world menu') -----
- makeNewDrawing: evt at: aPoint
- "make a new drawing, triggered by the given event, with the painting area centered around the given point"
-
- | w newSketch newPlayer sketchEditor aPalette rect aPaintBox aPaintTab aWorld |
- w := self world.
- w assureNotPaintingElse: [^ self].
- rect := self paintingBoundsAround: aPoint.
- aPalette := self standardPalette.
- aPalette ifNotNil: [aPalette showNoPalette; layoutChanged].
- w prepareToPaint.
-
- newSketch := self drawingClass new.
- Smalltalk at: #UnscriptedPlayer ifPresent:[:aClass|
- newSketch player: (newPlayer := aClass newUserInstance).
- newPlayer costume: newSketch.
- ].
- newSketch nominalForm: (Form extent: rect extent depth: w assuredCanvas depth).
- newSketch bounds: rect.
- sketchEditor := SketchEditorMorph new.
- w addMorphFront: sketchEditor.
- sketchEditor initializeFor: newSketch inBounds: rect pasteUpMorph: self.
- sketchEditor
- afterNewPicDo: [:aForm :aRect | | tfx whereToPresent |
- whereToPresent := self presenter.
- newSketch form: aForm.
- tfx := self transformFrom: w.
- newSketch position: (tfx globalPointToLocal: aRect origin).
- newSketch rotationStyle: sketchEditor rotationStyle.
- newSketch forwardDirection: sketchEditor forwardDirection.
-
- newPlayer ifNotNil:[newPlayer setHeading: sketchEditor forwardDirection].
- (aPaintTab := (aWorld := self world) paintingFlapTab)
- ifNotNil:[aPaintTab hideFlap]
- ifNil:[(aPaintBox := aWorld paintBox) ifNotNil:[aPaintBox delete]].
-
- self addMorphFront: (newPlayer ifNil:[newSketch] ifNotNil:[newPlayer costume]).
- w startSteppingSubmorphsOf: newSketch.
- whereToPresent drawingJustCompleted: newSketch]
- ifNoBits:[
- (aPaintTab := (aWorld := self world) paintingFlapTab)
- ifNotNil:[aPaintTab hideFlap]
- ifNil:[(aPaintBox := aWorld paintBox) ifNotNil:[aPaintBox delete]].
- aPalette ifNotNil: [aPalette showNoPalette].]!
Item was removed:
- ----- Method: PasteUpMorph>>makeNewDrawingWithin (in category 'painting') -----
- makeNewDrawingWithin
- "Start a painting session in my interior which will result in a new SketchMorph being created as one of my submorphs"
-
- | evt |
- evt := MouseEvent new setType: nil position: self center buttons: 0 hand: self world activeHand.
- self makeNewDrawing: evt!
Item was removed:
- ----- Method: PasteUpMorph>>mouseOverHalosString (in category 'menu & halo') -----
- mouseOverHalosString
- "Answer the string to be shown in a menu to represent the
- mouse-over-halos status"
- ^ (self wantsMouseOverHalos
- ifTrue: ['<on>']
- ifFalse: ['<off>'])
- , 'mouse-over halos' translated!
Item was removed:
- ----- Method: PasteUpMorph>>newDrawingFromMenu: (in category 'world menu') -----
- newDrawingFromMenu: evt
- self assureNotPaintingElse: [^ self].
- evt hand attachMorph: PaintInvokingMorph new markAsPartsDonor!
Item was removed:
- ----- Method: PasteUpMorph>>numberAtCursor (in category 'cursor') -----
- numberAtCursor
- "Answer the number represented by the object at my current cursor position"
-
- | chosenMorph |
- submorphs isEmpty ifTrue: [^ 0].
- chosenMorph := submorphs at: ((cursor truncated max: 1) min: submorphs size).
- ^ chosenMorph getNumericValue
- !
Item was removed:
- ----- Method: PasteUpMorph>>openScrapsBook: (in category 'world menu') -----
- openScrapsBook: evt
- "Open up the Scraps book in the center of the screen"
-
- evt hand world addMorphCentered: ScrapBook default scrapBook!
Item was removed:
- ----- Method: PasteUpMorph>>paintArea (in category 'world state') -----
- paintArea
- "What rectangle should the user be allowed to create a new painting in??
- An area beside the paintBox. Allow playArea to override with its own
- bounds!! "
- | playfield paintBoxBounds |
- playfield := self
- submorphNamed: 'playfield'
- ifNone: [].
- playfield
- ifNotNil: [^ playfield bounds].
- paintBoxBounds := self paintBox bounds.
- self firstHand targetPoint x < paintBoxBounds center x
- ifTrue: [^ bounds topLeft corner: paintBoxBounds left @ bounds bottom"paint on left side"]
- ifFalse: [^ paintBoxBounds right @ bounds top corner: bounds bottomRight]!
Item was removed:
- ----- Method: PasteUpMorph>>paintAreaFor: (in category 'world state') -----
- paintAreaFor: aSketchMorph
- "Answer the area to comprise the onion-skinned canvas for painting/repainting aSketchMorph"
-
- | itsOwner |
- ((itsOwner := aSketchMorph owner) notNil and: [itsOwner isPlayfieldLike])
- ifTrue: [^itsOwner bounds]. "handles every plausible situation"
- ^self paintArea!
Item was removed:
- ----- Method: PasteUpMorph>>paintingBoundsAround: (in category 'painting') -----
- paintingBoundsAround: aPoint
- "Return a rectangle for painting centered on the given point. Both the argument point and the result rectangle are in world coordinates."
-
- | paintExtent maxPaintArea myBnds |
- paintExtent := self reasonablePaintingExtent.
- maxPaintArea := paintExtent x * paintExtent y.
- myBnds := self boundsInWorld.
- (myBnds area <= maxPaintArea) ifTrue: [^ myBnds].
- ^ (aPoint - (paintExtent // 2) extent: paintExtent) intersect: myBnds
- !
Item was removed:
- ----- Method: PasteUpMorph>>paintingFlapTab (in category 'flaps') -----
- paintingFlapTab
- "If the receiver has a flap which has a paintbox, return it, else return nil"
- self flapTabs do:
- [:aTab | aTab referent submorphsDo:
- [:aMorph | (aMorph isKindOf: PaintBoxMorph) ifTrue: [^ aTab]]].
- ^ nil!
Item was removed:
- ----- Method: PasteUpMorph>>prepareToBeSaved (in category 'misc') -----
- prepareToBeSaved
- "Prepare for export via the ReferenceStream mechanism"
-
- | exportDict soundKeyList players |
- super prepareToBeSaved.
- turtlePen := nil.
- self isWorldMorph
- ifTrue:
- [self removeProperty: #scriptsToResume.
- soundKeyList := Set new.
- (players := self presenter allExtantPlayers)
- do: [:aPlayer | aPlayer slotInfo
- associationsDo: [:assoc | assoc value type == #Sound
- ifTrue: [soundKeyList
- add: (aPlayer instVarNamed: assoc key)]]].
- players
- do: [:p | p allScriptEditors
- do: [:e | (e allMorphs
- select: [:m | m isSoundTile])
- do: [:aTile | soundKeyList add: aTile literal]]].
- (self allMorphs
- select: [:m | m isSoundTile])
- do: [:aTile | soundKeyList add: aTile literal].
- soundKeyList removeAllFoundIn: SampledSound universalSoundKeys.
- soundKeyList
- removeAllSuchThat: [:aKey | (SampledSound soundLibrary includesKey: aKey) not].
- soundKeyList isEmpty
- ifFalse: [exportDict := Dictionary new.
- soundKeyList
- do: [:aKey | exportDict
- add: (SampledSound soundLibrary associationAt: aKey)].
- self setProperty: #soundAdditions toValue: exportDict]]!
Item was removed:
- ----- Method: PasteUpMorph>>prepareToPaint (in category 'painting') -----
- prepareToPaint
- "We're about to start painting. Do a few preparations that make the system more responsive."
-
- ^ self prepareToPaint: Preferences keepTickingWhilePainting not!
Item was removed:
- ----- Method: PasteUpMorph>>prepareToPaint: (in category 'painting') -----
- prepareToPaint: stopRunningScripts
- "We're about to start painting. Do a few preparations that make the system more responsive."
-
- self hideViewerFlaps. "make room"
- stopRunningScripts ifTrue:
- [self setProperty: #scriptsToResume toValue: self presenter allCurrentlyTickingScriptInstantiations. "We'll restart these when painting is done"
- self stopRunningAll]. "stop scripts"
- self abandonAllHalos. "no more halos"!
Item was removed:
- ----- Method: PasteUpMorph>>presentCardAndStackMenu (in category 'menu & halo') -----
- presentCardAndStackMenu
- "Put up a menu holding card/stack-related options."
-
- | aMenu |
- aMenu := MenuMorph new defaultTarget: self.
- aMenu addStayUpItem.
- aMenu addTitle: 'card and stack' translated.
- aMenu add: 'add new card' translated action: #insertCard.
- aMenu add: 'delete this card' translated action: #deleteCard.
- aMenu add: 'go to next card' translated action: #goToNextCardInStack.
- aMenu add: 'go to previous card' translated action: #goToPreviousCardInStack.
- aMenu addLine.
- aMenu add: 'show foreground objects' translated action: #showForegroundObjects.
- aMenu add: 'show background objects' translated action: #showBackgroundObjects.
- aMenu add: 'show designations' translated action: #showDesignationsOfObjects.
- aMenu add: 'explain designations' translated action: #explainDesignations.
- aMenu popUpInWorld: (self world ifNil: [self currentWorld])!
Item was removed:
- ----- Method: PasteUpMorph>>presentPlayfieldMenu (in category 'menu & halo') -----
- presentPlayfieldMenu
-
- self playfieldOptionsMenu popUpForHand: self activeHand in: self world!
Item was removed:
- ----- Method: PasteUpMorph>>presenter (in category 'accessing') -----
- presenter
- "Normally only the world will have a presenter, but the architecture supports individual localized presenters as well"
-
- ^ presenter ifNil:
- [self isWorldMorph
- ifTrue: [presenter := Presenter defaultPresenterClass new associatedMorph: self]
- ifFalse: [super presenter]]!
Item was removed:
- ----- Method: PasteUpMorph>>printScriptSummary (in category 'world menu') -----
- printScriptSummary
- "Put up a window with summaries of all scripts in the world"
-
- self presenter reportPlayersAndScripts
-
- "self currentWorld printScriptSummary"!
Item was removed:
- ----- Method: PasteUpMorph>>putUpPenTrailsSubmenu (in category 'menu & halo') -----
- putUpPenTrailsSubmenu
- "Put up the pen trails menu"
-
- | aMenu |
- aMenu := MenuMorph new defaultTarget: self.
- aMenu title: 'pen trails' translated.
- aMenu addStayUpItem.
- self addPenTrailsMenuItemsTo: aMenu.
- ^ aMenu popUpInWorld: self!
Item was removed:
- ----- Method: PasteUpMorph>>reasonablePaintingExtent (in category 'painting') -----
- reasonablePaintingExtent
- ^ Preferences unlimitedPaintArea
- ifTrue:
- [3000 @ 3000]
- ifFalse:
- [Preferences defaultPaintingExtent]!
Item was removed:
- ----- Method: PasteUpMorph>>rectifyCursor (in category 'cursor') -----
- rectifyCursor
- cursor := ((cursor truncated max: 1) min: submorphs size)
- !
Item was removed:
- ----- Method: PasteUpMorph>>referencePlayfield (in category 'e-toy support') -----
- referencePlayfield
- "Answer a pasteup morph to be used as the reference for cartesian coordinates.
- Do not get fooled by other morphs (like viewers) that happen to be named 'playfield'."
-
- ^self isWorldMorph
- ifTrue: [ self submorphThat: [ :s | (s knownName = 'playfield') and: [ s isPlayfieldLike] ] ifNone: [self]]
- ifFalse: [ super referencePlayfield ]!
Item was removed:
- ----- Method: PasteUpMorph>>referencePool (in category 'objects from disk') -----
- referencePool
- ^ self
- valueOfProperty: #References
- ifAbsentPut: [WeakValueDictionary new]
- !
Item was removed:
- ----- Method: PasteUpMorph>>releaseViewers (in category 'flaps') -----
- releaseViewers
- "In preparation for saving, make the flapTabs release their viewers."
-
- self flapTabs do: [:ft |
- (ft respondsTo: #hibernate) ifTrue: [ft hibernate]]!
Item was removed:
- ----- Method: PasteUpMorph>>removeAllViewers (in category 'world menu') -----
- removeAllViewers
- "Delete all the viewers lined up along my right margin."
-
- (self submorphs select: [:m | m isKindOf: ViewerFlapTab]) do:
- [:m |
- m referent ifNotNil: [m referent delete].
- m delete.]!
Item was removed:
- ----- Method: PasteUpMorph>>restoreBoundsOfSubmorphs (in category 'viewing') -----
- restoreBoundsOfSubmorphs
- "restores the saved xy-positions and extents"
-
- submorphs do:
- [:aSubmorph |
- aSubmorph valueOfProperty: #savedExtent ifPresentDo:
- [:anExtent | aSubmorph extent: anExtent].
- aSubmorph valueOfProperty: #savedPosition ifPresentDo:
- [:aPosition | aSubmorph position: aPosition]]!
Item was removed:
- ----- Method: PasteUpMorph>>resumeScriptsPausedByPainting (in category 'painting') -----
- resumeScriptsPausedByPainting
- "If there were any scripts running when painting was initiated, resume them now"
-
- | aList |
- (aList := self valueOfProperty: #scriptsToResume) isEmptyOrNil ifFalse:
- [aList do:
- [:aScriptInstantiation |
- aScriptInstantiation player costume isInWorld ifTrue:
- [aScriptInstantiation startRunningIfPaused]]].
- self removeProperty: #scriptsToResume!
Item was removed:
- ----- Method: PasteUpMorph>>saveBoundsOfSubmorphs (in category 'viewing') -----
- saveBoundsOfSubmorphs
- "store the current xy-positions and extents of submorphs for future use"
-
- submorphs do:
- [:aSubmorph |
- aSubmorph setProperty: #savedExtent toValue: aSubmorph extent.
- aSubmorph setProperty: #savedPosition toValue: aSubmorph position]!
Item was removed:
- ----- Method: PasteUpMorph>>selectedRect (in category 'cursor') -----
- selectedRect
- "Return a rectangle enclosing the morph at the current cursor. Note that the cursor may be a float and may be out of range, so pick the nearest morph. Assume there is at least one submorph."
-
- | p |
- p := cursor asInteger.
- p := p min: submorphs size.
- p := p max: 1.
- ^(submorphs at: p) fullBounds expandBy: 2!
Item was removed:
- ----- Method: PasteUpMorph>>sendTextContentsBackToDonor (in category 'menu & halo') -----
- sendTextContentsBackToDonor
- "Send my string contents back to the Text Morph from whence I came"
-
- (self valueOfProperty: #donorTextMorph) ifNotNil:
- [:aDonor | aDonor setCharacters: self assuredPlayer getStringContents]!
Item was removed:
- ----- Method: PasteUpMorph>>showStatusOfAllScripts (in category 'world menu') -----
- showStatusOfAllScripts
- "Put up a window that shows, and allows you to change, the status of all scripts"
-
- self presenter toolToViewScriptInstantiations!
Item was removed:
- ----- Method: PasteUpMorph>>showingListView (in category 'viewing') -----
- showingListView
- "Answer whether the receiver is currently showing a list view"
-
- ^ self hasProperty: #showingListView
- !
Item was removed:
- ----- Method: PasteUpMorph>>sortSubmorphsBy: (in category 'viewing') -----
- sortSubmorphsBy: sortOrderSymbol
- "Sort the receiver's submorphs by the criterion indicated in the provided symbol"
- self invalidRect: self fullBounds.
- submorphs := submorphs sorted: [:a :b | (a perform: sortOrderSymbol) <= (b perform: sortOrderSymbol)].
- self layoutChanged.!
Item was removed:
- ----- Method: PasteUpMorph>>standardPlayerHit (in category 'world state') -----
- standardPlayerHit
-
- self playSoundNamed: 'peaks'.
- !
Item was removed:
- ----- Method: PasteUpMorph>>startRunningAll (in category 'misc') -----
- startRunningAll
- "Start running all scripted morphs. Triggered by user hitting GO button"
-
- self presenter flushPlayerListCache. "Inefficient, but makes sure things come right whenever GO hit"
- self presenter allExtantPlayers do: [:aPlayer | aPlayer costume residesInPartsBin ifFalse: [aPlayer startRunning]].
-
- self world updateStatusForAllScriptEditors!
Item was removed:
- ----- Method: PasteUpMorph>>stepAll (in category 'misc') -----
- stepAll
- "tick all the paused player scripts in the receiver"
-
- self presenter allExtantPlayers do:
- [:aPlayer |
- aPlayer startRunning; step; stopRunning]!
Item was removed:
- ----- Method: PasteUpMorph>>stopRunningAll (in category 'misc') -----
- stopRunningAll
- "Reset all ticking scripts to be paused. Triggered by user hitting STOP button"
-
- self presenter allExtantPlayers do:
- [:aPlayer |
- aPlayer stopRunning].
-
- self world updateStatusForAllScriptEditors!
Item was removed:
- ----- Method: PasteUpMorph>>toggleAutoLineLayout (in category 'options') -----
- toggleAutoLineLayout
- "Toggle the auto-line-layout setting"
-
- self autoLineLayout: self autoLineLayout not.
- self autoLineLayout ifFalse: [self restoreBoundsOfSubmorphs].!
Item was removed:
- ----- Method: PasteUpMorph>>toggleClassicNavigatorIfAppropriate (in category 'world menu') -----
- toggleClassicNavigatorIfAppropriate
- "If appropriate, toggle the presence of classic navigator"
-
- Preferences classicNavigatorEnabled ifTrue: [^ Preferences toggle: #showProjectNavigator]!
Item was removed:
- ----- Method: PasteUpMorph>>toggleMouseOverHalos (in category 'options') -----
- toggleMouseOverHalos
- wantsMouseOverHalos := self wantsMouseOverHalos not!
Item was removed:
- ----- Method: PasteUpMorph>>triggerClosingScripts (in category 'world state') -----
- triggerClosingScripts
- "If the receiver has any scripts set to run on closing, run them now"
- | aPlayer |
- self allMorphsDo:[ :m|
- (aPlayer := m player) ifNotNil:
- [aPlayer runAllClosingScripts]]!
Item was removed:
- ----- Method: PasteUpMorph>>triggerOpeningScripts (in category 'world state') -----
- triggerOpeningScripts
- "If the receiver has any scripts set to run on opening, run them now"
- | aPlayer |
- self allMorphsDo:[ :m|
- (aPlayer := m player) ifNotNil:
- [aPlayer runAllOpeningScripts]]!
Item was removed:
- ----- Method: PasteUpMorph>>updateStatusForAllScriptEditors (in category 'misc') -----
- updateStatusForAllScriptEditors
- self allScriptEditors do: [:anEditor | anEditor updateStatus]!
Item was removed:
- ----- Method: PasteUpMorph>>valueAtCursor (in category 'cursor') -----
- valueAtCursor
- "Answer the submorph of mine indexed by the value of my 'cursor' slot"
-
- submorphs isEmpty ifTrue: [^ self presenter standardPlayer costume].
- ^ (submorphs at: ((cursor truncated max: 1) min: submorphs size)) morphRepresented!
Item was removed:
- ----- Method: PasteUpMorph>>valueAtCursor: (in category 'cursor') -----
- valueAtCursor: aMorph
- submorphs isEmpty ifTrue: [^ self].
- self rectifyCursor.
- self replaceSubmorph: self valueAtCursor by: aMorph!
Item was removed:
- ----- Method: PasteUpMorph>>viewingNormally (in category 'viewing') -----
- viewingNormally
- "Answer whether the receiver is being viewed normally, viz not in list-view or auto-line-layout"
-
- ^ (self showingListView or: [self autoLineLayout == true]) not
- !
Item was removed:
- ----- Method: PasteUpMorph>>wantsHaloFor: (in category 'halos and balloon help') -----
- wantsHaloFor: aSubMorph
- "Answer whether the receiver wishes for a mouse-over halo to be produced for aSubMorph"
-
- ^ wantsMouseOverHalos == true and:
- [self visible and:
- [isPartsBin ~~ true and:
- [self dropEnabled and:
- [aSubMorph renderedMorph isLikelyRecipientForMouseOverHalos]]]]!
Item was removed:
- ----- Method: PasteUpMorph>>wantsMouseOverHalos (in category 'options') -----
- wantsMouseOverHalos
- ^ wantsMouseOverHalos == true!
Item was removed:
- ----- Method: PasteUpMorph>>wantsMouseOverHalos: (in category 'options') -----
- wantsMouseOverHalos: aBoolean
- wantsMouseOverHalos := aBoolean!
Item was removed:
- Morph subclass: #PluggableTabButtonMorph
- instanceVariableNames: 'active model textSelector arcLengths subMorph'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Pluggable Widgets'!
-
- !PluggableTabButtonMorph commentStamp: 'KLC 9/17/2004 11:27' prior: 0!
- This is a specialized pluggable button morph that is meant to represent a tab in a set of tabs arranged horizontally. Each tab will overlap slightly when drawn. All but one tab will be drawn in left to right order in the specified color, but lighter. The active tab will be drawn last in the full color and slightly taller to indicate that it is selected. Clicking the active tab has no effect but clicking any other tab will change the active tab to the clicked tab.
-
- This morph does not itself accept any events. The parent tab set will grab the mouse clicks and handle notifying the appropriate tabs that they have been activated or deactivated.
-
- There is a single selector which provides the text for the button label and affects the width of the tab. When the width changes the tab will inform its parent that it has changed and that the layout needs to be updated. The model for the text selector of course should be the client for the tab set.
-
- The button label can be a String, Text, or Morph. Texts work better than plain Strings.!
Item was removed:
- ----- Method: PluggableTabButtonMorph class>>on:label: (in category 'instance creation') -----
- on: anObject label: getTextSelector
- | instance |
- instance := super new.
- instance model: anObject.
- instance textSelector: getTextSelector.
- ^ instance !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>active (in category 'access') -----
- active
- active ifNil: [ active := false ].
- ^ active!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>active: (in category 'access') -----
- active: aBoolean
- active := aBoolean.
- self changed.!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>arcLengths (in category 'private - access') -----
- arcLengths
- arcLengths ifNil: [ self calculateArcLengths ].
- ^ arcLengths!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>arcLengths: (in category 'private - access') -----
- arcLengths: anArrayOfIntegers
- arcLengths := anArrayOfIntegers
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>calculateArcLengths (in category 'precalculations') -----
- calculateArcLengths
- | array radius |
- radius := self cornerRadius.
- array := Array new: radius.
-
- 1 to: radius do: [ :i | | x |
- x := i - 0.5.
- array at: i
- put: (radius - ((2 * x * radius) - (x * x)) sqrt) asInteger].
-
- self arcLengths: array!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>cornerRadius (in category 'private - access') -----
- cornerRadius
- ^ 5
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>drawOn: (in category 'drawing') -----
- drawOn: aCanvas
- self drawTabOn: aCanvas.
- self drawSubMorphOn: aCanvas!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>drawSubMorphOn: (in category 'drawing') -----
- drawSubMorphOn: aCanvas
- | morphBounds |
- morphBounds := self bounds insetBy: (self cornerRadius + 3) @ (self topInactiveGap // 2 + 2).
- morphBounds := morphBounds translateBy: 0@(self topInactiveGap // 2 + 1).
- self active ifTrue: [
- morphBounds := morphBounds translateBy: 0@((self topInactiveGap // 2 + 1) negated)].
- self subMorph bounds height < (morphBounds height)
- ifTrue: [
- morphBounds := morphBounds
- insetBy: 0@((morphBounds height - self subMorph bounds height) // 2)].
- self subMorph bounds width < (morphBounds width)
- ifTrue: [
- morphBounds := morphBounds
- insetBy: ((morphBounds width - self subMorph bounds width) // 2)@0].
-
- self subMorph bounds: morphBounds.
- aCanvas drawMorph: self subMorph!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>drawTabOn: (in category 'drawing') -----
- drawTabOn: aCanvas
- | top myColor cornerRadius myArcLengths myBounds |
- cornerRadius := self cornerRadius.
- myBounds := self bounds.
- self active
- ifTrue: [ top := myBounds top.
- myColor := self color ]
- ifFalse: [ top := myBounds top + self topInactiveGap.
- myColor := self color whiter whiter ].
- aCanvas fillRectangle:
- ((myBounds left + cornerRadius)
- @ (top + cornerRadius)
- corner: (myBounds right - cornerRadius)
- @ self bottom)
- color: myColor.
- aCanvas fillRectangle:
- ((myBounds left + (cornerRadius * 2)) @ top
- corner: (myBounds right - (cornerRadius * 2))
- @ (top + cornerRadius))
- color: myColor.
- aCanvas fillOval:
- ((myBounds left + self cornerRadius) @ top
- corner: (myBounds left + (self cornerRadius * 3))
- @ (top + (self cornerRadius * 2)))
- color: myColor.
- aCanvas fillOval:
- ((myBounds right - (self cornerRadius * 3)) @ top
- corner: (myBounds right - self cornerRadius)
- @ (top + (self cornerRadius * 2)))
- color: myColor.
-
- myArcLengths := self arcLengths.
- 1 to: myArcLengths size do: [ :i | | length |
- length := myArcLengths at: i.
- aCanvas line: (myBounds left + cornerRadius - i) @ (myBounds bottom - 1 )
- to: (myBounds left + cornerRadius - i) @ (myBounds bottom - length - 1)
- color: myColor.
- aCanvas line: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - 1)
- to: (myBounds right - cornerRadius + i - 1) @ (myBounds bottom - length - 1)
- color: myColor]
-
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>initialize (in category 'initialization') -----
- initialize
- ^ super initialize
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>innerExtent: (in category 'access') -----
- innerExtent: aPoint
- "Set the extent based on the primary visible part of the tab. In other words add twice the cornerRadius to this extent"
- self extent: (aPoint x + (self cornerRadius * 2)) @ (aPoint y)!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>model (in category 'access') -----
- model
- ^ model
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>model: (in category 'access') -----
- model: anObject
- model := anObject!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>outerGap (in category 'access') -----
- outerGap
- "The horizontal distance of the outer left and right edges of the tab excluding the inner visible part"
- ^ self cornerRadius * 2!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>step (in category 'stepping') -----
- step
- self subMorph step.
- self changed.
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>stepTime (in category 'stepping') -----
- stepTime
- ^ self subMorph stepTime
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>subMorph (in category 'private - access') -----
- subMorph
- subMorph ifNil: [ self update: self textSelector ].
- ^ subMorph!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>subMorph: (in category 'private - access') -----
- subMorph: aMorph
- subMorph := aMorph
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>textSelector (in category 'access') -----
- textSelector
- ^ textSelector
- !
Item was removed:
- ----- Method: PluggableTabButtonMorph>>textSelector: (in category 'access') -----
- textSelector: aSymbol
- textSelector := aSymbol!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>toggle (in category 'actions') -----
- toggle
- self active: self active not!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>topInactiveGap (in category 'private - access') -----
- topInactiveGap
- ^ 5!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>update: (in category 'updating') -----
- update: aSelector
- self textSelector ifNotNil: [
- aSelector = self textSelector
- ifTrue: [ | morph |
- (aSelector isSymbol and: [model notNil])
- ifTrue: [
- morph :=
- (self model perform: aSelector) asMorph]
- ifFalse: [ morph := aSelector value asMorph].
- self subMorph: morph]].
- self changed!
Item was removed:
- ----- Method: PluggableTabButtonMorph>>wantsSteps (in category 'stepping') -----
- wantsSteps
- ^ self subMorph wantsSteps!
Item was removed:
- ----- Method: PluggableTextMorph>>tileForIt (in category 'menu commands') -----
- tileForIt
- "Return a tile referring to the object resulting form evaluating my current selection. Not currently threaded in, but useful in earlier demos and possibly still of value."
-
-
- self handleEdit:
- [textMorph editor evaluateSelectionAndDo: [:result | self currentHand attachMorph: result tileToRefer]]!
Item was removed:
- Object subclass: #Presenter
- instanceVariableNames: ''
- classVariableNames: 'DefaultPresenterClass'
- poolDictionaries: ''
- category: 'Morphic-Worlds'!
-
- !Presenter commentStamp: '<historical>' prior: 0!
- Optionally associated with a PasteUpMorph, provides a local scope for the running of scripts.
-
- Once more valuable, may be again, but at present occupies primarily a historical niche.
-
- Maintains a playerList cache.
-
- Holds, optionally three 'standard items' -- standardPlayer standardPlayfield standardPalette -- originally providing idiomatic support of ongoing squeak-team internal work, but now extended to more general applicability.
-
- !
Item was removed:
- ----- Method: Presenter class>>defaultPresenterClass (in category 'accessing') -----
- defaultPresenterClass
- "The default presenter class to use"
- ^DefaultPresenterClass ifNil:[self]!
Item was removed:
- ----- Method: Presenter class>>defaultPresenterClass: (in category 'accessing') -----
- defaultPresenterClass: aPresenterClass
- "The default presenter class to use"
- DefaultPresenterClass := aPresenterClass!
Item was removed:
- ----- Method: Presenter>>allCurrentlyTickingScriptInstantiations (in category 'stubs') -----
- allCurrentlyTickingScriptInstantiations
- "Answer a list of ScriptInstantiation objects representing all the scripts within the scope of the receiver which are currently ticking."
-
- ^ Array streamContents:
- [:aStream |
- self allExtantPlayers do:
- [:aPlayer | aPlayer instantiatedUserScriptsDo:
- [:aScriptInstantiation |
- aScriptInstantiation status == #ticking ifTrue:
- [aStream nextPut: aScriptInstantiation]]]]!
Item was removed:
- ----- Method: Presenter>>allExtantPlayers (in category 'stubs') -----
- allExtantPlayers
- ^#()!
Item was removed:
- ----- Method: Presenter>>associatedMorph: (in category 'accessing') -----
- associatedMorph: m!
Item was removed:
- ----- Method: Presenter>>browseAllScriptsTextually (in category 'stubs') -----
- browseAllScriptsTextually
- "Open a method-list browser on all the scripts in the project"
-
- | aList aMethodList |
- self flushPlayerListCache. "Just to be certain we get everything"
-
- (aList := self uniclassesAndCounts) size == 0 ifTrue: [^ self inform: 'there are no scripted players' translated].
- aMethodList := OrderedCollection new.
- aList do:
- [:aPair | aPair first addMethodReferencesTo: aMethodList].
- aMethodList size > 0 ifFalse: [^ self inform: 'there are no scripts in this project!!' translated].
-
- SystemNavigation new
- browseMessageList: aMethodList
- name: 'All scripts in this project'
- autoSelect: nil
-
- "
- ActiveWorld presenter browseAllScriptsTextually
- "!
Item was removed:
- ----- Method: Presenter>>currentlyViewing: (in category 'stubs') -----
- currentlyViewing: aPlayer
- ^false!
Item was removed:
- ----- Method: Presenter>>drawingJustCompleted: (in category 'stubs') -----
- drawingJustCompleted: aSketch!
Item was removed:
- ----- Method: Presenter>>flushPlayerListCache (in category 'stubs') -----
- flushPlayerListCache!
Item was removed:
- ----- Method: Presenter>>morph:droppedIntoPasteUpMorph: (in category 'stubs') -----
- morph: aMorph droppedIntoPasteUpMorph: aPasteUpMorph!
Item was removed:
- ----- Method: Presenter>>ownStandardPalette (in category 'stubs') -----
- ownStandardPalette
- ^nil!
Item was removed:
- ----- Method: Presenter>>positionStandardPlayer (in category 'stubs') -----
- positionStandardPlayer!
Item was removed:
- ----- Method: Presenter>>viewMorph: (in category 'stubs') -----
- viewMorph: aMorph
- aMorph inspect.
- !
Item was removed:
- ----- Method: Presenter>>viewObjectDirectly: (in category 'stubs') -----
- viewObjectDirectly: aMorph
- aMorph inspect.
- !
Item was removed:
- ----- Method: SelectionMorph>>couldMakeSibling (in category 'testing') -----
- couldMakeSibling
- "Answer whether it is appropriate to ask the receiver to make a sibling"
-
- ^ false!
Item was removed:
- ----- Method: SelectionMorph>>preferredDuplicationHandleSelector (in category 'testing') -----
- preferredDuplicationHandleSelector
- "Answer the selector, to be offered as the default in a halo open on me"
-
- ^ #addDupHandle:!
Item was removed:
- ----- Method: SimpleHaloMorph>>isMagicHalo (in category 'testing') -----
- isMagicHalo
-
- ^ false!
Item was removed:
- ----- Method: SimpleHaloMorph>>popUpMagicallyFor:hand: (in category 'pop up') -----
- popUpMagicallyFor: morph hand: hand
-
- self
- popUpFor: morph
- hand: hand.!
Item was removed:
- ----- Method: SimpleHierarchicalListMorph class>>submorphsExample (in category 'examples') -----
- submorphsExample
- "display a hierarchical list of the current world plus its submorphs plus its submorphs' submorphs etc."
- "SimpleHierarchicalListMorph submorphsExample"
- | morph |
- morph :=
- SimpleHierarchicalListMorph
- on: [ Array with: (MorphWithSubmorphsWrapper with: Project current world) ]
- list: #value
- selected: nil
- changeSelected: nil
- menu: nil
- keystroke: nil.
-
- morph openInWindow!
Item was removed:
- ----- Method: SketchMorph>>firstIntersectionWithLineFrom:to: (in category 'geometry') -----
- firstIntersectionWithLineFrom: start to: end
- | intersections last |
- intersections := self fullBounds extrapolatedIntersectionsWithLineFrom: start to: end.
- intersections size = 1 ifTrue: [ ^intersections anyOne ].
- intersections isEmpty ifTrue: [ ^nil ].
- intersections := intersections sorted: [ :a :b | (start dist: a) < (start dist: b) ].
- last := intersections first rounded.
- last pointsTo: intersections last rounded do: [ :pt |
- (self rotatedForm isTransparentAt: (pt - bounds origin)) ifFalse: [ ^last ].
- last := pt.
- ].
- ^intersections first rounded!
Item was removed:
- Object subclass: #StandardScriptingSystem
- instanceVariableNames: ''
- classVariableNames: 'ClassVarNamesInUse FormDictionary HelpStrings StandardPartsBin'
- poolDictionaries: ''
- category: 'Morphic-Worlds'!
-
- !StandardScriptingSystem commentStamp: '<historical>' prior: 0!
- An instance of this is installed as the value of the global variable "ScriptingSystem". Client subclasses are invited, such as one used internally by squeak team for ongoing internal work.!
Item was removed:
- ----- Method: StandardScriptingSystem class>>cleanUp: (in category 'class initialization') -----
- cleanUp: agressive
- "Clean up unreferenced players. If agressive, reinitialize and nuke players"
-
- self removeUnreferencedPlayers.
- agressive ifTrue:[
- References keys do: [:k | References removeKey: k].
- ClassVarNamesInUse := nil.
- self initialize.
- ].!
Item was removed:
- ----- Method: StandardScriptingSystem class>>initialize (in category 'class initialization') -----
- initialize
- "Initialize the scripting system. Sometimes this method is vacuously changed just to get it in a changeset so that its invocation will occur as part of an update"
-
- (self environment at: #ScriptingSystem ifAbsent: [nil]) ifNil:
- [self environment at: #ScriptingSystem put: self new].
-
- ScriptingSystem
- initializeHelpStrings.
-
- self registerInFlapsRegistry.
-
- "StandardScriptingSystem initialize"!
Item was removed:
- ----- Method: StandardScriptingSystem class>>removeUnreferencedPlayers (in category 'class initialization') -----
- removeUnreferencedPlayers
- "Remove existing but unreferenced player references"
- "StandardScriptingSystem removeUnreferencedPlayers"
- References keys do:
- [ : key | | ref |
- ref := References at: key.
- ((ref respondsTo: #costume) and: [ ref costume pasteUpMorph isNil ]) ifTrue: [ References removeKey: key ] ]!
Item was removed:
- ----- Method: StandardScriptingSystem>>allClassVarNamesInSystem (in category 'utilities') -----
- allClassVarNamesInSystem
- "Compute and answer a set of all the class variable names known to the sytem from any class"
-
- | aList |
- aList := OrderedCollection new.
- Object withAllSubclasses do:
- [:c | aList addAll: c allClassVarNames].
- ^ aList asSet
-
- "ScriptingSystem allClassVarNamesInSystem"
- !
Item was removed:
- ----- Method: StandardScriptingSystem>>customizeForEToyUsers: (in category 'utilities') -----
- customizeForEToyUsers: aBoolean
- "If aBoolean is true, set things up for etoy users. If it's false, unset some of those things. Some things are set when switching into etoy mode but not reversed when switching out of etoy mode."
-
- #(
- (allowEtoyUserCustomEvents no reverse)
- (balloonHelpEnabled yes dontReverse)
- (debugHaloHandle no reverse)
- (modalColorPickers yes dontReverse)
- (oliveHandleForScriptedObjects no dontReverse)
- (uniqueNamesInHalos yes reverse)
- (useUndo yes dontReverse)
- (infiniteUndo no dontReverse)
- (warnIfNoChangesFile no reverse)
- (warnIfNoSourcesFile no reverse)) do:
- [:trip |
- (aBoolean or: [trip third == #reverse]) ifTrue:
- [Preferences setFlag: trip first toValue:
- ((trip second == #yes) & aBoolean) | ((trip second == #no) & aBoolean not)]]!
Item was removed:
- ----- Method: StandardScriptingSystem>>deletePrivateGraphics (in category 'form dictionary') -----
- deletePrivateGraphics
- "ScriptingSystem deletePrivateGraphics"
- self deletePrivateGraphics: self privateGraphics
- afterStoringToFileNamed: 'disGraphics'!
Item was removed:
- ----- Method: StandardScriptingSystem>>deletePrivateGraphics:afterStoringToFileNamed: (in category 'form dictionary') -----
- deletePrivateGraphics: nameList afterStoringToFileNamed: aFileName
- "This method is used to strip private graphics from the FormDictionary and store them on a file of the given name"
-
- | replacement toRemove aReferenceStream |
- toRemove := Dictionary new.
- replacement := FormDictionary at: #Gets.
-
- nameList do:
- [:aKey |
- | keySymbol |
- keySymbol := aKey asSymbol.
- (toRemove at: keySymbol put: (self formAtKey: keySymbol)).
- FormDictionary at: keySymbol put: replacement].
-
- aReferenceStream := ReferenceStream fileNamed: aFileName.
- aReferenceStream nextPut: toRemove.
- aReferenceStream close!
Item was removed:
- ----- Method: StandardScriptingSystem>>formAtKey: (in category 'form dictionary') -----
- formAtKey: aString
- "Answer the form saved under the given key"
-
- ^((Symbol lookup: aString)
- ifNotNil: [ :aKey | FormDictionary at: aKey ifAbsent: [ FormDictionary at: #Cat ] ]
- ifNil: [ FormDictionary at: #Cat ])
- magnifyBy: RealEstateAgent scaleFactor!
Item was removed:
- ----- Method: StandardScriptingSystem>>formAtKey:extent:depth: (in category 'form dictionary') -----
- formAtKey: aKey extent: extent depth: depth
- "ScriptingSystem saveForm: (TileMorph downPicture) atKey: 'downArrow'"
- ^ FormDictionary at: aKey asSymbol ifAbsent: [Form extent: extent depth: depth]!
Item was removed:
- ----- Method: StandardScriptingSystem>>formDictionary (in category 'form dictionary') -----
- formDictionary
- ^FormDictionary!
Item was removed:
- ----- Method: StandardScriptingSystem>>helpStringOrNilFor: (in category 'help dictionary') -----
- helpStringOrNilFor: aSymbol
- "If my HelpStrings dictionary has an entry at the given symbol,
- answer that entry's value, else answer nil"
- HelpStrings
- at: aSymbol
- ifPresent:[:string | ^ string translated].
- ^ nil!
Item was removed:
- ----- Method: StandardScriptingSystem>>initializeHelpStrings (in category 'help dictionary') -----
- initializeHelpStrings
- "Initialize the data structure that determines, for the etoy system, help messages for various scripting elements. The structure is built up by letting every Morph subclass contribute elements simply by implementing method #helpContributions. Consult implementors of #helpContributions for examples of how this goes."
-
- "ScriptingSystem initializeHelpStrings"
-
- | aDictionary |
- aDictionary := IdentityDictionary new.
- "For safety, the new copy is built up in this temp first, so that if an error occurs during the creation of the structure, the old version will remain remain in place"
-
- Morph withAllSubclasses do:
- [:aClass | (aClass class includesSelector: #helpContributions)
- ifTrue:
- [aClass helpContributions do:
- [:pair | aDictionary at: pair first put: pair second]]].
-
- HelpStrings := aDictionary!
Item was removed:
- ----- Method: StandardScriptingSystem>>inspectFormDictionary (in category 'form dictionary') -----
- inspectFormDictionary
- "ScriptingSystem inspectFormDictionary"
-
- GraphicalDictionaryMenu openOn: FormDictionary withLabel: 'Testing One Two Three'!
Item was removed:
- ----- Method: StandardScriptingSystem>>privateGraphics (in category 'form dictionary') -----
- privateGraphics
- "ScriptingSystem deletePrivateGraphics"
- ^#(#BadgeMiniPic #BadgePic #Broom #CedarPic #CollagePic #CoverMain #CoverSpiral #CoverTexture #Fred #ImagiPic #KayaPic #StudioPic)!
Item was removed:
- ----- Method: StandardScriptingSystem>>saveForm:atKey: (in category 'form dictionary') -----
- saveForm: aForm atKey: aKey
- FormDictionary at: aKey asSymbol put: aForm!
Item was removed:
- ----- Method: StandardScriptingSystem>>soundNamesToSuppress (in category 'utilities') -----
- soundNamesToSuppress
- "Answer a list of sound-names that are not to be offered in sound-choice pop-ups unless they are the current choice"
-
- ^ #('scrape' 'scritch' 'peaks')!
Item was removed:
- ----- Method: StandardScriptingSystem>>squeakyMouseForm (in category 'form dictionary') -----
- squeakyMouseForm
- ^ self formAtKey: 'squeakyMouse'
-
- "
- ScriptingSystem saveForm: (Form
- extent: 30@29
- depth: 16
- fromArray: #( 1811114995 1878286257 2012637171 1811180532 1811180533 1811179508 1811180532 1811179508 1744006133 1878289396 1811180533 1878289396 1744007156 1674736630 1744006132 1811114995 1811181556 1744006131 1811246068 1811180532 1811179508 1811180532 1744071668 1811113972 1811180532 1811180532 1811179507 1878288338 1945529332 1744071668 1743941620 1811112945 1811179506 1811114995 1744006131 1744006130 1744005106 1811048434 1811113969 1743939570 1811179506 1743939571 1676833782 1676765171 1811047410 1744006131 1811048435 1811116020 1811180531 1743939571 1811048435 1743939570 1743939570 1743939570 1743940594 1744005106 1811181556 1811180532 1676766196 1743939570 1878420468 1676963830 1189896082 1811245044 1744137204 1744070644 1811179508 1811113971 1743939571 1811179508 1811246070 1811309524 1811302093 1811310580 1811246068 1674867703 1744049472 1120606594 1118465013 1744137205 1811179508 1811180532 1744071667 1744006132 1811112947 1811247095 1605584589 358761132 289435638 1676
830707 1741975543 1462778473 1811312631 702891724 1811310548 1945528308 1811178450 1945528307 1878288372 1878353875 1878421494 1051471335 1809213397 1118524175 1811246068 1945659348 1185698607 1878486005 1672694510 1118531574 1607626741 1878420467 1811180533 1743942645 1744072693 1811301035 1185770487 1878486006 1324239597 1811180533 1811116019 1120623438 1878352818 1945462739 704868339 1878289395 1811049459 1878221808 1878223859 1743876083 1811162563 1945463796 1811181556 1464746666 1811116018 1809019893 1120551562 1945464821 1741844468 1466842760 1878289395 1811048434 1811050483 1811050483 1878223859 1049188174 1741910004 1811181556 1256998634 1811114994 1878289396 1466840647 1744007156 1744006131 1676877216 1743940596 1878222835 1743938545 1878351792 1676833781 358641652 1743940596 1811050484 845566798 1811113970 1811114995 1811163652 1811112913 1878420468 1878282028 1811179506 1607560178 1878289395 1676900342 1878351825 1466853330 1811113971 1811116019 635659217 1811179506 18112
45045 1676942754 1744137206 1744201717 1676962806 1676962805 1811310581 1676896245 1744199635 1811376117 1744072695 1744005109 1811244019 499279861 1811310581 1811244020 1811293668 1399943159 1605528567 1744136181 982063522 986342388 1744070645 1744189066 430063308 1744071669 1744070644 1744067504 566519797 1744136181 1744137205 1743999854 912813044 1811311606 1742162607 4195488 283139922 1945531382 1253113857 144710948 1601400791 1811246069 1811167879 1464821747 1744136180 1674799094 1811178482 843473875 1811311606 1878533542 2106790 2080066222 1876193270 696845376 627472380 1185772536 1878355957 1743990309 1744007157 1676898294 1744006132 1811114996 1743941620 1811180533 1809204941 4194368 4217681 1878290421 1252982848 4194336 1670540278 1739811795 1878353906 1744006131 1811179506 1744007157 1744005106 1945462771 1811182582 1811311574 1393641133 1462856629 2012638196 1876382449 1112301394 1742041045 1945596917 1676833781 1811113970 1811179507 1811180532 1672705014 1674735606 16726
97648 1945725943 1878551479 1809215479 1811312629 1809216504 1809215479 1809215478 1462853490 1878487029 1744007158 1744005075 1811239726 704979363 495004132 700789287 562372997 631646663 1739998892 4194400 1116497846 698688932 562375109 770124262 633609569 495070758 1257010166 562315916 1809279958 2012894002 1047280171 980237901 910966381 1668677696 4194400 6314867 1047281260 908804749 910968495 1393719290 1809279959 1185750370 1809214455 1878469062 423836236 1532188466 1601592148 1462986647 1672937568 4194368 6319062 1603622706 1601525554 1601522417 1047336194 770206679 1878487031 1878409899 977955830 1809145716 1118586509 980105834 980045584 1811372914 980104778 1605526483 1395605131 910769804 1118651052 1534358520 1809136234 1118596053 1532059506 1878485973 1326456163 1945660374 1742106615 1811311607 1945725942 1742107641 1744072693 1811311605 1744203767 1878551543 564478604 1878553591 1603428242 1811048433 1811049459 1051290611 1744006131 1811049459 1878156273 1743874034 174400
7156 1743874033 1811048434 1811113970 1743939571 1743933228 1603301363 1743875059 1811049458 1945461745 1811181556 1811113971 1811049458 1811048434 1811116020 1878287346 1878223857 1743940594 1744006130 1744007157 1945395153 1945400309 1811048434 1743810547 1676765170 1878353906 1811113970 1743874032 1810983921 1743874033 1811113971 1676765169 1743874034 1743940593 1743939569 1811047409 1676765168 1743940595 1810981872 1945397235 1607560179 1743941620 1810982897 1810983921 1811048433 1744007155 1743875059 1811048434 1743875058 1743939568 1676832754 1811116019 1811114994 1811244019 1676962805 1677029367 1811244020 1744005106 1743940594 1811246068 1744070645 1676961781 1744004084 1676897269 1811180533 1878353908 1744004083 1744070645)
- offset: 0@0) atKey: 'squeakyMouse'"!
Item was removed:
- ----- Method: StandardScriptingSystem>>stripGraphicsForExternalRelease (in category 'utilities') -----
- stripGraphicsForExternalRelease
- "ScriptingSystem stripGraphicsForExternalRelease"
-
- | replacement |
- replacement := FormDictionary at: #Gets.
-
- #('BadgeMiniPic' 'BadgePic' 'Broom' 'CedarPic' 'CollagePic' 'CoverMain' 'CoverSpiral' 'CoverTexture' 'Fred' 'ImagiPic' 'KayaPic' 'StudioPic')
- do:
- [:aKey | FormDictionary at: aKey asSymbol put: replacement]!
Item was removed:
- ----- Method: SystemWindow>>extantSketchEditor (in category 'top window') -----
- extantSketchEditor
- "If my world has an extant SketchEditorMorph associated with anything
- in this window, return that SketchEditor, else return nil"
- | w sketchEditor pasteUp |
- (w := self world) isNil ifTrue: [^ nil].
- (sketchEditor := w sketchEditorOrNil) isNil ifTrue: [^ nil].
- (pasteUp := sketchEditor enclosingPasteUpMorph) isNil ifTrue: [^ nil].
- self findDeepSubmorphThat: [:m | m = pasteUp]
- ifAbsent: [^ nil].
- ^ sketchEditor!
Item was removed:
- ----- Method: SystemWindow>>wantsExpandBox (in category 'resize/collapse') -----
- wantsExpandBox
- "Answer whether I'd like an expand box"
-
- ^ Preferences alwaysHideExpandButton not!
Item was removed:
- ----- Method: SystemWindow>>wantsHalo (in category 'events') -----
- wantsHalo
- ^ false!
Item was removed:
- RectangleMorph subclass: #TextFieldMorph
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Morphic-Text Support'!
-
- !TextFieldMorph commentStamp: '<historical>' prior: 0!
- Act as a field in a HyperCard-like setting. Has both properties of a Rectangle, and exposes some proteries of the TextMorph it owns.
-
- !
Item was removed:
- ----- Method: TextFieldMorph class>>authoringPrototype (in category 'scripting') -----
- authoringPrototype
- "Answer an instance of the receiver that can serve as a prototype for authoring"
-
- | proto |
- proto := super authoringPrototype.
- proto setProperty: #shared toValue: true.
- proto extent: 170 @ 30.
- proto color: Color veryLightGray lighter.
- proto contents: 'on a clear day you can...'.
- ^ proto
- !
Item was removed:
- ----- Method: TextFieldMorph class>>initialize (in category 'class initialization') -----
- initialize
-
- self registerInFlapsRegistry. !
Item was removed:
- ----- Method: TextFieldMorph class>>registerInFlapsRegistry (in category 'class initialization') -----
- registerInFlapsRegistry
- "Register the receiver in the system's flaps registry"
- self environment
- at: #Flaps
- ifPresent: [:cl | cl registerQuad: {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}
- forFlapNamed: 'Scripting'.]!
Item was removed:
- ----- Method: TextFieldMorph class>>unload (in category 'class initialization') -----
- unload
- "Unload the receiver from global registries"
-
- self environment at: #Flaps ifPresent: [:cl |
- cl unregisterQuadsWithReceiver: self] !
Item was removed:
- ----- Method: TextFieldMorph>>append: (in category 'just like textMorph') -----
- append: stringOrText
- "add to my text"
- | tm |
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- tm contents append: stringOrText.
- tm releaseParagraph; paragraph.
-
-
- !
Item was removed:
- ----- Method: TextFieldMorph>>contents (in category 'just like textMorph') -----
- contents
- | tm |
- "talk to my text"
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- ^ tm contents!
Item was removed:
- ----- Method: TextFieldMorph>>contents: (in category 'just like textMorph') -----
- contents: textOrString
- "talk to my text"
- | tm newText atts |
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- textOrString isString ifTrue: [
- tm contents ifNotNil: ["Keep previous properties of the field"
- newText := textOrString asText.
- atts := tm contents attributesAt: 1.
- atts do: [:each | newText addAttribute: each].
- ^ tm contents: newText]].
-
- ^ tm contents: textOrString!
Item was removed:
- ----- Method: TextFieldMorph>>defaultColor (in category 'initialization') -----
- defaultColor
- "answer the default color/fill style for the receiver"
- ^ Color veryLightGray lighter!
Item was removed:
- ----- Method: TextFieldMorph>>fit (in category 'just like textMorph') -----
- fit
- "tell my text to recompute its looks"
- | tm |
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- tm releaseParagraph; paragraph.!
Item was removed:
- ----- Method: TextFieldMorph>>fontName:size: (in category 'just like textMorph') -----
- fontName: fontName size: fontSize
- | tm |
- "talk to my text"
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- ^ tm fontName: fontName size: fontSize
- !
Item was removed:
- ----- Method: TextFieldMorph>>initialize (in category 'initialization') -----
- initialize
- "initialize the state of the receiver"
- | tm |
- super initialize.
- ""
-
- self addMorph: (tm := TextMorph new).
- tm fillingOnOff!
Item was removed:
- ----- Method: TextFieldMorph>>lineCount (in category 'just like textMorph') -----
- lineCount
- | tm |
- "how many lines in my text"
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- ^ tm contents string lineCount!
Item was removed:
- ----- Method: TextFieldMorph>>prepend: (in category 'just like textMorph') -----
- prepend: stringOrText
- "add to my text"
- | tm |
-
- (tm := self findA: TextMorph) ifNil: [^ nil].
- tm contents prepend: stringOrText.
- tm releaseParagraph; paragraph.
-
-
- !
Item was removed:
- ----- Method: TextMorph>>cursor (in category 'accessing') -----
- cursor
- "Answer the receiver's logical cursor position"
-
- | loc |
- loc := self valueOfProperty: #textCursorLocation ifAbsentPut: [1].
- loc := loc min: text string size.
- ^ loc rounded
- !
Item was removed:
- ----- Method: TextMorph>>cursorWrapped: (in category 'accessing') -----
- cursorWrapped: aNumber
- "Set the cursor as indicated"
-
- self setProperty: #textCursorLocation toValue: (((aNumber rounded - 1) \\ text string size) + 1)
-
- !
Item was removed:
- ----- Method: TextMorph>>getAllButFirstCharacter (in category 'scripting access') -----
- getAllButFirstCharacter
- "Obtain all but the first character from the receiver; if that would be empty, return a black dot"
-
- | aString |
- ^ (aString := text string) size > 1
- ifTrue: [aString copyFrom: 2 to: aString size]
- ifFalse: ['·']!
Item was removed:
- ----- Method: TextMorph>>holderForCharacters (in category 'menu') -----
- holderForCharacters
- "Hand the user a Holder that is populated with individual text morphs representing my characters"
-
- | aHolder |
- aHolder := ScriptingSystem prototypicalHolder.
- aHolder setNameTo: 'H', self externalName.
- text string do:
- [:aChar |
- aHolder addMorphBack: (TextMorph new contents: aChar asText)].
- aHolder setProperty: #donorTextMorph toValue: self.
- aHolder fullBounds.
- aHolder openInHand!
Item was removed:
- ----- Method: TextMorph>>insertCharacters: (in category 'scripting access') -----
- insertCharacters: aString
- "Insert the characters from the given source at my current cursor position"
-
- | aLoc aText attributes |
- aLoc := self cursor max: 1.
- aText := aLoc > text size
- ifTrue: [aString asText]
- ifFalse: [
- attributes := (text attributesAt: aLoc)
- select: [:attr | attr mayBeExtended].
- Text string: aString attributes: attributes].
- paragraph replaceFrom: aLoc to: (aLoc - 1) with: aText displaying: true.
- self updateFromParagraph !
Item was removed:
- ----- Method: TextMorph>>insertContentsOf: (in category 'scripting access') -----
- insertContentsOf: aPlayer
- "Insert the characters from the given player at my current cursor position"
-
- | aLoc |
- aLoc := self cursor.
- paragraph replaceFrom: aLoc to: (aLoc - 1) with: aPlayer getStringContents displaying: true.
- self updateFromParagraph !
Item was removed:
- ----- Method: TextMorph>>setAllButFirstCharacter: (in category 'scripting access') -----
- setAllButFirstCharacter: source
- "Set all but the first char of the receiver to the source"
- | chars |
- (chars := self getCharacters) isEmpty
- ifTrue: [self newContents: '·' , source asString]
- ifFalse: [self newContents: (String
- streamContents: [:aStream |
- aStream nextPut: chars first.
- aStream nextPutAll: source])]!
Item was removed:
- ----- Method: TextMorph>>wouldAcceptKeyboardFocusUponTab (in category 'event handling') -----
- wouldAcceptKeyboardFocusUponTab
- "Answer whether the receiver might accept keyboard focus if
- tab were hit in some container playfield"
- ^ self inPartsBin not!
Item was removed:
- ----- Method: TextMorphForEditView>>wouldAcceptKeyboardFocusUponTab (in category 'event handling') -----
- wouldAcceptKeyboardFocusUponTab
- "Answer whether the receiver would be a happy inheritor of keyboard focus if tab were hit in an enclosing playfield under propitious circumstances. Does not make sense for this kind of morph, which is encased in a window"
-
- ^ false!
Item was removed:
- ----- Method: TheWorldMenu>>menuColorString (in category 'action') -----
- menuColorString
-
- ^ Preferences menuColorString!
Item was removed:
- ----- Method: TheWorldMenu>>mvcProjectsAllowed (in category 'commands') -----
- mvcProjectsAllowed
-
- ^Preferences mvcProjectsAllowed and: [Smalltalk includesKey: #StandardSystemView]!
Item was removed:
- ----- Method: TheWorldMenu>>roundedCornersString (in category 'action') -----
- roundedCornersString
-
- ^ (((SystemWindow roundedWindowCorners)
- ifTrue: ['stop']
- ifFalse: ['start']) , ' rounding window corners') translated!
Item was removed:
- ----- Method: TheWorldMenu>>toggleMenuColorPolicy (in category 'action') -----
- toggleMenuColorPolicy
-
- Preferences toggle: #menuColorFromWorld.!
Item was removed:
- ----- Method: UpdatingStringMorph>>isEtoyReadout (in category 'target access') -----
- isEtoyReadout
- "Answer whether the receiver can serve as an etoy readout"
-
- ^ true!
1
0