--- /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 $'
+! !
+