'From Squeak3.1alpha of 4 February 2001 [latest update: #3726] on 25 February 2001 at 11:31:17 pm'! "Change Set: ScriptBugs-tk Date: 25 February 2001 Author: Ted Kaehler Better explanation of how StackMorphs work. Command veryDeepCopy fixed. Universal tiles, more kinds of literals supported (Fraction). Type checking fix. Mousehandling fix. New tile construction (for SyntaxMorph) was putting in an extra layer of MessageNode in expressions like (a + (b - c)). '-c' was nested in there twice. fixed."! !StackMorph commentStamp: 'tk 2/23/2001 15:06' prior: 0! A book that is very much like a HyperCard stack. Each book page represents a different background. The page stays while different cards are projected onto it. The data for a single card is stored in a CardPlayer. There is a list of objects that only appear on this card (privateMorphs) and the card-specific text to be inserted into the background fields. Item How it is stored a background a page of the StackMorph a card data is in an instance of a subclass of CardPlayer. A list of CardPlayers is in the 'cards' inst var of the StackMorph. a background field a TextMorph on a page of the StackMorph a background picture a morph of any kind on a page of the StackMorph script for bkgnd button method in Player. Button is its costume. text in a background field value of inst var 'field1' in a CardPlayer. (The CardPlayer is also pointed at by the #cardInstance property of the bkgnd field (TextMorph)) text in a card field in the TextMorph in privateMorphs in the CardPlayer. picture on a card a morph of any kind in privateMorphs in the CardPlayer. script for card button method in the CardPlayer. Button is its costume. See VariableDock.! ]style[(365 4 5 16 788 12 1)f1,f1cblack;b,f1,f1b,f1,f1LVariableDock Comment;,f1! !Command methodsFor: 'copying' stamp: 'tk 2/25/2001 17:53'! veryDeepFixupWith: deepCopier | old | "ALL inst vars were weakly copied. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!" super veryDeepFixupWith: deepCopier. 1 to: self class instSize do: [:ii | old _ self instVarAt: ii. self instVarAt: ii put: (deepCopier references at: old ifAbsent: [old])]. ! ! !Command methodsFor: 'copying' stamp: 'tk 2/25/2001 17:53'! veryDeepInner: deepCopier "ALL fields are weakly copied!! Can't duplicate an object by duplicating a Command that involves it. See DeepCopier." super veryDeepInner: deepCopier. "just keep old pointers to all fields" parameters _ parameters.! ]style[(25 108 10 103)f1b,f1,f1LDeepCopier Comment;,f1! ! !MessageSend methodsFor: 'tiles' stamp: 'tk 2/24/2001 13:26'! stringFor: anObject | generic aName | "Return a string suitable for compiling. Literal or reference from global ref dictionary. self is always named via the ref dictionary." anObject isLiteral ifTrue: [^ anObject printString]. anObject class == Color ifTrue: [^ anObject printString]. anObject class superclass == Boolean ifTrue: [^ anObject printString]. anObject class == BlockContext ifTrue: [^ '[''do nothing'']']. "default block" "Real blocks need to construct tiles in a different way" anObject class isMeta ifTrue: ["a class" ^ anObject name]. generic _ anObject knownName. "may be nil or 'Ellipse' " aName _ anObject uniqueNameForReference. generic = aName ifFalse: [ (anObject respondsTo: #renameTo:) ifTrue: [anObject renameTo: aName] ifFalse: [aName _ anObject storeString]]. "for Fraction, LargeInt, etc" ^ aName ! ! !MouseOverHandler methodsFor: 'event handling' stamp: 'tk 2/25/2001 19:03'! processMouseOver: anEvent "Re-establish the z-order for all morphs wrt the given event" | hand localEvt focus evt | hand _ anEvent hand. leftMorphs _ mouseOverMorphs asIdentitySet. "Assume some coherence for the number of objects in over list" overMorphs _ WriteStream on: (Array new: leftMorphs size). enteredMorphs _ WriteStream on: #(). "Now go looking for eventual mouse overs" hand handleEvent: anEvent asMouseOver. "Get out early if there's no change" (leftMorphs size = 0 and:[enteredMorphs position = 0]) ifTrue:[^leftMorphs _ enteredMorphs _ overMorphs _ nil]. focus _ hand mouseFocus. "Send #mouseLeave as appropriate" evt _ anEvent asMouseLeave. "Keep the order of the left morphs by recreating it from the mouseOverMorphs" leftMorphs size > 1 ifTrue:[leftMorphs _ mouseOverMorphs select:[:m| leftMorphs includes: m]]. leftMorphs do:[:m| (m hasOwner: focus) ifTrue:[localEvt _ evt transformedBy: (m transformedFrom: hand). m handleEvent: localEvt] ifFalse:[overMorphs nextPut: m]]. "Send #mouseEnter as appropriate" evt _ anEvent asMouseEnter. enteredMorphs ifNil: ["inform: was called in handleEvent:" ^leftMorphs _ enteredMorphs _ overMorphs _ nil]. enteredMorphs _ enteredMorphs contents. enteredMorphs reverseDo:[:m| (m hasOwner: focus) ifTrue:[ localEvt _ evt transformedBy: (m transformedFrom: hand). m handleEvent: localEvt]]. "And remember the over list" overMorphs ifNil: ["inform: was called in handleEvent:" ^leftMorphs _ enteredMorphs _ overMorphs _ nil]. mouseOverMorphs _ overMorphs contents. leftMorphs _ enteredMorphs _ overMorphs _ nil. ! ! !SyntaxMorph methodsFor: 'type checking' stamp: 'tk 2/25/2001 20:07'! receiverTypeFor: aSelector | where | "Search for the type of the receiver of this selector. Return #unknown if not found." aSelector ifNil: [^ #unknown]. where _ aSelector numArgs = 0 ifTrue: [7] ifFalse: [9]. self class allSpecs do: [:catPair | catPair second do: [:spec | spec first == #command ifTrue: [ spec second == aSelector ifTrue: ["ours" ^ #player]]. spec first == #slot ifTrue: [ spec size >= where ifTrue: [ (spec at: where) == aSelector ifTrue: ["ours" ^ spec at: where-1]]]. ]]. ^ #unknown "What if the same selector appears more than one time?"! ! !SyntaxMorph methodsFor: 'type checking' stamp: 'tk 2/25/2001 18:50'! selector | sel cnt | "Find the selector I represent, or have inside of me. My parseNode is a SelectorNode or a MessageNode." parseNode class == SelectorNode ifTrue: [ ^ self decompile asString asSymbol]. parseNode class == KeyWordNode ifTrue: [ ^ self decompile asString asSymbol]. sel _ ''. cnt _ 0. submorphs do: [:mm | mm isSyntaxMorph ifTrue: [ cnt _ cnt + 1. (mm nodeClassIs: SelectorNode) ifTrue: [^ mm selector]. (mm nodeClassIs: MessagePartNode) ifTrue: [ sel _ sel, mm selector]. (mm nodeClassIs: KeyWordNode) ifTrue: [ sel _ sel, mm decompile asString]. cnt = 2 ifTrue: ["not the receiver. Selector and arg" (mm nodeClassIs: MessageNode) ifTrue: [ sel _ mm selector]]]]. sel ifNil: [^ nil]. sel size > 0 ifTrue: [^ sel asSymbol]. ^ nil! ! !SyntaxMorph methodsFor: 'node to morph' stamp: 'tk 2/25/2001 20:52'! messageNode: aNode receiver: receiver selector: selector keywords: key arguments: args | keywords column row receiverMorph firstArgMorph receiverWidth messageWidth onlyOne nodeWithNilReceiver isAConditional testAndReceiver anotherSelf wordyMorph | isAConditional _ #(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:) includes: key. receiver ifNotNil: ["i.e. not a cascade" anotherSelf _ self constructSelfVariant: receiver and: key. anotherSelf ifNotNil: [ wordyMorph _ self addString: anotherSelf. wordyMorph setProperty: #wordyVariantOfSelf toValue: true. self addMorph: wordyMorph. self layoutInset: 1. ^self ]. testAndReceiver _ self. self specialBlockFormatting ifTrue: [ isAConditional ifTrue: [ testAndReceiver _ self addRow: #keyword1 on: nil. self specialColor: (Color r: 1.0 g: 0.935 b: 0.774) andBorder: (Color r: 0.581 g: 0.774 b: 0.903). self useRoundedCorners. self layoutInset: 6. self setProperty: #variableInsetSize toValue: 6. testAndReceiver addNoiseString: 'Test' ]. ]. receiverMorph _ receiver asMorphicSyntaxIn: testAndReceiver. self specialBlockFormatting ifTrue: [ isAConditional ifTrue: [self setConditionalPartStyle: receiverMorph]. ]. ]. keywords _ key keywords. args size = 0 ifTrue: [ row _ (self addSingleKeywordRow: key) layoutInset: 1. ^ row parseNode: selector ]. receiverWidth _ receiver ifNil: [0] ifNotNil: [receiverMorph fullBounds width]. onlyOne _ args size = 1. (receiverWidth <= 80 and: [onlyOne]) ifTrue: [ row _ (self addSingleKeywordRow: keywords first) layoutInset: 1. row parseNode: selector. firstArgMorph _ args first asMorphicSyntaxIn: self. receiver ifNil: [^ self]. (firstArgMorph fullBounds height > 100 or: [firstArgMorph fullBounds width > 250]) ifTrue: [self foldMessageOneArg]. ^ self ]. nodeWithNilReceiver _ aNode copy receiver: nil. isAConditional & self specialBlockFormatting ifTrue: [ self listDirection: #topToBottom. ]. column _ self addColumn: #keyword1 on: nodeWithNilReceiver. "onlyOne ifTrue: [column parseNode: nil]. is a spacer" messageWidth _ 0. keywords with: (args copyFrom: 1 to: keywords size) do: [:kwd :arg | isAConditional ifTrue: [ column addMorphBack: (column transparentSpacerOfSize: 3@3). ]. (row _ column addRow: #keyword2 on: nodeWithNilReceiver) borderWidth: 1; parseNode: (nodeWithNilReceiver as: (onlyOne ifTrue: [MessageNode] ifFalse: [MessagePartNode])); borderColor: row stdBorderColor. isAConditional ifTrue: [row addMorphBack: (row transparentSpacerOfSize: 20@6)]. row addToken: kwd type: #keyword2 on: (onlyOne ifTrue: [SelectorNode new key: kwd code: nil "fill this in?"] ifFalse: [KeyWordNode new]). arg asMorphicSyntaxIn: row. messageWidth _ messageWidth + row fullBounds width]. onlyOne ifTrue: [self replaceSubmorph: column by: row. column _ row]. receiverMorph ifNil: [^self]. self alansTest1 ifTrue: [^self]. receiverWidth + messageWidth < 350 ifTrue: [ isAConditional ifFalse: [self unfoldMessage]. ^self ]. ((receiverWidth > 200 or: [receiverWidth > 80 and: [column fullBounds height > 20]]) or: [receiverMorph fullBounds width > 30 and: [column fullBounds height > 100 or: [column fullBounds width > 250]]]) ifTrue: [^ self foldMessage]! !