+ ToExShapeContainerElement example

fix ToQueueBasedCommandApplicationStrategy>>commandApplier: element:

src/Toplo-Examples/ToExShapeContainerCommand.class.st

@@ -0,0 +1,11 @@
+Class {
+	#name : #ToExShapeContainerCommand,
+	#superclass : #Object,
+	#category : #'Toplo-Examples-Experiments'
+}
+
+{ #category : #hook }
+ToExShapeContainerCommand >> applyOn: aShapeContainer [
+
+	self subclassResponsibility 
+]

src/Toplo-Examples/ToExShapeContainerElement.class.st

@@ -0,0 +1,55 @@
+Class {
+	#name : #ToExShapeContainerElement,
+	#superclass : #BlElement,
+	#instVars : [
+		'shapes'
+	],
+	#category : #'Toplo-Examples-Experiments'
+}
+
+{ #category : #'instance creation' }
+ToExShapeContainerElement class >> open [
+
+	<script>
+	self new openInSpace
+]
+
+{ #category : #drawing }
+ToExShapeContainerElement >> aeDrawOn: aeCanvas [
+
+	| extent |
+	super aeDrawOn: aeCanvas.
+	extent := self extent.
+	shapes do: [ :s |
+		aeCanvas pathFactory: [ :cairoContext |
+			cairoContext
+				circleCenterX: s shape center x * extent x / 100
+				y: s shape center y * extent y / 100
+				radius: s shape radius ].
+		aeCanvas setBackgroundWith: [ aeCanvas setSourceColor: s background ].
+		aeCanvas drawFigure ]
+]
+
+{ #category : #initialization }
+ToExShapeContainerElement >> initialize [
+
+	super initialize.
+	shapes := [  ].
+	self background: Color veryLightGray.
+	self constraintsDo: [ :c |
+		c horizontal matchParent.
+		c vertical matchParent ]
+]
+
+{ #category : #accessing }
+ToExShapeContainerElement >> shapes [
+
+	^ shapes 
+]
+
+{ #category : #accessing }
+ToExShapeContainerElement >> shapes: aShapeModelArray [
+
+	shapes := aShapeModelArray.
+	self invalidate
+]

src/Toplo-Examples/ToExShapeContainerManager.class.st

@@ -0,0 +1,66 @@
+Class {
+	#name : #ToExShapeContainerManager,
+	#superclass : #Object,
+	#instVars : [
+		'commandApplicationStrategy',
+		'shapeContainer'
+	],
+	#category : #'Toplo-Examples-Experiments'
+}
+
+{ #category : #'instance creation' }
+ToExShapeContainerManager class >> open [ 
+
+	<script>
+	self new open
+]
+
+{ #category : #adding }
+ToExShapeContainerManager >> addCommand: aCommand [
+
+	commandApplicationStrategy addCommand: aCommand 
+]
+
+{ #category : #adding }
+ToExShapeContainerManager >> applyCommand: aCommand [
+
+	aCommand applyOn: shapeContainer 
+]
+
+{ #category : #initialization }
+ToExShapeContainerManager >> defaultCommandApplicationStrategy [
+
+	^ ToQueueBasedCommandApplicationStrategy new
+]
+
+{ #category : #'instance creation' }
+ToExShapeContainerManager >> open [
+
+	self shapeContainer: ToExShapeContainerElement new.
+	shapeContainer openInSpace.
+	self addCommand: (ToExShapeNewGenerationCommand new
+			 size: 1000;
+			 yourself).
+	[
+	1 to: 500 do: [ :n |
+		self addCommand: ToExShapeShuffleCommand new.
+		n odd
+			ifTrue: [
+				self addCommand: (ToExShapeSortCommand new
+						 sortBlock: [ :a :b | b num < a num ];
+						 yourself) ]
+			ifFalse: [
+				self addCommand: (ToExShapeSortCommand new
+						 sortBlock: [ :a :b | a num < b num ];
+						 yourself) ].
+
+		(Delay forMilliseconds: 50) wait ] ] fork
+]
+
+{ #category : #accessing }
+ToExShapeContainerManager >> shapeContainer: aShapeContainer [
+
+	shapeContainer := aShapeContainer.
+	commandApplicationStrategy := self defaultCommandApplicationStrategy.
+	commandApplicationStrategy commandApplier: self element: shapeContainer
+]

src/Toplo-Examples/ToExShapeModel.class.st

@@ -0,0 +1,52 @@
+Class {
+	#name : #ToExShapeModel,
+	#superclass : #Object,
+	#instVars : [
+		'num',
+		'background',
+		'shape'
+	],
+	#category : #'Toplo-Examples-Experiments'
+}
+
+{ #category : #comparing }
+ToExShapeModel >> <= other [
+
+	^ num <= other num
+]
+
+{ #category : #accessing }
+ToExShapeModel >> background [
+
+	^ background
+]
+
+{ #category : #accessing }
+ToExShapeModel >> background: anObject [
+
+	background := anObject
+]
+
+{ #category : #accessing }
+ToExShapeModel >> num [
+
+	^ num
+]
+
+{ #category : #accessing }
+ToExShapeModel >> num: anObject [
+
+	num := anObject
+]
+
+{ #category : #accessing }
+ToExShapeModel >> shape [
+
+	^ shape
+]
+
+{ #category : #accessing }
+ToExShapeModel >> shape: aShape [
+
+	shape := aShape
+]

src/Toplo-Examples/ToExShapeNewGenerationCommand.class.st

@@ -0,0 +1,55 @@
+Class {
+	#name : #ToExShapeNewGenerationCommand,
+	#superclass : #ToExShapeContainerCommand,
+	#instVars : [
+		'random',
+		'size'
+	],
+	#category : #'Toplo-Examples-Experiments'
+}
+
+{ #category : #hook }
+ToExShapeNewGenerationCommand >> applyOn: aShapeContainer [
+
+	aShapeContainer shapes: self nextGeneration
+]
+
+{ #category : #initialization }
+ToExShapeNewGenerationCommand >> initialize [ 
+
+	super initialize.
+	random := Random new
+]
+
+{ #category : #'private - application' }
+ToExShapeNewGenerationCommand >> newCircle [
+
+	| center radius |
+	center := random next * 100 @ (random next * 100). "center as a percentage of the bounds"
+	radius := random nextBetween: 3 and: 20.
+	^ GCircle center: center asGPoint radius: radius
+]
+
+{ #category : #'private - application' }
+ToExShapeNewGenerationCommand >> nextGeneration [
+
+	^ Array streamContents: [ :stream |
+		  1 to: size do: [ :i |
+			  | shape model color |
+			  color := i <= (size / 2)
+				           ifTrue: [ Color blue ]
+				           ifFalse: [ Color red ].
+			  shape := self newCircle.
+			  model := ToExShapeModel new
+				           num: i;
+				           background: color;
+				           shape: shape;
+				           yourself.
+			  stream nextPut: model ] ]
+]
+
+{ #category : #'as yet unclassified' }
+ToExShapeNewGenerationCommand >> size: aNumber [
+
+	size := aNumber
+]

src/Toplo-Examples/ToExShapeShuffleCommand.class.st

@@ -0,0 +1,34 @@
+Class {
+	#name : #ToExShapeShuffleCommand,
+	#superclass : #ToExShapeContainerCommand,
+	#instVars : [
+		'random'
+	],
+	#category : #'Toplo-Examples-Experiments'
+}
+
+{ #category : #hook }
+ToExShapeShuffleCommand >> applyOn: aShapeContainer [
+
+	| shapes |
+	shapes := aShapeContainer shapes.
+	shapes do: [ :s |
+		s shape: (self movedCircle: s) ].
+	aShapeContainer invalidate
+]
+
+{ #category : #initialization }
+ToExShapeShuffleCommand >> initialize [ 
+
+	super initialize.
+	random := Random new
+]
+
+{ #category : #initialization }
+ToExShapeShuffleCommand >> movedCircle: aCircle [
+
+	| center radius |
+	center := random next * 100 @ (random next * 100). "center as a percentage of the bounds"
+	radius := aCircle shape radius.
+	^ GCircle center: center asGPoint radius: radius
+]

src/Toplo-Examples/ToExShapeSortCommand.class.st

@@ -0,0 +1,23 @@
+Class {
+	#name : #ToExShapeSortCommand,
+	#superclass : #ToExShapeContainerCommand,
+	#instVars : [
+		'sortBlock'
+	],
+	#category : #'Toplo-Examples-Experiments'
+}
+
+{ #category : #hook }
+ToExShapeSortCommand >> applyOn: aShapeContainer [
+
+	| shapes |
+	shapes := aShapeContainer shapes asSortedCollection: sortBlock.
+	aShapeContainer shapes: shapes asArray 
+
+]
+
+{ #category : #accessing }
+ToExShapeSortCommand >> sortBlock: anObject [
+
+	sortBlock := anObject
+]

src/Toplo-Widget-List/ToListSelecter.class.st

@@ -17,7 +17,7 @@ Class {
 	#category : #'Toplo-Widget-List-Selection-Selecter'
 }
 
-{ #category : #adding }
+{ #category : #'command application' }
 ToListSelecter >> addCommand: aCommand [
 
 	enabled ifFalse: [ ^ self ].

src/Toplo-Widget-List/ToQueueBasedCommandApplicationStrategy.class.st

@@ -29,7 +29,7 @@ ToQueueBasedCommandApplicationStrategy >> commandApplier: aCommandApplier elemen
 	super commandApplier: aCommandApplier element: anElement.
 	commandQueue := OrderedCollection new.
 	applicationTask := ToCommandApplicationTask new
-		                   element: aCommandApplier element;
+		                   element: anElement;
 		                   applier: aCommandApplier;
 		                   commandQueue: commandQueue;
 		                   finishedAction: [ queued := false ];