IMD 1.17: 19/01/2010 21:22:34 unlabeled 1 smalltalk class :54PUniFLEX Backuppare: aString) = 1! <= aString "Answer true if and only if the receiver collates before aString or is the same as aString. The collation sequence is ascii with case differences ignored." ^(self compare: aString) <= 2! = aString "Compare two strings. Primitive 148 handles LargePositiveInteger indices as well as SmallIntegers." ^super = aString! > aString "Answer true if and only if the receiver collates after aString. The collation sequence is ascii with case differenc *֎ *֎jTektronix 44042  !"#$%&'()*+,-./01234('&%$#"! es ignored." ^(self compare: aString) = 3! >= aString "Answer true if and only if the receiver collates after aString or is the same as aString. The collation sequence is ascii with case differences ignored." ^(self compare: aString) >= 2! hash | l m | (l _ m _ self size) <= 2 ifTrue: [l = 2 ifTrue: [m _ 3] ifFalse: [l = 1 ifTrue: [^((self at: 1) asciiValue bitAnd: 127) * 106]. ^21845]]. ^(self at: 1) asciiValue * 48 + ((self at: (m - 1)) asciiValue + l)! hashMappedBy>? : Collections-Text.st.8RP3B B, vsmalltal fY Y y:BՎ: map "My hash is independent of my oop" ^ self hash! match: text "Answer whether text matches the pattern in the receiver. Matching ignores upper/lower case differences. Where the receiver contains #, text may contain any single character. Where the receiver contains *, text may contain any sequence of characters." | pattern scanning p t back textStream startScan | pattern _ ReadStream on: self. textStream _ ReadStream on: text. scanning _ false. [pattern atEnd] whileFalse: [p _ pattArrayedCollection variableByteSubclass: #String instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Text'! String comment: 'I am an indexed collection of Characters. I really store 8-bit bytes, but my access protocol translates between these and real Character instances.'! !String methodsFor: 'comparing'! < aString "Answer true if and only if the receiver collates before aString. The collation sequence is ascii with case differences ignored." ^(self comern next. p = $* ifTrue: [pattern atEnd ifTrue: [^true]. scanning _ true. startScan _ pattern position] ifFalse: [textStream atEnd ifTrue: [^false]. t _ textStream next. (t asUppercase = p asUppercase or: [p = $#]) ifFalse: [scanning ifFalse: [^false]. back _ startScan - pattern position. pattern skip: back. textStream skip: back + 1]]. (scanning and: [pattern atEnd and: [textStream atEnd not]]) ifTrue: [back _ startScan - pattern position. pattern skip: back. textStream skip: back + 1] ]. ^textStream atEnd " Examples: 'xyz' match: 'Xyz' true 'x#z' match: 'x@z' true 'x*z' match: 'x whyNot? z' true '*x' match: 'xx' true "! sameAs: aString "Answer whether the receiver collates precisely with aString. The collation sequence is ascii with case differences ignored." ^(self compare: aString) = 2! spellAgainst: aString "Answer an integer between 0 and 100 indicating how similar the argument is toswer the Character stored in the field of the receiver indexed by the argument. Fail if the index argument is not an Integer or is out of bounds. Essential. See Object documentation whatIsAPrimitive." ^Character value: (super at: index)! basicAt: index put: aCharacter "Store the Character in the field of the receiver indicated by the index. Fail if the index is not an Integer or is out of bounds, or if the argument is not a Character. Essential. See Object documentation w the receiver. No case conversion is done." | i1 i2 size1 size2 score maxLen | size1 _ self size. size2 _ aString size. maxLen _ size1 max: size2. score _ 0. i1 _ i2 _ 1. [i1 <= size1 and: [i2 <= size2]] whileTrue: [(self at: i1) = (aString at: i2) ifTrue: [score _ score+1. "match" i1 _ i1+1. "advance both" i2 _ i2+1] ifFalse: [(i2 < size2 and: [(self at: i1) = (aString at: i2+1)]) ifTrue: [i2 _ i2+1] "skip in other" ifFalse: [(i1 < size1 and: [(self at: i1+1) = (ahatIsAPrimitive." (aCharacter isKindOf: Character) ifTrue: [super at: index put: aCharacter asciiValue. ^aCharacter] ifFalse: [self error: 'Strings only store Characters']! findString: subString startingAt: start "Answer the index of subString within the receiver, starting at start. If the receiver does not contain subString, answer 0." | aCharacter index | subString isEmpty ifTrue: [^0]. aCharacter _ subString first. start to: self size - subString size + 1 do: [:startIString at: i2)]) ifTrue: [i1 _ i1+1] "skip in self" ifFalse: [i1 _ i1+1. "miss - advance both" i2 _ i2+1] ] ] ]. score = maxLen ifTrue: [^100] ifFalse: [^100*score//maxLen] " 'Smalltalk' spellAgainst: 'Smalltlak' "! ! !String methodsFor: 'accessing'! at: index "Answer the Character stored in the field of the receiver indexed by the argument. Fail if the index argument is not an Integer or is out of bounds. Essential. See Object documentation whatIsAPrimitive." ^Character value: (super at: index)! at: index put: aCharacter "Store the Character in the field of the receiver indicated by the index. Fail if the index is not an Integer or is out of bounds, or if the argument is not a Character. Essential. See Object documentation whatIsAPrimitive." (aCharacter isKindOf: Character) ifTrue: [super at: index put: aCharacter asciiValue. ^aCharacter] ifFalse: [self error: 'Strings only store Characters']! basicAt: index "An: start to: stop with: replacement startingAt: repStart] ifFalse: [super replaceFrom: start to: stop with: replacement startingAt: repStart]! replaceFrom: start to: stop withByteArray: aByteArray startingAt: repStart "This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the byte array, aByteArray. Answer the receiver." | index repOff characterTable | repOff _ repStart - start. characterTable _ Character characterTable. "in-line asCharacter for speed" index _ start - 1. [(index _ index + 1) <= stop] whileTrue: [self at: index put: (characterTable at: (aByteArray at: repOff + index)+1)]! size "Answer the number of indexable fields in the receiver. This value is the same as the largest legal subscript. Essential. See Object documentation whatIsAPrimitive." ^self basicSize! string "Answer the receiver itself. This is for compatibility with other text classes." ^self! ! !String methodsFor: 'cby interpreting the receiver as the string representation of a number." ^Number readFromString: self! asParagraph "Answer a Paragraph whose text string is the receiver." ^Paragraph withText: self asText! asString "Answer the receiver itself." ^self! asSymbol "Answer the unique symbol whose characters are the characters of the string." ^Symbol intern: self! asText "Answer a Text whose string is the receiver." ^Text fromString: self! asTime "Answer a Time initialized from the receiver. See Topying'! copyUpTo: aCharacter "Answer a copy of the receiver from index 1 to the first occurrence of aCharacter, non-inclusive." | index | index _ self indexOf: aCharacter ifAbsent: [^self]. ^self copyFrom: 1 to: index-1! deepCopy "DeepCopy would otherwise mean make a copy of the character; since characters are unique, just return a shallowCopy." ^self shallowCopy! ! !String methodsFor: 'printing'! isLiteral ^true! printOn: aStream "Print inside string quotes, doubling imbedded quotesime readFrom:" ^Time readFrom: (ReadStream on: self)! asUppercase "Answer a string made up from the receiver whose characters are all uppercase." | aStream | aStream _ WriteStream on: (String new: self size). self do: [:aCharacter | aStream nextPut: aCharacter asUppercase]. ^aStream contents! contractTo: charCount "Shorten by ellipsis if too long" | half | self size > charCount ifTrue: [half _ charCount // 2. ^ self copyReplaceFrom: half to: self size - (charCount-half) + 2 with: '.." ^self storeOn: aStream! storeOn: aStream "Print inside string quotes, doubling imbedded quotes." | i length x | aStream nextPut: $'. i _ 0. length _ self size. [(i _ i + 1) <= length] whileTrue: [aStream nextPut: (x _ self at: i). x == $' ifTrue: [aStream nextPut: x]]. "embedded quotes get doubled" aStream nextPut: $'! ! !String methodsFor: 'converting'! asDate "Answer a Date initialized from the receiver. See Date readFrom:" ^Date readFrom: (ReadStream on: self)! asDisplayT..'] " 'antidisestablishmentarianism' contractTo: 10 'anti...ism' "! oldRunDecodeOn: decodedStream "Decodes strings encoded by the message oldRunEncoded. Output is written onto decodedStream" | index size byte count bitsValue | index _ 0. size _ self size. [index>=size] whileFalse: [byte _ (self at: (index _ index+1)). byte asInteger == 0 ifTrue: [count _ (self at: (index _ index+1)) asInteger. count = 0 ifTrue: "<0> <0> means one zero byte" [decodedStream nextPut: byte] ext "Answer a DisplayText whose text string is the receiver." ^DisplayText text: self asText! asFileName "Answer a string made up from the receiver that is an acceptable file name." ^Disk checkName: self fixErrors: true! asLowercase "Answer a string made up from the receiver whose characters are all lowercase." | aStream | aStream _ WriteStream on: (String new: self size). self do: [:aCharacter | aStream nextPut: aCharacter asLowercase]. ^aStream contents! asNumber "Answer the number created  ifFalse: "<0> means count bytes = bitsValue" [bitsValue _ (self at: (index _ index+1)). [(count _ count-1)>=0] whileTrue: [decodedStream nextPut: bitsValue]]] ifFalse: " means one nonZero byte" [decodedStream nextPut: byte]]. ^ decodedStream contents! oldRunEncoded "Returns a string with equal consecutive bytes encoded as <0> Single zeroes are encoded as <0> <0> " | stream count previousByte byte | stream _ WriteStream on: (String new: self size). count _ 0. previousByte _ self at: 1. 2 to: self size do: [:i | byte _ self at: i. (byte = previousByte and: [count < 255]) ifTrue: [count _ count + 1] ifFalse: [count > 0 ifTrue: [stream nextPut: (Character value: 0); nextPut: (Character value: count+1); nextPut: previousByte. count _ 0] ifFalse: [stream nextPut: previousByte. previousByte asInteger = 0 ifTrue: [stream nextPut: previousByte]]. previousByte _ byte] newString at: j put: (aString at: i). j _ j - 1]. ^aString sameAs: newString! ! !String methodsFor: 'private'! compare: s | i len endResult u1 u2 mylen | mylen _ self size. len _ s size. mylen < len ifTrue: [len _ mylen. endResult _ 1] ifFalse: [endResult _ mylen = len ifTrue: [2] ifFalse: [3]]. i _ 0. [(i _ i + 1) <= len] whileTrue: [u1 _ self at: i. u2 _ s at: i. u1 = u2 ifFalse: [u1 _ u1 asUppercase. u2 _ u2 asUppercase. u1 = u2 ifFals]. count > 0 ifTrue: [stream nextPut: (Character value: 0); nextPut: (Character value: count+1); nextPut: previousByte] ifFalse: [stream nextPut: previousByte. previousByte asInteger = 0 ifTrue: [stream nextPut: previousByte]]. ^stream contents! withCRs "substitute CRs for backslashes" ^ self collect: [:char | char = $\ ifTrue: [Character cr] ifFalse: [char]]! ! !String methodsFor: 'displaying'! displayAt: aPoint "Show a representation of the receiver as a DisplayText at locate: [^u1 < u2 ifTrue: [1] ifFalse: [3]]]]. ^endResult! primReplaceFrom: start to: stop with: replacement startingAt: repStart "This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. The range errors cause the primitive to fail." super replaceFrom: start to: stop with: replacement startingAt: repStart! stringhash ^self hash! ! "-- -- -- -- -- -- -- -- -- -- -- -ion aPoint on the display screen." self asDisplayText displayAt: aPoint! displayOn: aDisplayMedium at: aPoint "Show a representation of the receiver as a DisplayText at location aPoint on aDisplayMedium." self asDisplayText displayOn: aDisplayMedium at: aPoint! ! !String methodsFor: 'dummy protocol'! caesarCipher: anInteger "Answer the string with the letters rotated by anInteger. A primitive encoding scheme. Example: 'Hello' caesarCipher: 2 would return 'Jgnnq'." | aString - -- -- -- -- -- -- "! String class instanceVariableNames: ''! !String class methodsFor: 'instance creation'! fromString: aString "Answer a new String that is a copy of the argument, aString." | newString | newString _ self new: aString size. 1 to: aString size do: [:i | newString at: i put: (aString at: i)]. ^newString! readFrom: inStream "Answer a new String that is determined by reading the stream, inStream. Embedded double quotes become the quote Character." | outStream char done | o| aString _ String new: self size. 1 to: self size do: [:index | aString at: index put: ((self at: index) rotate: anInteger)]. ^aString! caesarRundown "Try all of the caesarCiphers (1 to 26) to decode a message." 1 to: 26 do: [:i | Transcript cr; show: i; show: (self caesarCipher: i)]. ^'Done'! isaPalindrome: aString "test a string to see if it is identical forward and backward" | newString j | newString _ String new: aString size. j _ aString size. 1 to: newString size do: [:i | utStream _ WriteStream on: (String new: 16). "go to first quote" inStream skipTo: $'. done _ false. [done or: [inStream atEnd]] whileFalse: [char _ inStream next. char = $' ifTrue: [char _ inStream next. char = $' ifTrue: [outStream nextPut: char] ifFalse: [done _ true]] ifFalse: [outStream nextPut: char]]. ^outStream contents! ! !String class methodsFor: 'examples'! example "To see the string displayed at the cursor point, execute this expression and select a point by pressing a mouse button." 'this is some text' displayOn: Display at: Sensor waitButton "String example"! ! String variableByteSubclass: #Symbol instanceVariableNames: '' classVariableNames: 'SingleCharSymbols USTable ' poolDictionaries: '' category: 'Collections-Text'! Symbol comment: 'Symbols are Strings which are created uniquely. Thus, someString asSymbol == someString asSymbol.'! !Symbol methodsFor: 'accessing'! at: anInteger put: anObject "you can not modify the receiver."s name" | i | i _ self indexOf: $. ifAbsent: [self error: 'class part not found']. ^(self copyFrom: 1 to: i-1) asSymbol! isCompound "return true if the receiver is of the form Class.foo " ^self includes: $.! isInfix "Answer whether the receiver is an infix message selector." ^(self at: 1) isLetter not! isKeyword "Answer whether the receiver is a message keyword, i.e., ends with colon." self size <= 1 ifTrue: [^false]. ^(self at: self size) = $:! keywords "Answer an array of the keywords that self errorNoModification! replaceFrom: start to: stop with: replacement startingAt: repStart self errorNoModification! ! !Symbol methodsFor: 'comparing'! = anObject ^self == anObject! hash "Answer with a SmallInteger whose value is half of the receiver's object pointer (interpreting object pointers as 16-bit signed quantities). Essential. See Object documentation whatIsAPrimitive." ^self! hashMappedBy: map "Answer what my hash would be if oops changed according to map compose the receiver." | result aStream i l char | result _ WriteStream on: (Array new: 10). aStream _ WriteStream on: (String new: 16). i _ 1. l _ self size. [i <= l] whileTrue: [char _ self at: i. aStream nextPut: char. (char = $: or: [i = l]) ifTrue: [result nextPut: aStream contents. aStream reset]. i _ i + 1]. ^result contents! numArgs "Answer the number of arguments that the receiver requires if it is interpreted as a message selector." | len n i | len _ se" ^ map newHashForObject: self! ! !Symbol methodsFor: 'copying'! copy "Answer with me, because Symbols are unique."! shallowCopy "Answer with me, because Symbols are unique."! ! !Symbol methodsFor: 'printing'! isLiteral ^Scanner isLiteralSymbol: self! printOn: aStream aStream nextPutAll: self! storeOn: aStream self isLiteral ifTrue: [aStream nextPut: $#. aStream nextPutAll: self] ifFalse: [super storeOn: aStream. aStream nextPutAll: ' asSymbol']! ! !Symbol methodsFor: 'conlf size. n _ (self at: 1) isLetter ifTrue: [0] ifFalse: [1]. i _ 1. [(i _ i + 1) <= len] whileTrue: "count colons" [(self at: i) = $: ifTrue: [n _ n + 1]]. ^n! selectorPart "return just my part after the class name if the receiver is a compound selector (otherwise the whole thing)" ^(self copyFrom: (self indexOf: $.) + 1 to: self size) asSymbol! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Symbol class instanceVariableNames: ''! !Symbol class methodsFor: 'class initializativerting'! asString | newString | newString _ String new: self size. 1 to: self size do: [:index | newString at: index put: (self at: index)]. ^newString! asSymbol! ! !Symbol methodsFor: 'private'! errorNoModification self error: 'symbols can not be modified.'! species ^String! string: aString 1 to: aString size do: [:j | super at: j put: (aString at: j)]. ^self! stringhash ^super hash! ! !Symbol methodsFor: 'system primitives'! classPart "I must be a compound selector. Return my clason'! initialize | a v | "make up table of 1-char atoms" v _ Array new: 128. a _ String new: 1. 1 to: 128 do: [:i | a at: 1 put: i - 1. v at: i put: a asSymbol]. SingleCharSymbols _ v "Symbol initialize."! ! !Symbol class methodsFor: 'instance creation'! correctMessage: unknown "Attempt to correct the spelling of an unknown message symbol." | lc candidates score bestScore guess hasColon nArgs smaller larger | lc _ unknown first asLowercase. hasColon _ unknown last = $:. unknown first isLetter ifFalse: [^ nil]. nArgs _ (unknown select: [:char | char = $:]) size. candidates _ OrderedCollection new. smaller _ unknown size-4. larger _ unknown size+4. Symbol allInstancesDo: "fast tests first" [:each | (((each at: 1) = lc and: [each size between: smaller and: larger]) and: [(each last = $:) = hasColon and: [each numArgs = nArgs]]) ifTrue: [candidates add: each]]. bestScore _ 0. candidates do: [:each | (score _ each spellAgainst: unknown) > bestScore ifTrue: [best ifTrue: [symBlock value: (v at: i). ^true]]]]. ^false! rehash "Rebuild the hash table that holds all the unique Symbols." | sym | USTable _ USTable collect: [:sym | Array new: 0]. Symbol allInstancesDo: [:sym | self intern: sym] "Symbol rehash"! table "Access for SystemTracer" ^USTable! table: newArray "Access for SystemTracer" ^USTable _ newArray! ! Symbol initialize! ArrayedCollection subclass: #Text instanceVariableNames: 'string runs ' classVariableNames: '' poScore _ score. guess _ each]]. bestScore > 50 ifFalse: [^false]. (self confirm: 'Confirm correction to ' , guess) ifTrue: [^ guess asSymbol] ifFalse: [^ nil]! intern: aString "Answer a unique Symbol whose characters are those of aString." | sym index | self hasInterned: aString ifTrue: [:sym | ^sym]. "check if already exists" aString size = 0 ifTrue: [^self error: 'Attempt to intern a symbol of length zero']. sym _ (aString isMemberOf: Symbol) ifTrue: [aString] "putting old symbol in new olDictionaries: 'TextConstants ' category: 'Collections-Text'! Text comment: 'Instance Variables: string: A String of Characters runs: A RunArray of emphasis codes The emphasis codes indicate abstract changes in character appearance. Actual display is performed in the presence of a TextStyle which indicates, for each abstract code, an actual font to be used'! !Text methodsFor: 'comparing'! = anotherText ^string = anotherText string! ! !Text methodsFor: 'accessing'! at: index ^string at: table" ifFalse: [(Symbol new: aString size) string: aString]. "create a new one" index _ aString stringhash \\ USTable size + 1. USTable at: index put: ((USTable at: index) copyWith: sym). ^sym! internCharacter: aCharacter "Answer with, and create if necessary, a unique Symbol whose characters are just this character." | ascii | (ascii _ aCharacter asciiValue) < 128 ifTrue: [^SingleCharSymbols at: ascii + 1]. ^self intern: (String with: aCharacter)! ! !Symbol class methodsFor: 'private'! haindex! at: index put: character ^string at: index put: character! findString: aString startingAt: start "Answer the index of subString within the receiver, starting at position start. If the receiver does not contain subString, answer 0." ^string findString: aString asString startingAt: start! replaceFrom: start to: stop with: aText string _ string copyReplaceFrom: start to: stop with: aText string. runs _ runs copyReplaceFrom: start to: stop with: aText runs! size ^string size! string "AnsInterned: aString ifTrue: symBlock "Answer with false if aString hasn't been interned (into a Symbol), otherwise supply the symbol to symBlock and return true" | v i ascii | aString size = 1 ifTrue: [(ascii _ (aString at: 1) asciiValue) < 128 ifTrue: [symBlock value: (SingleCharSymbols at: ascii + 1). ^true]]. v _ USTable at: aString stringhash \\ USTable size + 1. 1 to: v size do: [:i | (v at: i) == nil ifFalse: [aString size = (v at: i) size ifTrue: [aString = (v at: i) swer the string representation of the receiver." ^string! ! !Text methodsFor: 'copying'! copy ^self deepCopy! copyFrom: start to: stop "Answer with a copied subrange of this text" | realStart realStop | stop > self size ifTrue: [realStop _ self size] "handle selection at end of string" ifFalse: [realStop _ stop]. start < 1 ifTrue: [realStart _ 1] "handle selection before start of string" ifFalse: [realStart _ start]. ^Text string: (string copyFrom: realStart to: realStop) runs: (runs copyFrom: realStart to: realStop)! copyReplaceFrom: start to: stop with: aText ^self shallowCopy replaceFrom: start to: stop with: aText! ! !Text methodsFor: 'converting'! asDisplayText "Answer a DisplayText whose text is the receiver." ^DisplayText text: self! asLowercase string _ string asLowercase! asNumber "Answer the number created by interpreting the receiver as the textual representation of a number." ^string asNumber! asParagraph "Answer a Paragraph whose text is the receiver.anArray string _ aString. runs _ anArray! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Text class instanceVariableNames: ''! !Text class methodsFor: 'class initialization'! initialize "Initialize constants shared by classes associated with text display. Text initialize." (Smalltalk includes: TextConstants) ifFalse: [Smalltalk at: #TextConstants put: (Dictionary new: 32)]. TextConstants at: #CaretForm put: (Cursor extent: 16@16 fromArray: #( 2r110000000 2r11000" ^Paragraph withText: self! asString "Answer a String representation of the textual receiver." ^string! asText "Answer the receiver itself." ^self! asUppercase string _ string asUppercase! ! !Text methodsFor: 'emphasis'! allBold self emphasizeFrom: 1 to: self size with: 2! emphasisAt: characterIndex "Answer the code for characters in the run beginning at characterIndex." self size = 0 ifTrue: [^1]. "null text tolerates access" ^runs at: characterIndex! emphasizeFrom: start to: stop wit0000 2r1111000000 2r11111100000 2r11001100000 2r0 2r0 2r0 2r0 2r0 2r0 2r0 2r0 2r0 2r0 2r0) offset: -8@0). self initTextConstants! initTextConstants "Text initTextConstants." "Initialize constants shared by classes associated with text display, e.g., space, tab, cr, bs, esc." | tempArray | TextConstants at: #Space put: (32 asCharacter). TextConstants at: #Tab put: (9 asCharacter). TextConstants at: #CR put: (13 asCharacter). TextConstants at: #BS puth: emphasis "Set the emphasis for characters in the interval start-stop." runs _ runs copyReplaceFrom: start to: stop with: (RunArray new: stop - start + 1 withAll: emphasis)! makeSelectorBoldIn: aClass "For formatting Smalltalk source code, set the emphasis of that portion of the receiver's string that parses as a message selector to be bold." | parser | string size = 0 ifTrue: [^self]. (parser _ aClass parserClass new) parseSelector: string. self emphasizeFrom: 1 to: (parser end: (8 asCharacter). TextConstants at: #BS2 "F1" put: (151 asCharacter). TextConstants at: #Ctrlw put: (23 asCharacter). TextConstants at: #ESC put: (27 asCharacter). TextConstants at: #Cut "Rubout" put: (127 asCharacter). TextConstants at: #Paste "Ctrl^" put: (30 asCharacter). TextConstants at: #Ctrlt put: (20 asCharacter). TextConstants at: #Ctrlf put: (6 asCharacter). TextConstants at: #Ctrlz put: (26 asCharacter). "in case font doesn't have a width for space character" OfLastToken min: string size) with: 2! runLengthFor: characterIndex "Answer the count of characters remaining in run beginning with characterIndex." ^runs runLengthAt: characterIndex! ! !Text methodsFor: 'printing'! printOn: aStream aStream nextPutAll: 'Text for '. string printOn: aStream! storeOn: aStream aStream nextPutAll: '(Text string: '; store: string; nextPutAll: ' runs: '; store: runs; nextPut: $)! ! !Text methodsFor: 'private'! runs ^runs! setString: aString setRuns:  "some plausible numbers-- are there right ones?" TextConstants at: #DefaultSpace put: 4. TextConstants at: #DefaultTab put: 24. TextConstants at: #DefaultLineGrid put: 16. TextConstants at: #DefaultBaseline put: 12. TextConstants at: #DefaultRule put: Form over. TextConstants at: #DefaultMask put: Form black. TextConstants at: #CtrlMinus put: (137 asCharacter). TextConstants at: #CtrlShiftMinus put: (31 asCharacter). TextConstants at: #Ctrlb put: (2 asCharacter). TextConstants at: #CtrlB put: (230 asCharacter). TextConstants at: #Ctrli put: (150 asCharacter). TextConstants at: #CtrlI put: (214 asCharacter). TextConstants at: #Ctrlx put: (24 asCharacter). tempArray _ Array new: Display width // DefaultTab. 1 to: tempArray size do: [:i | tempArray at: i put: DefaultTab * i]. TextConstants at: #DefaultTabsArray put: tempArray. tempArray _ Array new: (Display width // DefaultTab) // 2. 1 to: tempArray size do: [:i | tempArray nts at: #Underlined put: 4. TextConstants at: #OverStruck put: 8. TextConstants at: #Subscripted put: 16. TextConstants at: #Superscripted put: 32. TextConstants at: #SubscriptedUnderlined put: 20. TextConstants at: #SuperscriptedUnderlined put: 36. TextConstants at: #UnderlinedBit put: 3. TextConstants at: #OverStruckBit put: 4. TextConstants at: #SubscriptedBit put: 5. TextConstants at: #SuperscriptedBit put: 6. TextConstants at: #SubSuperscriptMask put: 48. TextCon at: i put: (Array with: (DefaultTab*i) with: (DefaultTab*i))]. TextConstants at: #DefaultMarginTabsArray put: tempArray. self initTextConstants2.! initTextConstants2 "Text initTextConstants." "Initialize constants shared by classes associated with text display, e.g., space, tab, cr, bs, esc." TextConstants at: #Ctrlh put: (8 asCharacter). TextConstants at: #CtrlH put: (243 asCharacter). TextConstants at: #Ctrls put: (19 asCharacter). TextConstants at: #CtrlS put: (211 asChstants at: #NonFaceEmphasisMask put: 52. "overstrike not supported" TextConstants at: #FamilyName put: 1. TextConstants at: #PointSize put: 2. TextConstants at: #Face put: 3.! ! !Text class methodsFor: 'instance creation'! fromString: aString "Answer an instance of me whose characters are those of the argument, aString." ^self string: aString emphasis: 1! fromUser "Answer an instance of me obtained by requesting the user to type some characters into a View." | result | FillInThearacter). TextConstants at: #Ctrln put: (14 asCharacter). TextConstants at: #CtrlN put: (245 asCharacter). TextConstants at: #Ctrlp put: (16 asCharacter). TextConstants at: #CtrlTopBlank "CtrlF1" put: (145 asCharacter). TextConstants at: #CtrlMiddleBlank "CtrlF2" put: (146 asCharacter). TextConstants at: #CtrlBottomBlank "CtrlF3" put: (147 asCharacter). "location of non-character stop conditions" TextConstants at: #EndOfRun put: 257. TextConstants at: #CrossedX put: 258. Blank request: 'Type text followed by carriage return' displayAt: (50@ Display boundingBox height//2) centered: false action: [:result] initialAnswer: ''. ^self fromString: result! new: stringSize ^self fromString: (String new: stringSize)! string: aString emphasis: code "Answer an instance of me whose characters are those of the argument, aString. Use the font whose index into the default TextStyle font array is code." ^self string: aString runs: (RunArray new: aString size withAll: cod "values for alignment" TextConstants at: #LeftFlush put: 0. TextConstants at: #RightFlush put: 1. TextConstants at: #Centered put: 2. TextConstants at: #Justified put: 3. "subscripts for a marginTabsArray tuple" TextConstants at: #LeftMarginTab put: 1. TextConstants at: #RightMarginTab put: 2. "font faces" TextConstants at: #Basal put: 0. TextConstants at: #Bold put: 1. TextConstants at: #Italic put: 2. TextConstants at: #BoldItalic put: 3. TextConstae)! ! !Text class methodsFor: 'private'! string: aString runs: anArray ^self basicNew setString: aString setRuns: anArray! ! !Text class methodsFor: 'constants'! maxSize "Answer the largest basicSize which is valid for the receiver." ^String maxSize! ! Text initialize! Magnitude subclass: #Character instanceVariableNames: 'value ' classVariableNames: 'CharacterTable ' poolDictionaries: '' category: 'Collections-Text'! Character comment: 'This class represents characters by storing their associated ASCII (extended to 256 codes) code. The instances of this class are created uniquely, so that all instances $R (for instance) are identical'! !Character methodsFor: 'comparing'! < aCharacter "Answer true if the receiver's value < aCharacter's value." ^self asciiValue < aCharacter asciiValue! = aCharacter "Answer true if the receiver and the argument are the same object (have the same object pointer) and false otherwise. Optional. See Object documentation whatIsAPrimitive." ^self == aCharacter! > aCharacter "Answer true if the receiver's value > aCharacter's value." ^self asciiValue > aCharacter asciiValue! hash ^value! hashMappedBy: map "My hash is independent of my oop" ^ self hash! ! !Character methodsFor: 'accessing'! asciiValue "Answer the value of the receiver." ^value! digitValue "Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0 otherwise. This is used to parse literal numbers of radix 2-36." value <= $9 asciiValue m aStream nextPut: $$. aStream nextPut: self! storeOn: aStream "Character literals are preceded by '$'." aStream nextPut: $$; nextPut: self! ! !Character methodsFor: 'converting'! asCharacter "Answer the receiver itself." ^self! asInteger "Answer the value of the receiver." ^value! asLowercase "Answer a Character that is the lower case letter corresponding to the receiver. If the receiver is not an upper case letter, answer the receiver itself." 8r101 <= value ifTrue: [value <= 8r132ifTrue: [^value - $0 asciiValue]. value >= $A asciiValue ifTrue: [value <= $Z asciiValue ifTrue: [^value - $A asciiValue + 10]]. ^-1! ! !Character methodsFor: 'testing'! isAlphaNumeric "Answer whether the receiver is a letter or a digit." ^self isLetter or: [self isDigit]! isDigit "Answer whether the receiver is a digit." ^self >= $0 and: [self <= $9]! isLetter "Answer whether the receiver is a letter." ^(8r141 <= value and: [value <= 8r172]) or: [8r101 <= value and: [value <= 8r132]]! is ifTrue: [^Character value: value+8r40]]! asSymbol ^Symbol internCharacter: self! asUppercase "Answer a Character that is the upper case letter corresponding to the receiver. If the receiver is not a lower case letter, answer the receiver itself." 8r141 <= value ifTrue: [value <= 8r172 ifTrue: [^Character value: value-8r40]]! ! !Character methodsFor: 'rotating'! rotate: anInteger "do the right thing" | capA a | capA _ $A asInteger. a _ $a asInteger. self isLetter ifTrue: [Lowercase "Answer whether the receiver is a lowercase letter." ^self >= $a and: [self <= $z]! isSeparator "Answer whether the receiver is one of the separator characters--space, cr, tab, line feed, or form feed." value = 32 ifTrue: [^true]. "space" value = 13 ifTrue: [^true]. "cr" value = 9 ifTrue: [^true]. "tab" value = 10 ifTrue: [^true]. "line feed" value = 12 ifTrue: [^true]. "form feed" ^false! isUppercase "Answer whether the receiver is an uppercase letter." ^self >= $A and: [self <= $Zself isUppercase ifTrue: [^(self asInteger - capA + anInteger \\ 26 + capA) asCharacter] ifFalse: [^(self asInteger - a + anInteger \\ 26 + a) asCharacter]] ifFalse: [^self]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Character class instanceVariableNames: ''! !Character class methodsFor: 'class initialization'! initialize "Create the table of unique Characters. This code is not shown so that the user can not destroy the system by trying to recreate the table."! ! !Character class methodsFor: 'instance creation'! digitValue: x "Answer the Character whose digit value is x. For example, answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35." | index | index _ x truncated. ^CharacterTable at: (index < 10 ifTrue: [48 + index] ifFalse: [55 + index]) + 1! new "Creating new characters is not allowed." self error: 'cannot create new characters'! value: anInteger "Answer the Character whose value is anInteger. Characters are unique; they are stored iObject subclass: #Event instanceVariableNames: 'startingDateAndTime title duration ' classVariableNames: '' poolDictionaries: '' category: 'Course-Examples'! !Event methodsFor: 'accessing'! completionDate "Return the receiver's completion date" ^(Time from:(startingDateAndTime + duration))! ! !Event methodsFor: 'comparing'! ! !Event methodsFor: 'private'! duration: aDateAndTime "comment stating purpose of message" duration _ aDateAndTime! startingDateAndTime: aDateAndTime "comment statinn the class variable CharacterTable." ^CharacterTable at: anInteger + 1! ! !Character class methodsFor: 'accessing untypeable characters'! backspace "Answer the Character representing a backspace." ^self value: 8! cr "Answer the Character representing a carriage return." ^self value: 13! esc "Answer the Character representing an escape." ^self value: 27! lf "Answer the Character representing a line feed." ^self value: 10! newPage "Answer the Character representing a form feed." ^self valug purpose of message" startingDateAndTime _ aDateAndTime! title: aString "comment stating purpose of message" title _ aString! ! tokenish "Answer whether the receiver is a valid token-character--letter, digit, or colon." ^self isLetter or: [self isDigit or: [self = $:]]! ! !Character methodsFor: 'copying'! copy "Answer with me because Characters are unique."! deepCopy "Answer with self because Characters are unique."! ! !Character methodsFor: 'printing'! isLiteral ^true! printOn: aStreae: 12! space "Answer the Character representing a space." ^self value: 32! tab "Answer the Character representing a tab." ^self value: 9! ! !Character class methodsFor: 'constants'! characterTable "Answer the class variable in which unique Characters are stored." ^CharacterTable! ! Character initialize! ver is a digit." ^self >= $0 and: [self <= $9]! isLetter "Answer whether the receiver is a letter." ^(8r141 <= value and: [value <= 8r172]) or: [8r101 <= value and: [value <= 8r132]]! is 9Course-Examples.st.bak.8RP3B B, vsmalltal fY Y y:BՎ 9Course-Examples.st.8RP3B B, vsmalltal fY Y y:BՎObject subclass: #Event instanceVariableNames: 'startingDateAndTime title duration ' classVariableNames: '' poolDictionaries: '' category: 'Course-Examples'! !Event methodsFor: 'accessing'! completionDate "Return the receiver's completion date" ^(Time from:(startingDateAndTime + duration))! ! !Event methodsFor: 'comparing'! ! !Event methodsFor: 'private'! duration: aDateAndTime "comment stating purpose of message" duration _ aDateAndTime! startingDateAndTime: aDateAndTime "comment stating purpose of message" startingDateAndTime _ aDateAndTime! title: aString "comment stating purpose of message" title _ aString! ! tokenish "Answer whether the receiver is a valid token-character--letter, digit, or colon." ^self isLetter or: [self isDigit or: [self = $:]]! ! !Character methodsFor: 'copying'! copy "Answer with me because Characters are unique."! deepCopy "Answer with self because Characters are unique."! ! !Character methodsFor: 'printing'! isLiteral ^true! printOn: aStreaomUser positionForHardcopy. Display positionForHardcopy. HardcopyPositionerView on: Form fromUser. (Form readFrom: ''/smalltalk/demo/pegasus.form'') positionForHardcopy.'! !HardcopyPositionerController methodsFor: 'initialize-release'! initialize super initialize. self initializeYellowButtonMenu.! ! !HardcopyPositionerController methodsFor: 'control defaults'! isControlActive ^super isControlActive & sensor blueButtonPressed not! ! !HardcopyPositionerController methodsFor: 'accessing'! for.e .f6Hardcopy-Support.st.8RP3B B, vsmalltal fY Y y:BՎm ^form! form: aForm form_aForm! redButtonActivity view moveForm! ! !HardcopyPositionerController methodsFor: 'menu messages'! center view centerForm! copies FillInTheBlank request: 'How many copies? ' displayAt: Sensor cursorPoint centered: true action: [:answer |] initialAnswer: ''. answer notNil ifTrue: [view copyNum: answer asNumber] "watch out--answer should be checked better"! hardcopy "For testing, write out the form to a temporary file. Exec the sttops utility wiMouseMenuController subclass: #HardcopyPositionerController instanceVariableNames: 'form ' classVariableNames: 'YellowButtonMenu YellowButtonMessages ' poolDictionaries: '' category: 'Hardcopy-Support'! HardcopyPositionerController comment: 'I am the controller for a HardcopyPositionerView. Together we allow the user to position a representation of a form on a "piece of paper" for hardcopying. While the left mouse button is down, the form will follow the cursor. A form may be clipped by placing it soth the appropriate arguments, and then remove the file. Write results to named file." | fname args psname | FillInTheBlank request: 'file name ?' displayAt: Sensor cursorPoint centered: true action: [:answer | psname _ answer] initialAnswer: 'filename.ps'. Cursor execute showWhile: [form writeOn: (fname _ '/tmp/hardcopy'). args _ '/maryw/ogcst/sttops +x=' , view xTypeSetterOffset asInteger printString , ' +y=' , view yTypeSetterOffset asInteger printString , ' +s=' ,  that part of it falls in the unprintable portion of the page (the light gray border) or outside of the window entirely. Menu messages allow the user to magnify the original Form, rotate the Form (rotate is a toggle), center it, and send the form off to the laser writer using the current magnification, rotation, and placement. InstanceVariable form
The form to be hardcopied. Templates for opening a HardcopyPositionerView: (Form fromDisplay: (0@0 extent: 500@300)) positionForHardcopy. Form frview formScalingFactor asInteger printString, ' > ', psname. view formRotated ifTrue: [args _ args , ' +r']. (view copyNum > 1) ifTrue: [args _ args, ' +c=', view copyNum asInteger printString]. args _ args , ' ' , fname. TekSystemCall execSystemUtility: '/bin/shell' withArgs: (OrderedCollection with: '+c' with: args). (Disk file: fname) remove]! rotate view toggleRotation! scaleBy1 view scaleFormBy: 1.! scaleBy2 view scaleFormBy: 2.! scaleBy3 view scaleFormBy: 3.! scaleBy4 view scaleFormBy: 4.! scaleByN FillInTheBlank request: 'Scale by what factor? ' displayAt: Sensor cursorPoint centered: true action: [:answer |] initialAnswer: ''. answer notNil ifTrue: [view scaleFormBy: answer asNumber] "watch out--answer should be checked better"! ! !HardcopyPositionerController methodsFor: 'private'! initializeYellowButtonMenu self yellowButtonMenu: YellowButtonMenu yellowButtonMessages: YellowButtonMessages! ! "-- -- -- -- -- -- -- -- -- -- -- -- - part of the paper. Its extent reflects the current magnification factor. formScaling The current magnification. The scaling factor should always be an integer number of pixels for efficiency considerations. rotated A toggle: true if the form is rotated sideways. formLabel Represents the current form''s extent and magnification. Rotated if the form is rotated. Class variables: PixelsPerInch Number of pixels on the Display to represent one in- -- -- -- -- -- "! HardcopyPositionerController class instanceVariableNames: ''! !HardcopyPositionerController class methodsFor: 'instance creation'! for: aForm ^super new form: aForm! ! !HardcopyPositionerController class methodsFor: 'class initialization'! initialize YellowButtonMenu _ PopUpMenu labels: 'scale by 1 scale by 2 scale by 3 scale by 4 scale by N copies center rotate hardcopy' lines: #(5 8). YellowButtonMessages _ #(scaleBy1 scaleBy2 scaleBy3 scaleBy4 scaleByN copies center rotatch of the paper. PrintedDotsPerInch Number of dots the LaserWriter prints per inch.'! !HardcopyPositionerView methodsFor: 'accessing'! copyNum ^copies! copyNum: aNumber copies _ aNumber. self eraseClippedRect. self resetLabel. self displayClippedRect.! form: aForm self resetPageRelRectFor: aForm. self rotated: false. formScaling_1. copies_1. pageRelRect _ pageRelRect align: pageRelRect center with: self boundingBox center. self labelExtent: aForm extent scaling: formScaling coe hardcopy) "HardcopyPositionerController initialize. HardcopyPositionerController allInstancesDo: [:c | c initializeYellowButtonMenu]"! ! HardcopyPositionerController initialize! FormView subclass: #HardcopyPositionerView instanceVariableNames: 'copies pageRelRect formScaling rotated formLabel ' classVariableNames: 'PixelsPerInch PrintedDotsPerInch ' poolDictionaries: '' category: 'Hardcopy-Support'! HardcopyPositionerView comment: 'See the HardcopyPositionerController comment for information on pies: copies! labelExtent: aPoint scaling: anInteger formLabel _ (' ',aPoint printString ,' magnified by ',anInteger printString) asDisplayText form! labelExtent: aPoint scaling: anInteger copies: copyNumber formLabel _ (aPoint printString ,' scale: ',anInteger printString,' copies: ',copyNumber printString) asDisplayText form! resetLabel Cursor execute showWhile: [formLabel _ (controller form extent printString , ' scale: ' , formScaling printString , ' copies: ' , copies printString) asDisplayhow to open and use a HardcopyPositionerView. This code is experimental and unportable. It is designed to support a LaserWriter at 300 dots per inch. For 8.5 by 11 inch paper, approximately 7.5 by 10 inches is usable (7.5 inches * 300 dotsPerInch = 2250 dotsPerPage). For a 1024x1024 bitmap, a scaling factor of 2 would use 2048x2048 dots. Instance Variables: pageRelRect Current offset is maintained relative to the 0@0 origin of the HardcopyPositionerView which corresponds to the printableText form. rotated ifTrue: [formLabel _ formLabel rotateBy: 3]]! resetPageRelRectFor: aForm pageRelRect _ 0@0 extent: (aForm extent / PrintedDotsPerInch * PixelsPerInch) rounded! ! !HardcopyPositionerView methodsFor: 'rotation'! formRotated ^rotated! rotated: aBoolean rotated _ aBoolean.! toggleRotation rotated _ rotated not. self resetLabel. self eraseClippedRect. pageRelRect _ pageRelRect origin extent: pageRelRect extent y @ pageRelRect extent x. pageRelRect _ pageRelRect align: pageRelRect center with: self boundingBox center. self displayClippedRect! ! !HardcopyPositionerView methodsFor: 'scaling'! formScalingFactor ^formScaling! scaleFormBy: anInteger "Center the newly scaled form on the page" | oldCenter leftOverRect wasRotated | wasRotated _ rotated. self eraseClippedRect. self resetPageRelRectFor: controller form. pageRelRect extent: pageRelRect extent * anInteger. pageRelRect _ pageRelRect align: pageRelRect center with: self boundingBox center. formScaling _ andisplaying'! displayClippedRect "Display the rectangle representing the form according to the current magnification factor clipped to the printable part of the page. Label it with its real extent and current magnification. Should the rectangle be outlined or shaded?" " Display border: ((self displayTransform: pageRelRect) intersect: self insetDisplayBox) widthRectangle: (2@2 corner: 2@2) mask: Form lightGray. " Display fill: ((self displayTransform: pageRelRect) intersect: self insetDisplInteger. self rotated: false. self resetLabel. wasRotated ifTrue: [self toggleRotation]. self displayClippedRect.! ! !HardcopyPositionerView methodsFor: 'type setter point offsets'! calcTypeSetterPointsFor: pixels "Answer the number of type setter points for anInteger number of pixels." | inches | inches _ pixels / PixelsPerInch. ^72 * inches! xTypeSetterOffset "Answer the x offset in terms of type setter points (72 per inch)" ^self calcTypeSetterPointsFor: pageRelRect origin x! yTypeSetayBox) mask: Form gray. formLabel displayOn: Display at: (self displayTransform: (pageRelRect center - (formLabel extent / 2))) clippingBox: ((self displayTransform: pageRelRect) intersect: self insetDisplayBox) rounded rule: Form over mask: Form black! displayView Display fill: (self displayTransform: pageRelRect) mask: insideColor. self displayClippedRect.! eraseClippedRect Display fill: ((self displayTransform: pageRelRect) intersect: self insetDisplayBox) mask: Form white.! reveterOffset "Answer the y offset in terms of type setter points (72 per inch)" ^self calcTypeSetterPointsFor: pageRelRect origin y! ! !HardcopyPositionerView methodsFor: 'placement'! centerForm "Center the form on the page." self eraseClippedRect. pageRelRect _ pageRelRect align: pageRelRect center with: self boundingBox center. self displayClippedRect.! moveForm | extent origin newFrame oldFrame | oldFrame _ (self displayTransform: pageRelRect) intersect: self insetDisplayBox. Display fill:rseClippedRect Display reverse: ((self displayTransform: pageRelRect) intersect: self insetDisplayBox) rounded mask: Form gray.! reverseEntireRect Display reverse: (self displayTransform: pageRelRect) rounded mask: Form gray.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! HardcopyPositionerView class instanceVariableNames: ''! !HardcopyPositionerView class methodsFor: 'class initialization'! initialize PixelsPerInch _ 30. "Increase this number to make the view bigger."  oldFrame mask: Form gray. extent _ pageRelRect extent. Cursor origin showWhile: [origin _ Sensor cursorPoint. [Sensor redButtonPressed] whileTrue: [newFrame _ (origin _ Sensor cursorPoint) extent: extent. (newFrame areasDiffering: oldFrame) do: [:each | Display reverse: each mask: Form gray]. oldFrame _ newFrame]]. pageRelRect _ (self inverseDisplayTransform: newFrame) rounded. self reverseEntireRect. self displayClippedRect.! ! !HardcopyPositionerView methodsFor: 'PrintedDotsPerInch _ 300. "HardcopyPositionerView initialize"! ! !HardcopyPositionerView class methodsFor: 'instance creation'! on: aForm "HardcopyPositionerView on: Form fromUser" | paperRect formView topView borderView usablePaperRect | paperRect _ Form extent: (8.5@11 * PixelsPerInch) rounded. paperRect veryLightGray. borderView _ FormView new model: paperRect. borderView controller: (NoController new) initialize. usablePaperRect _ Form extent: (7.5@10 * PixelsPerInch) rounded. formView _ HardcopyPositionerView new model: usablePaperRect; form: aForm; borderWidth: 1; insideColor: Form white. formView controller: (HardcopyPositionerController for: aForm) initialize. topView _ StandardSystemView new label: 'Hardcopy Positioner'. topView addSubView: borderView. topView addSubView: formView align: formView viewport center with: borderView viewport center. topView borderWidth: 2. topView insideColor: Form white. topView minimumSize: paperRect extent. top implements the 'add left child' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. node addLeftChild: (Tree withLabel: newLabel)]]. self view display! addRightChild "This method implements the 'add right chilView maximumSize: paperRect extent. topView controller open! ! HardcopyPositionerView initialize! isplayClippedRect.! ! !HardcopyPositionerView methodsFor: 'type setter point offsets'! calcTypeSetterPointsFor: pixels "Answer the number of type setter points for anInteger number of pixels." | inches | inches _ pixels / PixelsPerInch. ^72 * inches! xTypeSetterOffset "Answer the x offset in terms of type setter points (72 per inch)" ^self calcTypeSetterPointsFor: pageRelRect origin x! yTypeSetd' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. node addRightChild: (Tree withLabel: newLabel)]]. self view display! changeLabel "This method implements the 'change label' menu selection." | node newLabG GTree-Application-All.st.8RP3B B, vsmalltal fY Y y:BՎel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter New Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: node label useCRController: true. node label: newLabel]]. self view display! removeNode "This method implements the 'remove node' menu selection." | node | model notNil ifTrue: [Cursor crossHair showWhile: [node _ moMouseMenuController subclass: #TreeController instanceVariableNames: '' classVariableNames: 'TreeYellowButtonMenu TreeYellowButtonMessages ' poolDictionaries: '' category: 'Tree-Application'! TreeController comment: 'This class provides a specialization of MouseMenuController to be used by TreeView in displaying a view of a tree. It takes care of presenting menus when appropriate and performing the corresponding message sends.'! !TreeController methodsFor: 'menu messages'! addLeftChild "This methoddel containsPoint: Sensor waitButton]. node ~~ nil ifTrue: [ view model: (model removeNode: node)]]. self view display! removeRoot "This method implements the 'remove root' menu selection." model notNil ifTrue: [view model: (model removeRoot)]. self view display! startNewTree "Interactively spawn a new tree in a new view." | newTree | newTree _ Tree withLabel: ''. TreeView openViewOf: newTree! traverseTree "Does an in order (left to right) traversal of a tree, high lighting each node"  model traverseTree! ! !TreeController methodsFor: 'control defaults'! isControlActive ^super isControlActive & sensor blueButtonPressed not! ! !TreeController methodsFor: 'initialize'! initialize super initialize. self initializeYellowButtonMenu! ! !TreeController methodsFor: 'private'! initializeYellowButtonMenu self yellowButtonMenu: TreeYellowButtonMenu yellowButtonMessages: TreeYellowButtonMessages.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeController class insdisplayAt: Sensor cursorPoint centered: true action: [:newLabel | newLabel] initialAnswer: '' useCRController: true. newTree _ OrderedTree withLabel: newLabel. OTView openViewOf: newTree! ! !OTController methodsFor: 'private'! initializeYellowButtonMenu self yellowButtonMenu: OTYellowButtonMenu yellowButtonMessages: OTYellowButtonMessages.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OTController class instanceVariableNames: ''! !OTController class methodsFor: 'initializtanceVariableNames: ''! !TreeController class methodsFor: 'class initialization'! initialize "Initialize the menu for the yellow mouse button." TreeYellowButtonMenu _ PopUpMenu labels: 'Remove Node Add Left Child Add Right Child Change Label Traverse Tree Start New Tree Remove Root'. TreeYellowButtonMessages _ #(removeNode addLeftChild addRightChild changeLabel traverseTree startNewTree removeRoot ) "TreeController initialize"! ! TreeController initialize! TreeController subclass: #OTControlleation'! initialize "For each new controller, set up the menu selections and initialize 'messages' to an array of corresponding message selectors." OTYellowButtonMenu _ PopUpMenu labels: 'Remove Node Add In Order Remove Root Start New Tree'. OTYellowButtonMessages _#(removeNode addInOrder removeRoot startNewOrdTree) "OTController initialize"! ! OTController initialize! Object subclass: #Tree instanceVariableNames: 'label leftChild rightChild parent whereLastDisplayed ' classVariableNames: 'HiLir instanceVariableNames: '' classVariableNames: 'OTYellowButtonMenu OTYellowButtonMessages ' poolDictionaries: '' category: 'Tree-Application'! OTController comment: 'This class provides a specialization of MouseMenuController to be used by OTView in displaying a view of an ordered tree. It takes care of presenting menus when appropriate and performing the corresponding message sends.'! !OTController methodsFor: 'menu messages'! addInOrder "This method implements the 'add in order' menu selection."tedNodeIcon NodeIcon ' poolDictionaries: '' category: 'Tree-Application'! Tree comment: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a pointer to the right sub-tree. parent This is a pointer to the parent of this node. | newLabel | FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. model addInOrder: (OrderedTree withLabel: newLabel). self view display! redraw "This method implements the 'redraw' menu selection." self view display! startNewOrdTree "Interactively spawn a new ordered tree in a new view." | newTree newLabel node | FillInTheBlank request: 'Enter New Label:' '! !Tree methodsFor: 'access'! addLeftChild: aTree "This method first removes aTree from whatever tree it is already in (if any) and then it adds it as the left child of the receiver." leftChild notNil ifTrue: [leftChild remove]. aTree notNil ifTrue: [aTree remove. aTree parent: self]. leftChild _ aTree! addRightChild: aTree "This method first removes aTree from whatever tree it is already in (if any) and then it adds it as the right child of the receiver." rightChild notNil ifTrue: [rightChild remove]. aTree notNil ifTrue: [aTree remove. aTree parent: self]. rightChild _ aTree! label "Return a copy of the value of the instance variable 'label'." ^label copy! label: aString "Set the label of this Node" label _ aString copy.! leftChild "Return the left sub-tree of the receiver." ^leftChild! parent "Return the parent of the receiver." ^parent! rightChild "Return the right sub-tree of the receiver." ^rightChild! ! !Tree methodsFor: 'testing'! contains: aLabel "This method alse ifTrue: [^self]]. rightChild notNil ifTrue: [gotIt _ rightChild removeNode: aNode. gotIt ~~ false ifTrue: [^self]]. ^false! removeRoot "This method returns a sub-tree containing all the nodes in the tree whose root is the receiver, except the root node. If the left sub-tree is nil, it just returns the right sub-tree. Otherwise, it adds the right sub-tree as the right child of the left sub-tree's right-most descendent and returns the modified left sub-tree." | newRoot | (leftChild isNil) & (rnswers the question: Does the sub-tree rooted at the receiver contain a node labelled with aLabel? It returns a boolean." self label = aLabel ifTrue: [^true]. rightChild isNil & leftChild isNil ifTrue: [^false]. leftChild isNil ifTrue: [^rightChild contains: aLabel]. rightChild isNil ifTrue: [^leftChild contains: aLabel]. ^(leftChild contains: aLabel) | (rightChild contains: aLabel)! height "Return the height of this sub-tree." | left right | left _ leftChild isNil ifTrue: [0] ifFalse: [leftChightChild isNil) ifTrue: [self remove. ^nil]. newRoot _ (leftChild isNil) ifTrue: [rightChild] ifFalse: [leftChild rightMostDescendent addRightChild: rightChild. leftChild]. parent isNil ifTrue: [^newRoot parent: nil]. parent leftChild == self ifTrue:[parent addLeftChild: newRoot. ^newRoot]. parent rightChild == self ifTrue:[parent addRightChild: newRoot. ^newRoot]. self error: 'Ill-formed tree within removeRoot'! rightMostDescendent "Return the right-most descendent of the receiver." | aTreild height]. right _ rightChild isNil ifTrue: [0] ifFalse: [rightChild height]. ^ 1 + (left max: right)! isLeaf "Is this node a leaf" ^leftChild isNil & rightChild isNil! numberOfNodes "This method returns the number of nodes in this sub-tree." ^ 1 + (leftChild isNil ifTrue: [0] ifFalse: [leftChild numberOfNodes]) + (rightChild isNil ifTrue: [0] ifFalse: [rightChild numberOfNodes])! ! !Tree methodsFor: 'tree functions'! remove: aLabel "Search the tree whose root is the rece | aTree _ self. [aTree rightChild isNil] whileFalse: [aTree _ aTree rightChild]. ^ aTree! traverseTree "Does an in order (left to right) traversal of a tree, high lighting each node" (self leftChild isNil) ifTrue: [self hiLiteMe] ifFalse: [self leftChild traverseTree. self hiLiteMe]. (self rightChild isNil) ifFalse: [self rightChild traverseTree].! ! !Tree methodsFor: 'printing'! printOn: aStream "This method prints a textual representation of the sub-tree rooted at the receiver on aStream." eiver for a node labelled with aLabel and remove that node. Return the modified tree's new root." ^ self "Unimplemented..."! removeNode: aNode "This method is passed aNode. It searches the sub-tree self for the node and removes it. (It does not remove the children of aNode.) If the tree contains aNode, it returns the modified sub-tree, otherwise it returns 'false'." | gotIt | (self = aNode) ifTrue: [^self removeRoot]. leftChild notNil ifTrue: [gotIt _ leftChild removeNode: aNode. gotIt ~~ fa self isLeaf ifTrue: [^ label printOn: aStream]. label printOn: aStream. aStream nextPutAll: ' withLeft: ('. (leftChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [leftChild printOn: aStream.]. aStream nextPutAll: ') withRight: ('. (rightChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [rightChild printOn: aStream.]. aStream nextPutAll: ')'! ! !Tree methodsFor: 'displaying'! containsPoint: cursorPoint "This method tests to see if the given point lies on top of any of this tree's nodes. If so, it returns that node, otherwise it returns nil. Every node has an instance variable describing the rectangle in which the node icon was displayed which is updated everytime the tree is re-displayed and which is used here." | ans | "See if I contain the cursor point." (whereLastDisplayed containsPoint: cursorPoint) ifTrue: [^self]. "See if the left sub-tree contains the point." leftChild notNil ifTrue: [ans _ leftChild containsPoint: cursorPoint. ans notNil ifTrue: [^ansChild displayOn: aForm at: rightPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]! ! !Tree methodsFor: 'private'! hiLiteMe "high-lights a node by xor'ing a filled node form over the displayed node for 1 second" |d| d _ Delay forMilliseconds: 300. HiLitedNodeIcon displayOn: Display at: (whereLastDisplayed origin) clippingBox: whereLastDisplayed rule: Form reverse mask: nil. d wait. HiLitedNodeIcon displayOn: Display at: (whereLastDisplayed origin) clippingBox: whereLastDisplayed ru]]. "See if the right sub-tree contains the point." rightChild notNil ifTrue: [ans _ rightChild containsPoint: cursorPoint. ans notNil ifTrue: [^ans]]. ^ nil! displayOn: aForm at: aPoint clippingBox: clipBox xIncr: xIncr yIncr: yIncr "This sub-tree is to display itself on the given Form. It displays arcs leading down to its sub-trees and then uses itself recursively to obtain a display of its sub-trees." | leftPoint rightPoint bottomPoint aBitBlt| "DISPLAY THE NODE ICON AND REMEMBER WHERE WE Dle: Form reverse mask: nil.! leftChild: aNode "Set the receivers left sub-tree to aNode." leftChild _ aNode! parent: aNode "Set the receiver's parent to aNode." parent _ aNode! remove "This method removes the receiver from whatever tree it is in (if any)." parent notNil ifTrue: [(parent leftChild = self) ifTrue: [parent leftChild: nil]. (parent rightChild = self) ifTrue: [parent rightChild: nil]]. parent _ nil! rightChild: aNode "Set the receiver's right sub-tree to aNode." rightChild _ aID IT" NodeIcon displayOn: aForm at: (aPoint x - 12) @ (aPoint y) clippingBox: clipBox. whereLastDisplayed _ ((aPoint x - 12) @ (aPoint y) extent: (NodeIcon extent)) intersect: clipBox. label asDisplayText displayOn: aForm at: (aPoint x - 5) @ (aPoint y + 5) clippingBox: clipBox. "SET UP A BITBLT FOR USE BELOW" aBitBlt _ BitBlt destForm: aForm sourceForm: (Form extent: 1@1) black halftoneForm: Form black combinationRule: 3 destOrigin: 0 @ 0 sourceOrigin: 0 @ 0 extent: aFoNode! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tree class instanceVariableNames: ''! !Tree class methodsFor: 'instance creation'! withLabel: aString "This method returns a new Tree with its label initialized to aString and with no children." | tree | tree _ self new. tree label: aString copy. ^ tree! withLabel: aLabel withLeft: left withRight: right "Create a node with aLabel. Left and right should be either sub-trees or nil. Add them as children to this node. Return the rrm computeBoundingBox extent clipRect: clipBox. "DISPLAY THE LEFT SUB-TREE" bottomPoint _ (aPoint x ) @ (aPoint y + 24). leftPoint _ (aPoint x - xIncr) @ (aPoint y + 60). leftChild notNil ifTrue: [aBitBlt drawFrom: bottomPoint to: leftPoint. leftChild displayOn: aForm at: leftPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]. "DISPLAY THE RIGHT SUB-TREE" rightPoint _ (aPoint x + xIncr) @ (aPoint y + 60). rightChild notNil ifTrue: [aBitBlt drawFrom: bottomPoint to: rightPoint. rightesult." | tree | tree _ self new. tree label: aLabel copy. tree addLeftChild: left. tree addRightChild: right. ^ tree! ! !Tree class methodsFor: 'Initialization'! initialize "This method initializes the class variable NodeIcon to contain a Form suitable for use in displaying an individual Node." | aCircle pen | NodeIcon _ Form extent: 25 @ 25. pen _ Form extent: 1@1. pen black. aCircle _ Circle new. aCircle form: pen. aCircle radius: 12. aCircle center: 12@12. aCircle displayOn: NodeIcon. HiLitedNodeIcon _ (Form dotOfSize: 25) offset: 0@0 "Tree initialize"! ! Tree initialize! Tree subclass: #OrderedTree instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tree-Application'! OrderedTree comment: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild ThopCenter + (0 @ 15) clippingBox: insetDisplayBox xIncr: 60 yIncr: 60]! ! !TreeView methodsFor: 'controller access'! defaultControllerClass "Answer the class of the default controller for the receiver. For the time being this is the dummy stub, NoController." ^TreeController! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeView class instanceVariableNames: ''! !TreeView class methodsFor: 'instance creation'! openViewOf: aTree "This method is passed a sub-tree. It ois is a pointer to the left sub-tree. rightChild This is a pointer to the right sub-tree. parent This is a pointer to the parent of this node.'! !OrderedTree methodsFor: 'access'! addInOrder: aSubTree "add a node to tree in alphabetical order with a pre-order ordering" | newNode | self label > aSubTree label ifTrue: [leftChild isNil ifTrue: [^self leftChild: aSubTree] ifFalse: [^leftChild addInOrder: aSubTree]]. self label < aSubTree label ifTrue: [rightChild isNil pens a view of it on the screen and returns a pointer to its view. In the process, it creates a TreeController which it activates to take care of button pressing and so on." | topView treeView | treeView _ self new model: aTree; borderWidth: 2; insideColor: Form white. topView _ (StandardSystemView model: aTree label: 'TreeView' minimumSize: 100@100) addSubView: treeView. topView controller open! ! TreeView subclass: #OTView instanceVariableNames: '' classVariableNames: '' poolDictifTrue: [^self rightChild: aSubTree] ifFalse: [^rightChild addInOrder: aSubTree]]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OrderedTree class instanceVariableNames: ''! OrderedTree class comment: 'This class contains instances of trees in a pre-order order.'! View subclass: #TreeView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tree-Application'! TreeView comment: 'This class (a subclass of View) is used to provide a view of trees as rionaries: '' category: 'Tree-Application'! !OTView methodsFor: 'controller access'! defaultControllerClass "Answer the class of the default controller for the receiver. For the time being this is the dummy stub, NoController." ^OTController! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! OTView class instanceVariableNames: ''! OTView class comment: 'This class represents a graphical view of an ordered tree that is ordered in a pre-order order.'! children to this node. Return the represented by instances of Tree. It provides a routine for filling in the view and a class method for opening the window. The rest is inherited from its superclass.'! !TreeView methodsFor: 'displaying'! displayView "This routine is called to display the tree. It makes use of the (inherited) instance variable 'model' and of the 'insetDisplayBox' instance variable to find out what area of the screen is to be displayed on." model notNil ifTrue: [model displayOn: Display at: insetDisplayBox t9? 9@Tree-Application-OK.st.8RP3B B, vsmalltal fY Y y:BՎ MouseMenuController subclass: #TreeController instanceVariableNames: '' classVariableNames: 'TreeYellowButtonMenu TreeYellowButtonMessages ' poolDictionaries: '' category: 'Tree-Application'! TreeController comment: 'This class provides a specialization of MouseMenuController to be used by TreeView in displaying a view of a tree. It takes care of presenting menus when appropriate and performing the corresponding message sends.'! !TreeController methodsFor: 'menu messages'! addLeftChild "This methoddel containsPoint: Sensor waitButton]. node ~~ nil ifTrue: [ view model: (model removeNode: node)]]. self view display! removeRoot "This method implements the 'remove root' menu selection." model notNil ifTrue: [view model: (model removeRoot)]. self view display! startNewTree "Interactively spawn a new tree in a new view." | newTree | newTree _ Tree withLabel: ''. TreeView openViewOf: newTree! traverseTree "Does an in order (left to right) traversal of a tree, high lighting each node"  implements the 'add left child' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. node addLeftChild: (Tree withLabel: newLabel)]]. self view display! addRightChild "This method implements the 'add right chil model traverseTree! ! !TreeController methodsFor: 'control defaults'! isControlActive ^super isControlActive & sensor blueButtonPressed not! ! !TreeController methodsFor: 'initialize'! initialize super initialize. self initializeYellowButtonMenu! ! !TreeController methodsFor: 'private'! initializeYellowButtonMenu self yellowButtonMenu: TreeYellowButtonMenu yellowButtonMessages: TreeYellowButtonMessages.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeController class insd' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. node addRightChild: (Tree withLabel: newLabel)]]. self view display! changeLabel "This method implements the 'change label' menu selection." | node newLabtanceVariableNames: ''! !TreeController class methodsFor: 'class initialization'! initialize "Initialize the menu for the yellow mouse button." TreeYellowButtonMenu _ PopUpMenu labels: 'Remove Node Add Left Child Add Right Child Change Label Traverse Tree Start New Tree Remove Root'. TreeYellowButtonMessages _ #(removeNode addLeftChild addRightChild changeLabel traverseTree startNewTree removeRoot ) "TreeController initialize"! ! TreeController initialize! Object subclass: #Tree instanceVariael | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter New Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: node label useCRController: true. node label: newLabel]]. self view display! removeNode "This method implements the 'remove node' menu selection." | node | model notNil ifTrue: [Cursor crossHair showWhile: [node _ mobleNames: 'label leftChild rightChild parent whereLastDisplayed ' classVariableNames: 'HiLitedNodeIcon NodeIcon ' poolDictionaries: '' category: 'Tree-Application'! Tree comment: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a p ointer to the right sub-tree. parent This is a pointer to the parent of this node.'! !Tree methodsFor: 'access'! addLeftChild: aTree "This method first removes aTree from whatever tree it is already in (if any) and then it adds it as the left child of the receiver." leftChild notNil ifTrue: [leftChild remove]. aTree notNil ifTrue: [aTree remove. aTree parent: self]. leftChild _ aTree! addRightChild: aTree "This method first removes aTree from whatever tree it is already in (if any) an !Tree methodsFor: 'tree functions'! remove: aLabel "Search the tree whose root is the receiver for a node labelled with aLabel and remove that node. Return the modified tree's new root." ^ self "Unimplemented..."! removeNode: aNode "This method is passed aNode. It searches the sub-tree self for the node and removes it. (It does not remove the children of aNode.) If the tree contains aNode, it returns the modified sub-tree, otherwise it returns 'false'." | gotIt | (self = aNode) ifTrue: [^self d then it adds it as the right child of the receiver." rightChild notNil ifTrue: [rightChild remove]. aTree notNil ifTrue: [aTree remove. aTree parent: self]. rightChild _ aTree! label "Return a copy of the value of the instance variable 'label'." ^label copy! label: aString "Set the label of this Node" label _ aString copy.! leftChild "Return the left sub-tree of the receiver." ^leftChild! parent "Return the parent of the receiver." ^parent! rightChild "Return the right sub-tree of theremoveRoot]. leftChild notNil ifTrue: [gotIt _ leftChild removeNode: aNode. gotIt ~~ false ifTrue: [^self]]. rightChild notNil ifTrue: [gotIt _ rightChild removeNode: aNode. gotIt ~~ false ifTrue: [^self]]. ^false! removeRoot "This method returns a sub-tree containing all the nodes in the tree whose root is the receiver, except the root node. If the left sub-tree is nil, it just returns the right sub-tree. Otherwise, it adds the right sub-tree as the right child of the left sub-tree's right-m receiver." ^rightChild! ! !Tree methodsFor: 'testing'! contains: aLabel "This method answers the question: Does the sub-tree rooted at the receiver contain a node labelled with aLabel? It returns a boolean." self label = aLabel ifTrue: [^true]. rightChild isNil & leftChild isNil ifTrue: [^false]. leftChild isNil ifTrue: [^rightChild contains: aLabel]. rightChild isNil ifTrue: [^leftChild contains: aLabel]. ^(leftChild contains: aLabel) | (rightChild contains: aLabel)! height "Return the heightost descendent and returns the modified left sub-tree." | newRoot | (leftChild isNil) & (rightChild isNil) ifTrue: [self remove. ^nil]. newRoot _ (leftChild isNil) ifTrue: [rightChild] ifFalse: [leftChild rightMostDescendent addRightChild: rightChild. leftChild]. parent isNil ifTrue: [^newRoot parent: nil]. parent leftChild == self ifTrue:[parent addLeftChild: newRoot. ^newRoot]. parent rightChild == self ifTrue:[parent addRightChild: newRoot. ^newRoot]. self error: 'Ill-formed tree within re of this sub-tree." | left right | left _ leftChild isNil ifTrue: [0] ifFalse: [leftChild height]. right _ rightChild isNil ifTrue: [0] ifFalse: [rightChild height]. ^ 1 + (left max: right)! isLeaf "Is this node a leaf" ^leftChild isNil & rightChild isNil! numberOfNodes "This method returns the number of nodes in this sub-tree." ^ 1 + (leftChild isNil ifTrue: [0] ifFalse: [leftChild numberOfNodes]) + (rightChild isNil ifTrue: [0] ifFalse: [rightChild numberOfNodes])! ! moveRoot'! rightMostDescendent "Return the right-most descendent of the receiver." | aTree | aTree _ self. [aTree rightChild isNil] whileFalse: [aTree _ aTree rightChild]. ^ aTree! traverseTree "Does an in order (left to right) traversal of a tree, high lighting each node" (self leftChild isNil) ifTrue: [self hiLiteMe] ifFalse: [self leftChild traverseTree. self hiLiteMe]. (self rightChild isNil) ifFalse: [self rightChild traverseTree].! ! !Tree methodsFor: 'printing'! printOn: aStream "This  method prints a textual representation of the sub-tree rooted at the receiver on aStream." self isLeaf ifTrue: [^ label printOn: aStream]. label printOn: aStream. aStream nextPutAll: ' withLeft: ('. (leftChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [leftChild printOn: aStream.]. aStream nextPutAll: ') withRight: ('. (rightChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [rightChild printOn: aStream.]. aStream nextPutAll: ')'! ! !Tree methodsFor: 'displaying'! contaiorm: Form black combinationRule: 3 destOrigin: 0 @ 0 sourceOrigin: 0 @ 0 extent: aForm computeBoundingBox extent clipRect: clipBox. "DISPLAY THE LEFT SUB-TREE" bottomPoint _ (aPoint x ) @ (aPoint y + 24). leftPoint _ (aPoint x - xIncr) @ (aPoint y + 60). leftChild notNil ifTrue: [aBitBlt drawFrom: bottomPoint to: leftPoint. leftChild displayOn: aForm at: leftPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]. "DISPLAY THE RIGHT SUB-TREE" rightPoint _ (aPoint x + xIncr) @ (aPoint nsPoint: cursorPoint "This method tests to see if the given point lies on top of any of this tree's nodes. If so, it returns that node, otherwise it returns nil. Every node has an instance variable describing the rectangle in which the node icon was displayed which is updated everytime the tree is re-displayed and which is used here." | ans | "See if I contain the cursor point." (whereLastDisplayed containsPoint: cursorPoint) ifTrue: [^self]. "See if the left sub-tree contains the point." leftChy + 60). rightChild notNil ifTrue: [aBitBlt drawFrom: bottomPoint to: rightPoint. rightChild displayOn: aForm at: rightPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]! ! !Tree methodsFor: 'private'! hiLiteMe "high-lights a node by xor'ing a filled node form over the displayed node for 1 second" |d| d _ Delay forMilliseconds: 300. HiLitedNodeIcon displayOn: Display at: (whereLastDisplayed origin) clippingBox: whereLastDisplayed rule: Form reverse mask: nil. d wait. HiLitedNodeIcild notNil ifTrue: [ans _ leftChild containsPoint: cursorPoint. ans notNil ifTrue: [^ans]]. "See if the right sub-tree contains the point." rightChild notNil ifTrue: [ans _ rightChild containsPoint: cursorPoint. ans notNil ifTrue: [^ans]]. ^ nil! displayOn: aForm at: aPoint clippingBox: clipBox xIncr: xIncr yIncr: yIncr "This sub-tree is to display itself on the given Form. It displays arcs leading down to its sub-trees and then uses itself recursively to obtain a display of its sub-trees." on displayOn: Display at: (whereLastDisplayed origin) clippingBox: whereLastDisplayed rule: Form reverse mask: nil.! leftChild: aNode "Set the receivers left sub-tree to aNode." leftChild _ aNode! parent: aNode "Set the receiver's parent to aNode." parent _ aNode! remove "This method removes the receiver from whatever tree it is in (if any)." parent notNil ifTrue: [(parent leftChild = self) ifTrue: [parent leftChild: nil]. (parent rightChild = self) ifTrue: [parent rightChild: nil]]. par| leftPoint rightPoint bottomPoint aBitBlt| "DISPLAY THE NODE ICON AND REMEMBER WHERE WE DID IT" NodeIcon displayOn: aForm at: (aPoint x - 12) @ (aPoint y) clippingBox: clipBox. whereLastDisplayed _ ((aPoint x - 12) @ (aPoint y) extent: (NodeIcon extent)) intersect: clipBox. label asDisplayText displayOn: aForm at: (aPoint x - 5) @ (aPoint y + 5) clippingBox: clipBox. "SET UP A BITBLT FOR USE BELOW" aBitBlt _ BitBlt destForm: aForm sourceForm: (Form extent: 1@1) black halftoneFent _ nil! rightChild: aNode "Set the receiver's right sub-tree to aNode." rightChild _ aNode! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tree class instanceVariableNames: ''! !Tree class methodsFor: 'instance creation'! withLabel: aString "This method returns a new Tree with its label initialized to aString and with no children." | tree | tree _ self new. tree label: aString copy. ^ tree! withLabel: aLabel withLeft: left withRight: right "Create a node with aLabel. Left an d right should be either sub-trees or nil. Add them as children to this node. Return the result." | tree | tree _ self new. tree label: aLabel copy. tree addLeftChild: left. tree addRightChild: right. ^ tree! ! !Tree class methodsFor: 'Initialization'! initialize "This method initializes the class variable NodeIcon to contain a Form suitable for use in displaying an individual Node." | aCircle pen | NodeIcon _ Form extent: 25 @ 25. pen _ Form extent: 1@1. pen black. aCircle _ Circle new. antroller which it activates to take care of button pressing and so on." | topView treeView | treeView _ self new model: aTree; borderWidth: 2; insideColor: Form white. topView _ (StandardSystemView model: aTree label: 'TreeView' minimumSize: 100@100) addSubView: treeView. topView controller open! ! omPoint to: leftPoint. leftChild displayOn: aForm at: leftPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]. "DISPLAY THE RIGHT SUB-TREE" rightPoint _ (aPoint x + xIncr) @ (aPoint Circle form: pen. aCircle radius: 12. aCircle center: 12@12. aCircle displayOn: NodeIcon. HiLitedNodeIcon _ (Form dotOfSize: 25) offset: 0@0 "Tree initialize"! ! Tree initialize! View subclass: #TreeView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tree-Application'! TreeView comment: 'This class (a subclass of View) is used to provide a view of trees as represented by instances of Tree. It provides a routine for filling in the view and a class method for 9?9@ :.Tree-Application.st.8RP3B B, vsmalltal fY Y y:BՎopening the window. The rest is inherited from its superclass.'! !TreeView methodsFor: 'displaying'! displayView "This routine is called to display the tree. It makes use of the (inherited) instance variable 'model' and of the 'insetDisplayBox' instance variable to find out what area of the screen is to be displayed on." model notNil ifTrue: [model displayOn: Display at: insetDisplayBox topCenter + (0 @ 15) clippingBox: insetDisplayBox xIncr: 60 yIncr: 60]! ! !TreeView methodMouseMenuController subclass: #TreeController instanceVariableNames: '' classVariableNames: 'TreeYellowButtonMenu TreeYellowButtonMessages ' poolDictionaries: '' category: 'Tree-Application'! TreeController comment: 'This class provides a specialization of MouseMenuController to be used by TreeView in displaying a view of a tree. It takes care of presenting menus when appropriate and performing the corresponding message sends.'! !TreeController methodsFor: 'menu messages'! addLeftChild "This methodsFor: 'controller access'! defaultControllerClass "Answer the class of the default controller for the receiver. For the time being this is the dummy stub, NoController." ^TreeController! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeView class instanceVariableNames: ''! !TreeView class methodsFor: 'instance creation'! openViewOf: aTree "This method is passed a sub-tree. It opens a view of it on the screen and returns a pointer to its view. In the process, it creates a TreeCo implements the 'add left child' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. node addLeftChild: (Tree withLabel: newLabel)]]. self view display! addRightChild "This method implements the 'add right chil d' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. node addRightChild: (Tree withLabel: newLabel)]]. self view display! changeLabel "This method implements the 'change label' menu selection." | node newLabtanceVariableNames: ''! !TreeController class methodsFor: 'class initialization'! initialize "Initialize the menu for the yellow mouse button." TreeYellowButtonMenu _ PopUpMenu labels: 'Remove Node Add Left Child Add Right Child Change Label Traverse Tree Start New Tree Remove Root'. TreeYellowButtonMessages _ #(removeNode addLeftChild addRightChild changeLabel traverseTree startNewTree removeRoot ) "TreeController initialize"! ! TreeController initialize! Object subclass: #Tree instanceVariael | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter New Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: node label useCRController: true. node label: newLabel]]. self view display! removeNode "This method implements the 'remove node' menu selection." | node | model notNil ifTrue: [Cursor crossHair showWhile: [node _ mobleNames: 'label leftChild rightChild parent whereLastDisplayed ' classVariableNames: 'HiLitedNodeIcon NodeIcon ' poolDictionaries: '' category: 'Tree-Application'! Tree comment: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a pdel containsPoint: Sensor waitButton]. node ~~ nil ifTrue: [ view model: (model removeNode: node)]]. self view display! removeRoot "This method implements the 'remove root' menu selection." model notNil ifTrue: [view model: (model removeRoot)]. self view display! startNewTree "Interactively spawn a new tree in a new view." | newTree | newTree _ Tree withLabel: ''. TreeView openViewOf: newTree! traverseTree "Does an in order (left to right) traversal of a tree, high lighting each node" ointer to the right sub-tree. parent This is a pointer to the parent of this node.'! !Tree methodsFor: 'access'! addLeftChild: aTree "This method first removes aTree from whatever tree it is already in (if any) and then it adds it as the left child of the receiver." leftChild notNil ifTrue: [leftChild remove]. aTree notNil ifTrue: [aTree remove. aTree parent: self]. leftChild _ aTree! addRightChild: aTree "This method first removes aTree from whatever tree it is already in (if any) an model traverseTree! ! !TreeController methodsFor: 'control defaults'! isControlActive ^super isControlActive & sensor blueButtonPressed not! ! !TreeController methodsFor: 'initialize'! initialize super initialize. self initializeYellowButtonMenu! ! !TreeController methodsFor: 'private'! initializeYellowButtonMenu self yellowButtonMenu: TreeYellowButtonMenu yellowButtonMessages: TreeYellowButtonMessages.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeController class insd then it adds it as the right child of the receiver." rightChild notNil ifTrue: [rightChild remove]. aTree notNil ifTrue: [aTree remove. aTree parent: self]. rightChild _ aTree! label "Return a copy of the value of the instance variable 'label'." ^label copy! label: aString "Set the label of this Node" label _ aString copy.! leftChild "Return the left sub-tree of the receiver." ^leftChild! parent "Return the parent of the receiver." ^parent! rightChild "Return the right sub-tree of the  receiver." ^rightChild! ! !Tree methodsFor: 'testing'! contains: aLabel "This method answers the question: Does the sub-tree rooted at the receiver contain a node labelled with aLabel? It returns a boolean." self label = aLabel ifTrue: [^true]. rightChild isNil & leftChild isNil ifTrue: [^false]. leftChild isNil ifTrue: [^rightChild contains: aLabel]. rightChild isNil ifTrue: [^leftChild contains: aLabel]. ^(leftChild contains: aLabel) | (rightChild contains: aLabel)! height "Return the heightost descendent and returns the modified left sub-tree." | newRoot | (leftChild isNil) & (rightChild isNil) ifTrue: [self remove. ^nil]. newRoot _ (leftChild isNil) ifTrue: [rightChild] ifFalse: [leftChild rightMostDescendent addRightChild: rightChild. leftChild]. parent isNil ifTrue: [^newRoot parent: nil]. parent leftChild == self ifTrue:[parent addLeftChild: newRoot. ^newRoot]. parent rightChild == self ifTrue:[parent addRightChild: newRoot. ^newRoot]. self error: 'Ill-formed tree within re of this sub-tree." | left right | left _ leftChild isNil ifTrue: [0] ifFalse: [leftChild height]. right _ rightChild isNil ifTrue: [0] ifFalse: [rightChild height]. ^ 1 + (left max: right)! isLeaf "Is this node a leaf" ^leftChild isNil & rightChild isNil! numberOfNodes "This method returns the number of nodes in this sub-tree." ^ 1 + (leftChild isNil ifTrue: [0] ifFalse: [leftChild numberOfNodes]) + (rightChild isNil ifTrue: [0] ifFalse: [rightChild numberOfNodes])! ! moveRoot'! rightMostDescendent "Return the right-most descendent of the receiver." | aTree | aTree _ self. [aTree rightChild isNil] whileFalse: [aTree _ aTree rightChild]. ^ aTree! traverseTree "Does an in order (left to right) traversal of a tree, high lighting each node" (self leftChild isNil) ifTrue: [self hiLiteMe] ifFalse: [self leftChild traverseTree. self hiLiteMe]. (self rightChild isNil) ifFalse: [self rightChild traverseTree].! ! !Tree methodsFor: 'printing'! printOn: aStream "This !Tree methodsFor: 'tree functions'! remove: aLabel "Search the tree whose root is the receiver for a node labelled with aLabel and remove that node. Return the modified tree's new root." ^ self "Unimplemented..."! removeNode: aNode "This method is passed aNode. It searches the sub-tree self for the node and removes it. (It does not remove the children of aNode.) If the tree contains aNode, it returns the modified sub-tree, otherwise it returns 'false'." | gotIt | (self = aNode) ifTrue: [^self  method prints a textual representation of the sub-tree rooted at the receiver on aStream." self isLeaf ifTrue: [^ label printOn: aStream]. label printOn: aStream. aStream nextPutAll: ' withLeft: ('. (leftChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [leftChild printOn: aStream.]. aStream nextPutAll: ') withRight: ('. (rightChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [rightChild printOn: aStream.]. aStream nextPutAll: ')'! ! !Tree methodsFor: 'displaying'! contairemoveRoot]. leftChild notNil ifTrue: [gotIt _ leftChild removeNode: aNode. gotIt ~~ false ifTrue: [^self]]. rightChild notNil ifTrue: [gotIt _ rightChild removeNode: aNode. gotIt ~~ false ifTrue: [^self]]. ^false! removeRoot "This method returns a sub-tree containing all the nodes in the tree whose root is the receiver, except the root node. If the left sub-tree is nil, it just returns the right sub-tree. Otherwise, it adds the right sub-tree as the right child of the left sub-tree's right-mnsPoint: cursorPoint "This method tests to see if the given point lies on top of any of this tree's nodes. If so, it returns that node, otherwise it returns nil. Every node has an instance variable describing the rectangle in which the node icon was displayed which is updated everytime the tree is re-displayed and which is used here." | ans | "See if I contain the cursor point." (whereLastDisplayed containsPoint: cursorPoint) ifTrue: [^self]. "See if the left sub-tree contains the point." leftCh ild notNil ifTrue: [ans _ leftChild containsPoint: cursorPoint. ans notNil ifTrue: [^ans]]. "See if the right sub-tree contains the point." rightChild notNil ifTrue: [ans _ rightChild containsPoint: cursorPoint. ans notNil ifTrue: [^ans]]. ^ nil! displayOn: aForm at: aPoint clippingBox: clipBox xIncr: xIncr yIncr: yIncr "This sub-tree is to display itself on the given Form. It displays arcs leading down to its sub-trees and then uses itself recursively to obtain a display of its sub-trees." on displayOn: Display at: (whereLastDisplayed origin) clippingBox: whereLastDisplayed rule: Form reverse mask: nil.! leftChild: aNode "Set the receivers left sub-tree to aNode." leftChild _ aNode! parent: aNode "Set the receiver's parent to aNode." parent _ aNode! remove "This method removes the receiver from whatever tree it is in (if any)." parent notNil ifTrue: [(parent leftChild = self) ifTrue: [parent leftChild: nil]. (parent rightChild = self) ifTrue: [parent rightChild: nil]]. par| leftPoint rightPoint bottomPoint aBitBlt| "DISPLAY THE NODE ICON AND REMEMBER WHERE WE DID IT" NodeIcon displayOn: aForm at: (aPoint x - 12) @ (aPoint y) clippingBox: clipBox. whereLastDisplayed _ ((aPoint x - 12) @ (aPoint y) extent: (NodeIcon extent)) intersect: clipBox. label asDisplayText displayOn: aForm at: (aPoint x - 5) @ (aPoint y + 5) clippingBox: clipBox. "SET UP A BITBLT FOR USE BELOW" aBitBlt _ BitBlt destForm: aForm sourceForm: (Form extent: 1@1) black halftoneFent _ nil! rightChild: aNode "Set the receiver's right sub-tree to aNode." rightChild _ aNode! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tree class instanceVariableNames: ''! !Tree class methodsFor: 'instance creation'! withLabel: aString "This method returns a new Tree with its label initialized to aString and with no children." | tree | tree _ self new. tree label: aString copy. ^ tree! withLabel: aLabel withLeft: left withRight: right "Create a node with aLabel. Left anorm: Form black combinationRule: 3 destOrigin: 0 @ 0 sourceOrigin: 0 @ 0 extent: aForm computeBoundingBox extent clipRect: clipBox. "DISPLAY THE LEFT SUB-TREE" bottomPoint _ (aPoint x ) @ (aPoint y + 24). leftPoint _ (aPoint x - xIncr) @ (aPoint y + 60). leftChild notNil ifTrue: [aBitBlt drawFrom: bottomPoint to: leftPoint. leftChild displayOn: aForm at: leftPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]. "DISPLAY THE RIGHT SUB-TREE" rightPoint _ (aPoint x + xIncr) @ (aPoint d right should be either sub-trees or nil. Add them as children to this node. Return the result." | tree | tree _ self new. tree label: aLabel copy. tree addLeftChild: left. tree addRightChild: right. ^ tree! ! !Tree class methodsFor: 'Initialization'! initialize "This method initializes the class variable NodeIcon to contain a Form suitable for use in displaying an individual Node." | aCircle pen | NodeIcon _ Form extent: 25 @ 25. pen _ Form extent: 1@1. pen black. aCircle _ Circle new. ay + 60). rightChild notNil ifTrue: [aBitBlt drawFrom: bottomPoint to: rightPoint. rightChild displayOn: aForm at: rightPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]! ! !Tree methodsFor: 'private'! hiLiteMe "high-lights a node by xor'ing a filled node form over the displayed node for 1 second" |d| d _ Delay forMilliseconds: 300. HiLitedNodeIcon displayOn: Display at: (whereLastDisplayed origin) clippingBox: whereLastDisplayed rule: Form reverse mask: nil. d wait. HiLitedNodeIcCircle form: pen. aCircle radius: 12. aCircle center: 12@12. aCircle displayOn: NodeIcon. HiLitedNodeIcon _ (Form dotOfSize: 25) offset: 0@0 "Tree initialize"! ! Tree initialize! View subclass: #TreeView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tree-Application'! TreeView comment: 'This class (a subclass of View) is used to provide a view of trees as represented by instances of Tree. It provides a routine for filling in the view and a class method for  opening the window. The rest is inherited from its superclass.'! !TreeView methodsFor: 'displaying'! displayView "This routine is called to display the tree. It makes use of the (inherited) instance variable 'model' and of the 'insetDisplayBox' instance variable to find out what area of the screen is to be displayed on." model notNil ifTrue: [model displayOn: Display at: insetDisplayBox topCenter + (0 @ 15) clippingBox: insetDisplayBox xIncr: 60 yIncr: 60]! ! !TreeView methodMouseMenuController subclass: #TreeController instanceVariableNames: '' classVariableNames: 'TreeYellowButtonMenu TreeYellowButtonMessages ' poolDictionaries: '' category: 'Tree-Application'! TreeController comment: 'This class provides a specialization of MouseMenuController to be used by TreeView in displaying a view of a tree. It takes care of presenting menus when appropriate and performing the corresponding message sends.'! !TreeController methodsFor: 'menu messages'! addLeftChild "This methodsFor: 'controller access'! defaultControllerClass "Answer the class of the default controller for the receiver. For the time being this is the dummy stub, NoController." ^TreeController! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeView class instanceVariableNames: ''! !TreeView class methodsFor: 'instance creation'! openViewOf: aTree "This method is passed a sub-tree. It opens a view of it on the screen and returns a pointer to its view. In the process, it creates a TreeCo implements the 'add left child' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. node addLeftChild: (Tree withLabel: newLabel)]]. self view display! addRightChild "This method implements the 'add right chilntroller which it activates to take care of button pressing and so on." | topView treeView | treeView _ self new model: aTree; borderWidth: 2; insideColor: Form white. topView _ (StandardSystemView model: aTree label: 'TreeView' minimumSize: 100@100) addSubView: treeView. topView controller open! ! omPoint to: leftPoint. leftChild displayOn: aForm at: leftPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]. "DISPLAY THE RIGHT SUB-TREE" rightPoint _ (aPoint x + xIncr) @ (aPoint d' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. node addRightChild: (Tree withLabel: newLabel)]]. self view display! changeLabel "This method implements the 'change label' menu selection." | node newLab8X 8Y : Tree-Application.st.bak.8RP3B B, vsmalltal fY Y y:BՎel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter New Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: node label useCRController: true. node label: newLabel]]. self view display! removeNode "This method implements the 'remove node' menu selection." | node | model notNil ifTrue: [Cursor crossHair showWhile: [node _ mo del containsPoint: Sensor waitButton]. node ~~ nil ifTrue: [ view model: (model removeNode: node)]]. self view display! removeRoot "This method implements the 'remove root' menu selection." model notNil ifTrue: [view model: (model removeRoot)]. self view display! startNewTree "Interactively spawn a new tree in a new view." | newTree | newTree _ Tree withLabel: ''. TreeView openViewOf: newTree! traverseTree "Does an in order (left to right) traversal of a tree, high lighting each node" ointer to the right sub-tree. parent This is a pointer to the parent of this node.'! !Tree methodsFor: 'access'! addLeftChild: aTree "This method first removes aTree from whatever tree it is already in (if any) and then it adds it as the left child of the receiver." leftChild notNil ifTrue: [leftChild remove]. aTree notNil ifTrue: [aTree remove. aTree parent: self]. leftChild _ aTree! addRightChild: aTree "This method first removes aTree from whatever tree it is already in (if any) an model traverseTree! ! !TreeController methodsFor: 'control defaults'! isControlActive ^super isControlActive & sensor blueButtonPressed not! ! !TreeController methodsFor: 'initialize'! initialize super initialize. self initializeYellowButtonMenu! ! !TreeController methodsFor: 'private'! initializeYellowButtonMenu self yellowButtonMenu: TreeYellowButtonMenu yellowButtonMessages: TreeYellowButtonMessages.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeController class insd then it adds it as the right child of the receiver." rightChild notNil ifTrue: [rightChild remove]. aTree notNil ifTrue: [aTree remove. aTree parent: self]. rightChild _ aTree! label "Return a copy of the value of the instance variable 'label'." ^label copy! label: aString "Set the label of this Node" label _ aString copy.! leftChild "Return the left sub-tree of the receiver." ^leftChild! parent "Return the parent of the receiver." ^parent! rightChild "Return the right sub-tree of thetanceVariableNames: ''! !TreeController class methodsFor: 'class initialization'! initialize "Initialize the menu for the yellow mouse button." TreeYellowButtonMenu _ PopUpMenu labels: 'Remove Node Add Left Child Add Right Child Change Label Traverse Tree Start New Tree Remove Root'. TreeYellowButtonMessages _ #(removeNode addLeftChild addRightChild changeLabel traverseTree startNewTree removeRoot ) "TreeController initialize"! ! TreeController initialize! Object subclass: #Tree instanceVaria receiver." ^rightChild! ! !Tree methodsFor: 'testing'! contains: aLabel "This method answers the question: Does the sub-tree rooted at the receiver contain a node labelled with aLabel? It returns a boolean." self label = aLabel ifTrue: [^true]. rightChild isNil & leftChild isNil ifTrue: [^false]. leftChild isNil ifTrue: [^rightChild contains: aLabel]. rightChild isNil ifTrue: [^leftChild contains: aLabel]. ^(leftChild contains: aLabel) | (rightChild contains: aLabel)! isLeaf "Is this node a lebleNames: 'label leftChild rightChild parent whereLastDisplayed ' classVariableNames: 'HiLitedNodeIcon NodeIcon ' poolDictionaries: '' category: 'Tree-Application'! Tree comment: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a paf" ^leftChild isNil & rightChild isNil! numberOfNodes "This method returns the number of nodes in this sub-tree." ^ 1 + (leftChild isNil ifTrue: [0] ifFalse: [leftChild numberOfNodes]) + (rightChild isNil ifTrue: [0] ifFalse: [rightChild numberOfNodes])! ! !Tree methodsFor: 'tree functions'! remove: aLabel "Search the tree whose root is the receiver for a node labelled with aLabel and remove that node. Return the modified tree's new root." ^ self "Unimplemented..."! removeNode : aNode "This method is passed aNode. It searches the sub-tree self for the node and removes it. (It does not remove the children of aNode.) If the tree contains aNode, it returns the modified sub-tree, otherwise it returns 'false'." | gotIt | (self = aNode) ifTrue: [^self removeRoot]. leftChild notNil ifTrue: [gotIt _ leftChild removeNode: aNode. gotIt ~~ false ifTrue: [^self]]. rightChild notNil ifTrue: [gotIt _ rightChild removeNode: aNode. gotIt ~~ false ifTrue: [^self]]. ^false! rem: [aStream nextPutAll: 'nil'] ifFalse: [leftChild printOn: aStream.]. aStream nextPutAll: ') withRight: ('. (rightChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [rightChild printOn: aStream.]. aStream nextPutAll: ')'! ! !Tree methodsFor: 'displaying'! containsPoint: cursorPoint "This method tests to see if the given point lies on top of any of this tree's nodes. If so, it returns that node, otherwise it returns nil. Every node has an instance variable describing the rectangle in whoveRoot "This method returns a sub-tree containing all the nodes in the tree whose root is the receiver, except the root node. If the left sub-tree is nil, it just returns the right sub-tree. Otherwise, it adds the right sub-tree as the right child of the left sub-tree's right-most descendent and returns the modified left sub-tree." | newRoot | (leftChild isNil) & (rightChild isNil) ifTrue: [self remove. ^nil]. newRoot _ (leftChild isNil) ifTrue: [rightChild] ifFalse: [leftChild rightMostDescendenich the node icon was displayed which is updated everytime the tree is re-displayed and which is used here." | ans | "See if I contain the cursor point." (whereLastDisplayed containsPoint: cursorPoint) ifTrue: [^self]. "See if the left sub-tree contains the point." leftChild notNil ifTrue: [ans _ leftChild containsPoint: cursorPoint. ans notNil ifTrue: [^ans]]. "See if the right sub-tree contains the point." rightChild notNil ifTrue: [ans _ rightChild containsPoint: cursorPoint. ans notNit addRightChild: rightChild. leftChild]. parent isNil ifTrue: [^newRoot parent: nil]. parent leftChild == self ifTrue:[parent addLeftChild: newRoot. ^newRoot]. parent rightChild == self ifTrue:[parent addRightChild: newRoot. ^newRoot]. self error: 'Ill-formed tree within removeRoot'! rightMostDescendent "Return the right-most descendent of the receiver." | aTree | aTree _ self. [aTree rightChild isNil] whileFalse: [aTree _ aTree leftChild]. ^ aTree! traverseTree "Does an in order (left to rl ifTrue: [^ans]]. ^ nil! displayOn: aForm at: aPoint clippingBox: clipBox xIncr: xIncr yIncr: yIncr "This sub-tree is to display itself on the given Form. It displays arcs leading down to its sub-trees and then uses itself recursively to obtain a display of its sub-trees." | leftPoint rightPoint bottomPoint aBitBlt| "DISPLAY THE NODE ICON AND REMEMBER WHERE WE DID IT" NodeIcon displayOn: aForm at: (aPoint x - 12) @ (aPoint y) clippingBox: clipBox. whereLastDisplayed _ ((aPoint x - 12) @ (aPoint yight) traversal of a tree, high lighting each node" (self leftChild isNil) ifTrue: [self hiLiteMe] ifFalse: [self leftChild traverseTree. self hiLiteMe]. (self rightChild isNil) ifFalse: [self rightChild traverseTree].! ! !Tree methodsFor: 'printing'! printOn: aStream "This method prints a textual representation of the sub-tree rooted at the receiver on aStream." self isLeaf ifTrue: [^ label printOn: aStream]. label printOn: aStream. aStream nextPutAll: ' withLeft: ('. (leftChild isNil) ifTrue) extent: (NodeIcon extent)) intersect: clipBox. label asDisplayText displayOn: aForm at: (aPoint x - 5) @ (aPoint y + 5) clippingBox: clipBox. "SET UP A BITBLT FOR USE BELOW" aBitBlt _ BitBlt destForm: aForm sourceForm: (Form extent: 1@1) black halftoneForm: Form black combinationRule: 3 destOrigin: 0 @ 0 sourceOrigin: 0 @ 0 extent: aForm computeBoundingBox extent clipRect: clipBox. "DISPLAY THE LEFT SUB-TREE" bottomPoint _ (aPoint x ) @ (aPoint y + 24). leftPoint _ (aPoint x - xIncr) @ (aPoint y + 60). leftChild notNil ifTrue: [aBitBlt drawFrom: bottomPoint to: leftPoint. leftChild displayOn: aForm at: leftPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]. "DISPLAY THE RIGHT SUB-TREE" rightPoint _ (aPoint x + xIncr) @ (aPoint y + 60). rightChild notNil ifTrue: [aBitBlt drawFrom: bottomPoint to: rightPoint. rightChild displayOn: aForm at: rightPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]! ! !Tree methodsFor: 'private'! hiLiteMe "higs methodsFor: 'Initialization'! initialize "This method initializes the class variable NodeIcon to contain a Form suitable for use in displaying an individual Node." | aCircle pen | NodeIcon _ Form extent: 25 @ 25. pen _ Form extent: 1@1. pen black. aCircle _ Circle new. aCircle form: pen. aCircle radius: 12. aCircle center: 12@12. aCircle displayOn: NodeIcon. HiLitedNodeIcon _ (Form dotOfSize: 25) offset: 0@0 "Tree initialize"! ! Tree initialize! View subclass: #TreeView instanceVariablh-lights a node by xor'ing a filled node form over the displayed node for 1 second" |d| d _ Delay forMilliseconds: 300. HiLitedNodeIcon displayOn: Display at: (whereLastDisplayed origin) clippingBox: whereLastDisplayed rule: Form reverse mask: nil. d wait. HiLitedNodeIcon displayOn: Display at: (whereLastDisplayed origin) clippingBox: whereLastDisplayed rule: Form reverse mask: nil.! leftChild: aNode "Set the receivers left sub-tree to aNode." leftChild _ aNode! parent: aNode "Set the reNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tree-Application'! TreeView comment: 'This class (a subclass of View) is used to provide a view of trees as represented by instances of Tree. It provides a routine for filling in the view and a class method for opening the window. The rest is inherited from its superclass.'! !TreeView methodsFor: 'displaying'! displayView "This routine is called to display the tree. It makes use of the (inherited) instance variable 'model' and of theceiver's parent to aNode." parent _ aNode! remove "This method removes the receiver from whatever tree it is in (if any)." parent notNil ifTrue: [(parent leftChild = self) ifTrue: [parent leftChild: nil]. (parent rightChild = self) ifTrue: [parent rightChild: nil]]. parent _ nil! rightChild: aNode "Set the receiver's right sub-tree to aNode." rightChild _ aNode! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tree class instanceVariableNames: ''! !Tree class methodsFor: 'instae 'insetDisplayBox' instance variable to find out what area of the screen is to be displayed on." model notNil ifTrue: [model displayOn: Display at: insetDisplayBox topCenter + (0 @ 15) clippingBox: insetDisplayBox xIncr: 60 yIncr: 60]! ! !TreeView methodsFor: 'controller access'! defaultControllerClass "Answer the class of the default controller for the receiver. For the time being this is the dummy stub, NoController." ^TreeController! ! "-- -- -- -- -- -- -- -- -- -- -- -nce creation'! withLabel: aString "This method returns a new Tree with its label initialized to aString and with no children." | tree | tree _ self new. tree label: aString copy. ^ tree! withLabel: aLabel withLeft: left withRight: right "Create a node with aLabel. Left and right should be either sub-trees or nil. Add them as children to this node. Return the result." | tree | tree _ self new. tree label: aLabel copy. tree addLeftChild: left. tree addRightChild: right. ^ tree! ! !Tree clas- -- -- -- -- -- -- "! TreeView class instanceVariableNames: ''! !TreeView class methodsFor: 'instance creation'! openViewOf: aTree "This method is passed a sub-tree. It opens a view of it on the screen and returns a pointer to its view. In the process, it creates a TreeController which it activates to take care of button pressing and so on." | topView treeView | treeView _ self new model: aTree; borderWidth: 2; insideColor: Form white. topView _ (StandardSystemView model: aTree label: 'TreeView' minimumSize: 100@100) addSubView: treeView. topView controller open! ! omPoint to: leftPoint. leftChild displayOn: aForm at: leftPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]. "DISPLAY THE RIGHT SUB-TREE" rightPoint _ (aPoint x + xIncr) @ (aPoint y + 60). rightChild notNil ifTrue: [aBitBlt drawFrom: bottomPoint to: rightPoint. rightChild displayOn: aForm at: rightPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]! ! !Tree methodsFor: 'private'! hiLiteMe "hig"Set the receiver's right sub-tree to aTree." rightChild _ aTree! ! !Tree methodsFor: 'testing'! contains: aLabel "This method answers the question: Does the sub-tree rooted at the receiver contain a node labelled with aLabel? It returns a boolean." self label = aLabel ifTrue: [^true]. rightChild isNil & leftChild isNil ifTrue: [^false]. leftChild isNil ifTrue: [^rightChild contains: aLabel]. rightChild isNil ifTrue: [^leftChild contains: aLabel]. ^(leftChild contains: aLabel) | (rightChild_ ` 'Tree-First.st.8RP3B B, vsmalltal fY Y y:BՎ contains: aLabel)! isLeaf "Is this node a leaf" ^leftChild isNil & rightChild isNil! numberOfNodes "This method returns the number of nodes in this sub-tree." ^ 1 + (leftChild isNil ifTrue: [0] ifFalse: [leftChild numberOfNodes]) + (rightChild isNil ifTrue: [0] ifFalse: [rightChild numberOfNodes])! ! !Tree methodsFor: 'tree functions'! remove: aLabel "Search the tree whose root is the receiver for a node labelled with aLabel and remove that node. Return the modified tree's newObject subclass: #Tree instanceVariableNames: 'label leftChild rightChild ' classVariableNames: '' poolDictionaries: '' category: 'Tree-Application'! Tree comment: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a pointer to the  root." "Unimplemented..." self error: 'This message is not implemented.'! removeRoot "This method returns a sub-tree containing all the nodes in the tree whose root is the receiver, except the root node. If the left sub-tree is nil, it just returns the right sub-tree. Otherwise, it adds the right sub-tree as the right child of the left sub-tree's right-most descendent and returns the modified left sub-tree." (leftChild isNil) ifTrue: [^rightChild] ifFalse: [leftChild rightMostDescendent right sub-tree. parent This is a pointer to the parent of this node.'! !Tree methodsFor: 'access'! label "Return a copy of the value of the instance variable 'label'." ^label copy! label: aString "Set the label of this Node" label _ aString copy.! leftChild "Return the left sub-tree of the receiver." ^leftChild! leftChild: aTree "Set the receiver's left sub-tree to aTree." leftChild _ aTree! rightChild "Return the right sub-tree of the receiver." ^rightChild! rightChild: aTree  rightChild: rightChild. ^leftChild].! rightMostDescendent "Return the right-most descendent of the receiver." | aTree | aTree _ self. [aTree rightChild isNil] whileFalse: [aTree _ aTree leftChild]. ^ aTree! ! !Tree methodsFor: 'printing'! printOn: aStream "This method prints a textual representation of the sub-tree rooted at the receiver on aStream." self isLeaf ifTrue: [^ label printOn: aStream]. label printOn: aStream. aStream nextPutAll: ' withLeft: ('. (leftChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [leftChild printOn: aStream.]. aStream nextPutAll: ') withRight: ('. (rightChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [rightChild printOn: aStream.]. aStream nextPutAll: ')'! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tree class instanceVariableNames: ''! !Tree class methodsFor: 'instance creation'! withLabel: aString "This method returns a new Tree with its label initialized to aString and with no children." | tree | tre  57Tree.ws.8RP3B B, vsmalltal fY Y y:BՎe _ Tree new. tree label: aString copy. ^ tree! withLabel: aLabel withLeft: left withRight: right "Create a node with aLabel. Left and right should be either sub-trees or nil. Add them as children to this node. Return the result." | tree | tree _ Tree new. tree label: aLabel copy. tree leftChild: left. tree rightChild: right. ^ tree! ! s node. Return the result." | tree | tree _ self new. tree label: aLabel copy. tree addLeftChild: left. tree addRightChild: right. ^ tree! ! !Tree clasaTree _ Tree withLabel: 'A'. bTree _ Tree withLabel: 'B'. cTree _ Tree withLabel: 'C'. dTree _ Tree withLabel: 'D'. eTree _ Tree withLabel: 'E'. fTree _ Tree withLabel: 'F'. gTree _ Tree withLabel: 'G'. hTree _ Tree withLabel: 'H'. aTree addLeftChild: bTree. cTree addLeftChild: eTree. bTree addLeftChild: dTree. cTree addRightChild: fTree. aTree addRightChild: cTree. dTree addLeftChild: gTree. dTree addRightChild: hTree. TreeView openViewOf: aTree. aTree inspect. ightChild This is a pointer to the ] ^ 60Tree-height.st.8RP3B B, vsmalltal fY Y y:BՎ|  }.WireController-movePin.st.8RP3B B, vsmalltal fY Y y:BՎ'From Smalltalk-80 version T2.1.2, of July 23, 1985 on 1 April 1986 at 10:54:47 am'! !Tree methodsFor: 'testing'! height "Return the height of this sub-tree." | left right | left _ leftChild isNil ifTrue: [0] ifFalse: [leftChild height]. right _ rightChild isNil ifTrue: [0] ifFalse: [rightChild height]. ^ 1 + (left max: right)! ! node. label This is the label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a pointer to the 'From Smalltalk-80 version T2.1.2, of July 23, 1985 on 10 February 1986 at 3:20:45 pm'! !WireController methodsFor: 'private'! movePin "Reads raw press and release coordinates, transforms them to Wire coordinates, finds and replaces the nearest pin with the new coordinate, and notifies the model and its dependents ofthe change." | old new | old _ view inverseDisplayTransform: sensor waitButton. sensor cursorPoint: (view displayTransform: (model pinNear: old)). Cursor crossHair showWhile: [new _ view inverseDisplayTransform: sensor waitNoButton]. model replace: (model pinNear: old) with: new. model changed! ! n a copy of the value of the instance variable 'label'." ^label copy! label: aString "Set the label of this Node" label _ aString copy.! leftChild "Return the left sub-tree of the receiver." ^leftChild! leftChild: aTree "Set the receiver's left sub-tree to aTree." leftChild _ aTree! rightChild "Return the right sub-tree of the receiver." ^rightChild! rightChild: aTree  with newPoint." self at: (self indexOf: aPoint) put: newPoint! ! !Wire methodsFor: 'optimize'! shorten "Try 20 random changes in the routing order. Keep only changes that shorten the length." 20 timesRepeat: [self shortenStep]! shortenStep "Try one random change in the routing order. Keep only if it shortens the length." | minLength i j | minLength _ self length. i _ self randomIndex. j _ self randomIndex. self exchange: i and: j. self length < minLength ifTrue: [minLen :&Wiring.st.8RP3B B, vsmalltal fY Y y:BՎgth _ self length. self changed] ifFalse: [self exchange: i and: j]! ! !Wire methodsFor: 'editing'! addPin "Adds a new point to a wire." self add: Sensor waitButton. Sensor waitNoButton. ^self! addPin: aPoint "Adds a new point to a wire." self add: Sensor waitButton. Sensor waitNoButton. ^self! edit "Open a wire editor" WireView openOn: self! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Wire class instanceVariableNames: ''! !Wire class methodsFor: 'builder'! make: OrderedCollection variableSubclass: #Wire instanceVariableNames: '' classVariableNames: 'Generator ' poolDictionaries: '' category: 'Wiring'! !Wire methodsFor: 'measurement'! length "I measure the length of a Wire." | total first next | total _ 0. first _ self first. self do: [:next | total _ total + (first dist: next). first _ next]. ^total! pinNear: aPoint "Finds the pin nearest aPoint." | thePin | thePin _ self first. self do: [:aPin | (aPin dist: aPoint) < (thePin dist: aanInteger "Makes a new wire with anInteger number of points input by the user." | aWire | aWire _ Wire new. anInteger timesRepeat: [aWire add: Sensor waitButton. Sensor waitNoButton]. ^aWire! ! !Wire class methodsFor: 'initialization'! initialize "Initialize new instance of class with Generator" Generator _ Random new "Wire initialize"! ! Wire initialize! Controller subclass: #WireController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'WiriPoint) ifTrue: [thePin _ aPin]]. ^thePin! ! !Wire methodsFor: 'display'! display "Display the wire as a single pixel wide line." | aPen | aPen _ Pen new up. self do: [:pin | aPen goto: pin; down]! ! !Wire methodsFor: 'private'! exchange: aInteger and: bInteger "Exchange wire points aInteger and bInter." self swap: aInteger with: bInteger! randomIndex "Generate randomIndex into Wire." ^(Generator next * self size) ceiling! replace: aPoint with: newPoint "Replaces the old point, aPoint,ng'! !WireController methodsFor: 'control defaults'! controlActivity "Allows us to graphically position pins in aWire." sensor redButtonPressed ifTrue: [self movePin]. sensor yellowButtonPressed ifTrue: [model shortenStep]! ! !WireController methodsFor: 'private'! movePin "Reads raw press and release coordinates, transforms them to Wire coordinates, finds and replaces the nearest pin with the new coordinate, and notifies the model and its dependents ofthe change." | old new | old _ view inverseDisplayTransform: sensor waitButton. sensor cursorPoint: (view displayTransform: (model pinNear: old)). Cursor read showWhile: [new _ view inverseDisplayTransform: sensor waitNoButton]. model replace: (model pinNear: old) with: new. model changed! ! View subclass: #WireView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Wiring'! !WireView methodsFor: 'displaying'! displayView "Display the wire as a single pixel wide line." | aPen x aDot | x _ 2.  :& Wiring.st.bak.8RP3B B, vsmalltal fY Y y:BՎaPen _ Pen new up. aDot _ Form dotOfSize: x + 3. aPen defaultNib: x. model do: [:pin | aPen goto: (self displayTransform: pin); down. aDot displayAt: (self displayTransform: pin)]! ! !WireView methodsFor: 'updating'! update: aModel "The receiver's model has changed. Redisplay the receiver in its entirety. " self display! ! !WireView methodsFor: 'controller access'! defaultControllerClass "Answer the class of the default controller for the receiver." ^WireController! ! "-- -- -- --OrderedCollection variableSubclass: #Wire instanceVariableNames: '' classVariableNames: 'Generator ' poolDictionaries: '' category: 'Wiring'! !Wire methodsFor: 'measurement'! length "I measure the length of a Wire." | total first next | total _ 0. first _ self first. self do: [:next | total _ total + (first dist: next). first _ next]. ^total! pinNear: aPoint "Finds the pin nearest aPoint." | thePin | thePin _ self first. self do: [:aPin | (aPin dist: aPoint) < (thePin dist: a -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! WireView class instanceVariableNames: ''! !WireView class methodsFor: 'examples'! example "This example prompts the user for 10 points to define a Wire, then opens an editor on the Wire." | aWire | aWire _ Wire make: 10. WireView openOn: aWire "WireView example"! ! !WireView class methodsFor: 'instance creation'! openOn: aWire " Creates a new WireView on aWire." | wireView topView | wireView _ self new. wireView model: aWire. wireView borPoint) ifTrue: [thePin _ aPin]]. ^thePin! ! !Wire methodsFor: 'display'! display "Display the wire as a single pixel wide line." | aPen | aPen _ Pen new up. self do: [:pin | aPen goto: pin; down]! ! !Wire methodsFor: 'private'! exchange: aInteger and: bInteger "Exchange wire points aInteger and bInter." self swap: aInteger with: bInteger! randomIndex "Generate randomIndex into Wire." ^(Generator next * self size) ceiling! replace: aPoint with: newPoint "Replaces the old point, aPoint,derWidth: 2. wireView insideColor: Form white. topView _ StandardSystemView new. topView label: 'Wire Editor'. topView addSubView: wireView. topView controller open! ! [:pin | aPen goto: pin; down]! ! !Wire methodsFor: 'private'! exchange: aInteger and: bInteger "Exchange wire points aInteger and bInter." self swap: aInteger with: bInteger! randomIndex "Generate randomIndex into Wire." ^(Generator next * self size) ceiling! replace: aPoint with: newPoint "Replaces the old point, aPoint, with newPoint." self at: (self indexOf: aPoint) put: newPoint! ! !Wire methodsFor: 'optimize'! shorten "Try 20 random changes in the routing order. Keep only changes that shorten the length." 20 timesRepeat: [self shortenStep]! shortenStep "Try one random change in the routing order. Keep only if it shortens the length." | minLength i j | minLength _ self length. i _ self randomIndex. j _ self randomIndex. self exchange: i and: j. self length < minLength ifTrue: [minLength _ self length. self changed] ifFalse: [self exchange: i and: j]! ! !Wire methodsFor: 'editing'! addPin "Adds a new point to a wire." self add: Sensor waitButton. Sensor waitNoButton. ^self! addPin: aPoint "Adds a new point to a wire." self add: Sensor waitButton. Sensor waitNoButton. ^self! edit "Open a wire editor" WireView openOn: self! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Wire class instanceVariableNames: ''! !Wire class methodsFor: 'builder'! make: aPen _ Pen new up. aDot _ Form dotOfSize: x + 3. aPen defaultNib: x. model do: [:pin | aPen goto: (self displayTransform: pin); down. aDot displayAt: (self displayTransform: pin)]! ! !WireView methodsFor: 'updating'! update: aModel "The receiver's model has changed. Redisplay the receiver in its entirety. " self display! ! !WireView methodsFor: 'controller access'! defaultControllerClass "Answer the class of the default controller for the receiver." ^WireController! ! "-- -- -- --anInteger "Makes a new wire with anInteger number of points input by the user." | aWire | aWire _ Wire new. anInteger timesRepeat: [aWire add: Sensor waitButton. Sensor waitNoButton]. ^aWire! ! !Wire class methodsFor: 'initialization'! initialize "Initialize new instance of class with Generator" Generator _ Random new "Wire initialize"! ! Wire initialize! Controller subclass: #WireController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Wiri -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! WireView class instanceVariableNames: ''! !WireView class methodsFor: 'examples'! example "This example prompts the user for 10 points to define a Wire, then opens an editor on the Wire." | aWire | aWire _ Wire make: 10. WireView openOn: aWire "WireView example"! ! !WireView class methodsFor: 'instance creation'! openOn: aWire " Creates a new WireView on aWire." | wireView topView | wireView _ self new. wireView model: aWire. wireView borng'! !WireController methodsFor: 'control defaults'! controlActivity "Allows us to graphically position pins in aWire." sensor redButtonPressed ifTrue: [self movePin]. sensor yellowButtonPressed ifTrue: [model shortenStep]! ! !WireController methodsFor: 'private'! movePin "Reads raw press and release coordinates, transforms them to Wire coordinates, finds and replaces the nearest pin with the new coordinate, and notifies the model and its dependents ofthe change." | old new | old _ view derWidth: 2. wireView insideColor: Form white. topView _ StandardSystemView new. topView label: 'Wire Editor'. topView addSubView: wireView. topView controller open! ! [:pin | aPen goto: pin; down]! ! !Wire methodsFor: 'private'! exchange: aInteger and: bInteger "Exchange wire points aInteger and bInter." self swap: aInteger with: bInteger! randomIndex "Generate randomIndex into Wire." ^(Generator next * self size) ceiling! replace: aPoint with: newPoint "Replaces the old point, aPoint,inverseDisplayTransform: sensor waitButton. sensor cursorPoint: (view displayTransform: (model pinNear: old)). Cursor read showWhile: [new _ view inverseDisplayTransform: sensor waitNoButton]. model replace: (model pinNear: old) with: new. model changed! ! View subclass: #WireView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Wiring'! !WireView methodsFor: 'displaying'! displayView "Display the wire as a single pixel wide line." | aPen x aDot | x _ 2. G H WiringWithList.st.8RP3B B, vsmalltal fY Y y:BՎOrderedCollection variableSubclass: #Wire instanceVariableNames: 'selectedPoint ' classVariableNames: 'Generator ' poolDictionaries: '' category: 'Wiring'! !Wire methodsFor: 'measurement'! length "I measure the length of a Wire." | total first next | total _ 0. first _ self first. self do: [:next | total _ total + (first dist: next). first _ next]. ^total! pinNear: aPoint "Finds the pin nearest aPoint." | thePin | thePin _ self first. self do: [:aPin | (aPin dist: aPoint) < ( | minLength i j | minLength _ self length. i _ self randomIndex. j _ self randomIndex. self exchange: i and: j. self length < minLength ifTrue: [minLength _ self length. self changed] ifFalse: [self exchange: i and: j]! ! !Wire methodsFor: 'editing'! edit "Open a wire editor" WireView openOn: self! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Wire class instanceVariableNames: ''! !Wire class methodsFor: 'builder'! make: anInteger "Makes a new wire with anIntegerthePin dist: aPoint) ifTrue: [thePin _ aPin]]. ^thePin! ! !Wire methodsFor: 'display'! display "Display the wire as a single pixel wide line." | aPen | aPen _ Pen new up. self do: [:pin | aPen goto: pin; down]! ! !Wire methodsFor: 'private'! changed "A modified version to work with a SelectionInList subView." self changed: #selectedPoint! exchange: aInteger and: bInteger "Exchange wire points aInteger and bInter." self swap: aInteger with: bInteger! randomIndex "Generate randomIndex in number of points input by the user." | aWire | aWire _ Wire new. anInteger timesRepeat: [aWire add: Sensor waitButton. Sensor waitNoButton]. ^aWire! ! !Wire class methodsFor: 'initialization'! initialize "Initialize new instance of class with Generator" Generator _ Random new "Wire initialize"! ! !Wire class methodsFor: 'example'! exampleOne "Prompt the user for 10 points and display the wire." | aWire | aWire _ Wire make: 10. WireView openOn: aWire "Wire exampleOne"! ! Wireto Wire." ^(Generator next * self size) ceiling! replace: aPoint with: newPoint "Replaces the old point, aPoint, with newPoint." self at: (self indexOf: aPoint) put: newPoint! ! !Wire methodsFor: 'menu messages'! addPoint "Adds a Point"! removePoint "Removes a Point"! ! !Wire methodsFor: 'list'! asWireList "Return a list of points." ^self asSortedCollection! listMenu "Return a middle button menu for action on selected item." ^ActionMenu labels: 'remove add' selectors: #(removePoint ad initialize! Controller subclass: #WireController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Wiring'! !WireController methodsFor: 'control defaults'! controlActivity "Allows us to graphically position pins in aWire." sensor redButtonPressed ifTrue: [self movePin] ifFalse: [model shortenStep]! ! !WireController methodsFor: 'private'! movePin "Reads raw press and release coordinates, transforms them to Wire coordinates, finds and replaces the neardPoint )! selectedPoint "Answer the selected point." selectedPoint! selectedPoint: aPoint "Store the selected point. You may want to modify this method to highlight the graphical wire display." selectedPoint _ aPoint! ! !Wire methodsFor: 'optimize'! shorten "Try 20 random changes in the routing order. Keep only changes that shorten the length." 20 timesRepeat: [self shortenStep]! shortenStep "Try one random change in the routing order. Keep only if it shortens the length." est pin with the new coordinate, and notifies the model and its dependents ofthe change." | old new | old _ view inverseDisplayTransform: sensor waitButton. sensor cursorPoint: (view displayTransform: (model pinNear: old)). Cursor crossHair showWhile: [new _ view inverseDisplayTransform: sensor waitNoButton]. model replace: (model pinNear: old) with: new. model changed! ! View subclass: #WireView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Wiring'! !WireView methodsFor: 'displaying'! displayView "Display the wire as a single pixel wide line." | aPen | aPen _ Pen new up. model do: [:pin | aPen goto: (self displayTransform: pin); down]! ! !WireView methodsFor: 'updating'! update: aModel "The receiver's model has changed. Redisplay the receiver in its entirety. " self display! ! !WireView methodsFor: 'controller access'! defaultControllerClass "Answer the class of the default controller for the receiver." ^WireController! ! "-- -- -w x^!bitMap.h.8RP3B B, vsmalltal fY Y y:BՎ- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! WireView class instanceVariableNames: ''! !WireView class methodsFor: 'instance creation'! openOn: aWire "Opens a view, containing 2 subViews, on aWire" | wireView wireListView topView | wireView _ self pinViewOn: aWire. wireListView _ self listViewOn: aWire. topView _ StandardSystemView new. topView label: 'Wire Editor'. topView addSubView: wireView in: (0.3 @ 0 extent: 0.7 @ 1) borderWidth: 2. topView addSubView: wireListView in: (/* Tektronix Smalltalk screen copy bit map file header format */ #define ID_FORM 1 /* instance of a Form */ struct bitMapHeader { short id; /* 1 indicates instance of a Form */ short width; /* # of bits wide */ short height; /* # of bits high */ short xOffset; /* */ short yOffset; /* */ }; /* after the header follows the bits in row-major order */ ntroller access'! defaultControllerClass "Answer the class of the default controller for the receiver." ^WireController! ! "-- -- -0 @ 0 extent: 0.3 @ 1) borderWidth: 2. topView controller open! ! !WireView class methodsFor: 'subview creation'! listViewOn: aWire "Build a subview to display a list of pins in aWire" ^SelectionInListView on: aWire printItems: true oneItem: false aspect: #selectedPoint change: #selectedPoint: list: #asWireList menu: #listMenu initialSelection: nil! pinViewOn: aWire "Build a subview to display a picture of aWire." | wireView | wireView _ self new. wireView model: aWire. wir,, 8 formFile.8RP3B B, vsmalltal fY Y y:BՎeView borderWidth: 2. wireView insideColor: Form white. ^wireView! ! selectedPoint: aPoint "Store the selected point. You may want to modify this method to highlight the graphical wire display." selectedPoint _ aPoint! ! !Wire methodsFor: 'optimize'! shorten "Try 20 random changes in the routing order. Keep only changes that shorten the length." 20 timesRepeat: [self shortenStep]! shortenStep "Try one random change in the routing order. Keep only if it shortens the length." ,,????????????????????????????????????????????????????  hardCopyForMary.st.8RP3B B, vsmalltal fY Y y:BՎ'From Smalltalk-80 version T2.1, of December 18, 1984 on 18 December 1984 at 5:33:10 pm'! "Bind the function key labeled F11 to the 'copy display' process"! !InputState class methodsFor: 'class initialization'! initialize "InputState initialize" "Define parameters" BitMin _ 8r200. "Min mouse/keyset bit code" BitMax _ 8r207. "Max mouse/keyset bit code" LshiftKey _ 8r210. RshiftKey _ 8r211. CtrlKey _ 8r212. LockKey _ 8r213. F1 _ 201. "F1 function key code" F12 _ 212. "F12 function key code"! ! InputState initialize! Object subclass: #InputState instanceVariableNames: 'x y bitState lshiftState rshiftState ctrlState lockState metaState keyboardQueue deltaTime baseTime timeProtect ' classVariableNames: 'BitMax BitMin CtrlKey CursorCenterKey F1 F12 InputProcess InputSemaphore LockKey LshiftKey RshiftKey ' poolDictionaries: '' category: 'System-Support'! !InputState methodsFor: 'private'! functionKeyAt: index "Execute the action associated with the function key at index 1 through12. Beޱ ޲ 8 landscape.8RP3B B, vsmalltal fY Y y:BՎ careful to fork off the process at suitable priority. This method is executed at lowIOPriority. " index == 11 ifTrue: [[Form fromUser writeOn: (FillInTheBlank request: 'Name of form to write on' initialAnswer: 'picture.form' )] forkAt: Processor userInterruptPriority]. index == 12 ifTrue: [Cursor currentCursor centerCursorInViewport]! specialKeyAt: index put: value | mask | index = CtrlKey ifTrue: [^ctrlState _ value bitShift: 1]. index = LshiftKey ifTrue: [^lshiftState _ value]. index = RshiftKey ifTrue: [^rshiftState _ value]. index = LockKey ifTrue: [^value == 1 ifTrue: [lockState _ lockState bitXor: 4]]. index = CursorCenterKey ifTrue: [^Cursor currentCursor centerCursorInViewport]. (index >= BitMin and: [index <= BitMax]) ifTrue: [mask _ 1 bitShift: index - BitMin. value = 1 ifTrue: [^bitState _ bitState bitOr: mask] ifFalse: [^bitState _ bitState bitAnd: -1 - mask]]. value ~= 0 ifTrue: [(index >= F1 and: [index <= F12]) ifTrue: ["a function key was just pressed down" self functionKeyAt: index - F1 + 1] ifFalse: [keyboardQueue nextPut: (KeyboardEvent code: index meta: metaState)]]! ! ????????????????????????????????????????????????????????????????????????????????????? :3lunar.ws.8RP3B B, vsmalltal fY Y y:BՎf_Form fromUser. f displayAt: 100@100 f _ Form extent:30@30 f displayAt: Sensor waitButton f _ Form extent:16@16 f bitEdit BitEditor magnifyOnScreen. circleForm_ Form extent:250@250. lunarLandscape writeOn: 'landscape'. lunarLandscape readFrom: 'landscape'. lunarLandscape_Form extent:900@500. lunarLandscape edit. (lunarModule figure) writeOn:'lunarfigure'. (lunarModule shape) writeOn:'lunarshape'. (lunarModule figure) readFrom:'lunarfigure'. (lunarModule shape) readFrom:'lunarshape'. lunarModule_OpaqueForm figure:(Form extent:40@40) shape:(Form extent:40@40). lunarModule bitEdit p_200@200. v_0@0. lunarLandscape displayAt:100@100. lunarModule follow: [a_0@0.2. Sensor yellowButtonPressed ifTrue:[a_a + (0@-2)]. Sensor redButtonPressed ifTrue:[a_a + (-1@0)]. Sensor blueButtonPressed ifTrue:[a_a + (1@0)]. v_v + a. (p_p + v) rounded] while:[Sensor leftShiftDown not]  8 $lunarfigure.8RP3B B, vsmalltal fY Y y:BՎ  7 - myfile.bak.8RP3B B, vsmalltal fY Y y:BՎ(( p8 0`A@A@@@|@@@@ @@ dscape'. lunarLandscape_Form extent:900@500. lunarLandscape edit. (lunarModule figure) writeOn:'lunarfigure'. (lunarModule shape) writeOn:'lunarshape'. (lunarModule figure) readFrom:'lunarfigure'. (lunarModule shape) readFrom:'lunarshape'. lunarModule_OpaqueFo89 :"newfile.ws.8RP3B B, vsmalltal fY Y y:BՎ 8 $lunarshape.8RP3B B, vsmalltal fY Y y:BՎaTime_Time now. aTime_aTime asSeconds. aDay_Date today. bcDay_Date newDay: 2 month: 'July' year: 1959. daysOld_aDay subtractDate: bcDay. aDay asSeconds - bcDay asSeconds. bcDay weekday sum_0. 1959 to: 1986 do: [:x | sum_sum + (Date leapYear: x)].^sum Time now 5:08:21 pm aForm_Form dotOfSize:15. aForm displayAt: Sensor cursorPoint. aPoint_Sensor cursorPoint. [Sensor anyButtonPressed] whileFalse: [bPoint_Sensor cursorPoint. ((aPoint dist:bPoint) >= 15) ifTrue:[aForm displayAt: Sensor cursor(( p8 0`AA@@|@@@@ @@ dscape'. lunarLandscape_Form extent:900@500. lunarLandscape edit. (lunarModule figure) writeOn:'lunarfigure'. (lunarModule shape) writeOn:'lunarshape'. (lunarModule figure) readFrom:'lunarfigure'. (lunarModule shape) readFrom:'lunarshape'. lunarModule_OpaqueFoPoint. aPoint_Sensor cursorPoint.] ] @40). lunarModule bitEdit p_200@200. v_0@0. lunarLandscape displayAt:100@100. lunarModule follow: [a_0@0.2. Sensor yellowButtonPressed ifTrue:[a_a + (0@-2)]. Sensor redButtonPressed ifTrue:[a_a + (-1@0)]. Sensor blueButtonPressed ifTrue:[a_a + (1@0)]. v_v + a. (p_p + v) rounded] while:[Sensor leftShiftDown not] ij :(ourwire.ws.8RP3B B, vsmalltal fY Y y:BՎNP`$. n "p( )=g.3/<4Q/<08NP$. n $0(V.N#3`$. n "p( )=g.3/<4x/<08NP$. n $0(V.N#3`n$. n "p()HH./93/<4/<08NO `6 cg rg~ sg xg ygD`SR`rJf.3/93NX`t-B$.l n #(3 y3 +gn -gf.4/93N(X#3m&.3/93NX.3N`$.3/93/<4/<08NO R`fNN^NuNVHaWire_WireView example. aWire_Wire make:6. aWire shorten. aWire shortenStep. aWire addPin. aWire display. ysOld_aDay subtractDate: bcDay. aDay asSeconds - bcDay asSeconds. bcDay weekday sum_0. 1959 to: 1986 do: [:x | sum_sum + (Date leapYear: x)].^sum Time now 5:08:21 pm aForm_Form dotOfSize:15. aForm displayAt: Sensor cursorPoint. aPoint_Sensor cursorPoint. [Sensor anyButtonPressed] whileFalse: [bPoint_Sensor cursorPoint. ((aPoint dist:bPoint) >= 15) ifTrue:[aForm displayAt: Sensor cursorBnA./. /.NPJfJy3fNrt334.HԂ-B4.H^悴gRn4.H-B.N>-@Jf".3/<4/<08NPp`P4.H./<5 N X4.H./<5N X.5/N .5PN $93g:.5mN .3/<5xN X.3/<5N X`*.3/<5N X.3/<5N X.3/93/<5N P.5N .6N t-B$.⴮lF./.t//.NO -@ڰg".3/<6/<08NPp`-nt-B$.޴l$.Sf3/ 4^!sttops.8RP3B B, vsmalltal fY Y y:BՎ 4.f nHH-B n.00/N TX`.0$.7/N TX n-HHH-B n.00/N TX`.0$.7/N TXR`*.0t /N TXR`.NNp`pN^NuNV.t/t //.NO Jn(. /93/<6A/<08NO p`p n Pg(. /93/<6l/<08NO p`> nJho Jhn(. /93/<6/<08NO p`pN^NuNV.6N .6N .7N .7N .7)N .7?N .# J*0v@g#: TЏ#3/Ho//N8OBN NVH n #3$.S-Bt-B$.l n "p( -g$. n "p( +fV$. n "p()HH `$. n "p( )=g.3/<3/<08NP$. n $0(V.N-@ m dn#3`.3/<3/<08NP`t#3`$. n "p( )=g.3/<4/<08NP$. n $0(V.N-@ m#3`.3/<4+/<087fN .7N .7N .7N .8N .8ON .8N .8N .8N .8N .8N .9N .9@N .9]N .9N .9N N^NuNVt-B$.3l.9N R`.9N N^NuNV.9N .:N N^Nu///?< ONO\ _eB#: Nu///?<$ ONO\ _eB#: Nu/ /й: /?< ONO\ _eX/9: #: NuNV/ O NOd #3p`p _N^NuA|:b #:NOdNBNu#3pNuNVNO NO !NO,` /NO+eNuK0J g HUNXK3f /NOeVNu/// / ?< ONO\ _e:BNuNO,e0BNuNVH@NOe"/gÈY LN^Nu#3p`#3pNuNVH . *n -g p`p-fJg +|*SmR UG(HH `.HH/NZX, f-g.N f| L N^NuNVA./<0N XN^NuNVH8~ n (X-H &n HH(gh %g./N TXR`H-LA.Nt `A-Ht -B|`vt-Bt -B|`dt-Bt-B.gp`p,`H-|:`-|:%t-Btg-g-g-g .N..NJg~-g .Nt*+B t+B`~ L N^NuNVH0*n rfD|R +f z` gp`lz./.NX. fp`L`" wfp|R +f` gp`$t ./.NX. fp` g(.Nt./.NX. fp`` af,<R +f z` gp`z./.NX. fLt ./.NX. fp`l g&.Nt./.NX. fp`@`t.t//NP`p`&N V(@ f .N`./HTN-B|.g .gJg|`B.` Jg|`B.`-|:6.g-SX.g-SX.g./././N O *@X`./././N!O *@X 0fJfR.NB*DЮ&lv .df$.f .f.gR$.Ԕ-Blt-B.f $.SJg.t /N TXR`tgL$.g.t-/N TXR`2.g.t+/N TXR`.g.t /N TXR.g.HH ``.t0/N TXR`d.t0/N TXR.tx/N TXR`>.t0/N TXR.tX/N TXR` og xg XgJo$SJg.t0/N P L0N^NuNVH8*n.. ,.(nzJnp`@,g p`,,g,ft)B g$SJo$,t)B$S(Jofn &x`Jo ,`p&D؀t)B&T$g $SJg`($g".N& f  `S`z$SJop(Jodn &x`Jo ,`p&D؀t)B&T$g $SJg`($g .N& f  `S`R` L8N^NuNVH0$.PSR.(y:B f(|:J#:B#:B:Jt#:N*Tb4f(`$-ԍ*B+G#:B g$ P B` M ` :B TXR`JoHH(g./N TXR`.g $.SJg.t /N TXR``.g-SX.g-SX(X o $.S `p,Jo".f$SJg.t /N TXR`./N TXR.g$SJg.t /N TXR``.g-SX.g-SX*SX.NB&Jl `o .` ,o ` .*&o".f$SJg.t /N TXR` g $SJg.HH/N TXR`Jo$SJg.t /N TXR``0.g-SX.g-SX.t%/N TXR``.g-SX.g-SX-KA.Hn/.f.N*@ fp`(M*U`L0N^NuNVH0..t.N $,g D,$9:F*cSԇ./NX./NXX܀$.N $*@fp`"(M)F g$ P B` L.N 9:BL0N^NuNVH0Jg $.Q B` n*H(y:Bbee cd`(T`g8$-ԍf T$(խ T*`*$,Ԍf $-լ(`(#:BL0N^NuNVt .t//.N!PN^Nu/ /////?< ONOO _eNu#3pNuHpLt4f4fLNu$&HCHAրHCԃ LNuHx"/gt$/`Hx"/gd$/cp`p0NTPހ&n`*n$.Д,$SJg.HH/N TXR`` dg\ ugf ogl xg~ Xg~ cg sg^ %g g8 eg2 Eg( fg gg Gg `B(n` n(gp` L8N^NuNVA ./.N XN^NuNVH *n|-g-fJg l-g-g,.N"Jft.t//-NP f| gBJm -`pD../-/-N,Pfp`p,*+|`|`| L N^NuNVH *n~$- g\-f$i 0JLNu(BDHD 0H@0H@`&( dp0"HAHA؁lSJ` `Hx"/gv$/`Hx"/gf$/c `p0f$i HB0JLNu(BDHD 0B@H@`&( dp0"HAHA؁lք `NuJ` /NOehBNu/// // ?< ONOO _eFNu/////////?<= ONOO _e Nu/// // ?< ONOO _eNu#3pNu/// // ?< ONOO _eBNu /NOeHNu/ o /NO _eNu/ /// ?< ONO\ _eBNu/// / ?</ ONO\ _eBNu/ /////?< ONOO _erNuHNOe"o H0H""LBNuL`L/// // ?< ONOO _e0BNuNV .NO7d #3p`pN^Nu /NO0eBNu#3pNuNV nJf SN^NuNVH *n -g~~-g4-f,.N"Jft.t//-NP f~ g,t.Hn /-N,P f . `p.t+B`Jf.N>+@f~-g4-f,.N"Jft.t//-NP f~ g,t.Hn /-N,P f . `p.t+B`>+|*R Un .NJgp@`p . rxG!`gf(Kf`z +g -Wfg|$ f& 0f(gt Xg xVf8tf2`mv$ot `"vf 0fgd Xg xVfgb 0e6 9b0` Ae Zb7Bd|Ё.HGGfJg"HDBDJgD" gS"LN^Nu nRp`NVA./.NfXJf&.HHO f$.fp`pN^Nu.`~-g-g,.N"Jft.t//-NP f~ gTJo -`pD../-/-N,Pg~`"+|*R Un . .`"+|*R Un . . L N^NuNVH~A./.NfXJf".HHO. g Af~ LN^NuNVH0*n$- g $- 0gp` -f:Jf4.NJg.N>+@f`-g.(|03l ,g,g.N`-g@t.Hn/-N(P. f. `^Jfp`p p`L`J*.//-N(P+@SmR U( ` fp`p pL0N^Nu/ /////?< ONOO _eNu#3pNuNVN^NuNVN^NuNVN^NuNVN^NuNVH8*n(Ut+B+B B-B-B-B-B-g< -fttB`, +fttB`  fttB` #fttB```H |0pHHg&t .Hn$ S/N P+@(nB-` *gp`p@g .fZH |0pHHg"t .HnHTN P+@ (nB-`R *gp`p@g`t+B `B- lgp`p@gGJf$ S B` L+H03stdin%s: 'c' option requires '=n', ignored %s: 'c=' value invalid (n<1|n>100), ignored %s: 's' option requires '=n', ignored %s: 's=' value invalid (<1), ignored %s: 'x' option requires '=n', ignored %s: 'y' option requires '=n', ignored %s: %c option unknown, ignored r-HH L8N^Nu0 HHHHHHHHHH BBBBBB DDDDDD NVH ~*|0 l$- g R` fp` L N^NuNVH *n.. ,.+G+F t+Bt+Bt+B*L N^NuNV./. /.N!PN^NuNVH8..,. *n(n m .NBop`X gJl $D.t(`t(&|:rB*(Jf`*Jg&&./NX(./NXXDЃ5` L8N^NuNV././. /.N O N^Nu NVH?8Lp%s: Could not open file %s %s: Could not allocate memory for line buffer /cbitWidth %d def /cbitHt %d def /dxWidInch cbitWidth 72 div def /dyHtInch cbitHt 72 div def 90 rotate margin %d add margin %d add neg translate margin %d add maxY margin %d add sub translate xDev %d mul yDev %d mul scale 0 dyHtInch inch neg translate doit %s: Error reading bitmap, fread failed %s: Cannot read bitmap file header for %s %s: File %s does not contain a bitmap Form %s: File %s contains invalid bitmap Form %%! %% Tektronix Smalltalk Picture %% save /psdumpsav exch def /inch {72 mul} def gsave initmatrix /margin 0.5 inch def /maxX 8.5 inch def /maxY 11 inch def /defPage {newpath margin dup moveto margin maxY margin sub lineto maxX margin sub maxY margin sub lineto maxX margin sub margin lineto closepath clip} def /devit {dtransform 2 copy dup mul exch dup mul exch add sqrt dup 3 1 roll div 3 1 roll div exch idtransform} def /xDev 1 0 devit pop def /yDev 0 1 devit exch pop def /cbi_write uldiv* ulmodX ulmul ulrdiv ulrmod: CR_VAL:J EDATA:F ___msz:B __allocp0 __iob3 __ioblst3 _copies:J _edata3 _environ3 _errno3 _file3 _fname3 _myname3 _rotate3 _scale3 _sentprolog3 _xpos3 _ypos: end_adr: stack_low_point08 stderr0 stdin0 stdout:t END:J __base:t _endtDepth 1 def /thisfile currentfile def /doit {/picstr cbitWidth 7 add 8 idiv string def dxWidInch inch dyHtInch inch scale {1.0 exch sub} settransfer cbitWidth cbitHt cbitDepth [cbitWidth 0 0 cbitHt neg 0 cbitHt] {thisfile picstr readhexstring pop} image} def defPage copypage showpage psdumpsav restore %% end :t 0123456789abcdef0123456789ABCDEF0123456789NO $$syscall# ETEXT Start V __allocfp __chcodes __exit __fil ^!sttops.c.8RP3B B, vsmalltal fY Y y:BՎlbuf v __fixstk z __fixstk_A0Z __flushbuft __fmtout  __fprtfT __fprtfpl __fscnfp! __itostr __ltostr __setupfp\ __sprtfpd __sscnfp __strtoi __termorpipe _abort _access _alarm _atoi _brk _cdata _close _convertfile _creat _create_contiguous@ _dupP _dup2# _etext _exit _/* * Smalltalk to PostScript converter -- takes a Smalltalk form and converts * it to a form which can be dumped directly to a PostScript printer, * such as the Apple LaserWriter. */ #include #include #include "bitMap.h" /* defines Smalltalk Form file structure */ #ifndef DEBUG #define dprintf() #endif char *myname = NULL; /* name of command */ FILE *file = stdin; /* default input is stdin */ char *fname = "stdin"; /* default input file name */ short sentprolog = 0; /* flag tfclose _fflush _finishup( _fopen _fprintf T _fputc _fread _freef _fstat" _isatty _kill _lrec _lseek8 _main> _malloc _open  _pause _pipe _printf _psfilendr _psheader( _read $ _sbrk R _stack _statB _strlen! _strtol _truncf* _urec _validateheader  _wait, hat header stuff has been output */ int scale = 3; /* default scaling factor */ int copies = 1; /* default number of copies */ int xpos = 0; /* default upper left x,y in points (1/72 inch) */ int ypos = 0; /* these are relative to the margin (.5,.5) */ int rotate = 0; /* flag indicates landscape instead of portrait */ main(argc,argv) int argc; char *argv[]; { int numfiles; int i,j; myname = argv[0]; /* set command name */ numfiles = argc - 1; /* number of possible file names */  for (i = 1; i < argc; i++) { /* process option flags */ if (argv[i][0] == '-' || argv[i][0] == '+') { switch (argv[i][1]) { case 'c': if (argv[i][2] != '=') { /* num copies */ fprintf(stderr, "%s: 'c' option requires '=n', ignored\n", myname); } j = atoi(&(argv[i][3])); if (j >= 1 && j <= 100) { copies = j; } else { fprintf(stderr, "%s: 'c=' value invalid (n<1|n>100), ignored\n", myname); } break; case 'r':check for a valid Form file, send the header prologue if * needed, and then actually convert the bits to hex for the PostScript * reader. */ convertfile(fd, fn) FILE *fd; char *fn; { struct bitMapHeader bhead; /* the Form header */ int bmw, bmh; /* height & width of bitmap in bytes */ char *lbuf, *bp; /* line buffer & pointer */ int l, b; /* line and byte counters */ int i; /* scratch variable */ short extra = 0; /* set if extra null byte */ if (validateheader(fd, fn,  rotate = 1; /* landscape */ break; case 's': if (argv[i][2] != '=') { /* scale factor */ fprintf(stderr, "%s: 's' option requires '=n', ignored\n", myname); } j = atoi(&(argv[i][3])); if (j >= 1) { scale = j; } else { fprintf(stderr, "%s: 's=' value invalid (<1), ignored\n", myname); } break; case 'x': if (argv[i][2] != '=') { /* xpos */ fprintf(stderr, "%s: 'x' option requires '=n', ignore&bhead) == 0) { if (sentprolog == 0) { psheader(); /* send the header */ sentprolog = 1; } bmw = 2*((bhead.width+15)/16); /* convert to even bytes */ if ((bhead.width+7)/8 != bmw) { extra++; dprintf("bmw = %d, bytes = %d\n", bmw, (bhead.width+7)/8); } bmh = bhead.height; lbuf = (char *)malloc(bmw); /* make a line buffer */ if (lbuf == NULL) { fprintf(stderr, "%s: Could not allocate memory for line buffer\n", myname); return(1); } dprintf("malloc for line buf returd\n", myname); } xpos = atoi(&(argv[i][3])); break; case 'y': if (argv[i][2] != '=') { /* ypos */ fprintf(stderr, "%s: 'y' option requires '=n', ignored\n", myname); } ypos = atoi(&(argv[i][3])); break; default: fprintf(stderr, "%s: %c option unknown, ignored\n", myname, argv[i][1]); break; } numfiles--; } } if (numfiles == 0) { /* if no file names, use stdin */ dprintf("No args, using stdin\n"); convened %x\n", lbuf); /* output PostScript definitions */ printf("/cbitWidth %d def\n", bhead.width); printf("/cbitHt %d def\n", bhead.height); printf("/dxWidInch cbitWidth 72 div def\n"); printf("/dyHtInch cbitHt 72 div def\n"); if (rotate) { printf("90 rotate\n"); printf("margin %d add ", xpos); printf("margin %d add neg translate\n", ypos); } else { printf("margin %d add ", xpos); printf("maxY margin %d add sub translate\n", ypos); } printf("xDev %d mul yDev %d mul srtfile(file, fname); } else { /* have args, loop through them */ dprintf("Found args, using each in turn\n"); for (i = 1; i < argc; i++) { fname = argv[i]; if (*fname != '+' && *fname != '-') { /* make sure not opt */ dprintf("Using file '%s'\n", fname); if ((file = fopen(fname, "r")) >= 0) { convertfile(file, fname); fclose(file); } else { fprintf(stderr, "%s: Could not open file %s\n", myname, fname); } } } } finishup(); } /* * convertfile -- cale\n", scale, scale); printf("0 dyHtInch inch neg translate\n"); printf("doit\n"); /* now for the hex image */ for (l = 0; l < bmh; l++) { /* step through the lines */ i = fread(lbuf, sizeof(char), bmw, fd); if (i != bmw) { fprintf(stderr, "%s: Error reading bitmap, fread failed\n", myname); return(1); } bp = lbuf; for (b = 0; b < bmw; b++) { /* step through the bytes */ if (b == bmw-1 && extra) continue; /* don't ship extra null byte */ i = (*bp >> 4) & 0xf; if (i <=9) putchar(i + '0'); else putchar(i - 10 + 'A'); i = *bp++ & 0xf; if (i <= 9) putchar(i + '0'); else putchar(i - 10 + 'A'); } putchar('\n'); } free(lbuf); psfilend(); /* send whatever is needed after a file */ return(0); } return(1); } /* * validateheader -- read in the Form file header and verify that it meets the * correct format. Return non-zero if not valid. */ validateheader(fd, fn, hd) FILE *fd; char *fn; struct bitMapHeader *hd; { if (frh inch dyHtInch inch scale\n"); printf(" {1.0 exch sub} settransfer\n"); printf(" cbitWidth cbitHt cbitDepth [cbitWidth 0 0 cbitHt neg 0 cbitHt]\n"); printf(" {thisfile picstr readhexstring pop} image} def\n\n"); /* clip to 8.5x11 page with 1/2 inch margins */ printf("defPage\n"); } psfilend() { int i; for (i = 1; i < copies; i++) { printf("copypage\n"); } printf("showpage\n"); } finishup() { printf("psdumpsav restore\n"); printf("%% end\n"); } #ifdef DEBUGead(hd, sizeof(struct bitMapHeader), 1, fd) <= 0) { fprintf(stderr, "%s: Cannot read bitmap file header for %s\n", myname, fn); return(1); } if (hd->id != ID_FORM) { fprintf(stderr, "%s: File %s does not contain a bitmap Form\n", myname, fn); return(1); } if (hd->width <= 0 || hd->height <= 0) { fprintf(stderr, "%s: File %s contains invalid bitmap Form\n", myname, fn); return(1); } return(0); } /* * psheader -- the postscript header code to act as prologue to dprintf(a1,a2,a3,a4,a5,a6,a7,a8) char *a1,*a2,*a3,*a4,*a5,*a6,*a7,*a8; { fprintf(stderr, "DBG: "); fprintf(stderr, a1,a2,a3,a4,a5,a6,a7,a8); fflush(stderr); } #endif dth+7)/8 != bmw) { extra++; dprintf("bmw = %d, bytes = %d\n", bmw, (bhead.width+7)/8); } bmh = bhead.height; lbuf = (char *)malloc(bmw); /* make a line buffer */ if (lbuf == NULL) { fprintf(stderr, "%s: Could not allocate memory for line buffer\n", myname); return(1); } dprintf("malloc for line buf retur the form info. */ psheader() { printf("%%!\n%% Tektronix Smalltalk Picture\n%%\n"); printf("save /psdumpsav exch def\n"); printf("/inch {72 mul} def\n"); printf("gsave initmatrix\n"); printf("/margin 0.5 inch def\n"); printf("/maxX 8.5 inch def /maxY 11 inch def\n"); printf("/defPage {newpath margin dup moveto\n"); printf(" margin maxY margin sub lineto\n"); printf(" maxX margin sub maxY margin sub lineto\n"); printf(" maxX margin sub margin lineto closepaz { 7 * textFile.8RP3B B, vsmalltal fY Y y:BՎth clip} def\n"); /* to calculate number of device units per 72nd of an inch */ printf("/devit {dtransform 2 copy dup mul exch dup mul exch add sqrt\n"); printf(" dup 3 1 roll div 3 1 roll div exch idtransform} def\n"); printf("/xDev 1 0 devit pop def\n"); printf("/yDev 0 1 devit exch pop def\n"); printf("/cbitDepth 1 def\n"); /* B&W only, no greyscale */ printf("/thisfile currentfile def\n"); printf("/doit {/picstr cbitWidth 7 add 8 idiv string def\n"); printf(" dxWidInc This is a sample text file for you to "play" with. Use the middle button menu to edit the contents of this file. You might try putting in tabs, changing fonts (use ctrl key with 1, 2, 3, ... to see what fonts are available) and correcting some of the mistakes you see hear. Since some of the mistakes are repeated, try using "again" to find all occurrences and correct them. { printf("margin %d add ", xpos); printf("maxY margin %d add sub translate\n", ypos); } printf("xDev %d mul yDev %d mul sz { 7 * textFile.bak.8RP3B B, vsmalltal fY Y y:BՎild: hTree. TreeView openViewOf: aTree. aTree inspect. nslate\n"); printf("doit\n"); /* now for the hex image */ for (l = 0; l < bmh; l++) { /* step through the lines */ i = fread(lbuf, sizeof(char), bmw, fd); if (i != bmw) { fprintf(stderr, "%s: Error reading bitmap, fread failed\n", myname); return(1); } bp = lbuf; for (b = 0; b < bmw; b++) { /* step through the bytes */ if (b == bmw-1 && extra) continue; /* don't ship extra null byte */ i = (*bp > This is a sample text file for you to "play" with. Use the middle button menu to edit the contents of this file. You might try putting in tabs, changing fonts (use ctrl key with 1, 2, 3, ... to see what fonts are available) and crroecting some of the misteaks you si hear. Since some of the misteaks are repeated, try using "again" to find all occurrences and crroect them. { printf("margin %d add ", xpos); printf("maxY margin %d add sub translate\n", ypos); } printf("xDev %d mul yDev %d mul s : usercChanges.8RP3B B, vsmalltal fY Y y:BՎ78 :"tree.ws.8RP3B B, vsmalltal fY Y y:BՎ SourceFiles _ Array new: 2. SourceFiles at: 1 put: (FileStream oldFileNamed: '/smalltalk/system/standardSources.VersionT2.1.2a'). SourceFiles at: 2 put: (FileStream oldFileNamed: '/userc/usercChanges'). (SourceFiles at: 1) readOnly. ! '----SNAPSHOT---- to /userc/usercImage: (16 June 1986 2:42:54 pm )'! !Circle class methodsFor: 'examples'! exampleOne "Click any button somewhere on the screen. The point will be the center of the circle of radius 150." | aCircle aForm | aForm _ Form new extent: 1 aString_String new. aString isaPalindrome: 'abab'. false 'Ctcpwrfgle gq yl mzhcar' caesarRundown aTree _ Tree withLabel: 'A'. bTree _ Tree withLabel: 'B'. cTree _ Tree withLabel: 'C'. dTree _ Tree withLabel: 'D'. eTree _ Tree withLabel: 'E'. fTree _ Tree withLabel: 'F'. gTree _ Tree withLabel: 'G'. hTree _ Tree withLabel: 'H'. aTree addLeftChild: bTree. cTree addLeftChild: eTree. bTree addLeftChild: dTree. cTree addRightChild: fTree. aTree addRightChild: cTree. dTree addLeftChild: gTree. dTree addRightCh@30. aForm gray. aCircle _ Circle new. aCircle form: aForm. aCircle radius: 150. aCircle center: Sensor waitButton. aCircle displayOn: Display "Circle exampleOne."! ! 3 + 2! 3 + 2! 3 + 2 * 5! 3 factorial! 2 sqrt! (2 @ 3)transpose! (2 @ 3)transpose! Spline example! Spline example! Line example! LinearFit example! Circle exampleOne! Curve example! Curve example! Curve example! Curve example! Circle exampleTwo! Circle exampleTwo! Circle exampleTwo! Circle exampleTwo! Circle exampleTwo! Circle exampleTwo! Circle exampleTwo! Circle exampleTwo! Circle exampleTwo! Circle exampleTwo! 3.14 rounded! 16 sqrt! 173 sqrt rounded! 173 sqrt rounded even! 20@30 dist: 40@50! sum _ 0. #(1 2 3 4 5) do: [:x | sum _ sum + (x factorial)].! sum _ 0. #(1 2 3 4 5) do: [:x | sum _ sum + (x factorial)]. ^ sum! Object subclass: #Tree instanceVariableNames: 'label leftChild rightChild ' classVariableNames: '' poolDictionaries: '' category: 'Tree-Application'! Tree comment: 'Each instance of Label "This method answers the question: Does the sub-tree rooted at the receiver contain a node labelled with aLabel? It returns a boolean." self label = aLabel ifTrue: [^true]. rightChild isNil & leftChild isNil ifTrue: [^false]. leftChild isNil ifTrue: [^rightChild contains: aLabel]. rightChild isNil ifTrue: [^leftChild contains: aLabel]. ^(leftChild contains: aLabel) | (rightChild contains: aLabel)! ! !Tree methodsFor: 'testing'! isLeaf "Is this node a leaf" ^leftChild isNil & rightChilthis class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a pointer to the right sub-tree. parent This is a pointer to the parent of this node.'! Tree comment: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its id isNil! ! !Tree methodsFor: 'testing'! numberOfNodes "This method returns the number of nodes in this sub-tree." ^ 1 + (leftChild isNil ifTrue: [0] ifFalse: [leftChild numberOfNodes]) + (rightChild isNil ifTrue: [0] ifFalse: [rightChild numberOfNodes])! ! !Tree methodsFor: 'tree functions'! remove: aLabel "Search the tree whose root is the receiver for a node labelled with aLabel and remove that node. Return the modified tree's new root." "Unimplemented..." self error: 'This messnstance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a pointer to the right sub-tree. parent This is a pointer to the parent of this node.'! !Tree methodsFor: 'access'! label "Return a copy of the value of the instance variable 'label'." ^label copy! ! !Tree methodsFor: 'access'! label: aString "Set the label ofage is not implemented.'! ! !Tree methodsFor: 'tree functions'! removeRoot "This method returns a sub-tree containing all the nodes in the tree whose root is the receiver, except the root node. If the left sub-tree is nil, it just returns the right sub-tree. Otherwise, it adds the right sub-tree as the right child of the left sub-tree's right-most descendent and returns the modified left sub-tree." (leftChild isNil) ifTrue: [^rightChild] ifFalse: [leftChild rightMostDescendent rightChild: r this Node" label _ aString copy.! ! !Tree methodsFor: 'access'! leftChild "Return the left sub-tree of the receiver." ^leftChild! ! !Tree methodsFor: 'access'! leftChild: aTree "Set the receiver's left sub-tree to aTree." leftChild _ aTree! ! !Tree methodsFor: 'access'! rightChild "Return the right sub-tree of the receiver." ^rightChild! ! !Tree methodsFor: 'access'! rightChild: aTree "Set the receiver's right sub-tree to aTree." rightChild _ aTree! ! !Tree methodsFor: 'testing'! contains: aightChild. ^leftChild].! ! !Tree methodsFor: 'tree functions'! rightMostDescendent "Return the right-most descendent of the receiver." | aTree | aTree _ self. [aTree rightChild isNil] whileFalse: [aTree _ aTree leftChild]. ^ aTree! ! !Tree methodsFor: 'printing'! printOn: aStream "This method prints a textual representation of the sub-tree rooted at the receiver on aStream." self isLeaf ifTrue: [^ label printOn: aStream]. label printOn: aStream. aStream nextPutAll: ' withLeft: ('. (leftChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [leftChild printOn: aStream.]. aStream nextPutAll: ') withRight: ('. (rightChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [rightChild printOn: aStream.]. aStream nextPutAll: ')'! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tree class instanceVariableNames: ''! !Tree class methodsFor: 'instance creation'! withLabel: aString "This method returns a new Tree with its label initialized to aString and with no childable 'label'." ^label copy! ! !Tree methodsFor: 'access'! label: aString "Set the label of this Node" label _ aString copy.! ! !Tree methodsFor: 'access'! leftChild "Return the left sub-tree of the receiver." ^leftChild! ! !Tree methodsFor: 'access'! leftChild: aTree "Set the receiver's left sub-tree to aTree." leftChild _ aTree! ! !Tree methodsFor: 'access'! rightChild "Return the right sub-tree of the receiver." ^rightChild! ! !Tree methodsFor: 'access'! rightChild: aTree "Set the receiverren." | tree | tree _ Tree new. tree label: aString copy. ^ tree! ! !Tree class methodsFor: 'instance creation'! withLabel: aLabel withLeft: left withRight: right "Create a node with aLabel. Left and right should be either sub-trees or nil. Add them as children to this node. Return the result." | tree | tree _ Tree new. tree label: aLabel copy. tree leftChild: left. tree rightChild: right. ^ tree! ! Object subclass: #Tree instanceVariableNames: 'label leftChild rightChild ' classVariableNa's right sub-tree to aTree." rightChild _ aTree! ! !Tree methodsFor: 'testing'! contains: aLabel "This method answers the question: Does the sub-tree rooted at the receiver contain a node labelled with aLabel? It returns a boolean." self label = aLabel ifTrue: [^true]. rightChild isNil & leftChild isNil ifTrue: [^false]. leftChild isNil ifTrue: [^rightChild contains: aLabel]. rightChild isNil ifTrue: [^leftChild contains: aLabel]. ^(leftChild contains: aLabel) | (rightChild contains: aLabel)!mes: '' poolDictionaries: '' category: 'Tree-Application'! Tree comment: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a pointer to the right sub-tree. parent This is a pointer to the parent of this node.'! Tree commen ! !Tree methodsFor: 'testing'! isLeaf "Is this node a leaf" ^leftChild isNil & rightChild isNil! ! !Tree methodsFor: 'testing'! numberOfNodes "This method returns the number of nodes in this sub-tree." ^ 1 + (leftChild isNil ifTrue: [0] ifFalse: [leftChild numberOfNodes]) + (rightChild isNil ifTrue: [0] ifFalse: [rightChild numberOfNodes])! ! !Tree methodsFor: 'tree functions'! remove: aLabel "Search the tree whose root is the receiver for a node labelled with aLabel and remove tt: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a pointer to the right sub-tree. parent This is a pointer to the parent of this node.'! !Tree methodsFor: 'access'! label "Return a copy of the value of the instance varihat node. Return the modified tree's new root." "Unimplemented..." self error: 'This message is not implemented.'! ! !Tree methodsFor: 'tree functions'! removeRoot "This method returns a sub-tree containing all the nodes in the tree whose root is the receiver, except the root node. If the left sub-tree is nil, it just returns the right sub-tree. Otherwise, it adds the right sub-tree as the right child of the left sub-tree's right-most descendent and returns the modified left sub-tree." (leftChild  isNil) ifTrue: [^rightChild] ifFalse: [leftChild rightMostDescendent rightChild: rightChild. ^leftChild].! ! !Tree methodsFor: 'tree functions'! rightMostDescendent "Return the right-most descendent of the receiver." | aTree | aTree _ self. [aTree rightChild isNil] whileFalse: [aTree _ aTree leftChild]. ^ aTree! ! !Tree methodsFor: 'printing'! printOn: aStream "This method prints a textual representation of the sub-tree rooted at the receiver on aStream." self isLeaf ifTrue: [^ lisplayAt: Sensor waitButton! f _ Form extent:16@16! f displayAt: 100@100! BitEditor magnifyOnScreen! BitEditor magnifyOnScreen! circleForm_ Form extent:25@25! circleForm_ Form extent:25@25. aCircle _ Circle new. aCircle radius:12. aCircle center:12@12. aCircle displayOn: circleForm. ! circleForm_ Form extent:25@25. aCircle _ Circle new. aCircle radius:12. aCircle center:12@12. aCircle displayOn: circleForm. ! circleForm_ Form extent:25@25. aCircle _ Circle new. aCircle radius:12. aCircle centerabel printOn: aStream]. label printOn: aStream. aStream nextPutAll: ' withLeft: ('. (leftChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [leftChild printOn: aStream.]. aStream nextPutAll: ') withRight: ('. (rightChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [rightChild printOn: aStream.]. aStream nextPutAll: ')'! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tree class instanceVariableNames: ''! !Tree class methodsFor: 'instance creation'! withLabel: aSt:12@12. aCircle displayOn: circleForm. ! circleForm_ Form extent:25@25. aCircle _ Circle new. aCircle radius:12. aCircle center:12@12. aCircle displayOn: circleForm. circleForm display.! aCircle display.! aCircle display.! circleForm_ Form extent:25@25. aCircle _ Circle new. aCircle radius:12. aCircle center:120@120. aCircle displayOn: circleForm. circleForm display. ! circleForm_ Form extent:250@250. aCircle _ Circle new. aCircle radius:12. aCircle center:120@120. aCircle displayOn: circleForm. circring "This method returns a new Tree with its label initialized to aString and with no children." | tree | tree _ Tree new. tree label: aString copy. ^ tree! ! !Tree class methodsFor: 'instance creation'! withLabel: aLabel withLeft: left withRight: right "Create a node with aLabel. Left and right should be either sub-trees or nil. Add them as children to this node. Return the result." | tree | tree _ Tree new. tree label: aLabel copy. tree leftChild: left. tree rightChild: right. ^ tree! ! leForm display. ! aForm writeOn: 'formFile'! aForm_ Form readFrom:'formFile'! lunarLandscape writeOn: 'patfile'.! (lunarModule figure) writeOn:'lunarfigure'. (lunarModule shape) writeOn:'lunarshape'.! lunarLandscape writeOn: 'landscape'.! p_200@200. v_0@0. lunarLandscape displayAt:100@100. lunarModule follow: [a_0@0.2. Sensor yellowButtonPressed ifTrue:[a_a + (0@-2)]. Sensor redButtonPressed ifTrue:[a_a + (-1@0)]. Sensor blueButtonPressed ifTraTree _ Tree new.! aTree leftChild: 'newLeft'.! aTree leftChild: 'newLeft'.! '----SNAPSHOT---- to /userc/trees: (17 June 1986 5:07:56 pm )'! f _ Form fromUser! f displayAt: 100@100! f_Form fromUser! f displayAt: 100@100! f_Form fromUser. f displayAt: 100@100 ! f_Form fromUser. f displayAt: 100@100 ! f_Form fromUser. f displayAt: 100@100 ! f _ Form extent:30@30! f displayAt: Sensor waitButton! f displayAt: Sensor waitButton! f displayAt: Sensor waitButton! f displayAt: Sensor waitButton! f due:[a_a + (1@0)]. v_v + a. (p_p + v) rounded] while:[Sensor leftShiftDown not]! p_200@200. v_0@0. lunarLandscape displayAt:100@100. lunarModule follow: [a_0@0.2. Sensor yellowButtonPressed ifTrue:[a_a + (0@-2)]. Sensor redButtonPressed ifTrue:[a_a + (-1@0)]. Sensor blueButtonPressed ifTrue:[a_a + (1@0)]. v_v + a. (p_p + v) rounded] while:[Sensor leftShiftDown not]! p_200@200. v_0@0. lunarLandscape displayAt:100@100. lunarModule foll ow: [a_0@0.2. Sensor yellowButtonPressed ifTrue:[a_a + (0@-2)]. Sensor redButtonPressed ifTrue:[a_a + (-1@0)]. Sensor blueButtonPressed ifTrue:[a_a + (1@0)]. v_v + a. (p_p + v) rounded] while:[Sensor leftShiftDown not]! '----SNAPSHOT---- to /userc/lunarImage: (18 June 1986 12:16:17 pm )'! '----SNAPSHOT---- to /userc/lunarImage: (18 June 1986 1:26:37 pm )'! lunarLandscape_Form extent:900@500.! lunarLandscape_Form extent:900@500.! ^Time dateAndnyButtonPressed] whileFalse: [bPoint_Sensor cursorPoint. ((aPoint dist:bPoint) >= 15) ifTrue:[aForm displayAt: Sensor cursorPoint. aPoint_Sensor cursorPoint.] ]! '----SNAPSHOT---- to /userc/bcImage: (18 June 1986 5:23:01 pm )'! String organization addCategory: 'dummy protocal' asSymbol before: nil! String organization removeCategory: 'dummy protocal' asSymbol! String organization addCategory: 'dummy protocol' asSymbol before: #private! !String methodsFor: 'dummy protocol'! TimeNow! ^Time dateAndTimeNow! ^Date newDay: 1000000 year: 1901 ! ^Date leapYear: 2000! Date indexOfMonth: #September! Date daysInMonth: #February forYear: 1984! Date daysInMonth: #February forYear: 1900! Date nameOfDay: 3! Date nameOfMonth:5 ! ^Time dateAndTimeNow! 'this is some text' displayOn: Display at: Sensor waitButton ! aDate_Date today! aDate_Date dateAndTimeNow ! aTime_Time totalSeconds! aTime_Time now.! aTime asSeconds.! aTime_Time now.! aTime asSeconds.! aTime_Time now. isaPalindrome: aString "test a string to see if it is identical forward and backward" | newString j | newString_String new: aString size. j_aString size. 1 to: newString size do:[:i | newString at: j put: (aString at: i). j_j-1.]. ^(aString sameAs: newString) ! ! 'abba' sameAs: 'abba'.! !String methodsFor: 'dummy protocol'! isaPalindrome: aString "test a string to see if it is identical forward and backward" | newString j | newString_String new: aString size. j_aStri aTime asSeconds.! aTime_Time now. ! aTime_Time now. ! aTime_aTime asSeconds.! aTime_Time now. aTime_aTime asSeconds. ! aTime_Time now. aTime_aTime asSeconds. ! aDay_Date today. bcDay_Date newDay: 2 month: 'July' year: 1959. daysOld_aDay subtractDate: bcDay.! aDay asSeconds - bcDay asSeconds.! bcDay weekday! sum_0. 1959 to: 1986 do: [:x | sum_sum + (Date leapYear: x)].^sum ! Time now! aForm_Form dotOfSize:15! aForm_Form dotOfSize:15. aForm displayAt: Sensor cursorPoint! Time now! Timeng size. 1 to: newString size do:[:i | newString at: j put: (aString at: i). j_j-1.]. ^(aString sameAs: newString) ! ! !String methodsFor: 'dummy protocol'! isaPalindrome: aString "test a string to see if it is identical forward and backward" | newString j | newString_String new: aString size. j_aString size. self halt. 1 to: newString size do:[:i | newString at: j put: (aString at: i). j_j-1.]. ^(aString sameAs: newString) ! ! !String methodsFor: 'dummy protocol' now ! (aPoint dist:bPoint) >= 15! Sensor anyButtonPressed! Smalltalk browseChangedMessages ! Sensor anyButtonPressed! aForm_Form dotOfSize:15. aForm displayAt: Sensor cursorPoint. aPoint_Sensor cursorPoint. [Sensor anyButtonPressed] whileFalse: [bPoint_Sensor cursorPoint. ((aPoint dist:bPoint) >= 15) ifTrue:[aForm displayAt: Sensor cursorPoint. aPoint_Sensor cursorPoint.] ]! aForm_Form dotOfSize:15. aForm displayAt: Sensor cursorPoint. aPoint_Sensor cursorPoint. [Sensor a! isaPalindrome: aString "test a string to see if it is identical forward and backward" | newString j | newString _ String new: aString size. j _ aString size. self halt. 1 to: newString size do: [:i | newString at: j put: (aString at: i). j _ j - 1]. ^aString sameAs: newString! ! !String methodsFor: 'dummy protocol'! isaPalindrome: aString "test a string to see if it is identical forward and backward" | newString j | newString _ String new: aString size. j _ aString size. 1 to: ne!wString size do: [:i | newString at: j put: (aString at: i). j _ j - 1]. ^aString sameAs: newString! ! aString_String new. aString isaPalindrome: 'abba'. ! aString_String new. aString isaPalindrome: 'abab'. ! !String methodsFor: 'dummy protocol'! ceaserCipher: anInteger "Answer the string with the letters rotated by anInteger. A primitive encoding scheme. Example: 'Hello' ceaserCipher: 2 would return 'Jgnnq'." | aString | aString_ String new: self size. 1 to: self size do: [:i" | aString | aString _ String new: self size. 1 to: self size do: [:index | aString at: index put: ((self at: index) rotate: anInteger)]. ^aString! ! String removeSelector: #ceaserCipher:! !String methodsFor: 'dummy protocol'! caesarRundown "Try all of the caesarCiphers (1 to 26) to decode a message." 1 to: 26 do:[:i | Transcript cr;show: (self caesarCipher: i)]! ! !String methodsFor: 'dummy protocol'! caesarRundown "Try all of the caesarCiphers (1 to 26) to decode a message." 1 to: 26 dndex | aString_aString at: index put: (( self at: index) rotate: anInteger)]. ^aString! ! !String methodsFor: 'dummy protocol'! ceaserCipher: anInteger "Answer the string with the letters rotated by anInteger. A primitive encoding scheme. Example: 'Hello' ceaserCipher: 2 would return 'Jgnnq'." | aString | aString _ String new: self size. 1 to: self size do: [:index | aString at: index put: ((self at: index) rotate: anInteger)]. ^aString! ! !String methodsFor: 'dummy protocoo: [:i | Transcript cr; show: (self caesarCipher: i)]! ! !String methodsFor: 'dummy protocol'! caesarCipher: anInteger "Answer the string with the letters rotated by anInteger. A primitive encoding scheme. Example: 'Hello' caesarCipher: 2 would return 'Jgnnq'." | aString | aString _ String new: self size. 1 to: self size do: [:index | aString at: index put: ((self at: index) rotate: anInteger)]. ^aString! ! Character organization addCategory: #rotating before: nil! !Characl'! rotate: anInteger "do the right thing" | capA a | capA_$A asInteger. a_$a asInteger. self isLetter ifTrue:[self isUppercase ifTrue:[^(self asInteger - capA + anInteger \\ 26 + capA) asCharacter] ifFalse:[^(self asInteger - a + anInteger \\ 26 + a) asCharacter]] ifFalse:[^self]! ! !String methodsFor: 'dummy protocol'! rotate: anInteger "do the right thing" | capA a | capA _ $A asInteger. a _ $a asInteger. self isLetter ifTrue: [self isUppercase ifTrue: [^(self asInteger - capA + anIntter methodsFor: 'rotating'! rotate: anInteger "do the right thing" | capA a | capA _ $A asInteger. a _ $a asInteger. self isLetter ifTrue: [self isUppercase ifTrue: [^(self asInteger - capA + anInteger \\ 26 + capA) asCharacter] ifFalse: [^(self asInteger - a + anInteger \\ 26 + a) asCharacter]] ifFalse: [^self]! ! String removeSelector: #rotate:! 'Ctepwrigle gq yl mzhcar' caesarRundown! !String methodsFor: 'dummy protocol'! caesarRundown "Try all of the caesarCiphers (1 to 26) to deceger \\ 26 + capA) asCharacter] ifFalse: [^(self asInteger - a + anInteger \\ 26 + a) asCharacter]] ifFalse: [^self]! ! !String methodsFor: 'dummy protocol'! caesarRundown "Try all of the caesarCiphers (1 to 26) to decode a message." 1 to: 26 do:[:i | self caesarCipher: i] ! ! !String methodsFor: 'dummy protocol'! caesarCipher: anInteger "Answer the string with the letters rotated by anInteger. A primitive encoding scheme. Example: 'Hello' ceaserCipher: 2 would return 'Jgnnq'.ode a message." 1 to: 26 do: [:i | Transcript cr; show: (self caesarCipher: i)]. ^'Done'! ! !String methodsFor: 'dummy protocol'! caesarRundown "Try all of the caesarCiphers (1 to 26) to decode a message." 1 to: 26 do: [:i | Transcript cr; show: (self caesarCipher: i)]. ^'Done'! ! 'Ctcpwregle gq yl mzhcar' caesarRundown ! 'Ctcpwregle gq yl mzhcar' caesarRundown! 'Ctcpwrfgle gq yl mzhcar' caesarRundown ! !String methodsFor: 'dummy protocol'! caesarRundown "Try all of the caesarCiphers (1 to 26) t!odel containsPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter New Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: node label useCRController: true. node label: newLabel]]. self view display! ! !TreeController methodsFor: 'menu messages'! removeNode "This method implements the 'remove node' menu selection." | node | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint the corresponding message sends.'! TreeController comment: 'This class provides a specialization of MouseMenuController to be used by TreeView in displaying a view of a tree. It takes care of presenting menus when appropriate and performing the corresponding message sends.'! !TreeController methodsFor: 'menu messages'! addLeftChild "This method implements the 'add left child' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model containsPoint: Sensor : Sensor waitButton]. node ~~ nil ifTrue: [ view model: (model removeNode: node)]]. self view display! ! !TreeController methodsFor: 'menu messages'! removeRoot "This method implements the 'remove root' menu selection." model notNil ifTrue: [view model: (model removeRoot)]. self view display! ! !TreeController methodsFor: 'menu messages'! startNewTree "Interactively spawn a new tree in a new view." | newTree | newTree _ Tree withLabel: ''. TreeView openViewOf: newTree! ! !TreeController mwaitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. node addLeftChild: (Tree withLabel: newLabel)]]. self view display! ! !TreeController methodsFor: 'menu messages'! addRightChild "This method implements the 'add right child' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ model contaethodsFor: 'menu messages'! traverseTree "Does an in order (left to right) traversal of a tree, high lighting each node" model traverseTree! ! !TreeController methodsFor: 'control defaults'! isControlActive ^super isControlActive & sensor blueButtonPressed not! ! !TreeController methodsFor: 'initialize'! initialize super initialize. self initializeYellowButtonMenu! ! !TreeController methodsFor: 'private'! initializeYellowButtonMenu self yellowButtonMenu: TreeYellowButtonMenu yellowButtonMessages:insPoint: Sensor waitButton]. node notNil ifTrue: [ FillInTheBlank request: 'Enter Node''s Label:' displayAt: Sensor cursorPoint centered: true action: [:newLabel | ] initialAnswer: 'X' useCRController: true. node addRightChild: (Tree withLabel: newLabel)]]. self view display! ! !TreeController methodsFor: 'menu messages'! changeLabel "This method implements the 'change label' menu selection." | node newLabel | model notNil ifTrue: [Cursor crossHair showWhile: [node _ m TreeYellowButtonMessages.! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeController class instanceVariableNames: ''! !TreeController class methodsFor: 'class initialization'! initialize "Initialize the menu for the yellow mouse button." TreeYellowButtonMenu _ PopUpMenu labels: 'Remove Node Add Left Child Add Right Child Change Label Traverse Tree Start New Tree Remove Root'. TreeYellowButtonMessages _ #(removeNode addLeftChild addRightChild changeLabel traverseTree startNewTree re"moveRoot ) "TreeController initialize"! ! TreeController initialize! Object subclass: #Tree instanceVariableNames: 'label leftChild rightChild parent whereLastDisplayed ' classVariableNames: 'HiLitedNodeIcon NodeIcon ' poolDictionaries: '' category: 'Tree-Application'! Tree comment: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the turn the left sub-tree of the receiver." ^leftChild! ! !Tree methodsFor: 'access'! parent "Return the parent of the receiver." ^parent! ! !Tree methodsFor: 'access'! rightChild "Return the right sub-tree of the receiver." ^rightChild! ! !Tree methodsFor: 'testing'! contains: aLabel "This method answers the question: Does the sub-tree rooted at the receiver contain a node labelled with aLabel? It returns a boolean." self label = aLabel ifTrue: [^true]. rightChild isNil & leftChild isNil ifTrue: [label on this node. leftChild This is a pointer to the left sub-tree. rightChild This is a pointer to the right sub-tree. parent This is a pointer to the parent of this node.'! Tree comment: 'Each instance of this class corresponds to a sub-tree where each node is labelled. Its instance variables contain pointers to the parent, children and label of the sub-tree''s root node. label This is the label on this node. leftChild This is a pointer to the left sub^false]. leftChild isNil ifTrue: [^rightChild contains: aLabel]. rightChild isNil ifTrue: [^leftChild contains: aLabel]. ^(leftChild contains: aLabel) | (rightChild contains: aLabel)! ! !Tree methodsFor: 'testing'! isLeaf "Is this node a leaf" ^leftChild isNil & rightChild isNil! ! !Tree methodsFor: 'testing'! numberOfNodes "This method returns the number of nodes in this sub-tree." ^ 1 + (leftChild isNil ifTrue: [0] ifFalse: [leftChild numberOfNodes]) + (rightChild isNil ifTrue: [0]-tree. rightChild This is a pointer to the right sub-tree. parent This is a pointer to the parent of this node.'! !Tree methodsFor: 'access'! addLeftChild: aTree "This method first removes aTree from whatever tree it is already in (if any) and then it adds it as the left child of the receiver." leftChild notNil ifTrue: [leftChild remove]. aTree notNil ifTrue: [aTree remove. aTree parent: self]. leftChild _ aTree! ! !Tree methodsFor: 'access'! addRightChild: aTree "This method f ifFalse: [rightChild numberOfNodes])! ! !Tree methodsFor: 'tree functions'! remove: aLabel "Search the tree whose root is the receiver for a node labelled with aLabel and remove that node. Return the modified tree's new root." ^ self "Unimplemented..."! ! !Tree methodsFor: 'tree functions'! removeNode: aNode "This method is passed aNode. It searches the sub-tree self for the node and removes it. (It does not remove the children of aNode.) If the tree contains aNode, it returns the modified subirst removes aTree from whatever tree it is already in (if any) and then it adds it as the right child of the receiver." rightChild notNil ifTrue: [rightChild remove]. aTree notNil ifTrue: [aTree remove. aTree parent: self]. rightChild _ aTree! ! !Tree methodsFor: 'access'! label "Return a copy of the value of the instance variable 'label'." ^label copy! ! !Tree methodsFor: 'access'! label: aString "Set the label of this Node" label _ aString copy.! ! !Tree methodsFor: 'access'! leftChild "Re-tree, otherwise it returns 'false'." | gotIt | (self = aNode) ifTrue: [^self removeRoot]. leftChild notNil ifTrue: [gotIt _ leftChild removeNode: aNode. gotIt ~~ false ifTrue: [^self]]. rightChild notNil ifTrue: [gotIt _ rightChild removeNode: aNode. gotIt ~~ false ifTrue: [^self]]. ^false! ! !Tree methodsFor: 'tree functions'! removeRoot "This method returns a sub-tree containing all the nodes in the tree whose root is the receiver, except the root node. If the left sub-tree is nil, it j"ich is used here." | ans | "See if I contain the cursor point." (whereLastDisplayed containsPoint: cursorPoint) ifTrue: [^self]. "See if the left sub-tree contains the point." leftChild notNil ifTrue: [ans _ leftChild containsPoint: cursorPoint. ans notNil ifTrue: [^ans]]. "See if the right sub-tree contains the point." rightChild notNil ifTrue: [ans _ rightChild containsPoint: cursorPoint. ans notNil ifTrue: [^ans]]. ^ nil! ! !Tree methodsFor: 'displaying'! displayOn: aForm at: aPoint . parent rightChild == self ifTrue:[parent addRightChild: newRoot. ^newRoot]. self error: 'Ill-formed tree within removeRoot'! ! !Tree methodsFor: 'tree functions'! rightMostDescendent "Return the right-most descendent of the receiver." | aTree | aTree _ self. [aTree rightChild isNil] whileFalse: [aTree _ aTree leftChild]. ^ aTree! ! !Tree methodsFor: 'tree functions'! traverseTree "Does an in order (left to right) traversal of a tree, high lighting each node" (self leftChild isNil) ifTrue: [sclippingBox: clipBox xIncr: xIncr yIncr: yIncr "This sub-tree is to display itself on the given Form. It displays arcs leading down to its sub-trees and then uses itself recursively to obtain a display of its sub-trees." | leftPoint rightPoint bottomPoint aBitBlt| "DISPLAY THE NODE ICON AND REMEMBER WHERE WE DID IT" NodeIcon displayOn: aForm at: (aPoint x - 12) @ (aPoint y) clippingBox: clipBox. whereLastDisplayed _ ((aPoint x - 12) @ (aPoint y) extent: (NodeIcon extent)) intersect: clipBox. elf hiLiteMe] ifFalse: [self leftChild traverseTree. self hiLiteMe]. (self rightChild isNil) ifFalse: [self rightChild traverseTree].! ! !Tree methodsFor: 'printing'! printOn: aStream "This method prints a textual representation of the sub-tree rooted at the receiver on aStream." self isLeaf ifTrue: [^ label printOn: aStream]. label printOn: aStream. aStream nextPutAll: ' withLeft: ('. (leftChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [leftChild printOn: aStream.]. aStream nextPut label asDisplayText displayOn: aForm at: (aPoint x - 5) @ (aPoint y + 5) clippingBox: clipBox. "SET UP A BITBLT FOR USE BELOW" aBitBlt _ BitBlt destForm: aForm sourceForm: (Form extent: 1@1) black halftoneForm: Form black combinationRule: 3 destOrigin: 0 @ 0 sourceOrigin: 0 @ 0 extent: aForm computeBoundingBox extent clipRect: clipBox. "DISPLAY THE LEFT SUB-TREE" bottomPoint _ (aPoint x ) @ (aPoint y + 24). leftPoint _ (aPoint x - xIncr) @ (aPoint y + 60). leftChild notNil All: ') withRight: ('. (rightChild isNil) ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [rightChild printOn: aStream.]. aStream nextPutAll: ')'! ! !Tree methodsFor: 'displaying'! containsPoint: cursorPoint "This method tests to see if the given point lies on top of any of this tree's nodes. If so, it returns that node, otherwise it returns nil. Every node has an instance variable describing the rectangle in which the node icon was displayed which is updated everytime the tree is re-displayed and whifTrue: [aBitBlt drawFrom: bottomPoint to: leftPoint. leftChild displayOn: aForm at: leftPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]. "DISPLAY THE RIGHT SUB-TREE" rightPoint _ (aPoint x + xIncr) @ (aPoint y + 60). rightChild notNil ifTrue: [aBitBlt drawFrom: bottomPoint to: rightPoint. rightChild displayOn: aForm at: rightPoint clippingBox: clipBox xIncr: xIncr//2 yIncr: yIncr]! ! !Tree methodsFor: 'private'! hiLiteMe "high-lights a node by xor'ing a filled node form over the dis#played node for 1 second" |d| d _ Delay forMilliseconds: 300. HiLitedNodeIcon displayOn: Display at: (whereLastDisplayed origin) clippingBox: whereLastDisplayed rule: Form reverse mask: nil. d wait. HiLitedNodeIcon displayOn: Display at: (whereLastDisplayed origin) clippingBox: whereLastDisplayed rule: Form reverse mask: nil.! ! !Tree methodsFor: 'private'! leftChild: aNode "Set the receivers left sub-tree to aNode." leftChild _ aNode! ! !Tree methodsFor: 'private'! parent: aNode "Set tfSize: 25) offset: 0@0 "Tree initialize"! ! Tree initialize! View subclass: #TreeView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tree-Application'! TreeView comment: 'This class (a subclass of View) is used to provide a view of trees as represented by instances of Tree. It provides a routine for filling in the view and a class method for opening the window. The rest is inherited from its superclass.'! TreeView comment: 'This class (a subclass of View) is usedhe receiver's parent to aNode." parent _ aNode! ! !Tree methodsFor: 'private'! remove "This method removes the receiver from whatever tree it is in (if any)." parent notNil ifTrue: [(parent leftChild = self) ifTrue: [parent leftChild: nil]. (parent rightChild = self) ifTrue: [parent rightChild: nil]]. parent _ nil! ! !Tree methodsFor: 'private'! rightChild: aNode "Set the receiver's right sub-tree to aNode." rightChild _ aNode! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Tree  to provide a view of trees as represented by instances of Tree. It provides a routine for filling in the view and a class method for opening the window. The rest is inherited from its superclass.'! !TreeView methodsFor: 'displaying'! displayView "This routine is called to display the tree. It makes use of the (inherited) instance variable 'model' and of the 'insetDisplayBox' instance variable to find out what area of the screen is to be displayed on." model notNil ifTrue: [model displayOn: Disclass instanceVariableNames: ''! !Tree class methodsFor: 'instance creation'! withLabel: aString "This method returns a new Tree with its label initialized to aString and with no children." | tree | tree _ self new. tree label: aString copy. ^ tree! ! !Tree class methodsFor: 'instance creation'! withLabel: aLabel withLeft: left withRight: right "Create a node with aLabel. Left and right should be either sub-trees or nil. Add them as children to this node. Return the result." | tree | tree _ seplay at: insetDisplayBox topCenter + (0 @ 15) clippingBox: insetDisplayBox xIncr: 60 yIncr: 60]! ! !TreeView methodsFor: 'controller access'! defaultControllerClass "Answer the class of the default controller for the receiver. For the time being this is the dummy stub, NoController." ^TreeController! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! TreeView class instanceVariableNames: ''! !TreeView class methodsFor: 'instance creation'! openViewOf: aTree "This method ilf new. tree label: aLabel copy. tree addLeftChild: left. tree addRightChild: right. ^ tree! ! !Tree class methodsFor: 'Initialization'! initialize "This method initializes the class variable NodeIcon to contain a Form suitable for use in displaying an individual Node." | aCircle pen | NodeIcon _ Form extent: 25 @ 25. pen _ Form extent: 1@1. pen black. aCircle _ Circle new. aCircle form: pen. aCircle radius: 12. aCircle center: 12@12. aCircle displayOn: NodeIcon. HiLitedNodeIcon _ (Form dotOs passed a sub-tree. It opens a view of it on the screen and returns a pointer to its view. In the process, it creates a TreeController which it activates to take care of button pressing and so on." | topView treeView | treeView _ self new model: aTree; borderWidth: 2; insideColor: Form white. topView _ (StandardSystemView model: aTree label: 'TreeView' minimumSize: 100@100) addSubView: treeView. topView controller open! ! 'From Smalltalk-80 version T2.1.2, of July 23, 1985 on 1 April #1986 at 10:54:47 am'! !Tree methodsFor: 'testing'! height "Return the height of this sub-tree." | left right | left _ leftChild isNil ifTrue: [0] ifFalse: [leftChild height]. right _ rightChild isNil ifTrue: [0] ifFalse: [rightChild height]. ^ 1 + (left max: right)! ! aTree _ Tree withLabel: 'A'. bTree _ Tree withLabel: 'B'. cTree _ Tree withLabel: 'C'. dTree _ Tree withLabel: 'D'. eTree _ Tree withLabel: 'E'. fTree _ Tree withLabel: 'F'. gTree _ Tree withLabel: 'G'. hTree _ Tree withLabel: 'ion'! new: numberOfPens "Create a Commander with numberOfPens elements, each of which is a Pen." | newCommander | newCommander _ super new: numberOfPens. 1 to: numberOfPens do: [:index | newCommander at: index put: Pen new]. ^newCommander! ! !Commander class methodsFor: 'instance creation'! new: numberOfPens "Create a Commander with numberOfPens elements, each of which is a Pen." | newCommander | newCommander _ super new: numberOfPens. 1 to: numberOfPens do: [:index | newCommander at: indeH'. aTree addLeftChild: bTree. cTree addLeftChild: eTree. bTree addLeftChild: dTree. cTree addRightChild: fTree. aTree addRightChild: cTree. dTree addLeftChild: gTree. dTree addRightChild: hTree. ! !Tree methodsFor: 'tree functions'! rightMostDescendent "Return the right-most descendent of the receiver." | aTree | aTree _ self. [aTree rightChild isNil] whileFalse: [aTree _ aTree rightChild]. ^ aTree! ! aTree _ Tree withLabel: 'A'. bTree _ Tree withLabel: 'B'. cTree _ Tree withLabel: 'C'. dTree _ Trx put: Pen new]. ^newCommander ! ! Object subclass: #Event instanceVariableNames: 'startingDate title duration' classVariableNames: '' poolDictionaries: '' category: 'Course-Examples'! Object subclass: #Event instanceVariableNames: 'startingDateAndTime title duration' classVariableNames: '' poolDictionaries: '' category: 'Course-Examples'! Event organization changeFromString: '(''accessing'') (''comparing'') (''private'') '! Date class! Object subclass: #Event instanceVariableNames: 'startinee withLabel: 'D'. eTree _ Tree withLabel: 'E'. fTree _ Tree withLabel: 'F'. gTree _ Tree withLabel: 'G'. hTree _ Tree withLabel: 'H'. aTree addLeftChild: bTree. cTree addLeftChild: eTree. bTree addLeftChild: dTree. cTree addRightChild: fTree. aTree addRightChild: cTree. dTree addLeftChild: gTree. dTree addRightChild: hTree. ! '----SNAPSHOT---- to /userc/treesave: (19 June 1986 12:14:29 pm )'! '----SNAPSHOT---- to /userc/treesave: (19 June 1986 2:09:42 pm )'! Array subclass: #Commander instanceVariableNgDate startingTime title duration ' classVariableNames: '' poolDictionaries: '' category: 'Course-Examples'! !Event methodsFor: 'private'! startingDate: aDate "comment stating purpose of message" startingDate _ aDate ! ! Time! !Event methodsFor: 'private'! startingTime: aTime "comment stating purpose of message" startingTime _ aTime Time! ! !Event methodsFor: 'private'! startingTime: aTime "comment stating purpose of message" startingTime _ aTime! ! !Event methodsFor: 'private'! startingTiames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Display Objects'! Commander class organization addCategory: 'instance creation' asSymbol before: nil! !Commander class methodsFor: 'instance creation'! new:numberOfPens "Create a Commander with numberOfPens elements, each of which is a Pen." | newCommander | newCommander _ super new: numberOfPens. 1 to: numberOfPens do: [:index | newCommander at:index put:Pen new]. ^newCommander! ! !Commander class methodsFor: 'instance creatme: aTime "comment stating purpose of message" startingTime _ aTime! ! Object subclass: #Event instanceVariableNames: 'startingDateAndTime title duration ' classVariableNames: '' poolDictionaries: '' category: 'Course-Examples'! Event removeSelector: #startingTime:! !Event methodsFor: 'private'! startingDateAndTime: aDateAndTime "comment stating purpose of message" startingDateAndTime _ aDateAndTime! ! Event removeSelector: #startingDate:! !Event methodsFor: 'private'! duration: aDateAndTime$ "comment stating purpose of message" duration _ aDateAndTime! ! !Event methodsFor: 'private'! title: aString "comment stating purpose of message" title _ aString! ! Time now! aDay_Date today! aDay asSeconds.! aa_aDay asSeconds. ! Time from: aa.! aa_(Date today asSeconds) + (Time now asSeconds). ! Time from: aa. ! aa_(Date today asSeconds) + (Time now asSeconds). aDay_ Time from: aa. ! !Event methodsFor: 'accessing'! completionDate "Return the receiver's completion date" ^(Time from:(stength i j | minLength _ self length. i _ self randomIndex. j _ self randomIndex. self exchange: i and: j. self length < minLength ifTrue: [minLength _ self length. self changed] ifFalse: [self exchange: i and: j]! ! !Wire methodsFor: 'editing'! edit "Open a wire editor" WireView openOn: self! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! Wire class instanceVariableNames: ''! !Wire class methodsFor: 'builder'! make: anInteger "Makes a new wire with anInteger number of artingDateAndTime + duration))! ! OrderedCollection variableSubclass: #Wire instanceVariableNames: '' classVariableNames: 'Generator ' poolDictionaries: '' category: 'Wiring'! !Wire methodsFor: 'measurement'! length "I measure the length of a Wire." | total first next | total _ 0. first _ self first. self do: [:next | total _ total + (first dist: next). first _ next]. ^total! ! !Wire methodsFor: 'measurement'! pinNear: aPoint "Finds the pin nearest aPoint." | thePin | thePin _ selpoints input by the user." | aWire | aWire _ Wire new. anInteger timesRepeat: [aWire add: Sensor waitButton. Sensor waitNoButton]. ^aWire! ! !Wire class methodsFor: 'initialization'! initialize "Initialize new instance of class with Generator" Generator _ Random new "Wire initialize"! ! Wire initialize! Controller subclass: #WireController instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Wiring'! !WireController methodsFor: 'control defaults'! controf first. self do: [:aPin | (aPin dist: aPoint) < (thePin dist: aPoint) ifTrue: [thePin _ aPin]]. ^thePin! ! !Wire methodsFor: 'display'! display "Display the wire as a single pixel wide line." | aPen | aPen _ Pen new up. self do: [:pin | aPen goto: pin; down]! ! !Wire methodsFor: 'private'! exchange: aInteger and: bInteger "Exchange wire points aInteger and bInter." self swap: aInteger with: bInteger! ! !Wire methodsFor: 'private'! randomIndex "Generate randomIndex into Wire." ^(GeneratolActivity "Allows us to graphically position pins in aWire." sensor redButtonPressed ifTrue: [self movePin] ifFalse: [model shortenStep]! ! !WireController methodsFor: 'private'! movePin "Reads raw press and release coordinates, transforms them to Wire coordinates, finds and replaces the nearest pin with the new coordinate, and notifies the model and its dependents ofthe change." | old new | old _ view inverseDisplayTransform: sensor waitButton. new _ view inverseDisplayTransform: sensor war next * self size) ceiling! ! !Wire methodsFor: 'private'! replace: aPoint with: newPoint "Replaces the old point, aPoint, with newPoint." self at: (self indexOf: aPoint) put: newPoint! ! !Wire methodsFor: 'optimize'! shorten "Try 20 random changes in the routing order. Keep only changes that shorten the length." 20 timesRepeat: [self shortenStep]! ! !Wire methodsFor: 'optimize'! shortenStep "Try one random change in the routing order. Keep only if it shortens the length." | minLitNoButton. model replace: (model pinNear: old) with: new. model changed! ! View subclass: #WireView instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Wiring'! !WireView methodsFor: 'displaying'! displayView "Display the wire as a single pixel wide line." | aPen | aPen _ Pen new up. model do: [:pin | aPen goto: (self displayTransform: pin); down]! ! !WireView methodsFor: 'updating'! update: aModel "The receiver's model has changed. Redisplay the receiver in i$ts entirety. " self display! ! !WireView methodsFor: 'controller access'! defaultControllerClass "Answer the class of the default controller for the receiver." ^WireController! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! WireView class instanceVariableNames: ''! !WireView class methodsFor: 'examples'! example "This example prompts the user for 10 points to define a Wire, then opens an editor on the Wire." | aWire | aWire _ Wire make: 10. WireView openOn: aWire "WireView  defaultNib: 2. model do: [:pin | aPen goto: (self displayTransform: pin); down; dotOfSize: 5]! ! "dotOfSize: is a message selector which is defined in these classes (Form class ). To see the definitions, go to the message list pane and use the middle button menu to select 'messages'." ! "dotOfSize: is a message selector which is defined in these classes (Form class ). To see the definitions, go to the message list pane and use the middle button menu to select 'messages'." ! !WireView methodsFor: 'dexample"! ! !WireView class methodsFor: 'instance creation'! openOn: aWire " Creates a new WireView on aWire." | wireView topView | wireView _ self new. wireView model: aWire. wireView borderWidth: 2. wireView insideColor: Form white. topView _ StandardSystemView new. topView label: 'Wire Editor'. topView addSubView: wireView. topView controller open! ! '----SNAPSHOT---- to /userc/usercImage: (20 June 1986 10:09:31 am )'! aWire_Wire make:6! aWire display! aWire shorten! aWire display! isplaying'! displayView "Display the wire as a single pixel wide line." | aPen | aPen _ Pen new up. aPen defaultNib: 2. model do: [:pin | aPen goto: (self displayTransform: pin); down; up. aPen defaultNib: 5; down;up. aPen defaultNib: 2; down] ! ! Pen new defaultNib: 8; down; up! Pen new defaultNib: 8; goto: Sensor cursorPoint; down; up! Pen new defaultNib: 8; up; goto: Sensor cursorPoint; down; up! !WireView methodsFor: 'displaying'! displayView "Display the wire as a single pixel wide line." aWire shortenStep! aWire display! '----SNAPSHOT---- to /userc/usercImage: (20 June 1986 10:15:13 am )'! aWire_Wire make:6.! aWire display.! aWire shorten.! aWire display.! aWire shorten.! aWire shorten.! aWire display.! !Wire methodsFor: 'editing'! addPin: aPoint "Adds a new point to a wire." self add: Sensor waitButton. Sensor waitNoButton. ^self ! ! !Wire methodsFor: 'editing'! addPin: aPoint "Adds a new point to a wire." self add: Sensor waitButton. Sensor waitNoButton. ^self! ! !W| aPen x aDot | x _ 2. aPen _ Pen new up. aDot _ Form dotOfSize:x + 3. aPen defaultNib: x. model do: [:pin | aPen goto: (self displayTransform: pin); down. aDot displayAt:(self displayTransform: pin). ] ! ! !WireView methodsFor: 'displaying'! displayView "Display the wire as a single pixel wide line." | aPen x aDot | x _ 2. aPen _ Pen new up. aDot _ Form dotOfSize: x + 3. aPen defaultNib: x. model do: [:pin | aPen goto: (self displayTransform: pin); down. aDot displayAt: (self displayTraire methodsFor: 'editing'! addPin "Adds a new point to a wire." self add: Sensor waitButton. Sensor waitNoButton. ^self! ! aWire addPin! aWire display.! !WireView methodsFor: 'displaying'! displayView "Display the wire as a single pixel wide line." | aPen | aPen _ Pen new up. aPen defaultNib: 5. model do: [:pin | aPen goto: (self displayTransform: pin); down]! ! !WireView methodsFor: 'displaying'! displayView "Display the wire as a single pixel wide line." | aPen | aPen _ Pen new up. aPennsform: pin)]! ! !WireController methodsFor: 'control defaults'! controlActivity "Allows us to graphically position pins in aWire." sensor redButtonPressed ifTrue: [self movePin]. sensor yellowButtonPressed ifTrue: [model shortenStep]! ! !WireController methodsFor: 'control defaults'! controlActivity "Allows us to graphically position pins in aWire." sensor redButtonPressed ifTrue: [self movePin]. sensor yellowButtonPressed ifTrue: [model shortenStep]! ! 'From Smalltalk-80 version T2.1.2, of J%uly 23, 1985 on 10 February 1986 at 3:20:45 pm'! !WireController methodsFor: 'private'! movePin "Reads raw press and release coordinates, transforms them to Wire coordinates, finds and replaces the nearest pin with the new coordinate, and notifies the model and its dependents ofthe change." | old new | old _ view inverseDisplayTransform: sensor waitButton. sensor cursorPoint: (view displayTransform: (model pinNear: old)). Cursor crossHair showWhile: [new _ view inverseDisplayTransform: sensor w pin with the new coordinate, and notifies the model and its dependents ofthe change." | old new | old _ view inverseDisplayTransform: sensor waitButton. sensor cursorPoint: (view displayTransform: (model pinNear: old)). Cursor read showWhile: [new _ view inverseDisplayTransform: sensor waitNoButton]. model replace: (model pinNear: old) with: new. model changed! ! '----SNAPSHOT---- to /userc/usercImage: (20 June 1986 12:22:56 pm )'! button menu to select 'messages'." ! !WireView methodsFor: 'daitNoButton]. model replace: (model pinNear: old) with: new. model changed! ! "crossHair is a message selector which is defined in these classes (Cursor class ). To see the definitions, go to the message list pane and use the middle button menu to select 'messages'." ! Cursor ! !WireController methodsFor: 'private'! movePin "Reads raw press and release coordinates, transforms them to Wire coordinates, finds and replaces the nearest pin with the new coordinate, and notifies the model and its @@nծBZ. * &/ . : 8./usercImage.usercImageusercImagedependents ofthe change." | old new | old _ view inverseDisplayTransform: sensor waitButton. sensor cursorPoint: (view displayTransform: (model pinNear: old)). Cursor ReadCursor showWhile: [new _ view inverseDisplayTransform: sensor waitNoButton]. model replace: (model pinNear: old) with: new. model changed! ! !WireController methodsFor: 'private'! movePin "Reads raw press and release coordinates, transforms them to Wire coordinates, finds and replaces the nearest pin with the new coordinate, and notifies the model and its dependents ofthe change." | old new | old _ view inverseDisplayTransform: sensor waitButton. sensor cursorPoint: (view displayTransform: (model pinNear: old)). Cursor square showWhile: [new _ view inverseDisplayTransform: sensor waitNoButton]. model replace: (model pinNear: old) with: new. model changed! ! !WireController methodsFor: 'private'! movePin "Reads raw press and release coordinates, transforms them to Wire coordinates, finds and replaces the nearest%&&''