"{ 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 $'

! !