[DEMO][APP] Squeak client for timeline presentationRussell Swan swan at dandenong.cs.umass.eduThu Feb 24 20:33:35 UTC 2000
This changeset contains a demo of a program I wrote. Research area is organization and visualization of text collections. We've been doing research on automatic recognition of topics contained in text that has explicit date tags, such as news or e-mail. We decided to use timelines to present the information found to a user. Currently the corpus is preprocessed and topics are pulled out and ranked. The squeak client then goes to the server and pulls out the (static) summary information for display. This is the first cut at the front end. I demoed this during a talk at CIKM in November, and at our labs dog-and-pony show, and my advisor is showing this to DARPA next week. In about two weeks I'm going to start rewriting this so it will query a server and get dynamic content about the topics for display. Currently it runs on two corpora - TDT1, which is January-June, 1995 of Reuters and CNN, and TDT2, which is January-June of CNN, AP wire, Voice of America, ABC World News tonight, New York Times, and Public Radio International. The demo requires morphic. In a workspace in a Morphic world, evaluate 'Timeline tdt1demo' or 'Timeline tdt2demo' for the quick and light demos, and 'Timeline tdt2eval' and 'Timeline tdt2' for larger datasets that demonstrate some of the problems I'm encountering. The large datasets are pretty zippy on an iMac or a new PC, but are extremely slow on my 5 year old SGI. This is the first time I've released this code, but in a month or two the demo will be released via the Web for anyone to try. I'd like some feedback from people on the list before the public release. Thanks and have fun ;-) -Russell Swan -------------- next part -------------- 'From Squeak2.7 of 5 January 2000 [latest update: #1762] on 23 February 2000 at 2:15:22 am'! ScaleMorph subclass: #ArrayScale instanceVariableNames: 'boundaryCollection labelCollection model ' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! Model subclass: #Counter instanceVariableNames: 'currentValue ' classVariableNames: '' poolDictionaries: '' category: 'CounterExample'! Counter class instanceVariableNames: ''! Model subclass: #CounterApplication instanceVariableNames: 'counter frame display controls ' classVariableNames: '' poolDictionaries: '' category: 'CounterExample'! CounterApplication class instanceVariableNames: ''! Object subclass: #Feature instanceVariableNames: 'start stop chi2 rank string ' classVariableNames: '' poolDictionaries: '' category: 'Story-Objects'! Object subclass: #Foo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! Object subclass: #HackClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! MenuItemMorph subclass: #MyMenuItemMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! MenuMorph subclass: #MyMenuMorph instanceVariableNames: 'showNames showOrg showLoc ' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! Slider subclass: #MySlider instanceVariableNames: 'target arguments minVal maxVal truncate ' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! TextMorph subclass: #MyTextMorph instanceVariableNames: 'model getSelector updateSymbol ' classVariableNames: '' poolDictionaries: '' category: 'CounterExample'! Object subclass: #MyUIExample instanceVariableNames: 'uiWindow ' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! Feature subclass: #NamedEntity instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Story-Objects'! NamedEntity subclass: #NamedOrg instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Story-Objects'! NamedEntity subclass: #NamedPerson instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Story-Objects'! NamedEntity subclass: #NamedPlace instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Story-Objects'! Feature subclass: #NounPhrase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Story-Objects'! LedMorph subclass: #PluggableLedMorph instanceVariableNames: 'getValueSelector model ' classVariableNames: '' poolDictionaries: '' category: 'CounterExample'! PluggableLedMorph class instanceVariableNames: ''! PolygonMorph subclass: #PolygonButtonMorph instanceVariableNames: 'target actionSelector arguments actWhen oldColor ' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! PolygonButtonMorph subclass: #BackTriangleMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! PolygonButtonMorph subclass: #FastBackMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! PolygonButtonMorph subclass: #FastForwardMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! PolygonButtonMorph subclass: #ForwardTriangleMorph instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! Object subclass: #Story instanceVariableNames: 'start stop chi2 rank nounPhrases namedEntities label1 label2 menu1 menu2 owner histWin ' classVariableNames: '' poolDictionaries: '' category: 'Story-Objects'! MorphicModel subclass: #Timeline instanceVariableNames: 'startSlider stopSlider startSliderValue stopSliderValue minVal maxVal begDate showStart showStop graphic stories forward fastForward back fastBack numStoriesShown counter counterLabel numberStoriesLabel yFillButton yFill ' classVariableNames: 'ClassVarName1 ClassVarName2 ' poolDictionaries: '' category: 'MyStuff'! Timeline class instanceVariableNames: ''! Object subclass: #WebHackClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'MyStuff'! !ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 11/20/1999 16:09'! buildLabels | scale x1 y1 y2 x ta tb xa xb t tickMorph tickStart tickStop startNum offSet | "morphic stuff here" (start >= stop) ifTrue: [ ^ self ]. self removeAllMorphs. scale _ (self innerBounds width-1) / (stop-start) asFloat. x1 _ self innerBounds left. y1 _ self innerBounds bottom. y2 _ y1 - (1.5 * majorTickLength). 1 to: labelCollection size do: [ :v | ta _ boundaryCollection at: v. tb _ boundaryCollection at: (v + 1). ( (ta > stop) | (tb < start) ) ifFalse: [ ( ta < start ) ifTrue: [xa _ x1. tickStart _ start.] ifFalse: [ xa _ x1 + (scale*(ta-start)). tickStart _ ta.]. ( tb > stop ) ifTrue: [xb _ self innerBounds right. tickStop _ stop.] ifFalse: [ xb _ x1 + (scale*(tb-start)). tickStop _ tb.]. t _ xa + xb. x _ t / 2.0. ( (xb - xa) > 50 ) ifTrue: [ tickMorph _ StringMorph contents: (labelCollection at: v). tickMorph align: tickMorph bounds bottomCenter with: x@(y1-1). tickMorph left < self left ifTrue: [tickMorph position: self left at tickMorph top]. tickMorph right > self right ifTrue: [tickMorph position: (self right-tickMorph width)@tickMorph top]. self addMorph: tickMorph]. "Range labels (months) filled in. Do individual days if total range is small enough" ( (stop - start) < 50 ) ifTrue: [ "Draw individual dates in, instead of just months" x _ x1 + (scale/2.0). "(tickStart = start) ifFalse: [" offSet _ tickStart - start. x _ x + (scale * offSet). startNum _ (tickStart - ta + 1). tickStart to: (tickStop-1) do: [ :q | tickMorph _ StringMorph contents: (startNum printString). tickMorph align: tickMorph bounds bottomCenter with: x at y2. self addMorph: tickMorph. startNum _ startNum + 1. x _ x + scale.] "]." ] ] ]. self drawStories.! ! !ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 2/22/2000 11:48'! drawOn: aCanvas | scale x1 y1 y2 x loopStart rect ytop yup ta tb xa xb | "super drawOn: aCanvas." "Can't call super drawOn: with ScaleMorph as parent because my drawOn: is different" "all non Morphic drawing (line, rect) goes here. Morphics go in buildLabels. Tried combining once, didn't work well. Duplicate some code and logic, but keep graphic models separate" (start >= stop) ifTrue: [ ^ self ]. aCanvas frameAndFillRectangle: (self bounds) fillColor: Color veryLightGray borderWidth: 1 borderColor: Color black. "First draw minor ticks" scale _ (self innerBounds width-1) / (stop-start) asFloat. x1 _ self innerBounds left. y1 _ self innerBounds bottom - 30. y2 _ y1 + minorTickLength. ytop _ self innerBounds top. loopStart _ ((start / minorTick ) ceiling) * minorTick. loopStart to: stop by: minorTick do: [:v | x _ x1 + (scale*(v - start)). aCanvas line: x at y1 to: x at y2 width: 1 color: Color black. ]. "Now draw major ticks on boundaries" x1 _ self innerBounds left. y2 _ y1 + majorTickLength. boundaryCollection do: [ :num | ( (num > start) & (num < stop)) ifTrue: [ x _ x1 + (scale*(num - start)). aCanvas line: x at y1 to: x at y2 width: 1 color: Color black. ] ]. scale _ (self innerBounds width-1) / (stop-start) asFloat. x1 _ self innerBounds left. y1 _ self innerBounds bottom. yup _ y1 - 30. y2 _ y1 - majorTickLength. 1 to: labelCollection size do: [ :v | ta _ boundaryCollection at: v. tb _ boundaryCollection at: (v + 1). ( (ta > stop) | (tb < start) ) ifFalse: [ "self halt." ( ta < start ) ifTrue: [xa _ x1] ifFalse: [ xa _ x1 + (scale*(ta-start))]. ( tb > stop ) ifTrue: [xb _ self innerBounds right] ifFalse: [ xb _ x1 + (scale*(tb-start))]. rect _ Rectangle origin: xa at ytop corner: xb at yup. (v even) ifTrue: [ aCanvas fillRectangle:rect color: Color veryVeryLightGray.] ifFalse: [ aCanvas fillRectangle:rect color: Color veryLightGray.]. ] ]. ((stop - start) < 50) ifTrue: [ loopStart _ ((start / minorTick ) ceiling) * minorTick. loopStart to: stop by: minorTick do: [:v | x _ x1 + (scale*(v - start)). aCanvas line: x at yup to: x at ytop width: 1 color: Color white.] ].! ! !ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 2/22/2000 22:10'! drawStories | scale x1 ta tb xa xb storyList loopStop button story ytop pnt rect rectHeight yscale chiRange ypos tempHeight yoff numToDraw smallChi2 | "morphic stuff here" storyList _ model visibleStories. numToDraw _ model numberStoriesToShow. ( storyList isNil ) ifFalse: [ scale _ (self innerBounds width-1) / (stop-start) asFloat. x1 _ self innerBounds left. ytop _ self innerBounds top. "chiRange _ (((model stories at: 1) chi2) / 8.0) log." smallChi2 _ model stories last chi2. chiRange _ (((model stories at: 1) chi2) /(smallChi2 ) ) log. tempHeight _ self innerBounds height. yscale _ (tempHeight - 70) asFloat / chiRange. loopStop _ storyList size. ( loopStop > numToDraw ) ifTrue: [ loopStop _ numToDraw ]. "Now that I know how deep the list goes, I can reset the y scale so stories fill the graphic" (loopStop > 1) ifTrue: [ (model yFill = #fill) ifTrue: [ smallChi2 _ (storyList at: loopStop) chi2. chiRange _ (((storyList at: 1) chi2) /(smallChi2 ) ) log. yscale _ (tempHeight - 70) asFloat / chiRange. ]. ]. 1 to: loopStop do: [ :s | story _ storyList at: s. ta _ story start. tb _ story stop + 1. ( ta < start ) ifTrue: [xa _ x1] ifFalse: [ xa _ x1 + (scale*(ta-start))]. ( tb > stop ) ifTrue: [xb _ self innerBounds right] ifFalse: [ xb _ x1 + (scale*(tb-start))]. yoff _ (((story chi2) / smallChi2) log) * yscale. ypos _ ytop + (tempHeight - yoff) rounded - 50. (story label1 isNil) ifFalse: [ button _ SimpleButtonMorph new. button label: (story label1). button color: Color transparent. button target: story. button actionSelector: #putUpMenu1:. pnt _ (((xa+xb)/2.0) truncated - 80)@ypos. button arguments: {pnt}. button cornerStyle: #square. button align: button bounds bottomRight with: (((xa+xb)/2.0))@(ypos - 1). self addMorph: button.]. (story label2 isNil) ifFalse: [ "button _ StringButtonMorph new. button contents: (story label2)." button _ SimpleButtonMorph new. button label: (story label2). button color: Color transparent. "button borderColor: Color lightGray." button target: story. button actionSelector: #putUpMenu2:. pnt _ (((xa+xb)/2.0) truncated +20)@(ypos - 3). button arguments: {pnt}. button cornerStyle: #square. button align: button bounds bottomLeft with: (((xa+xb)/2.0))@(ypos - 1). self addMorph: button. ]. rectHeight _ (((story storySize) / (story duration)) * 3.0) rounded. rect _ RectangleMorph new color: Color red; borderColor: Color red. rect width: ((xb - xa)-1); height: rectHeight. rect position: (xa+1)@ypos. self addMorph: rect. ]. ].! ! !ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 10/30/1999 22:29'! handlesMouseDown: evt ^ true.! ! !ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 10/26/1999 11:51'! model: anObject "Set my model and make me me a dependent of the given object." model ifNotNil: [model removeDependent: self]. anObject ifNotNil: [anObject addDependent: self]. model _ anObject.! ! !ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 10/26/1999 11:34'! oldBuildLabels | scale x1 y1 y2 x tickMorph ta tb xa xb t| self removeAllMorphs. scale _ (self innerBounds width-1) / (stop-start) asFloat. x1 _ self innerBounds left. y1 _ self innerBounds bottom. y2 _ y1 - majorTickLength. 1 to: labelCollection size do: [ :v | ta _ boundaryCollection at: v. tb _ boundaryCollection at: (v + 1). ( (ta > stop) | (tb < start) ) ifFalse: [ "self halt." ( ta < start ) ifTrue: [xa _ x1] ifFalse: [ xa _ x1 + (scale*(ta-start))]. ( tb > stop ) ifTrue: [xb _ self innerBounds right] ifFalse: [ xb _ x1 + (scale*(tb-start))]. t _ xa + xb. x _ t / 2.0. "x _ ((xa + xb) / 2.0)." tickMorph _ StringMorph contents: (labelCollection at: v). tickMorph align: tickMorph bounds bottomCenter with: x at y2. tickMorph left < self left ifTrue: [tickMorph position: self left at tickMorph top]. tickMorph right > self right ifTrue: [tickMorph position: (self right-tickMorph width)@tickMorph top]. self addMorph: tickMorph]] ! ! !ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 11/21/1999 22:57'! setBoundary: bCollection andLabels: lCollection boundaryCollection _ bCollection. labelCollection _ lCollection. ! ! !ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 10/26/1999 22:28'! start: aNumber start _ aNumber. self buildLabels.! ! !ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 10/26/1999 22:27'! stop: aNumber stop _ aNumber. self buildLabels.! ! !ArrayScale methodsFor: 'as yet unclassified' stamp: 'RCS 10/26/1999 19:38'! update: someArgs "Transcript show: 'In ArrayScaleMorph>>update:, numArgs is ', someArgs size asString, someArgs first, someArgs third asString; cr." (someArgs first = #stopSlider) ifTrue: [ self stop: ((someArgs third) + 1) ]. (someArgs first = #startSlider) ifTrue: [ self start: someArgs third ].! ! !Counter methodsFor: 'counting' stamp: 'RCS 11/30/1999 21:03'! clear self currentValue: 0.! ! !Counter methodsFor: 'counting' stamp: 'RCS 12/1/1999 20:25'! decrement ( (self currentValue) > 1 ) ifTrue: [ self currentValue: self currentValue - 1. ].! ! !Counter methodsFor: 'counting' stamp: 'RCS 11/30/1999 21:04'! increment self currentValue: self currentValue + 1.! ! !Counter methodsFor: 'accessing' stamp: 'RCS 11/30/1999 21:02'! currentValue ^ currentValue.! ! !Counter methodsFor: 'accessing' stamp: 'RCS 12/1/1999 19:38'! currentValue: anObject currentValue _ anObject. self changed: #counterChanged.! ! !Counter methodsFor: 'accessing' stamp: 'RCS 11/30/1999 22:25'! string ^ currentValue asString.! ! !Counter methodsFor: 'initialize-release' stamp: 'RCS 11/30/1999 21:01'! initialize currentValue _ 0.! ! !Counter class methodsFor: 'instance creation' stamp: 'RCS 11/30/1999 21:05'! new ^ super new initialize.! ! !CounterApplication methodsFor: 'interface' stamp: 'RCS 12/1/1999 20:26'! openAsMorph | rect | "create a model object" counter _ Counter new. "this is going to be the box containing our panel" frame _ AlignmentMorph new orientation: #horizontal. "create LED display" "display _ PluggableLedMorph new. display on: counter value: #currentValue. display digits: 4; extent: (410 at 150)." "display _ LedMorph new. display digits: 4; extent: (410 at 150)." rect _ RectangleMorph new color: Color white. display _ MyTextMorph new position: 30 at 30. display model: counter getSelector: 'currentValue' updateSymbol:'counterChanged'. rect addMorph: display. "display _ PluggableTextView on: counter text: #string accept: #nil." "display extent: 100 at 100." "display digits: 4; extent: (410 at 150)." "counter addDependent: display." controls _ AlignmentMorph new orientation: #vertical. "controls addMorph: (SimpleButtonMorph new target: counter; label: 'quit'; actionSelector: #delete)." controls addMorph: (SimpleButtonMorph new target: counter; label: '-'; actionSelector: #decrement). controls addMorph: (SimpleButtonMorph new target: counter; label: '+'; actionSelector: #increment). "controls addMorph: (SimpleButtonMorph new target: counter; label: 'clear'; actionSelector: #clear)." frame addMorph: controls. frame addMorph: rect. display newString: '0'. frame openInWorld. ! ! !CounterApplication methodsFor: 'as yet unclassified' stamp: 'RCS 12/2/1999 22:08'! addDependent: anObject counter addDependent: anObject.! ! !CounterApplication methodsFor: 'as yet unclassified' stamp: 'RCS 12/1/1999 20:07'! counter ^ counter! ! !CounterApplication methodsFor: 'as yet unclassified' stamp: 'RCS 12/2/1999 22:07'! position: aPoint frame position: aPoint.! ! !CounterApplication class methodsFor: 'as yet unclassified' stamp: 'RCS 11/30/1999 21:36'! openAsMorph ^ self new openAsMorph. ! ! !Feature methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:12'! chi2 ^ chi2! ! !Feature methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:13'! chi2: aFloat chi2 _ aFloat.! ! !Feature methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:11'! rank ^ rank! ! !Feature methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:12'! rank: anInteger rank _ anInteger.! ! !Feature methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:10'! start ^ start.! ! !Feature methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:11'! start: anInteger start _ anInteger.! ! !Feature methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:11'! stop ^ stop.! ! !Feature methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:11'! stop: anInteger stop _ anInteger.! ! !Feature methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:12'! string ^ string! ! !Feature methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:13'! string: aTextString. string _ aTextString.! ! !Feature methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:26'! isNamedEntity ^ false.! ! !Feature methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:26'! isNamedOrg ^ false.! ! !Feature methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:27'! isNamedPerson ^ false.! ! !Feature methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:27'! isNamedPlace ^ false.! ! !Feature methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:27'! isNounPhrase ^ false.! ! !Foo methodsFor: 'as yet unclassified' stamp: 'RCS 2/22/2000 00:41'! restoreDisplay ^ self! ! !HackClass methodsFor: 'as yet unclassified' stamp: 'RCS 10/31/1999 07:23'! buildFeature:aFile | line start stop chi2 type foo localString feat localList | localList _ OrderedCollection new. "[aFile atEnd] whileFalse: [" line _ aFile nextLine. foo _ line findTokens: ' '. "self halt." "Transcript show:'line is ::', line; cr." ((foo size) > 1) ifTrue: [ start _ foo at: 2 asNumber. stop _ foo at: 3 asNumber. chi2 _ foo at: 4 asNumber. type _ foo at: 5. localString _ foo at: 6. (foo size > 7 ) ifTrue: [ 7 to: ( (foo size) - 1) do: [ :v | localString _ localString, ' ', (foo at: v). ].]. (type = 'ORGANIZATION') ifTrue: [ feat _ NamedOrg new.]. (type = 'LOCATION') ifTrue: [ feat _ NamedPlace new.]. (type = 'PERSON') ifTrue: [ feat _ NamedPerson new.]. feat start: start; stop: stop; chi2: chi2; string: localString. localList add: feat. ]. "]." ^ localList. ! ! !HackClass methodsFor: 'as yet unclassified' stamp: 'RCS 10/31/1999 07:23'! buildNamedEntityList: aFile | line start stop chi2 type foo localString feat localList | localList _ OrderedCollection new. [true] whileTrue: [ line _ aFile nextLine. ( line == nil ) ifTrue: [ ^ localList]. foo _ line findTokens: ' '. "self halt." "Transcript show:'entities, line is ::', line, ' size is ', ((foo size) asString); cr." ((foo size) = 1) ifTrue: [ ^ localList.]. start _ foo at: 2 asNumber. stop _ foo at: 3 asNumber. chi2 _ foo at: 4 asNumber. type _ foo at: 5. localString _ foo at: 6. (foo size > 7 ) ifTrue: [ 7 to: ( (foo size) - 1) do: [ :v | localString _ localString, ' ', (foo at: v). ].]. (type = 'ORGANIZATION') ifTrue: [ feat _ NamedOrg new.]. (type = 'LOCATION') ifTrue: [ feat _ NamedPlace new.]. (type = 'PERSON') ifTrue: [ feat _ NamedPerson new.]. feat start: start; stop: stop; chi2: chi2; string: localString. localList add: feat. ] ! ! !HackClass methodsFor: 'as yet unclassified' stamp: 'RCS 10/31/1999 07:23'! buildNounPhrases: aFile | line start stop chi2 foo localString feat localList | localList _ OrderedCollection new. [true] whileTrue: [ line _ aFile nextLine. ( line isNil ) ifTrue: [ ^ localList]. foo _ line findTokens: ' '. "self halt." "Transcript show:'noun phrases, line is ::', line, ' size is ', ((foo size) asString); cr." ((foo size) = 1) ifTrue: [ ^ localList.]. start _ foo at: 2 asNumber. stop _ foo at: 3 asNumber. chi2 _ foo at: 4 asNumber. localString _ foo at: 5. (foo size > 6 ) ifTrue: [ 6 to: ( (foo size) - 1) do: [ :v | localString _ localString, ' ', (foo at: v). ].]. feat _ NounPhrase new. feat start: start; stop: stop; chi2: chi2; string: localString. localList add: feat. ] ! ! !HackClass methodsFor: 'as yet unclassified' stamp: 'RCS 2/22/2000 13:02'! buildStory:aFile | line storyObj localList start stop rank chi2 list1 list2 | localList _ OrderedCollection new. [aFile atEnd] whileFalse: [ storyObj _ Story new. line _ aFile nextLine. (line isNil ) ifTrue: [ ^ localList]. line _ aFile nextLine. (line isNil ) ifTrue: [ ^ localList]. start _ line asNumber. line _ aFile nextLine. stop _ line asNumber. line _ aFile nextLine. rank _ line asNumber. line _ aFile nextLine. chi2 _ line asNumber. line _ aFile nextLine. list1 _ self buildNamedEntityList: aFile. line _ aFile nextLine. list2 _self buildNounPhrases: aFile. line _ aFile nextLine. "line _ aFile nextLine." storyObj start: start. storyObj stop: stop. storyObj rank: rank. storyObj chi2: chi2. localList add: storyObj. storyObj namedEntities: list1. storyObj label1: ((list1 at:1) string). storyObj nounPhrases: list2. storyObj label2: ((list2 at:1) string). ]. ^ localList.! ! !MyMenuItemMorph commentStamp: '<historical>' prior: 0! Subclass MenuItemMorph to override deselectItem. This allows my submenus to remain up! !MyMenuItemMorph methodsFor: 'private' stamp: 'RCS 12/6/1999 12:33'! deselectItem "Override method in super so popUps are not automatically closed" self isSelected: false. subMenu ifNotNil: [subMenu deleteIfPopUp]. ! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 12/6/1999 12:50'! add: aString subMenu: aMenuMorph "Append the given submenu with the given label." | item | item _ MyMenuItemMorph new. item contents: aString; subMenu: aMenuMorph. self addMorphBack: item. ! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 12/6/1999 12:51'! add: aString target: target selector: aSymbol argumentList: argList "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument." | item | item _ MyMenuItemMorph new contents: aString; target: target; selector: aSymbol; arguments: argList asArray. self addMorphBack: item. ! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/23/1999 11:46'! addMyStayUpItem | menuString | "Append a menu item that can be used to toggle this menu's persistence. Slightly modified from parent, renamed so I can also call parent if I wish" ( stayUp ) ifTrue: [ menuString _ ' dismiss this menu'.] ifFalse: [ menuString _ ' keep this menu up'.]. self add: menuString target: self selector: #toggleStayUp: argumentList: EmptyArray. "stayUp _ true." self addLine! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/23/1999 11:46'! addShowLoc "Append a menu item that can be used to toggle whether named locations are shown." showLoc _ true. self add: 'hide places' target: self selector: #toggleShowLoc: argumentList: EmptyArray.! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/23/1999 11:47'! addShowNames "Append a menu item that can be used to toggle whether names are shown." showNames _ true. self add: 'hide names' target: self selector: #toggleShowNames: argumentList: EmptyArray.! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/23/1999 11:47'! addShowOrg "Append a menu item that can be used to toggle whether names are shown." showOrg _ true. self add: 'hide orgs' target: self selector: #toggleShowOrg: argumentList: EmptyArray.! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/23/1999 11:29'! changeLabel1 defaultTarget updatingLabel1: (popUpOwner contents).! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/23/1999 11:29'! changeLabel2 defaultTarget updatingLabel2: (popUpOwner contents).! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 12/6/1999 14:13'! delete "Override methos in super. This checks to see if I have any submenus up and active on the screenm and deletes them before I go away." | menus menusWithOwners mySubMenu item | "self halt." (self owner isNil) ifFalse: [ menus _ MyMenuMorph allInstances. menusWithOwners _ menus reject: [ :v | (v popUpOwner) isNil ]. mySubMenu _ menusWithOwners select: [ :v | ((v popUpOwner) owner) = self. ]. (mySubMenu size > 0) ifTrue: [ item _ mySubMenu first. item delete. ]. ]. super delete.! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/18/1999 12:28'! getPopUpOwnerName ^ popUpOwner contents. ! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:42'! toggleShowLoc: evt "Toggle my 'showNames' flag and adjust the menu item to reflect its new state." self items do: [:item | item selector = #toggleShowLoc: ifTrue: [showLoc _ showLoc not. showLoc ifTrue: [item contents: 'hide places'] ifFalse: [item contents: 'show places']]]. self updateDisplay.! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:41'! toggleShowNames: evt "Toggle my 'showNames' flag and adjust the menu item to reflect its new state." self items do: [:item | item selector = #toggleShowNames: ifTrue: [showNames _ showNames not. showNames ifTrue: [item contents: 'hide names'] ifFalse: [item contents: 'show names']]]. self updateDisplay.! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:17'! toggleShowOrg: evt "Toggle my 'showNames' flag and adjust the menu item to reflect its new state." self items do: [:item | item selector = #toggleShowOrg: ifTrue: [showOrg _ showOrg not. showOrg ifTrue: [item contents: 'hide orgs'] ifFalse: [item contents: 'show orgs']]]. self updateDisplay.! ! !MyMenuMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/23/1999 11:45'! updateDisplay | coll namedEnt subMenu | coll _ OrderedCollection new. 1 to: 8 do: [ :i | coll add: (submorphs at: i) ]. namedEnt _ defaultTarget namedEntitiesName: showNames loc: showLoc org: showOrg. submorphs _ coll. subMenu _ defaultTarget getStandardSubMenu: #changeLabel1. namedEnt do: [ :v | self add: (v string) subMenu: subMenu]. ! ! !MySlider methodsFor: 'as yet unclassified' stamp: 'RCS 10/30/1999 22:29'! handlesMouseDown: evt ^ true.! ! !MySlider methodsFor: 'as yet unclassified' stamp: 'RCS 10/9/1999 23:33'! model: thang slotName: nameOfThisPart slotName _ nameOfThisPart. self model: thang. ! ! !MySlider methodsFor: 'as yet unclassified' stamp: 'RCS 10/17/1999 23:26'! update: myArguments ( myArguments first == slotName asSymbol ) ifTrue: ["Transcript show: 'param is #startSlider'; cr. Transcript show: 'putting in value of ', myArguments second asString); cr." self value: myArguments second.] "ifFalse: [Transcript show: 'param is something else'; cr. ]." ! ! !MyTextMorph methodsFor: 'as yet unclassified' stamp: 'RCS 12/1/1999 19:30'! model: anObject anObject addDependent: self. model _ anObject.! ! !MyTextMorph methodsFor: 'as yet unclassified' stamp: 'RCS 12/1/1999 19:33'! model: anObject getSelector: aString updateSymbol: notherString getSelector _ aString asSymbol. updateSymbol _ notherString asSymbol. self model: anObject.! ! !MyTextMorph methodsFor: 'as yet unclassified' stamp: 'RCS 12/1/1999 20:24'! newString: aString | topCorner x y | self string: aString fontName: 'NewYork' size: 26. "self contents: aString." topCorner _ owner position. x _ topCorner x. y _ topCorner y. self position: (x+10)@(y+10). self extent: 40 at 40. ! ! !MyTextMorph methodsFor: 'as yet unclassified' stamp: 'RCS 12/1/1999 19:37'! update: aSymbol | val string | (aSymbol = updateSymbol) ifTrue: [ val _ model perform: getSelector. string _ val asString. self newString: string ]! ! !MyUIExample methodsFor: 'as yet unclassified' stamp: 'RCS 11/19/1999 00:10'! addMorph: aMorph uiWindow addRow: aMorph.! ! !MyUIExample methodsFor: 'as yet unclassified' stamp: 'RCS 11/19/1999 00:10'! simpleWindow2 "UIExample new simpleWindow1" uiWindow _ UIWindowMorph newWindow. uiWindow addTitleBar; setTitle: 'Simple Window'; position: 200 at 200; openInWorld.! ! !NamedEntity methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:27'! isNamedEntity ^ true.! ! !NamedOrg methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:27'! isNamedOrg ^ true.! ! !NamedPerson methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:27'! isNamedPerson ^ true.! ! !NamedPlace methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:28'! isNamedPlace ^ true.! ! !NounPhrase methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:28'! isNounPhrase ^ true.! ! !PluggableLedMorph methodsFor: 'updating' stamp: 'RCS 11/30/1999 21:44'! update: aSymbol aSymbol == getValueSelector ifTrue: [ ^ self value: (self model perform: self getValueSelector)]! ! !PluggableLedMorph methodsFor: 'accessing' stamp: 'RCS 11/30/1999 21:23'! getValueSelector ^ getValueSelector.! ! !PluggableLedMorph methodsFor: 'accessing' stamp: 'RCS 11/30/1999 21:23'! getValueSelector: aSelector getValueSelector _ aSelector.! ! !PluggableLedMorph methodsFor: 'accessing' stamp: 'RCS 11/30/1999 21:21'! model ^ model.! ! !PluggableLedMorph methodsFor: 'accessing' stamp: 'RCS 11/30/1999 21:21'! model: aModel model _ aModel.! ! !PluggableLedMorph methodsFor: 'initialization' stamp: 'RCS 11/30/1999 21:24'! on: anObject value: aSelector self model: anObject. self getValueSelector: aSelector.! ! !PluggableLedMorph class methodsFor: 'instance creation' stamp: 'RCS 11/30/1999 21:25'! on: anObject value: aSelector ^ self new on: anObject value: aSelector.! ! !PolygonButtonMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 12:03'! doButtonAction "Perform the action of this button. Subclasses may override this method. The default behavior is to send the button's actionSelector to its target object with its arguments." (target ~~ nil and: [actionSelector ~~ nil]) ifTrue: [ Cursor normal showWhile: [ target perform: actionSelector ]]. ! ! !PolygonButtonMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 12:05'! handlesMouseDown: evt ^ self isPartsDonor not ! ! !PolygonButtonMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 12:05'! initialize super initialize. target _ nil.! ! !PolygonButtonMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 12:05'! mouseDown: evt oldColor _ color. actWhen == #buttonDown ifTrue: [self doButtonAction]. ! ! !PolygonButtonMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 12:06'! mouseUp: evt oldColor ifNotNil: "if oldColor nil, it signals that mouse had not gone DOWN inside me, e.g. because of a cmd-drag; in this case we want to avoid triggering the action!!" [self color: oldColor. (actWhen == #buttonUp and: [self containsPoint: evt cursorPoint]) ifTrue: [self doButtonAction]] ! ! !PolygonButtonMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 12:06'! target ^ target! ! !PolygonButtonMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 12:06'! target: anObject target _ anObject.! ! !BackTriangleMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 12:20'! initialize super initialize. vertices _ Array with: 40 at 20 with: 20 at 30 with: 40 at 40. borderWidth _ 2. self borderColor: #raised. target _ nil. actionSelector _ #left1. arguments _ EmptyArray. actWhen _ #buttonUp. color _ Color darkGray. closed _ true. quickFill _ true. arrows _ #none. self computeBounds. ! ! !FastBackMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/30/1999 12:46'! initialize | coll | super initialize. coll _ OrderedCollection new. coll add: 50 at 20; add: 40 at 25; add: 40 at 20; add: 20 at 30; add: 40 at 40; add: 40 at 35; add: 50 at 40. "coll add: 20 at 20; add: 40 at 30; add: 20 at 40." vertices _ Array newFrom: coll. borderWidth _ 2. self borderColor: #raised. target _ nil. actionSelector _ #leftLarge. arguments _ EmptyArray. actWhen _ #buttonUp. color _ Color darkGray. closed _ true. quickFill _ true. arrows _ #none. self computeBounds.! ! !FastForwardMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/30/1999 12:34'! initialize | coll | super initialize. coll _ OrderedCollection new. coll add: 20 at 20; add: 30 at 25; add: 30 at 20; add: 50 at 30; add: 30 at 40; add: 30 at 35; add: 20 at 40. "coll add: 20 at 20; add: 40 at 30; add: 20 at 40." vertices _ Array newFrom: coll. borderWidth _ 2. self borderColor: #raised. target _ nil. actionSelector _ #rightLarge. arguments _ EmptyArray. actWhen _ #buttonUp. color _ Color darkGray. closed _ true. quickFill _ true. arrows _ #none. self computeBounds. ! ! !ForwardTriangleMorph methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 18:14'! initialize super initialize. vertices _ Array with: 20 at 20 with: 40 at 30 with: 20 at 40. borderWidth _ 2. self borderColor: #raised. target _ nil. actionSelector _ #right1. arguments _ EmptyArray. actWhen _ #buttonUp. color _ Color darkGray. closed _ true. quickFill _ true. arrows _ #none. self computeBounds. ! ! !Story commentStamp: '<historical>' prior: 0! Still need to add accessors for features. Will have them for noun phrases, named entities, named entities by type, and features in general (combination of lists). Need to decide if I'll return the lists or copies of the lists.! !Story methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:16'! chi2 ^ chi2! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:16'! chi2: aFloat chi2 _ aFloat.! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/27/1999 18:35'! duration ^ ( (stop - start) + 1)! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/27/1999 18:35'! label1 ^ label1! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/27/1999 18:35'! label1: aString label1 _ aString.! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/27/1999 18:35'! label2 ^ label2! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/27/1999 18:35'! label2: aString label2 _ aString.! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:16'! rank ^ rank! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:17'! rank: anInteger rank _ anInteger.! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:17'! start ^ start.! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/27/1999 02:09'! start: anInteger start _ anInteger.! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:17'! stop ^ stop.! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/18/1999 00:18'! stop: anInteger stop _ anInteger.! ! !Story methodsFor: 'accessors' stamp: 'RCS 10/27/1999 18:34'! storySize "report how long this story spans" ^ (nounPhrases size + namedEntities size)! ! !Story methodsFor: 'accessors' stamp: 'RCS 11/14/1999 00:57'! updatingLabel1: aString label1 _ aString. "self halt." owner updateGraphic.! ! !Story methodsFor: 'accessors' stamp: 'RCS 11/14/1999 00:12'! updatingLabel2: aString label2 _ aString. "self halt." owner updateGraphic.! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 11/18/1999 12:56'! doHist | h bars m | h _ self getHistogram. bars _ h collect: [:v | Morph new extent: 5 at v]. m _ AlignmentMorph newRow centering: #bottomRight. m addAllMorphs: bars. m openInWorld. " ^ m" ! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 10/29/1999 07:02'! doNothing ! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 11/18/1999 12:54'! getHistogram | hist | hist _ OrderedCollection new. hist add: 5. hist add: 7. hist add: 4. hist add: 0. hist add: 9. hist add: 13. hist add: 4. hist add: 0. ^ hist.! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 12/2/1999 22:53'! getStandardSubMenu: aSymbol | subMenu | subMenu _ MyMenuMorph new. subMenu addStayUpItem. subMenu defaultTarget: self. subMenu add: 'Make title' target: subMenu action: aSymbol. subMenu addLine. subMenu add: 'Get Histogram' action: #doNothing. subMenu addLine. subMenu add: 'show context' action: #doNothing. subMenu add: 'Your ad here!!!!' action: #doNothing. subMenu addLine. subMenu addTitle: 'foo' updatingSelector: #getPopUpOwnerName updateTarget: subMenu. ^ subMenu.! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 10/27/1999 00:53'! namedEntities ^ namedEntities.! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 10/27/1999 00:54'! namedEntities: anOrderedCollection namedEntities _ anOrderedCollection.! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:40'! namedEntitiesName: showName loc: showLoc org: showOrg | coll tempColl | coll _ namedEntities reject: [ :v | ( v string) = (self label1)]. (showName) ifFalse: [ tempColl _ coll. coll _ tempColl reject: [ :v | v isNamedPerson ]. ]. (showLoc) ifFalse: [ tempColl _ coll. coll _ tempColl reject: [ :v | v isNamedPlace ]. ]. (showOrg) ifFalse: [ tempColl _ coll. coll _ tempColl reject: [ :v | v isNamedOrg ]. ]. ^ coll.! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 10/27/1999 00:53'! nounPhrases ^ nounPhrases.! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 10/27/1999 00:54'! nounPhrases: anOrderedCollection nounPhrases _ anOrderedCollection.! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 23:59'! owner ^ owner! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 11/14/1999 00:00'! owner: anObject owner _ anObject.! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 12/12/1999 17:00'! putUpMenu1: someArgs | menu subMenu | menu _ MyMenuMorph new. subMenu _ self getStandardSubMenu: #changeLabel1. menu stayUp: true. menu addMyStayUpItem. menu addShowNames. menu addShowLoc. menu addShowOrg. menu addLine. menu defaultTarget: self. menu addLine. menu add: self label1 subMenu: subMenu. menu addLine. menu addTitle: self label1. namedEntities do: [ :v | (( v string) = self label1 ) ifFalse: [ menu add: v string subMenu: subMenu] ]. menu position: someArgs. menu openInWorld.! ! !Story methodsFor: 'as yet unclassified' stamp: 'RCS 12/12/1999 17:01'! putUpMenu2: someArgs | menu subMenu | subMenu _ self getStandardSubMenu: #changeLabel2. menu _ MyMenuMorph new. menu stayUp: true. menu addMyStayUpItem. menu stayUp: true. menu defaultTarget: self. menu addLine. menu add: self label2 subMenu: subMenu. menu addLine. menu addTitle: self label2. nounPhrases do: [ :v | (( v string) = self label2 ) ifFalse: [ menu add: v string subMenu: subMenu] ]. menu position: someArgs. menu openInWorld.! ! !Timeline methodsFor: 'input events' stamp: 'RCS 2/22/2000 11:59'! fitToWindow " A lot of code here, but this is a window init function, which tend to get big" " Code is fairly understandable. I'll clean it up as I learn" | worldRect worldLength worldHeight sliderLength leftOffset | World restoreDisplay. worldRect _ World bounds. worldLength _ worldRect right - worldRect left. worldHeight _ worldRect bottom - worldRect top. sliderLength _ worldLength - 250. leftOffset _ 150. startSlider position: leftOffset@(worldHeight-40). startSlider extent: sliderLength at 16. stopSlider position: leftOffset@(worldHeight-20). stopSlider extent: sliderLength at 16. forward position: (worldLength - 95)@(worldHeight - 35). back position: 120@(worldHeight - 35). counter position: 40@(worldHeight - 100). counterLabel position:20@(worldHeight - 120). numberStoriesLabel position:50@(worldHeight - 150). fastForward position: (worldLength - 60)@(worldHeight - 35). fastBack position: 80@(worldHeight - 35). graphic position: leftOffset at 50. graphic extent: sliderLength@(worldHeight-100). ! ! !Timeline methodsFor: 'input events' stamp: 'RCS 2/22/2000 21:58'! setDate: aString start: anInt stop: anotherInt " A lot of code here, but this is a window init function, which tend to get big" " Code is fairly understandable. I'll clean it up as I learn" | worldRect worldLength worldHeight sliderLength leftOffset boundaryCollection labelCollection button | (World class = PasteUpMorph) ifTrue: [ worldRect _ World bounds. worldLength _ worldRect right - worldRect left. worldHeight _ worldRect bottom - worldRect top. "sliderLength _ (0.85 * worldLength) asInteger. leftOffset _ (0.1 * worldLength) asInteger." sliderLength _ worldLength - 250. leftOffset _ 150. begDate _ Date fromString: aString. minVal _ anInt. maxVal _ anotherInt. showStart _ minVal. showStop _ maxVal. startSlider _ MySlider new initialize openInWorld. startSlider model: self slotName: 'startSlider'. startSlider position: leftOffset@(worldHeight-40). startSlider extent: sliderLength at 16. stopSlider _ MySlider new initialize openInWorld. stopSlider model: self slotName: 'stopSlider'. stopSlider position: leftOffset@(worldHeight-20). stopSlider extent: sliderLength at 16. stopSlider value: 1.0. forward _ ForwardTriangleMorph new. forward target: self. forward position: (worldLength - 95)@(worldHeight - 35). back _ BackTriangleMorph new. back target: self. back position: 120@(worldHeight - 35). forward openInWorld. back openInWorld. counter _ CounterApplication openAsMorph. counter position: 40@(worldHeight - 100). counter counter currentValue: 6. numStoriesShown _ 6. counter addDependent: self. counterLabel _ TextMorph new contents:'Max stories to show'; position:20@(worldHeight - 120); openInWorld; configureForKids. fastForward _ FastForwardMorph new. fastForward target: self. fastForward position: (worldLength - 60)@(worldHeight - 35). fastBack _ FastBackMorph new. fastBack target: self. fastBack position: 80@(worldHeight - 35). fastForward openInWorld. fastBack openInWorld. boundaryCollection _ OrderedCollection new. labelCollection _ OrderedCollection new. self getBound: boundaryCollection andLabels: labelCollection fromDate: begDate start: anInt stop: anotherInt. graphic _ ArrayScale new initialize. graphic setBoundary: boundaryCollection andLabels: labelCollection. graphic model: self. graphic start: anInt. graphic stop: anotherInt. graphic position: leftOffset at 50. graphic extent: sliderLength@(worldHeight-100). graphic openInWorld. button _ SimpleButtonMorph new. button label: 'resize'. button target: self. button actionSelector: #fitToWindow. button position: 40 at 60. button cornerStyle: #square. button openInWorld. yFillButton _ SimpleButtonMorph new. yFillButton label: 'fixed y'. yFillButton target: self. yFillButton actionSelector: #toggleYFill. yFillButton position: 40 at 90. yFillButton cornerStyle: #square. yFill _ #fixed. yFillButton openInWorld. ] ifFalse: [self halt.]. ! ! !Timeline methodsFor: 'input events' stamp: 'RCS 2/22/2000 00:29'! startSlider: arg1 | myParamArray | "Automatically generated null response." "Add code below for appropriate behavior..." startSliderValue _ arg1. showStart _ (startSliderValue * (maxVal - minVal) + 0.5) truncated + minVal. "Transcript show: 'Timeline>>startSlider arg1 = '; show: arg1 asString; cr." myParamArray _ Array new: 2. myParamArray at:1 put: #startSlider. myParamArray at:2 put: arg1. "self changed: myParamArray." self changed: {#startSlider. arg1, showStart}.! ! !Timeline methodsFor: 'input events' stamp: 'RCS 2/22/2000 00:29'! startSliderValue: arg1 | myParamArray newArg| "Automatically generated null response." "Add code below for appropriate behavior..." startSliderValue _ arg1. showStart _ (startSliderValue * (maxVal - minVal) + 0.5) truncated + minVal. newArg _ (showStart - minVal) / (maxVal - minVal). "Transcript show: 'Timeline>>startSlider arg1 = '; show: arg1 asString; cr." myParamArray _ Array new: 2. myParamArray at:1 put: #startSlider. myParamArray at:2 put: newArg. "self changed: myParamArray." self changed: {#startSlider. arg1. showStart}. (showStart < showStop) ifFalse:[ self setStop: showStart + 1.].! ! !Timeline methodsFor: 'input events' stamp: 'RCS 2/22/2000 00:30'! stopSlider: arg1 | myParamArray | "Automatically generated null response." "Add code below for appropriate behavior..." stopSliderValue _ arg1. showStop _ (stopSliderValue * (maxVal - minVal) + 0.5) truncated + minVal. "Transcript show: 'Timeline>>stopSlider arg1 = '; show: arg1 asString; cr." myParamArray _ Array new: 2. myParamArray at:1 put: #stopSlider. myParamArray at:2 put: arg1. "self changed: myParamArray." self changed: {#stopSlider. arg1, showStop}.! ! !Timeline methodsFor: 'input events' stamp: 'RCS 2/22/2000 00:30'! stopSliderValue: arg1 | myParamArray newArg| "Automatically generated null response." "Add code below for appropriate behavior..." stopSliderValue _ arg1. showStop _ (stopSliderValue * (maxVal - minVal) + 0.5) truncated + minVal. newArg _ (showStop - minVal) / (maxVal - minVal). "Transcript show: 'Timeline>>stopSlider arg1 = '; show: arg1 asString; cr." myParamArray _ Array new: 2. myParamArray at:1 put: #stopSlider. myParamArray at:2 put: newArg. "self changed: myParamArray." self changed: {#stopSlider. arg1. showStop}. (showStart < showStop) ifFalse:[ self setStart: showStop - 1.].! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 10/17/1999 21:57'! begDate ^ begDate.! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 11/20/1999 17:25'! build: urlString | file startnum stopnum dateString curString storyURL list | file _ HTTPSocket httpGet:urlString. "self halt." curString _ file nextDelimited: Character separators. list _ curString findTokens: Character separators. startnum _ (list at: 1) asNumber. stopnum _ (list at: 2) asNumber. dateString _ list at: 3. storyURL _ list at:4. self setDate: dateString start: startnum stop: stopnum. self getStoriesFromURL: storyURL.! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 11/21/1999 23:20'! getBound: bCollection andLabels: lCollection fromDate: anchorDate start: startVal stop: stopVal | begMonth begYear endMonth endYear tempDate | tempDate _ anchorDate addDays: stopVal. endMonth _ tempDate monthIndex. endYear _ tempDate year. tempDate _ anchorDate addDays: startVal. begMonth _ tempDate monthIndex. begYear _ tempDate year. (endYear = begYear) ifFalse: [ " I don't handle this yet. Need to fix later" self halt. ] ifTrue: [ bCollection add: startVal. lCollection add: tempDate monthName. (begMonth + 1) to: endMonth do: [ :v | tempDate _ Date newDay: 1 month: v year: begYear. bCollection add: (tempDate subtractDate: anchorDate). lCollection add: tempDate monthName. ]. bCollection add: (stopVal + 1). ]. ! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 11/9/1999 11:06'! getStoriesFromFile: fileName | file hack | file _ FileStream oldFileNamed: fileName. hack _ HackClass new. self stories: (hack buildStory:file). file close.! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 2/22/2000 00:51'! getStoriesFromURL: url | file hack worldRect worldHeight | file _ HTTPSocket httpGet:url. hack _ WebHackClass new. self stories: (hack buildStory:file). file close. worldRect _ World bounds. worldHeight _ worldRect bottom - worldRect top. numberStoriesLabel _ TextMorph new contents:self stories size printString, ' stories'; position:50@(worldHeight - 150); openInWorld; configureForKids.! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 18:18'! left1 | newArg| (showStart > minVal) ifTrue: [ showStop _ showStop - 1. newArg _ (showStop - minVal) / (maxVal - minVal). self changed: { #stopSlider. newArg. showStop }. showStart _ showStart - 1. newArg _ (showStart - minVal) / (maxVal - minVal). self changed: { #startSlider. newArg. showStart }. ]! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 11/30/1999 12:45'! leftLarge | newArg amtToMove roomToMove | roomToMove _ showStart - minVal. (roomToMove > 0) ifTrue: [ amtToMove _ ((showStop - showStart) * 7 /10) rounded. (amtToMove > roomToMove) ifTrue: [ amtToMove _ roomToMove ]. showStop _ showStop - amtToMove. newArg _ (showStop - minVal) / (maxVal - minVal). self changed: { #stopSlider. newArg. showStop }. showStart _ showStart - amtToMove. newArg _ (showStart - minVal) / (maxVal - minVal). self changed: { #startSlider. newArg. showStart }. ]! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 12/2/1999 22:12'! numberStoriesToShow ^ numStoriesShown.! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 11/24/1999 18:17'! right1 | newArg| (showStop < maxVal) ifTrue: [ showStop _ showStop + 1. newArg _ (showStop - minVal) / (maxVal - minVal). self changed: { #stopSlider. newArg. showStop }. showStart _ showStart + 1. newArg _ (showStart - minVal) / (maxVal - minVal). self changed: { #startSlider. newArg. showStart }. ]! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 11/30/1999 12:36'! rightLarge | newArg amtToMove roomToMove | roomToMove _ maxVal - showStop. (roomToMove > 0) ifTrue: [ amtToMove _ ((showStop - showStart) * 7 /10) rounded. (amtToMove > roomToMove) ifTrue: [ amtToMove _ roomToMove ]. showStop _ showStop + amtToMove. newArg _ (showStop - minVal) / (maxVal - minVal). self changed: { #stopSlider. newArg. showStop }. showStart _ showStart + amtToMove. newArg _ (showStart - minVal) / (maxVal - minVal). self changed: { #startSlider. newArg. showStart }. ]! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 10/16/1999 10:13'! setStart: aValue | newArg| showStart _ aValue. newArg _ (showStart - minVal) / (maxVal - minVal). "myParamArray _ Array new: 2. myParamArray at:1 put: #startSlider. myParamArray at:2 put: newArg." self changed: { #startSlider. newArg. showStart}.! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 10/16/1999 10:14'! setStop: aValue | newArg| showStop _ aValue. newArg _ (showStop - minVal) / (maxVal - minVal). "myParamArray _ Array new: 2. myParamArray at:1 put: #stopSlider. myParamArray at:2 put: newArg." self changed: { #stopSlider. newArg. showStop }.! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 10/27/1999 18:55'! stories ^ stories! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 11/14/1999 00:07'! stories: aStoryList stories _ aStoryList. aStoryList do: [ :v | v owner: self]. graphic buildLabels.! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 2/22/2000 22:12'! toggleYFill (yFill = #fixed) ifTrue: [ yFill _ #fill. yFillButton label: 'fill y'. ] ifFalse: [ yFill _ #fixed. yFillButton label: 'fixed y'. ]. graphic buildLabels.! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 12/2/1999 22:33'! update: aSymbol | newNumber | (aSymbol = #counterChanged) ifTrue: [ newNumber _ counter counter currentValue. (numStoriesShown = newNumber) ifFalse: [ numStoriesShown _ newNumber. self updateGraphic. ] ]! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 11/14/1999 00:13'! updateGraphic (graphic isNil) ifFalse: [ graphic buildLabels].! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 10/27/1999 19:09'! visibleStories | newList selectBlock | ( stories isNil) ifTrue: [ ^ nil]. selectBlock _ [ :s | (s start < showStop) & (s stop > showStart)]. newList _ stories select: selectBlock. ^ newList. ! ! !Timeline methodsFor: 'as yet unclassified' stamp: 'RCS 2/22/2000 21:58'! yFill ^ yFill.! ! !Timeline class methodsFor: 'Examples' stamp: 'RCS 2/22/2000 22:28'! tdt1demo "Build example timeline from last 6 months of TDT1 corpus" Timeline new build:'hobart.cs.umass.edu/~swan/tdt'.! ! !Timeline class methodsFor: 'Examples' stamp: 'RCS 2/22/2000 22:29'! tdt2 "Build full timeline from TDT2 corpus" Timeline new build:'hobart.cs.umass.edu/~swan/tdt2full'.! ! !Timeline class methodsFor: 'Examples' stamp: 'RCS 2/22/2000 22:28'! tdt2demo "Build example timeline from TDT2 corpus" Timeline new build:'hobart.cs.umass.edu/~swan/tdt2'.! ! !Timeline class methodsFor: 'Examples' stamp: 'RCS 2/22/2000 22:29'! tdt2eval "Build timeline from TDT2 eval corpus (May - June)" Timeline new build:'hobart.cs.umass.edu/~swan/tdt2eval'.! ! !WebHackClass methodsFor: 'as yet unclassified' stamp: 'RCS 2/22/2000 13:04'! buildNamedEntityList: aFile | tupletString tuplet localList start stop chi2 type localString feat | localList _ OrderedCollection new. [true] whileTrue: [ tupletString _ aFile nextDelimited: $}. tuplet _ tupletString findTokens: Character separators. ((tuplet size) < 1) ifTrue: [ ^ localList.]. start _ tuplet at: 2 asNumber. stop _ tuplet at: 3 asNumber. chi2 _ tuplet at: 4 asNumber. type _ tuplet at: 5. localString _ tuplet at: 6. (tuplet size > 6 ) ifTrue: [ 7 to: (tuplet size) do: [ :v | localString _ localString, ' ', (tuplet at: v). ].]. (type = 'ORGANIZATION') ifTrue: [ feat _ NamedOrg new.]. (type = 'LOCATION') ifTrue: [ feat _ NamedPlace new.]. (type = 'PERSON') ifTrue: [ feat _ NamedPerson new.]. feat start: start; stop: stop; chi2: chi2; string: localString. localList add: feat. ] ! ! !WebHackClass methodsFor: 'as yet unclassified' stamp: 'RCS 2/22/2000 13:04'! buildNounPhrases: aFile | tupletString tuplet localList start stop chi2 localString feat | localList _ OrderedCollection new. [true] whileTrue: [ tupletString _ aFile nextDelimited: $}. tuplet _ tupletString findTokens: Character separators. ((tuplet size) < 1) ifTrue: [ ^ localList.]. start _ tuplet at: 2 asNumber. stop _ tuplet at: 3 asNumber. chi2 _ tuplet at: 4 asNumber. localString _ tuplet at: 5. (tuplet size > 5 ) ifTrue: [ 6 to: (tuplet size) do: [ :v | localString _ localString, ' ', (tuplet at: v). ].]. feat _ NounPhrase new. feat start: start; stop: stop; chi2: chi2; string: localString. localList add: feat. ] ! ! !WebHackClass methodsFor: 'as yet unclassified' stamp: 'RCS 11/13/1999 16:27'! buildStory:aFile | storyObj localList start stop rank chi2 list1 list2 strip toklist | " aFile is something returned by HTTPSocket httpGet: 'url' " localList _ OrderedCollection new. [aFile atEnd] whileFalse: [ storyObj _ Story new. strip _ aFile nextDelimited: ${. toklist _ strip findTokens: Character separators. start _ toklist first asNumber. stop _ toklist second asNumber. rank _ toklist third asNumber. chi2 _ toklist fourth asNumber. "strip _ aFile nextDelimited: ${." list1 _ self buildNamedEntityList: aFile. strip _ aFile nextDelimited: ${. list2 _self buildNounPhrases: aFile. "Transcript show: 'here I am, last line in loop is: ', line; cr." "line _ aFile nextLine." storyObj start: start. storyObj stop: stop. storyObj rank: rank. storyObj chi2: chi2. localList add: storyObj. storyObj namedEntities: list1. storyObj label1: ((list1 at:1) string). storyObj nounPhrases: list2. storyObj label2: ((list2 at:1) string). strip _ aFile nextDelimited: ${. ]. ^ localList.! ! Timeline class removeSelector: #tdt1!
More information about the Squeak-dev mailing list |