diff -r 6f40d57a93c4 -r 2562070b22a5 gui/PPBrowserStream.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gui/PPBrowserStream.st	Tue Mar 04 22:14:15 2014 +0100
@@ -0,0 +1,161 @@
+"{ Package: 'stx:goodies/petitparser/gui' }"
+
+PPStream subclass:#PPBrowserStream
+	instanceVariableNames:'positions stamps parsers'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitGui-Core'
+!
+
+
+!PPBrowserStream methodsFor:'accessing'!
+
+next
+	| result |
+	result := super next.
+	self step.
+	^ result
+!
+
+next: aNumber
+	| result |
+	result := super next: aNumber.
+	self step.
+	^ result
+! !
+
+!PPBrowserStream methodsFor:'converting'!
+
+asExecutionTrace
+	| trace |
+	trace := OrderedCollection new: parsers size.
+	1 to: parsers size do: [ :index |
+		| parser |
+		parser := parsers at: index.
+		parser name isNil ifFalse: [
+			| start stop |
+			start := positions at: index.
+			stop := positions at: index + 1 ifAbsent: [ self size ].
+			trace addLast: (Array with: parser with: start with: stop) ] ].
+	^ trace
+!
+
+asFrequencyTable
+	| bag total result |
+	bag := parsers asBag.
+	total := 100.0 / bag size.
+	result := OrderedCollection new.
+	bag sortedCounts 
+		do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ].
+	^ result
+!
+
+asPositionDrawing
+	| stream source last |
+	stream := WriteStream on: String new.
+	source := self contents readStream.
+	last := 0.
+	[ source atEnd ] whileFalse: [
+		[ source atEnd not and: [ source peek isSeparator ] ]
+			whileTrue: [ source next ].
+		stream nextPutAll: '\fill [source] ('; print: source position / 100.0; nextPutAll: ', 0) rectangle ('.
+		[ source atEnd not and: [ source peek isSeparator not ] ]
+			whileTrue: [ source next ].
+		stream print: source position / 100.0; nextPutAll: ', '; print: self positions size / 100.0; nextPutAll: ');'; cr ].
+	stream nextPutAll: '\draw [parser] (0, 0)'.
+	1 to: self positions size do: [ :index |
+		last <= (self positions at: index)
+			ifTrue: [ stream nextPutAll: ' --' ].
+		last := self positions at: index.
+		stream nextPutAll: ' ('; print: last / 100.0; nextPutAll: ', '; print: index / 100.0; nextPut: $) ].
+	stream nextPut: $;.
+	^ stream contents
+!
+
+asPositionMorph
+	| width height canvas morph |
+	width := self size + 1 min: 2048.
+	height := self positions size min: 2048.
+	canvas := FormCanvas extent: width @ height.
+	self contents keysAndValuesDo: [ :index :char |
+		char isSeparator 
+			ifFalse: [ canvas line: index @ 1 to: index @ height color: Color paleBlue ] ].
+	1 to: height do: [ :index |
+		canvas form colorAt: (self positions at: index) @ index put: Color black ].
+	morph := canvas form asMorph.
+	morph 
+		on: #mouseDown
+		send: #mouseDown:with:
+		to: self.
+	^ morph
+!
+
+asTimingTable
+	| bag total result |
+	bag := Bag new.
+	1 to: stamps size - 1 do: [ :index |
+		bag
+			add: (parsers at: index) 
+			withOccurrences: (stamps at: index + 1) - (stamps at: index) ].
+	total := stamps last - stamps first.
+	result := OrderedCollection new.
+	bag sortedCounts
+		do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ].
+	^ result
+! !
+
+!PPBrowserStream methodsFor:'information'!
+
+parsers
+	^ parsers
+!
+
+positions
+	^ positions
+!
+
+stamps
+	^ stamps
+! !
+
+!PPBrowserStream methodsFor:'positioning'!
+
+position: aNumber
+	super position: aNumber.
+	self step
+!
+
+reset
+	super reset.
+	positions := OrderedCollection new: 1024.
+	stamps := OrderedCollection new: 1024.
+	parsers := OrderedCollection new: 1024
+! !
+
+!PPBrowserStream methodsFor:'private'!
+
+mouseDown: anEvent with: aMorph
+	| location string parser |
+	location := anEvent position.
+	string := collection 
+		copyFrom: (location x - 5 min: collection size max: 1) asInteger
+		to: (location x + 5 min: collection size max: 1) asInteger.
+	parser := parsers at: location y
+!
+
+step
+	positions addLast: position.
+	stamps addLast: Time millisecondClockValue.
+	parsers addLast: thisContext sender sender receiver
+! !
+
+!PPBrowserStream class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/PPBrowserStream.st,v 1.1 2014-03-04 21:14:15 cg Exp $'
+!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/PPBrowserStream.st,v 1.1 2014-03-04 21:14:15 cg Exp $'
+! !
+