gui/PPBrowserStream.st
changeset 328 2562070b22a5
equal deleted inserted replaced
327:6f40d57a93c4 328:2562070b22a5
       
     1 "{ Package: 'stx:goodies/petitparser/gui' }"
       
     2 
       
     3 PPStream subclass:#PPBrowserStream
       
     4 	instanceVariableNames:'positions stamps parsers'
       
     5 	classVariableNames:''
       
     6 	poolDictionaries:''
       
     7 	category:'PetitGui-Core'
       
     8 !
       
     9 
       
    10 
       
    11 !PPBrowserStream methodsFor:'accessing'!
       
    12 
       
    13 next
       
    14 	| result |
       
    15 	result := super next.
       
    16 	self step.
       
    17 	^ result
       
    18 !
       
    19 
       
    20 next: aNumber
       
    21 	| result |
       
    22 	result := super next: aNumber.
       
    23 	self step.
       
    24 	^ result
       
    25 ! !
       
    26 
       
    27 !PPBrowserStream methodsFor:'converting'!
       
    28 
       
    29 asExecutionTrace
       
    30 	| trace |
       
    31 	trace := OrderedCollection new: parsers size.
       
    32 	1 to: parsers size do: [ :index |
       
    33 		| parser |
       
    34 		parser := parsers at: index.
       
    35 		parser name isNil ifFalse: [
       
    36 			| start stop |
       
    37 			start := positions at: index.
       
    38 			stop := positions at: index + 1 ifAbsent: [ self size ].
       
    39 			trace addLast: (Array with: parser with: start with: stop) ] ].
       
    40 	^ trace
       
    41 !
       
    42 
       
    43 asFrequencyTable
       
    44 	| bag total result |
       
    45 	bag := parsers asBag.
       
    46 	total := 100.0 / bag size.
       
    47 	result := OrderedCollection new.
       
    48 	bag sortedCounts 
       
    49 		do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ].
       
    50 	^ result
       
    51 !
       
    52 
       
    53 asPositionDrawing
       
    54 	| stream source last |
       
    55 	stream := WriteStream on: String new.
       
    56 	source := self contents readStream.
       
    57 	last := 0.
       
    58 	[ source atEnd ] whileFalse: [
       
    59 		[ source atEnd not and: [ source peek isSeparator ] ]
       
    60 			whileTrue: [ source next ].
       
    61 		stream nextPutAll: '\fill [source] ('; print: source position / 100.0; nextPutAll: ', 0) rectangle ('.
       
    62 		[ source atEnd not and: [ source peek isSeparator not ] ]
       
    63 			whileTrue: [ source next ].
       
    64 		stream print: source position / 100.0; nextPutAll: ', '; print: self positions size / 100.0; nextPutAll: ');'; cr ].
       
    65 	stream nextPutAll: '\draw [parser] (0, 0)'.
       
    66 	1 to: self positions size do: [ :index |
       
    67 		last <= (self positions at: index)
       
    68 			ifTrue: [ stream nextPutAll: ' --' ].
       
    69 		last := self positions at: index.
       
    70 		stream nextPutAll: ' ('; print: last / 100.0; nextPutAll: ', '; print: index / 100.0; nextPut: $) ].
       
    71 	stream nextPut: $;.
       
    72 	^ stream contents
       
    73 !
       
    74 
       
    75 asPositionMorph
       
    76 	| width height canvas morph |
       
    77 	width := self size + 1 min: 2048.
       
    78 	height := self positions size min: 2048.
       
    79 	canvas := FormCanvas extent: width @ height.
       
    80 	self contents keysAndValuesDo: [ :index :char |
       
    81 		char isSeparator 
       
    82 			ifFalse: [ canvas line: index @ 1 to: index @ height color: Color paleBlue ] ].
       
    83 	1 to: height do: [ :index |
       
    84 		canvas form colorAt: (self positions at: index) @ index put: Color black ].
       
    85 	morph := canvas form asMorph.
       
    86 	morph 
       
    87 		on: #mouseDown
       
    88 		send: #mouseDown:with:
       
    89 		to: self.
       
    90 	^ morph
       
    91 !
       
    92 
       
    93 asTimingTable
       
    94 	| bag total result |
       
    95 	bag := Bag new.
       
    96 	1 to: stamps size - 1 do: [ :index |
       
    97 		bag
       
    98 			add: (parsers at: index) 
       
    99 			withOccurrences: (stamps at: index + 1) - (stamps at: index) ].
       
   100 	total := stamps last - stamps first.
       
   101 	result := OrderedCollection new.
       
   102 	bag sortedCounts
       
   103 		do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ].
       
   104 	^ result
       
   105 ! !
       
   106 
       
   107 !PPBrowserStream methodsFor:'information'!
       
   108 
       
   109 parsers
       
   110 	^ parsers
       
   111 !
       
   112 
       
   113 positions
       
   114 	^ positions
       
   115 !
       
   116 
       
   117 stamps
       
   118 	^ stamps
       
   119 ! !
       
   120 
       
   121 !PPBrowserStream methodsFor:'positioning'!
       
   122 
       
   123 position: aNumber
       
   124 	super position: aNumber.
       
   125 	self step
       
   126 !
       
   127 
       
   128 reset
       
   129 	super reset.
       
   130 	positions := OrderedCollection new: 1024.
       
   131 	stamps := OrderedCollection new: 1024.
       
   132 	parsers := OrderedCollection new: 1024
       
   133 ! !
       
   134 
       
   135 !PPBrowserStream methodsFor:'private'!
       
   136 
       
   137 mouseDown: anEvent with: aMorph
       
   138 	| location string parser |
       
   139 	location := anEvent position.
       
   140 	string := collection 
       
   141 		copyFrom: (location x - 5 min: collection size max: 1) asInteger
       
   142 		to: (location x + 5 min: collection size max: 1) asInteger.
       
   143 	parser := parsers at: location y
       
   144 !
       
   145 
       
   146 step
       
   147 	positions addLast: position.
       
   148 	stamps addLast: Time millisecondClockValue.
       
   149 	parsers addLast: thisContext sender sender receiver
       
   150 ! !
       
   151 
       
   152 !PPBrowserStream class methodsFor:'documentation'!
       
   153 
       
   154 version
       
   155     ^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/PPBrowserStream.st,v 1.1 2014-03-04 21:14:15 cg Exp $'
       
   156 !
       
   157 
       
   158 version_CVS
       
   159     ^ '$Header: /cvs/stx/stx/goodies/petitparser/gui/PPBrowserStream.st,v 1.1 2014-03-04 21:14:15 cg Exp $'
       
   160 ! !
       
   161