├── .gitignore ├── .project ├── .properties ├── LICENSE ├── Pharo ├── .properties ├── AppMaker │ ├── AmAppMaker.class.st │ ├── AmQuitWindowEventsHanlder.class.st │ ├── README.md │ └── package.st ├── BaselineAnalyzer │ ├── BaDependencyAnalyzer.class.st │ ├── BaDependencyAnalyzerTest.class.st │ └── package.st ├── BaselineOfAppMaker │ ├── BaselineOfAppMaker.class.st │ └── package.st ├── BaselineOfBaselineAnalyzer │ ├── BaselineOfBaselineAnalyzer.class.st │ └── package.st ├── BaselineOfBooleanExpressions │ ├── BaselineOfBooleanExpressions.class.st │ └── package.st ├── BaselineOfCodeMetrics │ ├── BaselineOfCodeMetrics.class.st │ └── package.st ├── BaselineOfConcurrency │ ├── BaselineOfConcurrency.class.st │ └── package.st ├── BaselineOfCsvToPillarConverter │ ├── BaselineOfCsvToPillarConverter.class.st │ └── package.st ├── BaselineOfEasyUI │ ├── BaselineOfEasyUI.class.st │ └── package.st ├── BaselineOfLightweightObserver │ ├── BaselineOfLightweightObserver.class.st │ └── package.st ├── BaselineOfNetworkExtras │ ├── BaselineOfNetworkExtras.class.st │ └── package.st ├── BaselineOfPharoExtra │ ├── BaselineOfPharoExtra.class.st │ └── package.st ├── BaselineOfPharoMisc │ ├── BaselineOfPharoMisc.class.st │ └── package.st ├── BaselineOfSimpleMiddleware │ ├── BaselineOfSimpleMiddleware.class.st │ └── package.st ├── BaselineOfStateMachine │ ├── BaselineOfStateMachine.class.st │ └── package.st ├── BaselineOfTasks │ ├── BaselineOfTasks.class.st │ └── package.st ├── BooleanExpressions │ ├── BeBooleanExpressionsTest.class.st │ ├── Collection.extension.st │ ├── README.md │ └── package.st ├── CodeMetrics-Tests │ ├── CmClassAForTestSupport.class.st │ ├── CmClassBForTestSupport.class.st │ ├── CmClassCForTestSupport.class.st │ ├── CmCodeAnalyzerTest.class.st │ └── package.st ├── CodeMetrics │ ├── CmCodeAnalyzer.class.st │ └── package.st ├── Concurrency │ ├── CcPromise.class.st │ ├── CcPromiseAlreadySettledError.class.st │ ├── CcPromiseTest.class.st │ ├── CcPromiseTimeout.class.st │ ├── CcService.class.st │ ├── CcServiceActivityTest.class.st │ ├── CcServiceConditionalLoopTest.class.st │ ├── CcServiceExamples.class.st │ ├── CcServiceNameAndPriorityTest.class.st │ ├── CcServiceRacingConditions.class.st │ ├── CcServiceRunner.class.st │ ├── CcServiceState.class.st │ ├── CcServiceStateTest.class.st │ ├── CcServiceTest.class.st │ ├── CcStarted.class.st │ ├── CcStopped.class.st │ ├── CcTConcurrencyTest.trait.st │ ├── CcTWaitPolling.trait.st │ ├── CcTimeout.class.st │ └── package.st ├── CsvToPillarConverter │ ├── CsvToPillarConverter.class.st │ └── package.st ├── EasyUI │ ├── Character.extension.st │ ├── CharacterKeyCombinationTest.class.st │ ├── EzApp.class.st │ ├── EzAppTest.class.st │ ├── EzArc.class.st │ ├── EzAtomicDrawing.class.st │ ├── EzBotFleetApp.class.st │ ├── EzBoundedDrawing.class.st │ ├── EzBoundedDrawingTest.class.st │ ├── EzBox.class.st │ ├── EzClosedDrawing.class.st │ ├── EzCompositeDrawing.class.st │ ├── EzDrawing.class.st │ ├── EzDrawingBoard.class.st │ ├── EzDrawingBoardTest.class.st │ ├── EzImageDrawing.class.st │ ├── EzLandscapeApp.class.st │ ├── EzOval.class.st │ ├── EzPacManFace.class.st │ ├── EzPacManFaceLeftward.class.st │ ├── EzPacManFaceRightward.class.st │ ├── EzPacManSprite.class.st │ ├── EzPacmanMovingApp.class.st │ ├── EzPacmanRotatingApp.class.st │ ├── EzPolyLine.class.st │ ├── EzRays.class.st │ ├── EzResizableDiskApp.class.st │ ├── EzRoundBot.class.st │ ├── EzSpaceshipApp.class.st │ ├── EzTDemoApp.trait.st │ ├── EzTDrawingContainer.trait.st │ ├── SpAthensMorph.extension.st │ └── package.st ├── LightweightObserver │ ├── Array.extension.st │ ├── Collection.extension.st │ ├── CompiledMethod.extension.st │ ├── Dictionary.extension.st │ ├── LoArrayAutomaticEventGenerationTest.class.st │ ├── LoAutomaticEventGenerationTest.class.st │ ├── LoCompositeObserver.class.st │ ├── LoCustomEventObserverTest.class.st │ ├── LoDice.class.st │ ├── LoDiceAdder.class.st │ ├── LoDiceAdderPresenter.class.st │ ├── LoDiceAdderTest.class.st │ ├── LoDiceList.class.st │ ├── LoDiceListPresenter.class.st │ ├── LoDiceListTest.class.st │ ├── LoDicePresenter.class.st │ ├── LoDiceTest.class.st │ ├── LoDiceUiTest.class.st │ ├── LoDictionaryAutomaticEventGenerationTest.class.st │ ├── LoElasticCollectionAutomaticEventGenerationTest.class.st │ ├── LoEvent.class.st │ ├── LoEvent1ForTest.class.st │ ├── LoEvent2ForTest.class.st │ ├── LoEvent3ForTest.class.st │ ├── LoEventDispatcher.class.st │ ├── LoGenericObserver.class.st │ ├── LoIvChangeEvent.class.st │ ├── LoNullPackage.class.st │ ├── LoOrderedCollectionAutomaticEventGenerationTest.class.st │ ├── LoSequenceableCollectionAutomaticEventGenerationTest.class.st │ ├── LoSetAutomaticEventGenerationTest.class.st │ ├── LoSingleElementAddEvent.class.st │ ├── LoSingleElementChangeEvent.class.st │ ├── LoSingleElementRemoveEvent.class.st │ ├── LoSingleElementReplaceEvent.class.st │ ├── LoSortedCollectionAutomaticEventGenerationTest.class.st │ ├── LoSubject.class.st │ ├── LoSubjectArray.class.st │ ├── LoSubjectAutomaticCodeGenerationTest.class.st │ ├── LoSubjectBasicMethodChangeForbiddenError.class.st │ ├── LoSubjectDictionary.class.st │ ├── LoSubjectForTest.class.st │ ├── LoSubjectOrderedCollection.class.st │ ├── LoSubjectSet.class.st │ ├── LoSubjectSortedCollection.class.st │ ├── LoSubjectSupportMethod.class.st │ ├── LoTElasticSubjectCollection.trait.st │ ├── LoTMapAccessSubjectCollection.trait.st │ ├── LoTSequeceableSubjectCollection.trait.st │ ├── LoTSubjectCollection.trait.st │ ├── OrderedCollection.extension.st │ ├── Set.extension.st │ ├── SortedCollection.extension.st │ ├── UndefinedObject.extension.st │ └── package.st ├── NetNameResolverBugFix │ ├── NetNameResolver.extension.st │ └── package.st ├── NetworkExtras │ ├── ByteArray.extension.st │ ├── NeAllPortsUsedError.class.st │ ├── NeAlreadyUsedSocketPort.class.st │ ├── NeBroadcastSocket.class.st │ ├── NeChunk.class.st │ ├── NeChunkCollectionInfo.class.st │ ├── NeContentChunk.class.st │ ├── NeDataSplitter.class.st │ ├── NeInvalidBroadcastIp.class.st │ ├── NeInvalidMulticastGroupIpError.class.st │ ├── NeInvalidSocketPortError.class.st │ ├── NeIpAddressTest.class.st │ ├── NeIpV4Address.class.st │ ├── NeMultiSourceDataReconstructor.class.st │ ├── NeMultiSourceSplitReconstructLargeDataTest.class.st │ ├── NeMulticastServer.class.st │ ├── NeMulticastSocket.class.st │ ├── NeMulticastSocketTest.class.st │ ├── NeMulticastUdpServerTest.class.st │ ├── NeServer.class.st │ ├── NeSingleSourceDataReconstructor.class.st │ ├── NeSocket.class.st │ ├── NeSocketTest.class.st │ ├── NeSplitReconstructLargeDataTest.class.st │ ├── NeTLargeDataProviderForTest.trait.st │ ├── NeTResetTrackedUsedPortsOnStartUp.trait.st │ ├── NeTcpServer.class.st │ ├── NeTcpServerTest.class.st │ ├── NeTcpSocket.class.st │ ├── NeTcpSocketPortTest.class.st │ ├── NeTcpSocketTest.class.st │ ├── NeTcpUsedPortsTracker.class.st │ ├── NeUdpLargeDataReceiver.class.st │ ├── NeUdpLargeDataSender.class.st │ ├── NeUdpSendReceiveLargeDataTest.class.st │ ├── NeUdpServer.class.st │ ├── NeUdpServerTest.class.st │ ├── NeUdpSocket.class.st │ ├── NeUdpSocketPortTest.class.st │ ├── NeUdpSocketTest.class.st │ ├── NeUdpUnicastSocketTest.class.st │ ├── NeUdpUsedPortsTracker.class.st │ ├── NeUnicastUdpServer.class.st │ ├── NeUnicastUdpServerTest.class.st │ ├── NeUnicastUdpSocket.class.st │ ├── NeUsedPortsTracker.class.st │ ├── String.extension.st │ ├── ZdcAbstractSocketStream.extension.st │ └── package.st ├── PharoExtra │ ├── DateAndTime.extension.st │ ├── Duration.extension.st │ ├── Number.extension.st │ ├── PeSequenceableCollectionGroupingTest.class.st │ ├── PhDateAndTimeTest.class.st │ ├── PhDurationTest.class.st │ ├── README.md │ ├── SequenceableCollection.extension.st │ ├── Time.extension.st │ └── package.st ├── PharoMisc │ ├── PmGitBridge.class.st │ └── package.st ├── SimpleMiddleware │ ├── Boolean.extension.st │ ├── Character.extension.st │ ├── Color.extension.st │ ├── Number.extension.st │ ├── Object.extension.st │ ├── Point.extension.st │ ├── SmDispatcher.class.st │ ├── SmDispatcherTest.class.st │ ├── SmMarshaller.class.st │ ├── SmMarshallerTest.class.st │ ├── SmMiddleware.class.st │ ├── SmProtocol.class.st │ ├── SmProxy.class.st │ ├── SmRemoteMessage.class.st │ ├── SmRemoteReference.class.st │ ├── SmServer.class.st │ ├── SmSingleMiddlewareTest.class.st │ ├── SmThreeMiddlewareTest.class.st │ ├── String.extension.st │ ├── UndefinedObject.extension.st │ └── package.st ├── StateMachine │ ├── SmAutomaton.class.st │ ├── SmAutomatonTest.class.st │ ├── SmConditionalTransition.class.st │ ├── SmCustomStateForTest.class.st │ ├── SmState.class.st │ ├── SmTransition.class.st │ └── package.st └── Tasks │ ├── TkActingTaskState.class.st │ ├── TkDoneTaskState.class.st │ ├── TkDoneThreadState.class.st │ ├── TkFiniteDurationTask.class.st │ ├── TkFiniteIterationsTask.class.st │ ├── TkFiniteTask.class.st │ ├── TkFixedDurationTaskTest.class.st │ ├── TkFixedIterationsCountTaskTest.class.st │ ├── TkForeverRepeatingTaskTest.class.st │ ├── TkGenericFiniteTask.class.st │ ├── TkGenericFiniteTaskTest.class.st │ ├── TkKilledThreadState.class.st │ ├── TkNewThreadState.class.st │ ├── TkOneShotTaskTest.class.st │ ├── TkPendingTaskState.class.st │ ├── TkSetUpTaskState.class.st │ ├── TkStartableThreadState.class.st │ ├── TkStartedThreadState.class.st │ ├── TkStoppedThreadState.class.st │ ├── TkTConcurrencyTest.trait.st │ ├── TkTWaitPolling.trait.st │ ├── TkTask.class.st │ ├── TkTaskState.class.st │ ├── TkTaskTest.class.st │ ├── TkTaskTestBench.class.st │ ├── TkTearDownTaskState.class.st │ ├── TkTestBench.class.st │ ├── TkThread.class.st │ ├── TkThreadFinalizer.class.st │ ├── TkThreadState.class.st │ ├── TkThreadTest.class.st │ ├── TkThreadTestBench.class.st │ ├── TkTimeout.class.st │ └── package.st ├── README.md └── Resources └── EasyUI ├── rocket-small.png └── rocket.txt /.gitignore: -------------------------------------------------------------------------------- 1 | # changes file 2 | *.changes 3 | 4 | # system image 5 | *.image 6 | 7 | # Pharo Smalltalk Debug log file 8 | PharoDebug.log 9 | 10 | # Squeak Smalltalk Debug log file 11 | SqueakDebug.log 12 | 13 | # Monticello package cache 14 | /package-cache 15 | 16 | # playground cache 17 | /play-cache 18 | /play-stash 19 | 20 | # Metacello-github cache 21 | /github-cache 22 | github-*.zip 23 | -------------------------------------------------------------------------------- /.project: -------------------------------------------------------------------------------- 1 | { 2 | 'srcDirectory' : 'Pharo' 3 | } -------------------------------------------------------------------------------- /.properties: -------------------------------------------------------------------------------- 1 | { 2 | #format : #tonel 3 | } -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018 Noury Bouraqadi 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Pharo/.properties: -------------------------------------------------------------------------------- 1 | { 2 | #format : #tonel 3 | } -------------------------------------------------------------------------------- /Pharo/AppMaker/AmAppMaker.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I turn a development image into a ready to use app. 3 | I disable development menus and shortcuts. 4 | Image is locked so users can only interact via UI kept open. 5 | 6 | Usage 7 | Simply click on the System/'App Maker' menu 8 | " 9 | Class { 10 | #name : #AmAppMaker, 11 | #superclass : #Object, 12 | #category : #AppMaker 13 | } 14 | 15 | { #category : #'app making' } 16 | AmAppMaker class >> makeApp [ 17 | 18 | self new makeApp 19 | ] 20 | 21 | { #category : #'world menu' } 22 | AmAppMaker class >> menuCommandOn: aBuilder [ 23 | 24 | (aBuilder item: #'App Maker') 25 | parent: #System; 26 | action: [ self makeApp ]; 27 | help: 'Turns the image into a ready to use app. Disables all development tool menus & shortcuts.'; 28 | icon: (self iconNamed: #smallObjects) 29 | ] 30 | 31 | { #category : #'app making' } 32 | AmAppMaker >> captureMainWindowEvents [ 33 | World windowEventHandler: AmQuitWindowEventsHanlder new 34 | ] 35 | 36 | { #category : #'app making' } 37 | AmAppMaker >> disableDevMenusAndShortcuts [ 38 | KMRepository default: KMRepository new. 39 | MenubarMorph showMenubar: false. 40 | "By default World does not have an event handler (used in Morph>>handlesMouseDown:). 41 | So, PasteUpMorph>>mouseDown: proceeds and shows popup development menu. 42 | We avoid this by adding an event handler that captures the mouseDown event (see Morph>>on:send:to:)" 43 | World on: #mouseDown send: #value to: nil. 44 | 45 | ] 46 | 47 | { #category : #'app making' } 48 | AmAppMaker >> makeApp [ 49 | self disableDevMenusAndShortcuts. 50 | self removeTaskBar. 51 | self captureMainWindowEvents. 52 | (self confirm: 'Development tools are now disabled. Save image?') ifFalse: [ ^self ]. 53 | self saveImage 54 | ] 55 | 56 | { #category : #'app making' } 57 | AmAppMaker >> removeTaskBar [ 58 | World removeTaskbar 59 | ] 60 | 61 | { #category : #'app making' } 62 | AmAppMaker >> saveImage [ 63 | SessionManager default snapshot: true andQuit: false 64 | ] 65 | -------------------------------------------------------------------------------- /Pharo/AppMaker/AmQuitWindowEventsHanlder.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I handle main window events received by World. 3 | I quit whenever requested 4 | " 5 | Class { 6 | #name : #AmQuitWindowEventsHanlder, 7 | #superclass : #Object, 8 | #category : #AppMaker 9 | } 10 | 11 | { #category : #'event handling' } 12 | AmQuitWindowEventsHanlder >> windowEvent: anEvent [ 13 | anEvent type == #windowClose ifTrue: [ 14 | SessionManager default snapshot: false andQuit: true]. 15 | 16 | ] 17 | -------------------------------------------------------------------------------- /Pharo/AppMaker/README.md: -------------------------------------------------------------------------------- 1 | # AppMaker 2 | I turn a development image into a ready to use app. 3 | I disable development menus and shortcuts. 4 | Image is locked so users can only interact via UI kept open. 5 | 6 | ## Install 7 | ``` 8 | Metacello new 9 | baseline: 'AppMaker'; 10 | repository: 'github://bouraqadi/PharoMisc'; 11 | load 12 | ``` 13 | 14 | ## Usage 15 | Simply click on the `System/App Maker` menu 16 | -------------------------------------------------------------------------------- /Pharo/AppMaker/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #AppMaker } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineAnalyzer/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineAnalyzer' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfAppMaker/BaselineOfAppMaker.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfAppMaker', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfAppMaker', 5 | #package : 'BaselineOfAppMaker' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfAppMaker >> baseline: spec [ 10 | 11 | 12 | spec for: #'common' do: [ 13 | spec 14 | package: #AppMaker. ]. 15 | 16 | ] 17 | -------------------------------------------------------------------------------- /Pharo/BaselineOfAppMaker/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfAppMaker' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfBaselineAnalyzer/BaselineOfBaselineAnalyzer.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #BaselineOfBaselineAnalyzer, 3 | #superclass : #BaselineOf, 4 | #category : #BaselineOfBaselineAnalyzer 5 | } 6 | 7 | { #category : #baselines } 8 | BaselineOfBaselineAnalyzer >> baseline: spec [ 9 | 10 | 11 | spec for: #common do: [ 12 | spec 13 | package: 'BaselineAnalyzer' 14 | ] 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/BaselineOfBaselineAnalyzer/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #BaselineOfBaselineAnalyzer } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfBooleanExpressions/BaselineOfBooleanExpressions.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfBooleanExpressions', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfBooleanExpressions', 5 | #package : 'BaselineOfBooleanExpressions' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfBooleanExpressions >> baseline: spec [ 10 | 11 | 12 | spec for: #'common' do: [ 13 | spec 14 | package: #BooleanExpressions. ]. 15 | 16 | ] 17 | -------------------------------------------------------------------------------- /Pharo/BaselineOfBooleanExpressions/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfBooleanExpressions' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfCodeMetrics/BaselineOfCodeMetrics.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #BaselineOfCodeMetrics, 3 | #superclass : #BaselineOf, 4 | #category : #BaselineOfCodeMetrics 5 | } 6 | 7 | { #category : #baselines } 8 | BaselineOfCodeMetrics >> baseline: spec [ 9 | 10 | 11 | spec for: #'common' do: [ 12 | spec 13 | blessing: #'baseline'; 14 | package: #CodeMetrics; 15 | package: 'CodeMetrics-Tests' with: [ spec requires: #(CodeMetrics) ] 16 | ]. 17 | 18 | ] 19 | -------------------------------------------------------------------------------- /Pharo/BaselineOfCodeMetrics/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #BaselineOfCodeMetrics } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfConcurrency/BaselineOfConcurrency.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfConcurrency', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfConcurrency', 5 | #package : 'BaselineOfConcurrency' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfConcurrency >> baseline: spec [ 10 | 11 | 12 | spec for: #'common' do: [ 13 | spec 14 | package: #Concurrency. ]. 15 | 16 | ] 17 | -------------------------------------------------------------------------------- /Pharo/BaselineOfConcurrency/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfConcurrency' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfCsvToPillarConverter/BaselineOfCsvToPillarConverter.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfCsvToPillarConverter', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfCsvToPillarConverter', 5 | #package : 'BaselineOfCsvToPillarConverter' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfCsvToPillarConverter >> baseline: spec [ 10 | 11 | 12 | spec for: #'common' do: [ 13 | spec 14 | baseline: 'NeoCSV' with: [ 15 | spec repository: 'github://svenvc/NeoCSV']; 16 | package: #CsvToPillarConverter with: [ 17 | spec requires: #('NeoCSV' ). ]. ]. 18 | 19 | ] 20 | -------------------------------------------------------------------------------- /Pharo/BaselineOfCsvToPillarConverter/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfCsvToPillarConverter' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfEasyUI/BaselineOfEasyUI.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfEasyUI', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfEasyUI', 5 | #package : 'BaselineOfEasyUI' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfEasyUI >> baseline: spec [ 10 | 11 | 12 | spec for: #common do: [ 13 | spec 14 | baseline: 'PharoMisc' 15 | with: [ spec repository: 'github://bouraqadi/PharoMisc:pharo12' ]. 16 | spec package: 'EasyUI' with: [ spec requires: #( 'PharoMisc' ) ] ] 17 | ] 18 | -------------------------------------------------------------------------------- /Pharo/BaselineOfEasyUI/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfEasyUI' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfLightweightObserver/BaselineOfLightweightObserver.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfLightweightObserver', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfLightweightObserver', 5 | #package : 'BaselineOfLightweightObserver' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfLightweightObserver >> baseline: spec [ 10 | 11 | 12 | spec for: #'common' do: [ 13 | spec 14 | package: #LightweightObserver. ]. 15 | 16 | ] 17 | -------------------------------------------------------------------------------- /Pharo/BaselineOfLightweightObserver/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfLightweightObserver' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfNetworkExtras/BaselineOfNetworkExtras.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfNetworkExtras', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfNetworkExtras', 5 | #package : 'BaselineOfNetworkExtras' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfNetworkExtras >> baseline: spec [ 10 | 11 | 12 | spec for: #'common' do: [ 13 | spec 14 | baseline: #Concurrency with: [ 15 | spec repository: 'github://bouraqadi/PharoMisc:pharo12']; 16 | package: #NetNameResolverBugFix; 17 | package: #NetworkExtras with: [ 18 | spec requires: #(Concurrency NetNameResolverBugFix) 19 | ]. ]. 20 | 21 | ] 22 | -------------------------------------------------------------------------------- /Pharo/BaselineOfNetworkExtras/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfNetworkExtras' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfPharoExtra/BaselineOfPharoExtra.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfPharoExtra', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfPharoExtra', 5 | #package : 'BaselineOfPharoExtra' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfPharoExtra >> baseline: spec [ 10 | 11 | 12 | spec for: #common do: [ 13 | spec 14 | package: #PharoExtra ] 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/BaselineOfPharoExtra/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfPharoExtra' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfPharoMisc/BaselineOfPharoMisc.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #BaselineOfPharoMisc, 3 | #superclass : #BaselineOf, 4 | #category : #BaselineOfPharoMisc 5 | } 6 | 7 | { #category : #baselines } 8 | BaselineOfPharoMisc >> baseline: spec [ 9 | 10 | 11 | spec for: #common do: [ 12 | spec 13 | baseline: 'GitBridge' 14 | with: [ spec repository: 'github://jecisc/GitBridge' ]. 15 | spec package: 'PharoMisc' with: [ spec requires: #( 'GitBridge' ) ] ] 16 | ] 17 | -------------------------------------------------------------------------------- /Pharo/BaselineOfPharoMisc/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #BaselineOfPharoMisc } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfSimpleMiddleware/BaselineOfSimpleMiddleware.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfSimpleMiddleware', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfSimpleMiddleware', 5 | #package : 'BaselineOfSimpleMiddleware' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfSimpleMiddleware >> baseline: spec [ 10 | 11 | 12 | spec for: #'common' do: [ 13 | spec 14 | package: #SimpleMiddleware 15 | ]. 16 | 17 | ] 18 | -------------------------------------------------------------------------------- /Pharo/BaselineOfSimpleMiddleware/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfSimpleMiddleware' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfStateMachine/BaselineOfStateMachine.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfStateMachine', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfStateMachine', 5 | #package : 'BaselineOfStateMachine' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfStateMachine >> baseline: spec [ 10 | 11 | 12 | spec for: #'common' do: [ 13 | spec 14 | package: #StateMachine. ]. 15 | 16 | ] 17 | -------------------------------------------------------------------------------- /Pharo/BaselineOfStateMachine/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfStateMachine' } 2 | -------------------------------------------------------------------------------- /Pharo/BaselineOfTasks/BaselineOfTasks.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : 'BaselineOfTasks', 3 | #superclass : 'BaselineOf', 4 | #category : 'BaselineOfTasks', 5 | #package : 'BaselineOfTasks' 6 | } 7 | 8 | { #category : 'baselines' } 9 | BaselineOfTasks >> baseline: spec [ 10 | 11 | 12 | spec for: #'common' do: [ 13 | spec 14 | baseline: 'StateMachine' with: [ 15 | spec 16 | repository: 'github://bouraqadi/PharoMisc:pharo12' ]. 17 | spec 18 | package: 'Tasks'. 19 | ] 20 | ] 21 | -------------------------------------------------------------------------------- /Pharo/BaselineOfTasks/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : 'BaselineOfTasks' } 2 | -------------------------------------------------------------------------------- /Pharo/BooleanExpressions/Collection.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Collection } 2 | 3 | { #category : #'*BooleanExpressions' } 4 | Collection >> allFalse [ 5 | self ifEmpty: [ ^false ]. 6 | ^self noneSatisfy: [ :each| each value ] 7 | ] 8 | 9 | { #category : #'*BooleanExpressions' } 10 | Collection >> allTrue [ 11 | self ifEmpty: [ ^false ]. 12 | ^self allSatisfy: [ :each| each value ] 13 | ] 14 | 15 | { #category : #'*BooleanExpressions' } 16 | Collection >> anyFalse [ 17 | ^self anySatisfy: [ :each| each value not ] 18 | ] 19 | 20 | { #category : #'*BooleanExpressions' } 21 | Collection >> anyTrue [ 22 | ^self anySatisfy: [ :each| each value ] 23 | ] 24 | -------------------------------------------------------------------------------- /Pharo/BooleanExpressions/README.md: -------------------------------------------------------------------------------- 1 | # BooleanExpressions 2 | This package introduces extensions to collections to make it easy to write usual expressions. 3 | The goal is to avoid writing long sequences of logic messages such as: 4 | ```Smalltalk 5 | exp1 or: [ exp2 or: [exp3 or: [exp4]] 6 | exp1 and: [ exp2 and: [exp3 and: [exp4]] 7 | ``` 8 | 9 | # Install 10 | ```Smalltalk 11 | Metacello new 12 | baseline: 'BooleanExpressions'; 13 | repository: 'github://bouraqadi/PharoMisc'; 14 | load 15 | ``` 16 | 17 | # Usage 18 | `{[exp1]. [exp2]. [exp3]. [exp4]} anyTrue; allTrue; anyFalse; allFalse` 19 | 20 | Note that boolean expressions are inside blocks to allow for delayed evaluation. 21 | But, this is of course not mandatory. 22 | -------------------------------------------------------------------------------- /Pharo/BooleanExpressions/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #BooleanExpressions } 2 | -------------------------------------------------------------------------------- /Pharo/CodeMetrics-Tests/CmClassAForTestSupport.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CmClassAForTestSupport, 3 | #superclass : #Object, 4 | #category : #'CodeMetrics-Tests-TestSupport-AAA' 5 | } 6 | 7 | { #category : #any } 8 | CmClassAForTestSupport >> m1 [ 9 | ] 10 | 11 | { #category : #any } 12 | CmClassAForTestSupport >> m2 [ 13 | 14 | 15 | ] 16 | 17 | { #category : #any } 18 | CmClassAForTestSupport >> m3 [ 19 | 20 | 21 | ] 22 | -------------------------------------------------------------------------------- /Pharo/CodeMetrics-Tests/CmClassBForTestSupport.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CmClassBForTestSupport, 3 | #superclass : #Object, 4 | #category : #'CodeMetrics-Tests-TestSupport-BBB' 5 | } 6 | 7 | { #category : #any } 8 | CmClassBForTestSupport >> m1 [ 9 | ] 10 | 11 | { #category : #any } 12 | CmClassBForTestSupport >> m2 [ 13 | 14 | 15 | ] 16 | 17 | { #category : #any } 18 | CmClassBForTestSupport >> m3 [ 19 | ] 20 | 21 | { #category : #any } 22 | CmClassBForTestSupport >> m4 [ 23 | ] 24 | -------------------------------------------------------------------------------- /Pharo/CodeMetrics-Tests/CmClassCForTestSupport.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CmClassCForTestSupport, 3 | #superclass : #Object, 4 | #category : #'CodeMetrics-Tests-TestSupport-BBB' 5 | } 6 | 7 | { #category : #any } 8 | CmClassCForTestSupport >> m1 [ 9 | ] 10 | 11 | { #category : #any } 12 | CmClassCForTestSupport >> m2 [ 13 | ] 14 | 15 | { #category : #any } 16 | CmClassCForTestSupport >> m3 [ 17 | ] 18 | -------------------------------------------------------------------------------- /Pharo/CodeMetrics-Tests/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #'CodeMetrics-Tests' } 2 | -------------------------------------------------------------------------------- /Pharo/CodeMetrics/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #CodeMetrics } 2 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcPromiseAlreadySettledError.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Error signaled when a promise on attemps to provide a result or an exception to a promise already setlled 3 | " 4 | Class { 5 | #name : #CcPromiseAlreadySettledError, 6 | #superclass : #Error, 7 | #category : #'Concurrency-Kernel' 8 | } 9 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcPromiseTimeout.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Signals to process waiting that promise didn't settle yet. 3 | See CcPromise>>#wait: 4 | " 5 | Class { 6 | #name : #CcPromiseTimeout, 7 | #superclass : #Error, 8 | #category : #'Concurrency-Kernel' 9 | } 10 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcServiceConditionalLoopTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CcServiceConditionalLoopTest, 3 | #superclass : #CcServiceTest, 4 | #instVars : [ 5 | 'count', 6 | 'actionFinishedSemaphore' 7 | ], 8 | #category : #'Concurrency-Test' 9 | } 10 | 11 | { #category : #testing } 12 | CcServiceConditionalLoopTest >> setUp [ 13 | super setUp. 14 | count := 0. 15 | actionFinishedSemaphore := Semaphore new. 16 | service := CcService 17 | repeat: [ count := count + 1] 18 | every: 10 milliSeconds 19 | while: [ count < 10 ] 20 | ensure: [actionFinishedSemaphore signal]. 21 | 22 | ] 23 | 24 | { #category : #testing } 25 | CcServiceConditionalLoopTest >> testPerformsOnlyIfWhileConditionIsTrueOnStart [ 26 | count := 20. 27 | service start. 28 | self assertSemaphore: actionFinishedSemaphore signaledWithinSeconds: 1. 29 | self assert: count equals: 20. 30 | 31 | ] 32 | 33 | { #category : #testing } 34 | CcServiceConditionalLoopTest >> testStopWhenWhileConditionIsFalse [ 35 | service start. 36 | self assertSemaphore: actionFinishedSemaphore signaledWithinSeconds: 1. 37 | self assert: count = 10. 38 | 39 | ] 40 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcServiceExamples.class.st: -------------------------------------------------------------------------------- 1 | " 2 | See class side for examples of CcThread 3 | " 4 | Class { 5 | #name : #CcServiceExamples, 6 | #superclass : #Object, 7 | #category : #'Concurrency-Kernel' 8 | } 9 | 10 | { #category : #examples } 11 | CcServiceExamples class >> autoStopOnGarbageCollect [ 12 | 13 | |counter runner | 14 | counter := 0. 15 | runner := CcService 16 | repeat: [ 17 | counter := counter + 1. 18 | self inform: counter printString] 19 | every: 300 milliSeconds 20 | while: [ counter < 100 ]. 21 | runner start 22 | ] 23 | 24 | { #category : #examples } 25 | CcServiceExamples class >> countUpTo10 [ 26 | 27 | |counter runner | 28 | counter := 0. 29 | runner := CcService 30 | repeat: [ 31 | counter := counter + 1. 32 | self inform: counter printString] 33 | every: 100 milliSeconds 34 | while: [ counter < 10 ]. 35 | runner runTillDone. 36 | 37 | ] 38 | 39 | { #category : #examples } 40 | CcServiceExamples class >> pingPong [ 41 | 42 | |ping pong | 43 | Transcript open. 44 | ping := CcService 45 | repeat: [Transcript cr; show: '--------ping'] 46 | every: 400 milliSeconds. 47 | pong := CcService 48 | repeat: [Transcript cr; show: 'PONG'] 49 | every: 200 milliSeconds. 50 | ping start. 51 | pong start. 52 | UIManager default centeredAlert: 'click to stop' title: 'Concurrency' configure: [:any| ] . 53 | ping stop. 54 | pong stop 55 | 56 | ] 57 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcServiceNameAndPriorityTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CcServiceNameAndPriorityTest, 3 | #superclass : #CcServiceTest, 4 | #category : #'Concurrency-Test' 5 | } 6 | 7 | { #category : #testing } 8 | CcServiceNameAndPriorityTest >> testNameChangeWhileStarted [ 9 | service := CcService do: [ [ 50 milliSeconds wait] repeat ]. 10 | self startService. 11 | service name: 'Service for test only'. 12 | self assert: self serviceProcess name equals: service name. 13 | 14 | ] 15 | 16 | { #category : #testing } 17 | CcServiceNameAndPriorityTest >> testNameChangeWhileStopped [ 18 | service := CcService do: [ [ 50 milliSeconds wait] repeat ]. 19 | service name: 'Service for test only'. 20 | self startService. 21 | self assert: self serviceProcess name equals: service name. 22 | 23 | ] 24 | 25 | { #category : #testing } 26 | CcServiceNameAndPriorityTest >> testPriorityChangeWhileStarted [ 27 | | initialPriority newPriority | 28 | initialPriority := Processor highestPriority. 29 | service := CcService do: [ 30 | [(Delay forMilliseconds: 100) wait] repeat 31 | ]. 32 | service priority: initialPriority. 33 | self startService. 34 | newPriority := Processor userBackgroundPriority. 35 | self deny: newPriority = initialPriority. 36 | self assert: service isStarted. 37 | service priority: newPriority. 38 | self assert: self serviceProcess priority = newPriority 39 | 40 | ] 41 | 42 | { #category : #testing } 43 | CcServiceNameAndPriorityTest >> testPriorityChangeWhileStopped [ 44 | | initialPriority | 45 | initialPriority := Processor highestPriority. 46 | service := CcService do: [ 47 | [(Delay forMilliseconds: 100) wait]repeat 48 | ]. 49 | self assert: service isStopped. 50 | service priority: initialPriority. 51 | self startService. 52 | self assert: self serviceProcess priority = initialPriority 53 | ] 54 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcServiceRacingConditions.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CcServiceRacingConditions, 3 | #superclass : #CcServiceActivityTest, 4 | #category : #'Concurrency-Test' 5 | } 6 | 7 | { #category : #testing } 8 | CcServiceRacingConditions >> testConcurrentStartStop [ 9 | | starter stopper switchForcing testSupportServices | 10 | service := CcService repeat: [] every: 300 milliSecond ensure: [ 11 | activityTerminatedSemaphore signal 12 | ]. 13 | service priority: 40. 14 | starter := CcService repeat: [ service start ] every: 50 milliSeconds. 15 | stopper := CcService repeat: [ service stop] every: 50 milliSeconds. 16 | {starter. stopper} do: [ : each | each priority: 45 ]. 17 | switchForcing := CcService repeat: ["Do Nothing!"] every: 30 milliSeconds. 18 | switchForcing priority: 50. 19 | testSupportServices := {switchForcing. starter. stopper }. 20 | testSupportServices do: #start. 21 | 500 milliSeconds wait. 22 | testSupportServices do: #stop. 23 | ] 24 | 25 | { #category : #testing } 26 | CcServiceRacingConditions >> testFastStartStop [ 27 | service := CcService repeat: [] every: 300 milliSecond ensure: [ 28 | activityTerminatedSemaphore signal. 29 | ]. 30 | 5 timesRepeat: [service start;stop; start;stop]. 31 | self assertSemaphore: activityTerminatedSemaphore signaledWithinMilliseconds: 500. 32 | ] 33 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcServiceRunner.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CcServiceRunner, 3 | #superclass : #Object, 4 | #instVars : [ 5 | 'process', 6 | 'ensureBlock', 7 | 'serviceWeakArray' 8 | ], 9 | #category : #'Concurrency-Kernel' 10 | } 11 | 12 | { #category : #accessing } 13 | CcServiceRunner >> activityBlock [ 14 | ^self service activityBlock 15 | ] 16 | 17 | { #category : #initialization } 18 | CcServiceRunner >> initialize [ 19 | super initialize . 20 | serviceWeakArray := WeakArray new: 1 21 | ] 22 | 23 | { #category : #accessing } 24 | CcServiceRunner >> name [ 25 | ^self service name 26 | ] 27 | 28 | { #category : #running } 29 | CcServiceRunner >> newProcess [ 30 | ^ [ self run ] newProcess 31 | ] 32 | 33 | { #category : #running } 34 | CcServiceRunner >> onProcessStarted [ 35 | self service ifNil: [ ^self ]. 36 | self service onProcessStarted 37 | ] 38 | 39 | { #category : #running } 40 | CcServiceRunner >> onProcessStopped [ 41 | ensureBlock value. 42 | self service ifNotNil: [: aService | aService onProcessStopped] 43 | 44 | ] 45 | 46 | { #category : #accessing } 47 | CcServiceRunner >> priority [ 48 | ^self service priority 49 | ] 50 | 51 | { #category : #accessing } 52 | CcServiceRunner >> process [ 53 | ^ process 54 | ] 55 | 56 | { #category : #running } 57 | CcServiceRunner >> run [ 58 | ^ [ self onProcessStarted. 59 | self activityBlock value ] 60 | ensure: [ self onProcessStopped ] 61 | ] 62 | 63 | { #category : #accessing } 64 | CcServiceRunner >> service [ 65 | ^serviceWeakArray first 66 | ] 67 | 68 | { #category : #accessing } 69 | CcServiceRunner >> service: aService [ 70 | ^serviceWeakArray at: 1 put: aService 71 | ] 72 | 73 | { #category : #running } 74 | CcServiceRunner >> start [ 75 | ensureBlock := self service ensureBlock. 76 | process := self newProcess. 77 | process name: self name. 78 | process priority: self priority. 79 | process resume. 80 | 81 | ] 82 | 83 | { #category : #running } 84 | CcServiceRunner >> stop [ 85 | process ifNil: [ ^self ]. 86 | process terminate 87 | 88 | ] 89 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcServiceState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CcServiceState, 3 | #superclass : #Object, 4 | #instVars : [ 5 | 'serviceWeakArray' 6 | ], 7 | #category : #'Concurrency-Kernel' 8 | } 9 | 10 | { #category : #accessing } 11 | CcServiceState >> currentState: aState [ 12 | self service state: aState 13 | ] 14 | 15 | { #category : #testing } 16 | CcServiceState >> ifStarted: blockForStarted ifStopped: blockForStopped [ 17 | self subclassResponsibility 18 | ] 19 | 20 | { #category : #accessing } 21 | CcServiceState >> process [ 22 | ^self service process 23 | ] 24 | 25 | { #category : #accessing } 26 | CcServiceState >> runner [ 27 | ^self service runner 28 | ] 29 | 30 | { #category : #accessing } 31 | CcServiceState >> service [ 32 | ^ serviceWeakArray first 33 | ] 34 | 35 | { #category : #accessing } 36 | CcServiceState >> service: aService [ 37 | serviceWeakArray := WeakArray with: aService. 38 | 39 | ] 40 | 41 | { #category : #signalling } 42 | CcServiceState >> signalProcessStarted [ 43 | self service signalProcessStarted 44 | 45 | ] 46 | 47 | { #category : #signalling } 48 | CcServiceState >> signalProcessStopped [ 49 | self service signalProcessStopped 50 | 51 | ] 52 | 53 | { #category : #activity } 54 | CcServiceState >> start [ 55 | self subclassResponsibility 56 | ] 57 | 58 | { #category : #printing } 59 | CcServiceState >> stateString [ 60 | self subclassResponsibility 61 | ] 62 | 63 | { #category : #activity } 64 | CcServiceState >> stop [ 65 | self subclassResponsibility 66 | ] 67 | 68 | { #category : #state } 69 | CcServiceState >> transitionTo: aStateClass [ 70 | self currentState: aStateClass new 71 | ] 72 | 73 | { #category : #signalling } 74 | CcServiceState >> waitProcessStarted [ 75 | self service waitProcessStarted 76 | 77 | ] 78 | 79 | { #category : #signalling } 80 | CcServiceState >> waitProcessStopped [ 81 | self service waitProcessStopped 82 | 83 | ] 84 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcServiceStateTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CcServiceStateTest, 3 | #superclass : #CcServiceTest, 4 | #instVars : [ 5 | 'startSemaphore', 6 | 'stopSemaphore' 7 | ], 8 | #category : #'Concurrency-Test' 9 | } 10 | 11 | { #category : #'test state requests' } 12 | CcServiceStateTest >> setUp [ 13 | super setUp. 14 | startSemaphore := Semaphore new. 15 | stopSemaphore := Semaphore new. 16 | service := CcService 17 | do: [startSemaphore signal] 18 | thenRepeat: [ ] 19 | every: 50 milliSeconds 20 | ensure: [ stopSemaphore signal ] 21 | ] 22 | 23 | { #category : #'test state requests' } 24 | CcServiceStateTest >> testNewService [ 25 | self deny: service isStarted. 26 | self assert: service isStopped. 27 | 28 | ] 29 | 30 | { #category : #'test state requests' } 31 | CcServiceStateTest >> testStart [ 32 | self startService. 33 | self assertSemaphore: startSemaphore signaledWithinMilliseconds: 100. 34 | self assert: service isStarted. 35 | self deny: service isStopped. 36 | 37 | ] 38 | 39 | { #category : #'test state requests' } 40 | CcServiceStateTest >> testStartStop [ 41 | self startService. 42 | self assertSemaphore: startSemaphore signaledWithinMilliseconds: 100. 43 | service stop. 44 | self assertSemaphore: stopSemaphore signaledWithinMilliseconds: 100. 45 | self deny: service isStarted. 46 | self assert: service isStopped 47 | ] 48 | 49 | { #category : #'test state requests' } 50 | CcServiceStateTest >> testStartStopStart [ 51 | self startService. 52 | self assertSemaphore: startSemaphore signaledWithinMilliseconds: 100. 53 | service stop. 54 | self assertSemaphore: stopSemaphore signaledWithinMilliseconds: 100. 55 | self startService. 56 | self assertSemaphore: startSemaphore signaledWithinMilliseconds: 100. 57 | self assert: service isStarted. 58 | self deny: service isStopped. 59 | 60 | ] 61 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcServiceTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CcServiceTest, 3 | #superclass : #TestCase, 4 | #traits : 'CcTConcurrencyTest + CcTWaitPolling', 5 | #classTraits : 'CcTConcurrencyTest classTrait + CcTWaitPolling classTrait', 6 | #instVars : [ 7 | 'service', 8 | 'runner' 9 | ], 10 | #category : #'Concurrency-Test' 11 | } 12 | 13 | { #category : #testing } 14 | CcServiceTest >> runCaseManaged [ 15 | self runCase 16 | ] 17 | 18 | { #category : #testing } 19 | CcServiceTest >> serviceProcess [ 20 | runner ifNil: [ ^nil ]. 21 | ^runner process 22 | ] 23 | 24 | { #category : #testing } 25 | CcServiceTest >> startService [ 26 | runner := service runner. 27 | service start 28 | ] 29 | 30 | { #category : #testing } 31 | CcServiceTest >> tearDown [ 32 | super tearDown. 33 | self serviceProcess ifNotNil: [ :process | process terminate ] 34 | ] 35 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcStarted.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CcStarted, 3 | #superclass : #CcServiceState, 4 | #category : #'Concurrency-Kernel' 5 | } 6 | 7 | { #category : #testing } 8 | CcStarted >> ifStarted: blockForStarted ifStopped: blockForStopped [ 9 | ^blockForStarted value 10 | ] 11 | 12 | { #category : #accessing } 13 | CcStarted >> name: aString [ 14 | self process name: aString 15 | ] 16 | 17 | { #category : #accessing } 18 | CcStarted >> onProcessStopped [ 19 | self transitionTo: CcStopped. 20 | self signalProcessStopped 21 | ] 22 | 23 | { #category : #accessing } 24 | CcStarted >> priority: anInteger [ 25 | self process priority: anInteger. 26 | ] 27 | 28 | { #category : #activity } 29 | CcStarted >> start [ 30 | ^self 31 | ] 32 | 33 | { #category : #printing } 34 | CcStarted >> stateString [ 35 | ^'started' 36 | ] 37 | 38 | { #category : #activity } 39 | CcStarted >> stop [ 40 | self runner stop. 41 | self waitProcessStopped 42 | ] 43 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcStopped.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CcStopped, 3 | #superclass : #CcServiceState, 4 | #category : #'Concurrency-Kernel' 5 | } 6 | 7 | { #category : #activity } 8 | CcStopped >> ifStarted: blockForStarted ifStopped: blockForStopped [ 9 | ^blockForStopped value 10 | ] 11 | 12 | { #category : #accessing } 13 | CcStopped >> name: aString [ 14 | ^self 15 | ] 16 | 17 | { #category : #activity } 18 | CcStopped >> onProcessStarted [ 19 | self transitionTo: CcStarted. 20 | self signalProcessStarted 21 | 22 | ] 23 | 24 | { #category : #accessing } 25 | CcStopped >> priority: anInteger [ 26 | ^self 27 | ] 28 | 29 | { #category : #activity } 30 | CcStopped >> start [ 31 | self runner start. 32 | self waitProcessStarted. 33 | 34 | ] 35 | 36 | { #category : #printing } 37 | CcStopped >> stateString [ 38 | ^'stopped' 39 | ] 40 | 41 | { #category : #activity } 42 | CcStopped >> stop [ 43 | ^self 44 | ] 45 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcTConcurrencyTest.trait.st: -------------------------------------------------------------------------------- 1 | " 2 | TConcurrencyTest provides methods to ease testing concurrent code with the following pattern. 3 | 4 | -A semaphore is shared between the process for testcase and the concurrent process under test. 5 | 6 | -the concurrent process under test is supposed signal the semaphore upon some condition. 7 | 8 | -testcase waits for signals or timeouts to decide whether the test failed or not 9 | 10 | " 11 | Trait { 12 | #name : #CcTConcurrencyTest, 13 | #traits : 'CcTWaitPolling', 14 | #classTraits : 'CcTWaitPolling classTrait', 15 | #category : #'Concurrency-Kernel' 16 | } 17 | 18 | { #category : #testing } 19 | CcTConcurrencyTest >> assertFork: aBlock endsWithinMilliseconds: milliseconds [ 20 | | semaphore | 21 | semaphore := Semaphore new. 22 | [ aBlock ensure: [ semaphore signal ] ] fork. 23 | self assertSemaphore: semaphore signaledWithinMilliseconds: milliseconds 24 | ] 25 | 26 | { #category : #testing } 27 | CcTConcurrencyTest >> assertFork: aBlock endsWithinSeconds: seconds [ 28 | | semaphore | 29 | semaphore := Semaphore new. 30 | [ aBlock ensure: [ semaphore signal ] ] fork. 31 | self assertSemaphore: semaphore signaledWithinSeconds: seconds 32 | ] 33 | 34 | { #category : #testing } 35 | CcTConcurrencyTest >> assertFork: aBlock raise: exceptionClass withinMilliseconds: milliseconds [ 36 | | semaphore | 37 | semaphore := Semaphore new. 38 | [ aBlock on: exceptionClass do: [: ex| semaphore signal ] ] fork. 39 | self assertSemaphore: semaphore signaledWithinMilliseconds: milliseconds 40 | ] 41 | 42 | { #category : #testing } 43 | CcTConcurrencyTest >> assertFork: aBlock raise: exceptionClass withinSeconds: seconds [ 44 | self assertFork: aBlock raise: exceptionClass withinMilliseconds: seconds * 1000 45 | ] 46 | 47 | { #category : #testing } 48 | CcTConcurrencyTest >> assertSemaphore: semaphore signaledWithinMilliseconds: milliseconds [ 49 | | isTimeout | 50 | isTimeout := [(semaphore waitTimeoutMSecs: milliseconds)] on: TestTookTooMuchTime do: [ : ex| true ]. 51 | self deny: isTimeout 52 | ] 53 | 54 | { #category : #testing } 55 | CcTConcurrencyTest >> assertSemaphore: semaphore signaledWithinSeconds: seconds [ 56 | self deny: (semaphore waitTimeoutSeconds: seconds) 57 | ] 58 | 59 | { #category : #waiting } 60 | CcTConcurrencyTest >> defaultActionOnTimeout [ 61 | self fail: 'Timeout' 62 | ] 63 | 64 | { #category : #testing } 65 | CcTConcurrencyTest >> denySemaphore: semaphore signaledWithinMilliseconds: milliseconds [ 66 | self assert: (semaphore waitTimeoutMSecs: milliseconds) 67 | ] 68 | 69 | { #category : #testing } 70 | CcTConcurrencyTest >> denySemaphore: semaphore signaledWithinSeconds: seconds [ 71 | self assert: (semaphore waitTimeoutSeconds: seconds) 72 | ] 73 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcTWaitPolling.trait.st: -------------------------------------------------------------------------------- 1 | " 2 | I provide facility methods for waiting some undefined duration, which is typical in networking. 3 | Waiting is done in short iterations (see method waitWhile:onTimeout:do:), hence the polling. 4 | By default, the current thread is suspended for 50 milliseconds on every iteration (see method iterationDuration). 5 | 6 | " 7 | Trait { 8 | #name : #CcTWaitPolling, 9 | #category : #'Concurrency-Kernel' 10 | } 11 | 12 | { #category : #waiting } 13 | CcTWaitPolling >> defaultActionOnTimeout [ 14 | CcTimeout signal 15 | ] 16 | 17 | { #category : #waiting } 18 | CcTWaitPolling >> defaultTimeoutDuration [ 19 | ^500 milliSeconds 20 | ] 21 | 22 | { #category : #waiting } 23 | CcTWaitPolling >> iterationDuration [ 24 | ^ 50 milliSeconds 25 | ] 26 | 27 | { #category : #waiting } 28 | CcTWaitPolling >> waitUntil: conditionBlock [ 29 | self waitUntil: conditionBlock timeout: self defaultTimeoutDuration 30 | ] 31 | 32 | { #category : #waiting } 33 | CcTWaitPolling >> waitUntil: conditionBlock onTimeout: aDuration do: aBlock [ 34 | self waitWhile: [ conditionBlock value not ] onTimeout: aDuration do: aBlock 35 | ] 36 | 37 | { #category : #waiting } 38 | CcTWaitPolling >> waitUntil: conditionBlock timeout: aDuration [ 39 | self waitUntil: conditionBlock onTimeout: aDuration do: [ self fail: 'Timeout' ] 40 | ] 41 | 42 | { #category : #waiting } 43 | CcTWaitPolling >> waitWhile: conditionBlock [ 44 | self waitWhile: conditionBlock timeout: self defaultTimeoutDuration 45 | ] 46 | 47 | { #category : #waiting } 48 | CcTWaitPolling >> waitWhile: conditionBlock onTimeout: aDuration do: aBlock [ 49 | | iterationCount iterationDuration | 50 | iterationDuration := self iterationDuration. 51 | iterationCount := (aDuration / iterationDuration) ceiling max: 1. 52 | iterationCount 53 | timesRepeat: [ conditionBlock value 54 | ifFalse: [ ^ self ]. 55 | iterationDuration wait ]. 56 | aBlock value 57 | ] 58 | 59 | { #category : #waiting } 60 | CcTWaitPolling >> waitWhile: conditionBlock timeout: aDuration [ 61 | self waitWhile: conditionBlock onTimeout: aDuration do: [self defaultActionOnTimeout] 62 | ] 63 | -------------------------------------------------------------------------------- /Pharo/Concurrency/CcTimeout.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CcTimeout, 3 | #superclass : #Error, 4 | #category : #'Concurrency-Kernel' 5 | } 6 | -------------------------------------------------------------------------------- /Pharo/Concurrency/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #Concurrency } 2 | -------------------------------------------------------------------------------- /Pharo/CsvToPillarConverter/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #CsvToPillarConverter } 2 | -------------------------------------------------------------------------------- /Pharo/EasyUI/Character.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Character } 2 | 3 | { #category : #'*EasyUI' } 4 | Character >> asKeyCombination [ 5 | | lowerCaseCombination | 6 | self asLowercase = self ifTrue: [^ KMSingleKeyCombination from: self]. 7 | lowerCaseCombination := KMSingleKeyCombination from: self asLowercase. 8 | ^KMModifiedKeyCombination modifier: KMModifier shift character: lowerCaseCombination. 9 | ] 10 | -------------------------------------------------------------------------------- /Pharo/EasyUI/CharacterKeyCombinationTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #CharacterKeyCombinationTest, 3 | #superclass : #TestCase, 4 | #category : #'EasyUI-Tests' 5 | } 6 | 7 | { #category : #tests } 8 | CharacterKeyCombinationTest >> testArrowShift [ 9 | | combination modifiedCombination | 10 | combination := Character arrowDown asKeyCombination. 11 | modifiedCombination := combination modifiedBy: KMMetaModifier shift. 12 | self assert: combination key equals: KeyboardKey down. 13 | self assert: combination modifier equals: KMNoModifier new. 14 | self assert: modifiedCombination modifier equals: KMModifier shift 15 | ] 16 | 17 | { #category : #tests } 18 | CharacterKeyCombinationTest >> testLowercaseKeyCombination [ 19 | | combination | 20 | combination := $a asKeyCombination. 21 | self assert: combination key equals: KeyboardKey A. 22 | self assert: combination modifier equals: KMNoModifier new. 23 | ] 24 | 25 | { #category : #tests } 26 | CharacterKeyCombinationTest >> testUppercaseKeyCombination [ 27 | | combination | 28 | combination := $A asKeyCombination. 29 | self assert: combination key equals: KeyboardKey A. 30 | self assert: combination modifier equals: KMModifier shift. 31 | ] 32 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzApp.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzApp, 3 | #superclass : #Object, 4 | #instVars : [ 5 | 'drawingBoard', 6 | 'windowPresenter', 7 | 'title' 8 | ], 9 | #category : #'EasyUI-Kernel' 10 | } 11 | 12 | { #category : #'instance creation' } 13 | EzApp class >> newOpenWindow [ 14 | ^self new 15 | openWindow; 16 | yourself 17 | ] 18 | 19 | { #category : #'window handling' } 20 | EzApp >> closeWindow [ 21 | windowPresenter ifNil: [ ^self ]. 22 | windowPresenter close 23 | ] 24 | 25 | { #category : #'window handling' } 26 | EzApp >> defaultTitle [ 27 | ^self className 28 | ] 29 | 30 | { #category : #accessing } 31 | EzApp >> drawingBoard [ 32 | ^drawingBoard 33 | ] 34 | 35 | { #category : #initialization } 36 | EzApp >> drawingBoardExtent [ 37 | ^ 800 @ 600 38 | ] 39 | 40 | { #category : #initialization } 41 | EzApp >> initialize [ 42 | super initialize. 43 | drawingBoard := EzDrawingBoard surfaceExtent: self drawingBoardExtent. 44 | title := self defaultTitle. 45 | ] 46 | 47 | { #category : #'window handling' } 48 | EzApp >> openWindow [ 49 | 50 | windowPresenter ifNotNil: [ self closeWindow ]. 51 | windowPresenter := drawingBoard open. 52 | windowPresenter title: self title. 53 | self window beUnresizeable 54 | ] 55 | 56 | { #category : #accessing } 57 | EzApp >> title [ 58 | ^ title 59 | ] 60 | 61 | { #category : #accessing } 62 | EzApp >> title: aString [ 63 | title := aString. 64 | self windowPresenter ifNil: [ ^self ]. 65 | self windowPresenter title: aString. 66 | ] 67 | 68 | { #category : #accessing } 69 | EzApp >> window [ 70 | ^self windowPresenter window 71 | ] 72 | 73 | { #category : #'window handling' } 74 | EzApp >> windowPosition [ 75 | ^self window position 76 | ] 77 | 78 | { #category : #'window handling' } 79 | EzApp >> windowPosition: aPoint [ 80 | self window position: aPoint. 81 | ] 82 | 83 | { #category : #'window handling' } 84 | EzApp >> windowPresenter [ 85 | ^windowPresenter 86 | ] 87 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzAppTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzAppTest, 3 | #superclass : #TestCase, 4 | #instVars : [ 5 | 'app' 6 | ], 7 | #category : #'EasyUI-Tests' 8 | } 9 | 10 | { #category : #running } 11 | EzAppTest >> setUp [ 12 | super setUp. 13 | app := EzApp new. 14 | app openWindow 15 | ] 16 | 17 | { #category : #running } 18 | EzAppTest >> tearDown [ 19 | super tearDown. 20 | app closeWindow 21 | ] 22 | 23 | { #category : #running } 24 | EzAppTest >> testCloseWindowBeforeOpening [ 25 | | otherApp | 26 | otherApp := EzApp new. 27 | self shouldnt: [otherApp closeWindow] raise: Exception. 28 | ] 29 | 30 | { #category : #running } 31 | EzAppTest >> testWindowPositionChange [ 32 | | newPosition | 33 | newPosition := app window position + 200. 34 | app windowPosition: newPosition. 35 | self assert: app window position equals: newPosition. 36 | self assert: app windowPosition equals: newPosition. 37 | ] 38 | 39 | { #category : #running } 40 | EzAppTest >> testWindowResizingForbidden [ 41 | self deny: app window isResizeable. 42 | ] 43 | 44 | { #category : #running } 45 | EzAppTest >> testWindowTitle [ 46 | | newTitle | 47 | newTitle := 'new title for test'. 48 | app title: newTitle. 49 | self assert: app window title equals: newTitle 50 | ] 51 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzArc.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzArc, 3 | #superclass : #EzClosedDrawing, 4 | #instVars : [ 5 | 'radius', 6 | 'angleSpan' 7 | ], 8 | #category : #'EasyUI-Kernel' 9 | } 10 | 11 | { #category : #'instance creation' } 12 | EzArc class >> center: center radius: radius angleSpan: angleSpan [ 13 | ^(self radius: radius angleSpan: angleSpan) 14 | center: center; 15 | yourself 16 | 17 | ] 18 | 19 | { #category : #'instance creation' } 20 | EzArc class >> radius: radius angleSpan: angleSpan [ 21 | ^self new 22 | radius: radius; 23 | angleSpan: angleSpan; 24 | yourself 25 | 26 | ] 27 | 28 | { #category : #accessing } 29 | EzArc >> angleSpan [ 30 | ^ angleSpan 31 | ] 32 | 33 | { #category : #accessing } 34 | EzArc >> angleSpan: anObject [ 35 | angleSpan := anObject. 36 | self redraw 37 | ] 38 | 39 | { #category : #rendering } 40 | EzArc >> newShapeForCanvas: canvas [ 41 | | vertice | 42 | ^canvas createPath: [ : path | 43 | path absolute. 44 | vertice := (radius * angleSpan degreeCos) @ (radius * angleSpan degreeSin). 45 | path lineTo: vertice. 46 | path ccwArcTo: radius@0 angle: angleSpan degreesToRadians. 47 | path lineTo: 0@0. 48 | ]. 49 | 50 | ] 51 | 52 | { #category : #accessing } 53 | EzArc >> radius [ 54 | ^ radius 55 | ] 56 | 57 | { #category : #accessing } 58 | EzArc >> radius: anObject [ 59 | radius := anObject. 60 | self redraw 61 | ] 62 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzAtomicDrawing.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzAtomicDrawing, 3 | #superclass : #EzDrawing, 4 | #instVars : [ 5 | 'shape' 6 | ], 7 | #category : #'EasyUI-Kernel' 8 | } 9 | 10 | { #category : #rendering } 11 | EzAtomicDrawing >> drawOn: canvas [ 12 | canvas setShape: (self shapeForCanvas: canvas). 13 | 14 | ] 15 | 16 | { #category : #rendering } 17 | EzAtomicDrawing >> newShapeForCanvas: canvas [ 18 | ^self subclassResponsibility 19 | ] 20 | 21 | { #category : #rendering } 22 | EzAtomicDrawing >> redraw [ 23 | shape := nil. 24 | super redraw. 25 | ] 26 | 27 | { #category : #accessing } 28 | EzAtomicDrawing >> shape [ 29 | ^ shape 30 | ] 31 | 32 | { #category : #accessing } 33 | EzAtomicDrawing >> shape: anObject [ 34 | shape := anObject. 35 | self redraw. 36 | ] 37 | 38 | { #category : #rendering } 39 | EzAtomicDrawing >> shapeForCanvas: canvas [ 40 | ^shape ifNil: [ shape := self newShapeForCanvas: canvas ]. 41 | 42 | ] 43 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzBotFleetApp.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzBotFleetApp, 3 | #superclass : #EzApp, 4 | #traits : 'EzTDemoApp', 5 | #classTraits : 'EzTDemoApp classTrait', 6 | #category : #'EasyUI-Examples-Apps' 7 | } 8 | 9 | { #category : #initialization } 10 | EzBotFleetApp >> defaultTitle [ 11 | ^'Bots Moving Around (Spacebar)' 12 | ] 13 | 14 | { #category : #initialization } 15 | EzBotFleetApp >> initialize [ 16 | | pathRadius delta | 17 | super initialize. 18 | { Color green -> (200@100). 19 | Color cyan -> (600@200). 20 | Color magenta -> (300@300)} asDictionary keysAndValuesDo: [: color : origin | 21 | |bot| 22 | bot := EzRoundBot new. 23 | bot fillColor: color. 24 | bot origin: origin. 25 | drawingBoard add: bot. 26 | ]. 27 | pathRadius := 20. 28 | drawingBoard 29 | bindKeyCombination: Character space asKeyCombination 30 | toAction: [ 31 | drawingBoard drawings do: [: each | 32 | delta := (pathRadius * each angle degreeCos) @ (pathRadius * each angle degreeSin). 33 | each origin: each origin + delta. 34 | each angle: each angle + 10. 35 | ] 36 | ]. 37 | 38 | ] 39 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzBoundedDrawing.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzBoundedDrawing, 3 | #superclass : #EzClosedDrawing, 4 | #instVars : [ 5 | 'width', 6 | 'height' 7 | ], 8 | #category : #'EasyUI-Kernel' 9 | } 10 | 11 | { #category : #'instance creation' } 12 | EzBoundedDrawing class >> width: width height: height [ 13 | ^ self new 14 | width: width height: height; 15 | yourself 16 | ] 17 | 18 | { #category : #rendering } 19 | EzBoundedDrawing >> bounds [ 20 | ^ (self width/ -2) @ (self height/ -2) extent: self width @ self height. 21 | ] 22 | 23 | { #category : #accessing } 24 | EzBoundedDrawing >> corner: newCorner [ 25 | | previousCorner | 26 | previousCorner := (self width/ -2) @ (self height/ -2). 27 | self center: self center + newCorner - previousCorner. 28 | ] 29 | 30 | { #category : #accessing } 31 | EzBoundedDrawing >> height [ 32 | ^height 33 | ] 34 | 35 | { #category : #accessing } 36 | EzBoundedDrawing >> height: aNumber [ 37 | 38 | self width: width height: aNumber 39 | ] 40 | 41 | { #category : #accessing } 42 | EzBoundedDrawing >> validLengthFrom: newLength [ 43 | 44 | newLength < 1 ifTrue: [ ^ 1 ]. 45 | ^ newLength rounded 46 | ] 47 | 48 | { #category : #accessing } 49 | EzBoundedDrawing >> width [ 50 | ^width 51 | ] 52 | 53 | { #category : #accessing } 54 | EzBoundedDrawing >> width: aNumber [ 55 | 56 | self width: aNumber height: height 57 | ] 58 | 59 | { #category : #accessing } 60 | EzBoundedDrawing >> width: newWidth height: newHeight [ 61 | 62 | width := self validLengthFrom: newWidth. 63 | height := self validLengthFrom: newHeight. 64 | self redraw 65 | ] 66 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzBoundedDrawingTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzBoundedDrawingTest, 3 | #superclass : #TestCase, 4 | #instVars : [ 5 | 'drawing' 6 | ], 7 | #category : #'EasyUI-Tests' 8 | } 9 | 10 | { #category : #tests } 11 | EzBoundedDrawingTest >> setUp [ 12 | 13 | super setUp. 14 | drawing := EzOval circleCenter: 0 @ 0 radius: 80 15 | ] 16 | 17 | { #category : #tests } 18 | EzBoundedDrawingTest >> testExtentAlwaysInt [ 19 | 20 | { (0.1 -> 1). 21 | (0.8 -> 1). 22 | (3.14 -> 3) } asDictionary keysAndValuesDo: [ :provided :expected | 23 | drawing width: provided. 24 | self assert: drawing width equals: expected. 25 | drawing height: provided. 26 | self assert: drawing height equals: expected. 27 | drawing width: provided height: provided. 28 | self assert: drawing width equals: expected. 29 | self assert: drawing height equals: expected ] 30 | ] 31 | 32 | { #category : #tests } 33 | EzBoundedDrawingTest >> testExtentAlwaysPositive [ 34 | 35 | #( 0 -1 -974 ) do: [ :invalidValue | 36 | drawing width: 100 height: 100. 37 | self assert: drawing width equals: 100. 38 | self assert: drawing height equals: 100. 39 | drawing width: invalidValue. 40 | self assert: drawing width equals: 1. 41 | drawing height: invalidValue. 42 | self assert: drawing height equals: 1. 43 | drawing width: 100 height: 100. 44 | drawing width: invalidValue height: invalidValue. 45 | self assert: drawing width equals: 1. 46 | self assert: drawing height equals: 1. 47 | drawing width: 100 height: 100. 48 | drawing width: 42 height: invalidValue. 49 | self assert: drawing width equals: 42. 50 | self assert: drawing height equals: 1. 51 | drawing width: 100 height: 100. 52 | drawing width: invalidValue height: 56. 53 | self assert: drawing width equals: 1. 54 | self assert: drawing height equals: 56 ] 55 | ] 56 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzBox.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzBox, 3 | #superclass : #EzBoundedDrawing, 4 | #category : #'EasyUI-Kernel' 5 | } 6 | 7 | { #category : #'instance creation' } 8 | EzBox class >> rectangleCenter: center width: width height: height [ 9 | ^ (self width: width height: height) 10 | center: center; 11 | yourself 12 | ] 13 | 14 | { #category : #'instance creation' } 15 | EzBox class >> rectangleCorner: corner width: width height: height [ 16 | ^ (self width: width height: height) 17 | corner: corner; 18 | yourself 19 | ] 20 | 21 | { #category : #'instance creation' } 22 | EzBox class >> squareCenter: center length: length [ 23 | ^self rectangleCenter: center width: length height: length 24 | ] 25 | 26 | { #category : #'instance creation' } 27 | EzBox class >> squareCorner: corner length: length [ 28 | ^self rectangleCorner: corner width: length height: length 29 | ] 30 | 31 | { #category : #rendering } 32 | EzBox >> newShapeForCanvas: canvas [ 33 | ^ self bounds 34 | ] 35 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzClosedDrawing.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzClosedDrawing, 3 | #superclass : #EzAtomicDrawing, 4 | #instVars : [ 5 | 'fillColor', 6 | 'borderColor', 7 | 'borderWidth' 8 | ], 9 | #category : #'EasyUI-Kernel' 10 | } 11 | 12 | { #category : #accessing } 13 | EzClosedDrawing >> borderColor [ 14 | ^ borderColor 15 | ] 16 | 17 | { #category : #accessing } 18 | EzClosedDrawing >> borderColor: anObject [ 19 | borderColor := anObject. 20 | self redraw. 21 | ] 22 | 23 | { #category : #accessing } 24 | EzClosedDrawing >> borderWidth [ 25 | ^ borderWidth 26 | ] 27 | 28 | { #category : #accessing } 29 | EzClosedDrawing >> borderWidth: anObject [ 30 | borderWidth := anObject. 31 | self redraw. 32 | ] 33 | 34 | { #category : #accessing } 35 | EzClosedDrawing >> center [ 36 | ^self origin 37 | ] 38 | 39 | { #category : #accessing } 40 | EzClosedDrawing >> center: newCenter [ 41 | self origin: newCenter 42 | ] 43 | 44 | { #category : #initialization } 45 | EzClosedDrawing >> defaultBorderColor [ 46 | ^ Color black 47 | ] 48 | 49 | { #category : #initialization } 50 | EzClosedDrawing >> defaultBorderWidth [ 51 | ^ 3 52 | ] 53 | 54 | { #category : #initialization } 55 | EzClosedDrawing >> defaultFillColor [ 56 | ^ Color green 57 | ] 58 | 59 | { #category : #rendering } 60 | EzClosedDrawing >> drawOn: canvas [ 61 | super drawOn: canvas. 62 | canvas setPaint: self fillColor. 63 | canvas draw. 64 | (canvas setStrokePaint: self borderColor) width: self borderWidth. 65 | canvas draw. 66 | 67 | 68 | ] 69 | 70 | { #category : #accessing } 71 | EzClosedDrawing >> fillColor [ 72 | ^ fillColor 73 | ] 74 | 75 | { #category : #accessing } 76 | EzClosedDrawing >> fillColor: anObject [ 77 | fillColor := anObject. 78 | self redraw. 79 | ] 80 | 81 | { #category : #initialization } 82 | EzClosedDrawing >> initialize [ 83 | super initialize. 84 | fillColor := self defaultFillColor. 85 | borderColor := self defaultBorderColor. 86 | borderWidth := self defaultBorderWidth. 87 | 88 | ] 89 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzCompositeDrawing.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzCompositeDrawing, 3 | #superclass : #EzDrawing, 4 | #traits : 'EzTDrawingContainer', 5 | #classTraits : 'EzTDrawingContainer classTrait', 6 | #category : #'EasyUI-Kernel' 7 | } 8 | 9 | { #category : #'instance creation' } 10 | EzCompositeDrawing class >> withAll: drawings [ 11 | ^self new 12 | addAll: drawings; 13 | yourself 14 | ] 15 | 16 | { #category : #initialization } 17 | EzCompositeDrawing >> initialize [ 18 | super initialize. 19 | self initDrawings. 20 | ] 21 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzDrawingBoard.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzDrawingBoard, 3 | #superclass : #SpAthensPresenter, 4 | #traits : 'EzTDrawingContainer', 5 | #classTraits : 'EzTDrawingContainer classTrait', 6 | #instVars : [ 7 | 'backgroundPaint' 8 | ], 9 | #category : #'EasyUI-Kernel' 10 | } 11 | 12 | { #category : #'instance creation' } 13 | EzDrawingBoard class >> surfaceExtent: extent [ 14 | ^self new 15 | surfaceExtent: extent; 16 | yourself 17 | ] 18 | 19 | { #category : #specs } 20 | EzDrawingBoard class >> title [ 21 | ^'Easy UI Drawing Board' 22 | ] 23 | 24 | { #category : #accessing } 25 | EzDrawingBoard >> backgroundPaint [ 26 | ^ backgroundPaint 27 | ] 28 | 29 | { #category : #accessing } 30 | EzDrawingBoard >> backgroundPaint: anObject [ 31 | backgroundPaint := anObject 32 | ] 33 | 34 | { #category : #initialization } 35 | EzDrawingBoard >> defaultBackgroundPaint [ 36 | ^Color white 37 | ] 38 | 39 | { #category : #initialization } 40 | EzDrawingBoard >> defaultSurfaceExtent [ 41 | ^800@600 42 | ] 43 | 44 | { #category : #accessing } 45 | EzDrawingBoard >> height [ 46 | ^self surfaceExtent y 47 | ] 48 | 49 | { #category : #initialization } 50 | EzDrawingBoard >> initialExtent [ 51 | ^surfaceExtent + self windowDeltaExtent 52 | 53 | ] 54 | 55 | { #category : #initialization } 56 | EzDrawingBoard >> initialize [ 57 | super initialize. 58 | self initDrawings. 59 | self surfaceExtent: self defaultSurfaceExtent. 60 | self backgroundPaint: self defaultBackgroundPaint. 61 | self drawBlock: [ :canvas | self renderOn: canvas ] 62 | ] 63 | 64 | { #category : #rendering } 65 | EzDrawingBoard >> redraw [ 66 | self adapter changed 67 | ] 68 | 69 | { #category : #rendering } 70 | EzDrawingBoard >> renderOn: canvas [ 71 | canvas setShape: (0 @ 0 corner: self surfaceExtent). 72 | canvas setPaint: self backgroundPaint. 73 | canvas draw. 74 | self drawOn: canvas 75 | ] 76 | 77 | { #category : #accessing } 78 | EzDrawingBoard >> width [ 79 | ^self surfaceExtent x 80 | ] 81 | 82 | { #category : #initialization } 83 | EzDrawingBoard >> windowBorderWidth [ 84 | ^5 85 | ] 86 | 87 | { #category : #initialization } 88 | EzDrawingBoard >> windowDeltaExtent [ 89 | ^(self windowBorderWidth * 2)@(self windowBorderWidth + self windowTopHeight) 90 | ] 91 | 92 | { #category : #initialization } 93 | EzDrawingBoard >> windowTopHeight [ 94 | ^28 95 | ] 96 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzDrawingBoardTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzDrawingBoardTest, 3 | #superclass : #TestCase, 4 | #instVars : [ 5 | 'board', 6 | 'drawing' 7 | ], 8 | #category : #'EasyUI-Tests' 9 | } 10 | 11 | { #category : #running } 12 | EzDrawingBoardTest >> setUp [ 13 | super setUp. 14 | board := EzDrawingBoard new. 15 | drawing := EzPolyLine from: 100@100 to: 700@500. 16 | 17 | ] 18 | 19 | { #category : #running } 20 | EzDrawingBoardTest >> testAddingSeveralTime2Drawings [ 21 | | otherDrawing | 22 | otherDrawing := EzBox width: 20 height: 10. 23 | 10 timesRepeat: [ board addAll: {drawing. otherDrawing} ]. 24 | self assertCollection: board drawings asArray hasSameElements: {drawing. otherDrawing}. 25 | board drawings do: [ : each | 26 | self assert: each container identicalTo: board]. 27 | ] 28 | 29 | { #category : #running } 30 | EzDrawingBoardTest >> testAddingSeveralTimeTheSameDrawing [ 31 | 10 timesRepeat: [ board add: drawing ]. 32 | self assert: board drawings asArray equals: {drawing}. 33 | self assert: drawing container identicalTo: board. 34 | ] 35 | 36 | { #category : #running } 37 | EzDrawingBoardTest >> testRemovingSeveralTimeTheSameDrawing [ 38 | board add: drawing. 39 | board remove: drawing. 40 | self assert: board drawings isEmpty. 41 | 10 timesRepeat: [ board remove: drawing ]. 42 | self assert: board drawings isEmpty. 43 | self assert: drawing container isNil. 44 | ] 45 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzImageDrawing.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzImageDrawing, 3 | #superclass : #EzDrawing, 4 | #instVars : [ 5 | 'image' 6 | ], 7 | #category : #'EasyUI-Kernel' 8 | } 9 | 10 | { #category : #'instance creation' } 11 | EzImageDrawing class >> image: aForm [ 12 | ^self new 13 | image: aForm; 14 | yourself 15 | ] 16 | 17 | { #category : #'instance creation' } 18 | EzImageDrawing class >> imageFilePath: pathString [ 19 | | image | 20 | image := self imageFromFilePath: pathString. 21 | ^ self image: image 22 | ] 23 | 24 | { #category : #'instance creation' } 25 | EzImageDrawing class >> imageFromFilePath: pathString [ 26 | ^ ImageReadWriter formFromFileNamed: pathString 27 | ] 28 | 29 | { #category : #accessing } 30 | EzImageDrawing >> bounds [ 31 | ^ 0@0 extent: image extent 32 | ] 33 | 34 | { #category : #rendering } 35 | EzImageDrawing >> drawOn: aCanvas [ 36 | | cached | 37 | cached := aCanvas 38 | cacheAt: image 39 | ifAbsentPut: [ image asAthensPaintOn: aCanvas ]. 40 | aCanvas setPaint: cached. 41 | aCanvas paintTransform 42 | restoreAfter: [ 43 | aCanvas drawShape: self bounds ] 44 | ] 45 | 46 | { #category : #accessing } 47 | EzImageDrawing >> image [ 48 | ^ image 49 | ] 50 | 51 | { #category : #accessing } 52 | EzImageDrawing >> image: anObject [ 53 | image := anObject 54 | ] 55 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzOval.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzOval, 3 | #superclass : #EzBoundedDrawing, 4 | #category : #'EasyUI-Kernel' 5 | } 6 | 7 | { #category : #'instance creation' } 8 | EzOval class >> circleCenter: position diameter: diameter [ 9 | ^self ellipseCenter: position width: diameter height: diameter 10 | ] 11 | 12 | { #category : #'instance creation' } 13 | EzOval class >> circleCenter: center radius: radius [ 14 | ^self circleCenter: center diameter: 2 * radius 15 | ] 16 | 17 | { #category : #'instance creation' } 18 | EzOval class >> ellipseCenter: center width: width height: height [ 19 | ^ self new 20 | width: width height: height; 21 | center: center; 22 | yourself 23 | ] 24 | 25 | { #category : #accessing } 26 | EzOval >> diameter: newDiameter [ 27 | self width: newDiameter height: newDiameter 28 | ] 29 | 30 | { #category : #accessing } 31 | EzOval >> maxDiameter [ 32 | 33 | ^ self width max: self height 34 | ] 35 | 36 | { #category : #accessing } 37 | EzOval >> minDiameter [ 38 | 39 | ^self width min: self height 40 | ] 41 | 42 | { #category : #rendering } 43 | EzOval >> newShapeForCanvas: canvas [ 44 | ^EllipseMorph newBounds: self bounds 45 | ] 46 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzPacManFace.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzPacManFace, 3 | #superclass : #EzCompositeDrawing, 4 | #instVars : [ 5 | 'body', 6 | 'eye' 7 | ], 8 | #category : #'EasyUI-Examples-Drawings' 9 | } 10 | 11 | { #category : #accessing } 12 | EzPacManFace >> bodyColor [ 13 | ^body fillColor 14 | ] 15 | 16 | { #category : #accessing } 17 | EzPacManFace >> bodyColor: aColor [ 18 | body fillColor: aColor 19 | ] 20 | 21 | { #category : #accessing } 22 | EzPacManFace >> borderColor [ 23 | ^body borderColor 24 | ] 25 | 26 | { #category : #accessing } 27 | EzPacManFace >> borderColor: aColor [ 28 | body borderColor: aColor 29 | ] 30 | 31 | { #category : #initialization } 32 | EzPacManFace >> defaultBodyAngle [ 33 | self subclassResponsibility 34 | ] 35 | 36 | { #category : #initialization } 37 | EzPacManFace >> defaultEyeCenter [ 38 | self subclassResponsibility 39 | ] 40 | 41 | { #category : #accessing } 42 | EzPacManFace >> eyeColor [ 43 | ^eye fillColor 44 | ] 45 | 46 | { #category : #accessing } 47 | EzPacManFace >> eyeColor: aColor [ 48 | eye fillColor: aColor 49 | ] 50 | 51 | { #category : #initialization } 52 | EzPacManFace >> initialize [ 53 | super initialize. 54 | body := EzArc radius: 100 angleSpan: 300. 55 | body angle: self defaultBodyAngle. 56 | self bodyColor: Color yellow. 57 | eye := EzOval circleCenter: self defaultEyeCenter diameter: 25. 58 | eye borderWidth: 0. 59 | self eyeColor: Color black. 60 | self 61 | addAll: 62 | {body. 63 | eye} 64 | ] 65 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzPacManFaceLeftward.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzPacManFaceLeftward, 3 | #superclass : #EzPacManFace, 4 | #category : #'EasyUI-Examples-Drawings' 5 | } 6 | 7 | { #category : #initialization } 8 | EzPacManFaceLeftward >> defaultBodyAngle [ 9 | ^ 210 10 | ] 11 | 12 | { #category : #initialization } 13 | EzPacManFaceLeftward >> defaultEyeCenter [ 14 | ^ -30 @ -50 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzPacManFaceRightward.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzPacManFaceRightward, 3 | #superclass : #EzPacManFace, 4 | #category : #'EasyUI-Examples-Drawings' 5 | } 6 | 7 | { #category : #initialization } 8 | EzPacManFaceRightward >> defaultBodyAngle [ 9 | ^ 30 10 | ] 11 | 12 | { #category : #initialization } 13 | EzPacManFaceRightward >> defaultEyeCenter [ 14 | ^ 30 @ -50 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzPacManSprite.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzPacManSprite, 3 | #superclass : #EzCompositeDrawing, 4 | #instVars : [ 5 | 'leftward', 6 | 'rightward' 7 | ], 8 | #category : #'EasyUI-Examples-Drawings' 9 | } 10 | 11 | { #category : #initialization } 12 | EzPacManSprite >> initialize [ 13 | super initialize. 14 | leftward := EzPacManFaceLeftward new. 15 | rightward := EzPacManFaceRightward new. 16 | self lookRight. 17 | self addAll: {leftward. rightward}. 18 | ] 19 | 20 | { #category : #actions } 21 | EzPacManSprite >> lookDown [ 22 | rightward hide. 23 | leftward show. 24 | leftward angle: -90. 25 | 26 | ] 27 | 28 | { #category : #actions } 29 | EzPacManSprite >> lookLeft [ 30 | rightward hide. 31 | leftward show. 32 | leftward angle: 0. 33 | 34 | ] 35 | 36 | { #category : #actions } 37 | EzPacManSprite >> lookRight [ 38 | leftward hide. 39 | rightward show. 40 | rightward angle: 0. 41 | 42 | ] 43 | 44 | { #category : #actions } 45 | EzPacManSprite >> lookUp [ 46 | leftward hide. 47 | rightward show. 48 | rightward angle: -90. 49 | 50 | ] 51 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzPacmanRotatingApp.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzPacmanRotatingApp, 3 | #superclass : #EzApp, 4 | #traits : 'EzTDemoApp', 5 | #classTraits : 'EzTDemoApp classTrait', 6 | #category : #'EasyUI-Examples-Apps' 7 | } 8 | 9 | { #category : #'window handling' } 10 | EzPacmanRotatingApp >> defaultTitle [ 11 | ^'Rotating Pacman (All four arrows)' 12 | ] 13 | 14 | { #category : #initialization } 15 | EzPacmanRotatingApp >> initialize [ 16 | | pacman | 17 | super initialize. 18 | drawingBoard backgroundPaint: Color cyan. 19 | 50 to: 750 by: 50 do: [ :x | 20 | 50 to: 550 by: 50 do: [ :y | 21 | | pebble | 22 | pebble := EzOval circleCenter: x @ y diameter: 20. 23 | pebble fillColor: Color magenta. 24 | drawingBoard add: pebble. 25 | ] 26 | ]. 27 | pacman := EzPacManSprite new. 28 | pacman origin: 400 @ 300. 29 | drawingBoard add: pacman. 30 | drawingBoard bindKeyCombination: Character arrowLeft asKeyCombination toAction: [ pacman lookLeft ]. 31 | drawingBoard bindKeyCombination: Character arrowRight asKeyCombination toAction: [ pacman lookRight ]. 32 | drawingBoard bindKeyCombination: Character arrowUp asKeyCombination toAction: [ pacman lookUp ]. 33 | drawingBoard bindKeyCombination: Character arrowDown asKeyCombination toAction: [ pacman lookDown ]. 34 | 35 | ] 36 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzPolyLine.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzPolyLine, 3 | #superclass : #EzAtomicDrawing, 4 | #instVars : [ 5 | 'width', 6 | 'color', 7 | 'extents' 8 | ], 9 | #category : #'EasyUI-Kernel' 10 | } 11 | 12 | { #category : #'instance creation' } 13 | EzPolyLine class >> from: startPoint to: endPoint [ 14 | ^self vertices: { startPoint. endPoint } 15 | ] 16 | 17 | { #category : #'instance creation' } 18 | EzPolyLine class >> vertices: vertices [ 19 | ^self new 20 | vertices: vertices; 21 | yourself 22 | ] 23 | 24 | { #category : #accessing } 25 | EzPolyLine >> color [ 26 | ^ color 27 | ] 28 | 29 | { #category : #accessing } 30 | EzPolyLine >> color: anObject [ 31 | color := anObject. 32 | self redraw. 33 | ] 34 | 35 | { #category : #initialization } 36 | EzPolyLine >> defaultColor [ 37 | ^Color black 38 | ] 39 | 40 | { #category : #initialization } 41 | EzPolyLine >> defaultWidth [ 42 | ^3 43 | ] 44 | 45 | { #category : #rendering } 46 | EzPolyLine >> drawOn: canvas [ 47 | super drawOn: canvas. 48 | (canvas setStrokePaint: self color) width: self width. 49 | canvas draw. 50 | 51 | ] 52 | 53 | { #category : #accessing } 54 | EzPolyLine >> extents [ 55 | ^ extents 56 | ] 57 | 58 | { #category : #accessing } 59 | EzPolyLine >> extents: anObject [ 60 | extents := anObject. 61 | "Shape is recreated only if its nil" 62 | self shape: nil. 63 | 64 | ] 65 | 66 | { #category : #initialization } 67 | EzPolyLine >> initialize [ 68 | super initialize. 69 | self color: self defaultColor. 70 | self width: self defaultWidth. 71 | extents := OrderedCollection new. 72 | ] 73 | 74 | { #category : #rendering } 75 | EzPolyLine >> newShapeForCanvas: canvas [ 76 | ^canvas createPath: [ : path | 77 | path relative. 78 | self extents do: [ : each | 79 | path lineTo: each]. 80 | ]. 81 | 82 | ] 83 | 84 | { #category : #initialization } 85 | EzPolyLine >> vertices: points [ 86 | | newExtents previous | 87 | origin := points first. 88 | previous := origin. 89 | newExtents := OrderedCollection new. 90 | points allButFirst do: [ : each | 91 | newExtents add: each - previous. 92 | previous := each ]. 93 | self extents: newExtents. 94 | ] 95 | 96 | { #category : #accessing } 97 | EzPolyLine >> width [ 98 | ^ width 99 | ] 100 | 101 | { #category : #accessing } 102 | EzPolyLine >> width: anObject [ 103 | width := anObject. 104 | self redraw. 105 | ] 106 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzRays.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzRays, 3 | #superclass : #EzPolyLine, 4 | #category : #'EasyUI-Kernel' 5 | } 6 | 7 | { #category : #'instance creation' } 8 | EzRays class >> spanAngle: spanAngle radius: radius angleStep: deltaAngle [ 9 | ^ self new 10 | spanAngle: spanAngle radius: radius angleStep: deltaAngle; 11 | yourself 12 | ] 13 | 14 | { #category : #'instance creation' } 15 | EzRays class >> spanAngle: spanAngle radius: radius raysCount: raysCount [ 16 | ^ self new 17 | spanAngle: spanAngle radius: radius raysCount: raysCount; 18 | yourself 19 | ] 20 | 21 | { #category : #accessing } 22 | EzRays >> center [ 23 | ^self origin 24 | ] 25 | 26 | { #category : #accessing } 27 | EzRays >> center: newCenter [ 28 | ^self origin: newCenter 29 | ] 30 | 31 | { #category : #rendering } 32 | EzRays >> newShapeForCanvas: canvas [ 33 | ^canvas createPath: [ : path | 34 | self extents do: [ : each | 35 | path absolute. 36 | path moveTo: 0@0. 37 | path relative. 38 | path lineTo: each. 39 | ]. 40 | ]. 41 | 42 | ] 43 | 44 | { #category : #initialization } 45 | EzRays >> spanAngle: spanAngle radius: radius angleStep: deltaAngle [ 46 | | rayAngle ray newExtents | 47 | newExtents := OrderedCollection new. 48 | rayAngle := 0. 49 | [rayAngle <= spanAngle] whileTrue: [ 50 | ray := (radius * rayAngle degreeCos) @ (radius * rayAngle degreeSin). 51 | newExtents add: ray. 52 | rayAngle := rayAngle + deltaAngle. 53 | ]. 54 | self extents: newExtents 55 | 56 | 57 | ] 58 | 59 | { #category : #initialization } 60 | EzRays >> spanAngle: spanAngle radius: radius raysCount: raysCount [ 61 | self 62 | spanAngle: spanAngle 63 | radius: radius 64 | angleStep: spanAngle / raysCount. 65 | 66 | ] 67 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzRoundBot.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #EzRoundBot, 3 | #superclass : #EzCompositeDrawing, 4 | #instVars : [ 5 | 'laser', 6 | 'body', 7 | 'heading' 8 | ], 9 | #category : #'EasyUI-Examples-Drawings' 10 | } 11 | 12 | { #category : #accessing } 13 | EzRoundBot >> borderColor [ 14 | ^body borderColor 15 | ] 16 | 17 | { #category : #accessing } 18 | EzRoundBot >> borderColor: aColor [ 19 | body borderColor: aColor. 20 | heading color: aColor. 21 | ] 22 | 23 | { #category : #accessing } 24 | EzRoundBot >> fillColor [ 25 | ^body fillColor 26 | ] 27 | 28 | { #category : #accessing } 29 | EzRoundBot >> fillColor: aColor [ 30 | body fillColor: aColor 31 | ] 32 | 33 | { #category : #rendering } 34 | EzRoundBot >> hideLaser [ 35 | laser hide 36 | ] 37 | 38 | { #category : #initialization } 39 | EzRoundBot >> initialize [ 40 | | bodyRadius | 41 | super initialize. 42 | bodyRadius := 50. 43 | body := EzOval circleCenter: 0@0 radius: bodyRadius. 44 | body borderWidth: 2. 45 | heading := EzPolyLine from: 0 @ 0 to: bodyRadius @ 0. 46 | heading width: 5. 47 | laser := EzRays spanAngle: 270 radius: 200 angleStep: 3. 48 | laser angle: -135. 49 | laser color: Color red. 50 | laser width: 1. 51 | self borderColor: Color black. 52 | self fillColor: Color yellow. 53 | self addAll: { body. heading. laser } 54 | ] 55 | 56 | { #category : #rendering } 57 | EzRoundBot >> isShowingLaser [ 58 | ^laser isShowing 59 | ] 60 | 61 | { #category : #accessing } 62 | EzRoundBot >> laserColor [ 63 | ^laser color 64 | ] 65 | 66 | { #category : #accessing } 67 | EzRoundBot >> laserColor: aColor [ 68 | laser color: aColor 69 | ] 70 | 71 | { #category : #rendering } 72 | EzRoundBot >> showLaser [ 73 | laser show 74 | ] 75 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzTDemoApp.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : #EzTDemoApp, 3 | #category : #'EasyUI-Examples-Apps' 4 | } 5 | 6 | { #category : #examples } 7 | EzTDemoApp classSide >> demo [ 8 | 9 | self newOpenWindow 10 | ] 11 | -------------------------------------------------------------------------------- /Pharo/EasyUI/EzTDrawingContainer.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : #EzTDrawingContainer, 3 | #instVars : [ 4 | 'drawings' 5 | ], 6 | #category : #'EasyUI-Kernel' 7 | } 8 | 9 | { #category : #adding } 10 | EzTDrawingContainer >> add: aDrawing [ 11 | (self drawings includes: aDrawing) 12 | ifTrue: [ ^ self ]. 13 | self basicAdd: aDrawing. 14 | self redraw. 15 | 16 | 17 | ] 18 | 19 | { #category : #adding } 20 | EzTDrawingContainer >> addAll: newDawings [ 21 | newDawings do: [ : each | self basicAdd: each ]. 22 | self redraw. 23 | ] 24 | 25 | { #category : #adding } 26 | EzTDrawingContainer >> basicAdd: aDrawing [ 27 | drawings add: aDrawing. 28 | aDrawing container: self. 29 | 30 | ] 31 | 32 | { #category : #adding } 33 | EzTDrawingContainer >> basicRemove: aDrawing [ 34 | drawings remove: aDrawing. 35 | aDrawing container: nil. 36 | 37 | ] 38 | 39 | { #category : #rendering } 40 | EzTDrawingContainer >> drawOn: canvas [ 41 | drawings do: [ :each | each renderOn: canvas] 42 | ] 43 | 44 | { #category : #accessing } 45 | EzTDrawingContainer >> drawings [ 46 | ^drawings 47 | ] 48 | 49 | { #category : #initialization } 50 | EzTDrawingContainer >> initDrawings [ 51 | drawings := OrderedCollection new. 52 | ] 53 | 54 | { #category : #rendering } 55 | EzTDrawingContainer >> moveToBack: aDrawing [ 56 | drawings remove: aDrawing. 57 | drawings addFirst: aDrawing. 58 | self redraw. 59 | ] 60 | 61 | { #category : #rendering } 62 | EzTDrawingContainer >> moveToFront: aDrawing [ 63 | drawings remove: aDrawing. 64 | drawings addLast: aDrawing. 65 | self redraw. 66 | ] 67 | 68 | { #category : #adding } 69 | EzTDrawingContainer >> remove: aDrawing [ 70 | (self drawings includes: aDrawing) 71 | ifFalse: [ ^ self ]. 72 | self basicRemove: aDrawing. 73 | self redraw. 74 | 75 | ] 76 | 77 | { #category : #adding } 78 | EzTDrawingContainer >> removeAll [ 79 | self removeAll: drawings copy. 80 | 81 | ] 82 | 83 | { #category : #adding } 84 | EzTDrawingContainer >> removeAll: oldDawings [ 85 | oldDawings do: [ : each | self basicRemove: each ]. 86 | self redraw. 87 | ] 88 | -------------------------------------------------------------------------------- /Pharo/EasyUI/SpAthensMorph.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #SpAthensMorph } 2 | 3 | { #category : #'*EasyUI' } 4 | SpAthensMorph >> takesKeyboardFocus [ 5 | ^ true 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/EasyUI/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #EasyUI } 2 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/Array.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Array } 2 | 3 | { #category : #'*LightweightObserver' } 4 | Array >> asSubject [ 5 | | subject | 6 | subject := LoSubjectArray new: self size. 7 | self withIndexDo: [ : value : index | subject at: index put: value ]. 8 | self becomeForward: subject. 9 | 10 | 11 | ] 12 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/Collection.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Collection } 2 | 3 | { #category : #'*LightweightObserver' } 4 | Collection class >> adoptInstance: aCollection [ 5 | [ super adoptInstance: aCollection ] 6 | on: Error 7 | do: [ (self withAll: aCollection) become: aCollection ] 8 | ] 9 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/CompiledMethod.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #CompiledMethod } 2 | 3 | { #category : #'*LightweightObserver' } 4 | CompiledMethod >> isBasicMethod [ 5 | ^false 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/Dictionary.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Dictionary } 2 | 3 | { #category : #'*LightweightObserver' } 4 | Dictionary >> asSubject [ 5 | LoSubjectDictionary adoptInstance: self 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoArrayAutomaticEventGenerationTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoArrayAutomaticEventGenerationTest, 3 | #superclass : #LoAutomaticEventGenerationTest, 4 | #category : #'LightweightObserver-Test' 5 | } 6 | 7 | { #category : #testing } 8 | LoArrayAutomaticEventGenerationTest >> testAtPut [ 9 | | lastRemovedValue lastAddedValue lastIndex| 10 | subject collection: { 11. 21. 31. }. 11 | subject 12 | afterReplaceInCollection: #collection 13 | do: [ : index : addedValue : removedValue | 14 | lastIndex := index. 15 | lastRemovedValue := removedValue. 16 | lastAddedValue := addedValue]. 17 | subject collection at: 1 put: 10. 18 | self assert: lastRemovedValue equals: 11. 19 | self assert: lastAddedValue equals: 10. 20 | self assert: lastIndex equals: 1. 21 | subject collection at: 2 put: 20. 22 | self assert: lastRemovedValue equals: 21. 23 | self assert: lastAddedValue equals: 20. 24 | self assert: lastIndex equals: 2. 25 | 26 | ] 27 | 28 | { #category : #testing } 29 | LoArrayAutomaticEventGenerationTest >> testReset [ 30 | | lastRemovedValue lastAddedValue lastIndex| 31 | subject collection: #(a b c). 32 | subject 33 | afterReplaceInCollection: #collection 34 | do: [ : index : addedValue : removedValue| 35 | lastIndex := index. 36 | lastRemovedValue := removedValue. 37 | lastAddedValue := addedValue]. 38 | subject collection: { 11. 21. 31. }. 39 | subject collection at: 1 put: 10. 40 | self assert: lastRemovedValue equals: 11. 41 | self assert: lastAddedValue equals: 10. 42 | self assert: lastIndex equals: 1. 43 | subject collection at: 2 put: 20. 44 | self assert: lastRemovedValue equals: 21. 45 | self assert: lastAddedValue equals: 20. 46 | self assert: lastIndex equals: 2. 47 | 48 | ] 49 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoCompositeObserver.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Composite observer. I am actually a collection of observers that are my children. 3 | 4 | Instance Variables 5 | children: 6 | 7 | " 8 | Class { 9 | #name : #LoCompositeObserver, 10 | #superclass : #Object, 11 | #instVars : [ 12 | 'children' 13 | ], 14 | #category : #'LightweightObserver-Kernel' 15 | } 16 | 17 | { #category : #'instance creation' } 18 | LoCompositeObserver class >> children: aCollection [ 19 | ^self new 20 | children: aCollection; 21 | yourself 22 | ] 23 | 24 | { #category : #accessing } 25 | LoCompositeObserver >> children [ 26 | ^ children 27 | ] 28 | 29 | { #category : #accessing } 30 | LoCompositeObserver >> children: anObject [ 31 | children := anObject 32 | ] 33 | 34 | { #category : #observing } 35 | LoCompositeObserver >> startObserving [ 36 | self children do: [ : each | each startObserving ] 37 | ] 38 | 39 | { #category : #observing } 40 | LoCompositeObserver >> stopObserving [ 41 | self children do: [ : each | each stopObserving ] 42 | ] 43 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoDice.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent a dice with many faces, one and only one is always up. 3 | See class side example methods in LoDicePresenter 4 | 5 | Public API and Key Messages 6 | - roll 7 | Randomly choose the face up among my faces 8 | 9 | - faceUp 10 | Answers the current face up 11 | 12 | - how to create instances. 13 | -- faces: aCollection 14 | Creates a dice where faces are objects of the collection 15 | 16 | -- of: numberOfFaces 17 | Creates a dice with the provided number of faces. Each face is a number starting from 1 and up to numberOfFaces 18 | 19 | Internal Representation and Key Implementation Points. 20 | 21 | Instance Variables 22 | faceUp: 23 | faces: 24 | 25 | 26 | Implementation Points 27 | Rolling a dice = defines the faceUp using the atRandom = uses the global shared random number generator 28 | " 29 | Class { 30 | #name : #LoDice, 31 | #superclass : #LoSubject, 32 | #instVars : [ 33 | 'faceUp', 34 | 'faces' 35 | ], 36 | #category : #'LightweightObserver-Example' 37 | } 38 | 39 | { #category : #'instance creation' } 40 | LoDice class >> faces: faces [ 41 | ^self new 42 | faces: faces; 43 | yourself 44 | ] 45 | 46 | { #category : #'instance creation' } 47 | LoDice class >> of: facesCount [ 48 | ^self faces: (1 to: facesCount) 49 | ] 50 | 51 | { #category : #initialization } 52 | LoDice >> defaultFacesCount [ 53 | ^6 54 | ] 55 | 56 | { #category : #playing } 57 | LoDice >> faceUp [ 58 | ^faceUp 59 | ] 60 | 61 | { #category : #playing } 62 | LoDice >> faceUp: currentFace [ 63 | ^faceUp := currentFace 64 | ] 65 | 66 | { #category : #accessing } 67 | LoDice >> faces [ 68 | ^faces 69 | ] 70 | 71 | { #category : #initialization } 72 | LoDice >> faces: aCollection [ 73 | faces := aCollection. 74 | self roll 75 | ] 76 | 77 | { #category : #accessing } 78 | LoDice >> facesCount [ 79 | ^self faces size 80 | ] 81 | 82 | { #category : #initialization } 83 | LoDice >> facesCount: faceMaxValue [ 84 | self faces: (1 to: faceMaxValue) 85 | ] 86 | 87 | { #category : #initialization } 88 | LoDice >> initialize [ 89 | super initialize. 90 | self facesCount: self defaultFacesCount 91 | ] 92 | 93 | { #category : #playing } 94 | LoDice >> roll [ 95 | ^self faceUp: self faces atRandom 96 | ] 97 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoDiceAdder.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a list of numerical dice. I computes the total of faces up, upon rolling dice, or when adding or removing dice. 3 | 4 | Public API and Key Messages 5 | - total 6 | Answers the current total of dice faces up 7 | 8 | Implementation Points 9 | Relies on the observer pattern to update total upon a dice collection change, a dice faceUp change 10 | See methods linkTo: and addDice: 11 | 12 | " 13 | Class { 14 | #name : #LoDiceAdder, 15 | #superclass : #LoDiceList, 16 | #instVars : [ 17 | 'total' 18 | ], 19 | #category : #'LightweightObserver-Example' 20 | } 21 | 22 | { #category : #'initialize-release' } 23 | LoDiceAdder >> dice: aCollection [ 24 | super dice: aCollection. 25 | self dice do: [ : each | self linkTo: each]. 26 | 27 | ] 28 | 29 | { #category : #'initialize-release' } 30 | LoDiceAdder >> initialize [ 31 | super initialize. 32 | self afterChangeOfCollection: #dice do: [ self updateTotal ]. 33 | self afterReplaceInCollection: #dice do: [: index : newDice | 34 | self linkTo: newDice ]. 35 | self afterAddToCollection: #dice do: [: newDice | 36 | self linkTo: newDice ]. 37 | self afterChangeOf: #dice do: [ self updateTotal ]. 38 | self updateTotal 39 | ] 40 | 41 | { #category : #playing } 42 | LoDiceAdder >> linkTo: aDice [ 43 | aDice afterChangeOf: #faceUp do: [ self updateTotal ]. 44 | ] 45 | 46 | { #category : #playing } 47 | LoDiceAdder >> total [ 48 | ^total 49 | ] 50 | 51 | { #category : #'private-generated' } 52 | LoDiceAdder >> total: anObject [ 53 | total := anObject 54 | ] 55 | 56 | { #category : #playing } 57 | LoDiceAdder >> updateTotal [ 58 | | newTotal | 59 | newTotal := self dice inject: 0 into: [ : sum : each | sum + each faceUp]. 60 | ^self total: newTotal 61 | ] 62 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoDiceTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoDiceTest, 3 | #superclass : #TestCase, 4 | #instVars : [ 5 | 'dice' 6 | ], 7 | #category : #'LightweightObserver-Example' 8 | } 9 | 10 | { #category : #running } 11 | LoDiceTest >> assertFaceUpBelongsToFaces: faceValues [ 12 | | faceUp | 13 | dice faces: faceValues. 14 | 100 15 | timesRepeat: [ faceUp := dice roll. 16 | (faceValues includes: faceUp) 17 | ifFalse: [ self fail: 'Dice face up should belong to faces collection' ] ] 18 | ] 19 | 20 | { #category : #running } 21 | LoDiceTest >> setUp [ 22 | super setUp. 23 | dice := LoDice new. 24 | ] 25 | 26 | { #category : #running } 27 | LoDiceTest >> testCreation [ 28 | | userDefinedFaces | 29 | dice := LoDice new. 30 | self assert: dice faces equals: (1 to: 6). 31 | 32 | 2 to: 32 do: [ : facesCount | 33 | dice := LoDice of: facesCount. 34 | self assert: dice faces equals: (1 to: facesCount). 35 | ]. 36 | 37 | userDefinedFaces := #(a b c). 38 | dice := LoDice faces: userDefinedFaces. 39 | self assert: dice faces equals: userDefinedFaces. 40 | 41 | userDefinedFaces := #(a a a b). 42 | dice := LoDice faces: userDefinedFaces. 43 | self assert: dice faces equals: userDefinedFaces. 44 | 45 | 46 | ] 47 | 48 | { #category : #running } 49 | LoDiceTest >> testFaceUpBelongsToDiceFaces [ 50 | self assertFaceUpBelongsToFaces: #(a b). 51 | self assertFaceUpBelongsToFaces: #(z a x). 52 | dice facesCount: 12. 53 | self assert: dice faces equals: (1 to: 12). 54 | self assertFaceUpBelongsToFaces: dice faces. 55 | 56 | ] 57 | 58 | { #category : #running } 59 | LoDiceTest >> testFaceUpChangesUponRolls [ 60 | |oldFaceUp | 61 | oldFaceUp := dice faceUp. 62 | 100 timesRepeat: [ 63 | dice roll. 64 | oldFaceUp = dice faceUp ifFalse: [^true]. 65 | oldFaceUp := dice faceUp. 66 | ]. 67 | self fail: 'Dice face up should change upon roll' 68 | ] 69 | 70 | { #category : #running } 71 | LoDiceTest >> testObserver [ 72 | |observedValue| 73 | dice afterChangeOf: #faceUp do: [ : newFaceUp | observedValue := newFaceUp ]. 74 | 10 timesRepeat: [ 75 | dice roll. 76 | self assert: observedValue equals: dice faceUp 77 | ]. 78 | ] 79 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoDiceUiTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoDiceUiTest, 3 | #superclass : #TestCase, 4 | #category : #'LightweightObserver-Example' 5 | } 6 | 7 | { #category : #tests } 8 | LoDiceUiTest >> testDiceAdderObservedByPresenter [ 9 | | diceAdder presenter displayedFaces faceUpStrings oldTotal | 10 | diceAdder := LoDiceAdder withTwoDice. 11 | presenter := LoDiceAdderPresenter new. 12 | presenter linkTo: diceAdder. 13 | 10 timesRepeat: [ 14 | diceAdder roll. 15 | displayedFaces := presenter dicePresenters collect: [: each | each diceFaceUpString]. 16 | faceUpStrings := diceAdder facesUp collect: #asString. 17 | self assert: displayedFaces asArray equals: faceUpStrings asArray. 18 | self assert: presenter totalString equals: diceAdder total asString]. 19 | oldTotal := diceAdder total. 20 | 100 timesRepeat: [ 21 | presenter rollButton performAction. 22 | oldTotal = diceAdder total ifFalse: [ ^self ] 23 | ]. 24 | self fail: 'Click on Roll button should make total change' 25 | 26 | ] 27 | 28 | { #category : #tests } 29 | LoDiceUiTest >> testDiceListObservedByPresenter [ 30 | | diceList presenter displayedFaces faceUpStrings | 31 | diceList := LoDiceList withTwoDice. 32 | presenter := LoDiceListPresenter new. 33 | presenter linkTo: diceList. 34 | 10 timesRepeat: [ 35 | diceList roll. 36 | displayedFaces := presenter dicePresenters collect: [: each | each diceFaceUpString]. 37 | faceUpStrings := diceList facesUp collect: #asString. 38 | self assert: displayedFaces asArray equals: faceUpStrings asArray]. 39 | 40 | ] 41 | 42 | { #category : #tests } 43 | LoDiceUiTest >> testDiceObservedByPresenter [ 44 | | dice presenter oldFaceUp | 45 | dice := LoDice new. 46 | presenter := LoDicePresenter new. 47 | presenter linkTo: dice. 48 | 10 timesRepeat: [ 49 | dice roll. 50 | self assert: presenter diceFaceUpString equals: dice faceUp asString]. 51 | oldFaceUp := dice faceUp. 52 | 100 timesRepeat: [ 53 | presenter diceFaceUpPresenter performAction. 54 | oldFaceUp = dice faceUp ifFalse: [ ^self ]. 55 | ]. 56 | self fail: 'Click on presenter should make dice roll' 57 | 58 | ] 59 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoEvent.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent an event that is triggered by a subject and dispatched to observers. 3 | 4 | Events are organized in a class hierarchy. Observers of an event class also observe its subclasses. 5 | 6 | See LoEvent class>>#dispatch:toObserversFrom: 7 | 8 | " 9 | Class { 10 | #name : #LoEvent, 11 | #superclass : #Object, 12 | #category : #'LightweightObserver-Kernel' 13 | } 14 | 15 | { #category : #dispatching } 16 | LoEvent class >> dispatch: anEvent toObserversFrom: aDispatcher [ 17 | (aDispatcher observersOf: self) do: [: anObserver | anObserver handle: anEvent]. 18 | self == LoEvent ifTrue: [ ^self ]. 19 | self superclass dispatch: anEvent toObserversFrom: aDispatcher 20 | 21 | ] 22 | 23 | { #category : #dispatching } 24 | LoEvent >> dispatchToObserversFrom: aDispatcher [ 25 | self class dispatch: self toObserversFrom: aDispatcher 26 | ] 27 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoEvent1ForTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoEvent1ForTest, 3 | #superclass : #LoEvent, 4 | #instVars : [ 5 | 'data' 6 | ], 7 | #category : #'LightweightObserver-Test' 8 | } 9 | 10 | { #category : #accessing } 11 | LoEvent1ForTest >> data [ 12 | ^ data 13 | ] 14 | 15 | { #category : #accessing } 16 | LoEvent1ForTest >> data: anObject [ 17 | data := anObject 18 | ] 19 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoEvent2ForTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoEvent2ForTest, 3 | #superclass : #LoEvent, 4 | #category : #'LightweightObserver-Test' 5 | } 6 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoEvent3ForTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoEvent3ForTest, 3 | #superclass : #LoEvent2ForTest, 4 | #category : #'LightweightObserver-Test' 5 | } 6 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoEventDispatcher.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I dispatch events, that is I perform blocks registered for given event classes. 3 | 4 | Instance Variables 5 | dispatchDict: (Set of BlockClosure)> 6 | 7 | 8 | " 9 | Class { 10 | #name : #LoEventDispatcher, 11 | #superclass : #Object, 12 | #instVars : [ 13 | 'dispatchDict' 14 | ], 15 | #category : #'LightweightObserver-Kernel' 16 | } 17 | 18 | { #category : #dispatching } 19 | LoEventDispatcher >> dispatch: event [ 20 | event dispatchToObserversFrom: self 21 | 22 | ] 23 | 24 | { #category : #'initialize-release' } 25 | LoEventDispatcher >> initialize [ 26 | super initialize. 27 | dispatchDict := Dictionary new. 28 | 29 | ] 30 | 31 | { #category : #accessing } 32 | LoEventDispatcher >> observersOf: eventClass [ 33 | ^dispatchDict at: eventClass ifAbsentPut: Set new 34 | ] 35 | 36 | { #category : #dispatching } 37 | LoEventDispatcher >> on: eventClass do: aBlockClosure [ 38 | | eventObservers | 39 | eventObservers := self observersOf: eventClass. 40 | ^LoGenericObserver observersPool: eventObservers actionBlock: aBlockClosure. 41 | 42 | ] 43 | 44 | { #category : #dispatching } 45 | LoEventDispatcher >> unsubscribe: anObserver [ 46 | anObserver stopObserving 47 | ] 48 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoGenericObserver.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a generic single event observer. I perform a block when I am notified that an event instance of the event class I subscribed to occured. 3 | 4 | I am typically created by the event dispatcher. 5 | See LoEventDispatcher>>#on:do: 6 | 7 | Internal Representation and Key Implementation Points. 8 | 9 | Instance Variables 10 | actionBlock: 11 | observersPool: 12 | 13 | Implementation Points 14 | I am observing while I am inside the observers pool. 15 | Observation stops when I quit the pool. 16 | 17 | 18 | " 19 | Class { 20 | #name : #LoGenericObserver, 21 | #superclass : #Object, 22 | #instVars : [ 23 | 'observersPool', 24 | 'actionBlock' 25 | ], 26 | #category : #'LightweightObserver-Kernel' 27 | } 28 | 29 | { #category : #'instance creation' } 30 | LoGenericObserver class >> observersPool: eventObservers actionBlock: aBlockClosure [ 31 | ^self new 32 | observersPool: eventObservers; 33 | actionBlock: aBlockClosure; 34 | yourself 35 | ] 36 | 37 | { #category : #accessing } 38 | LoGenericObserver >> actionBlock [ 39 | ^ actionBlock 40 | ] 41 | 42 | { #category : #accessing } 43 | LoGenericObserver >> actionBlock: anObject [ 44 | actionBlock := anObject 45 | ] 46 | 47 | { #category : #observing } 48 | LoGenericObserver >> handle: anEvent [ 49 | self actionBlock cull: anEvent 50 | ] 51 | 52 | { #category : #accessing } 53 | LoGenericObserver >> observersPool [ 54 | ^ observersPool 55 | ] 56 | 57 | { #category : #accessing } 58 | LoGenericObserver >> observersPool: aCollection [ 59 | observersPool := aCollection. 60 | self startObserving 61 | ] 62 | 63 | { #category : #observing } 64 | LoGenericObserver >> startObserving [ 65 | self observersPool add: self 66 | ] 67 | 68 | { #category : #observing } 69 | LoGenericObserver >> stopObserving [ 70 | self observersPool remove: self ifAbsent: [] 71 | ] 72 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoIvChangeEvent.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent a change in one or more instance variables. 3 | 4 | Instance Variables 5 | ivsDict: Object> : map IV names to IV values 6 | 7 | 8 | Implementation Points 9 | " 10 | Class { 11 | #name : #LoIvChangeEvent, 12 | #superclass : #LoEvent, 13 | #instVars : [ 14 | 'ivsDict' 15 | ], 16 | #category : #'LightweightObserver-Kernel' 17 | } 18 | 19 | { #category : #accessing } 20 | LoIvChangeEvent >> addIv: ivName newValue: newValue [ 21 | ^ivsDict at: ivName put: newValue 22 | ] 23 | 24 | { #category : #accessing } 25 | LoIvChangeEvent >> ifChanged: ivName do: aBlock [ 26 | | newValue | 27 | newValue := ivsDict at: ivName ifAbsent: [ ^self ]. 28 | aBlock cull: newValue 29 | ] 30 | 31 | { #category : #initialization } 32 | LoIvChangeEvent >> initialize [ 33 | super initialize. 34 | ivsDict := Dictionary new 35 | ] 36 | 37 | { #category : #accessing } 38 | LoIvChangeEvent >> newValueFor: ivName [ 39 | ^ivsDict at: ivName ifAbsent: [ nil ]. 40 | ] 41 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoNullPackage.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Placeholder for packages for subject support methods. 3 | 4 | See LoSubjectSupportMethod>>#packageFromOrganizer: 5 | " 6 | Class { 7 | #name : #LoNullPackage, 8 | #superclass : #Object, 9 | #category : #'LightweightObserver-Kernel' 10 | } 11 | 12 | { #category : #adding } 13 | LoNullPackage >> addMethod: aCollection [ 14 | ^self 15 | ] 16 | 17 | { #category : #converting } 18 | LoNullPackage >> asRingDefinition [ 19 | ^nil 20 | ] 21 | 22 | { #category : #testing } 23 | LoNullPackage >> isDefault [ 24 | ^true 25 | ] 26 | 27 | { #category : #accessing } 28 | LoNullPackage >> name [ 29 | ^'NullPackage' 30 | ] 31 | 32 | { #category : #accessing } 33 | LoNullPackage >> package [ 34 | ^self 35 | ] 36 | 37 | { #category : #accessing } 38 | LoNullPackage >> packageManifestOrNil [ 39 | ^nil 40 | ] 41 | 42 | { #category : #'organization updating' } 43 | LoNullPackage >> updateSelector: oldSelector inClass: aClass withNewSelector: newSelector [ 44 | ^self 45 | ] 46 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSequenceableCollectionAutomaticEventGenerationTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSequenceableCollectionAutomaticEventGenerationTest, 3 | #superclass : #LoElasticCollectionAutomaticEventGenerationTest, 4 | #category : #'LightweightObserver-Test' 5 | } 6 | 7 | { #category : #testing } 8 | LoSequenceableCollectionAutomaticEventGenerationTest class >> isAbstract [ 9 | ^self == LoSequenceableCollectionAutomaticEventGenerationTest 10 | ] 11 | 12 | { #category : #testing } 13 | LoSequenceableCollectionAutomaticEventGenerationTest >> testRemoveElementByIndex [ 14 | | lastRemovedValue lastIndex | 15 | subject collection addAll: { 11. 12. 13. 20. 31. 32. 33 }. 16 | subject afterRemoveFromCollection: #collection do: [ : removedValue : index | 17 | lastRemovedValue := removedValue. 18 | lastIndex := index]. 19 | subject collection removeFirst. 20 | self assert: lastRemovedValue equals: 11. 21 | self assert: lastIndex equals: 1. 22 | subject collection removeLast. 23 | self assert: lastRemovedValue equals: 33. 24 | self assert: lastIndex equals: 6. 25 | subject collection removeAt: 2. 26 | self assert: lastRemovedValue equals: 13. 27 | self assert: lastIndex equals: 2. 28 | 29 | ] 30 | 31 | { #category : #testing } 32 | LoSequenceableCollectionAutomaticEventGenerationTest >> testRemoveElementByIndexWithoutEventDispatch [ 33 | subject collection addAll: { 11. 12. 13. 20. 31. 32. 33 }. 34 | self 35 | shouldnt: [ 36 | subject collection removeFirst. 37 | subject collection removeLast. 38 | subject collection removeAt: 2. 39 | ] 40 | raise: Error. 41 | 42 | ] 43 | 44 | { #category : #testing } 45 | LoSequenceableCollectionAutomaticEventGenerationTest >> testRemoveOneElementWithIndex [ 46 | | lastRemovedValue lastIndex | 47 | subject collection addAll: { 11. 12. 13. 20. 31. 32. 33 }. 48 | subject afterRemoveFromCollection: #collection do: [ : removedValue : index | 49 | lastRemovedValue := removedValue. 50 | lastIndex := index]. 51 | subject collection remove: 100 ifAbsent: []. 52 | self assert: lastRemovedValue isNil. 53 | self assert: lastIndex isNil. 54 | subject collection remove: 20. 55 | self assert: lastRemovedValue equals: 20. 56 | self assert: lastIndex equals: 4. 57 | subject collection remove: 13. 58 | self assert: lastRemovedValue equals: 13. 59 | self assert: lastIndex equals: 3. 60 | subject collection remove: 31. 61 | self assert: lastRemovedValue equals: 31. 62 | self assert: lastIndex equals: 3. 63 | 64 | ] 65 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSetAutomaticEventGenerationTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSetAutomaticEventGenerationTest, 3 | #superclass : #LoElasticCollectionAutomaticEventGenerationTest, 4 | #category : #'LightweightObserver-Test' 5 | } 6 | 7 | { #category : #testing } 8 | LoSetAutomaticEventGenerationTest >> collectionClass [ 9 | ^Set 10 | ] 11 | 12 | { #category : #testing } 13 | LoSetAutomaticEventGenerationTest >> testAddRedundantElement [ 14 | | additionCount | 15 | additionCount := 0. 16 | subject afterAddToCollection: #collection do: [ additionCount := additionCount + 1]. 17 | subject collection add: #monday. 18 | self assert: additionCount equals: 1. 19 | subject collection add: #monday. 20 | self assert: additionCount equals: 1. 21 | 22 | ] 23 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSingleElementAddEvent.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSingleElementAddEvent, 3 | #superclass : #LoSingleElementChangeEvent, 4 | #category : #'LightweightObserver-Collections' 5 | } 6 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSingleElementChangeEvent.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSingleElementChangeEvent, 3 | #superclass : #LoEvent, 4 | #instVars : [ 5 | 'element', 6 | 'index' 7 | ], 8 | #category : #'LightweightObserver-Collections' 9 | } 10 | 11 | { #category : #'instance creation' } 12 | LoSingleElementChangeEvent class >> element: anObject [ 13 | ^self new 14 | element: anObject; 15 | yourself 16 | ] 17 | 18 | { #category : #'instance creation' } 19 | LoSingleElementChangeEvent class >> element: anObject at: index [ 20 | ^(self element: anObject) 21 | index: index; 22 | yourself 23 | ] 24 | 25 | { #category : #accessing } 26 | LoSingleElementChangeEvent >> element [ 27 | ^ element 28 | ] 29 | 30 | { #category : #accessing } 31 | LoSingleElementChangeEvent >> element: anObject [ 32 | element := anObject 33 | ] 34 | 35 | { #category : #accessing } 36 | LoSingleElementChangeEvent >> index [ 37 | ^ index 38 | ] 39 | 40 | { #category : #accessing } 41 | LoSingleElementChangeEvent >> index: anObject [ 42 | index := anObject 43 | ] 44 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSingleElementRemoveEvent.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSingleElementRemoveEvent, 3 | #superclass : #LoSingleElementChangeEvent, 4 | #category : #'LightweightObserver-Collections' 5 | } 6 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSingleElementReplaceEvent.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSingleElementReplaceEvent, 3 | #superclass : #LoSingleElementChangeEvent, 4 | #instVars : [ 5 | 'addedElement', 6 | 'key' 7 | ], 8 | #category : #'LightweightObserver-Collections' 9 | } 10 | 11 | { #category : #'instance creation' } 12 | LoSingleElementReplaceEvent class >> at: key replaced: oldObject by: newObject [ 13 | ^self new 14 | key: key; 15 | removedElement: oldObject; 16 | addedElement: newObject; 17 | yourself 18 | ] 19 | 20 | { #category : #accessing } 21 | LoSingleElementReplaceEvent >> addedElement [ 22 | ^ addedElement 23 | ] 24 | 25 | { #category : #accessing } 26 | LoSingleElementReplaceEvent >> addedElement: anObject [ 27 | addedElement := anObject 28 | ] 29 | 30 | { #category : #accessing } 31 | LoSingleElementReplaceEvent >> key [ 32 | ^ key 33 | ] 34 | 35 | { #category : #accessing } 36 | LoSingleElementReplaceEvent >> key: anObject [ 37 | key := anObject 38 | ] 39 | 40 | { #category : #accessing } 41 | LoSingleElementReplaceEvent >> removedElement [ 42 | ^ self element 43 | ] 44 | 45 | { #category : #accessing } 46 | LoSingleElementReplaceEvent >> removedElement: anObject [ 47 | ^ self element: anObject 48 | ] 49 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSortedCollectionAutomaticEventGenerationTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSortedCollectionAutomaticEventGenerationTest, 3 | #superclass : #LoSequenceableCollectionAutomaticEventGenerationTest, 4 | #category : #'LightweightObserver-Test' 5 | } 6 | 7 | { #category : #testing } 8 | LoSortedCollectionAutomaticEventGenerationTest >> collectionClass [ 9 | ^SortedCollection 10 | ] 11 | 12 | { #category : #testing } 13 | LoSortedCollectionAutomaticEventGenerationTest >> testAddLastElement [ 14 | | lastAddedValue lastIndex | 15 | subject afterAddToCollection: #collection do: [ : newValue : newIndex| 16 | lastAddedValue := newValue. 17 | lastIndex := newIndex]. 18 | subject collection addLast: #sunday. 19 | self assert: lastAddedValue equals: #sunday. 20 | self assert: lastIndex equals: 1. 21 | subject collection addLast: #saturday. 22 | self assert: lastAddedValue equals: #saturday. 23 | self assert: lastIndex equals: 2 24 | 25 | ] 26 | 27 | { #category : #testing } 28 | LoSortedCollectionAutomaticEventGenerationTest >> testAddOneElementWithIndex [ 29 | | lastAddedValue lastIndex | 30 | subject afterAddToCollection: #collection do: [ : newValue : newIndex| 31 | lastAddedValue := newValue. 32 | lastIndex := newIndex]. 33 | subject collection add: #monday. 34 | self assert: lastAddedValue equals: #monday. 35 | self assert: lastIndex equals: 1. 36 | subject collection add: #sunday. 37 | self assert: lastAddedValue equals: #sunday. 38 | self assert: lastIndex equals: 2. 39 | subject collection add: #saturday. 40 | self assert: lastAddedValue equals: #saturday. 41 | self assert: lastIndex equals: 2. 42 | subject collection add: #wednesday. 43 | self assert: lastAddedValue equals: #wednesday. 44 | self assert: lastIndex equals: 4. 45 | 46 | ] 47 | 48 | { #category : #testing } 49 | LoSortedCollectionAutomaticEventGenerationTest >> testArbitraryChangeWithLastElementManipulation [ 50 | | changeCount | 51 | changeCount := 0. 52 | subject afterChangeOfCollection: #collection do: [changeCount := changeCount + 1]. 53 | subject collection add: 10. 54 | self assert: changeCount equals: 1. 55 | subject collection addLast: 5. 56 | self assert: changeCount equals: 2. 57 | subject collection addLast: 4. 58 | self assert: changeCount equals: 3. 59 | subject collection remove: 10. 60 | self assert: changeCount equals: 4. 61 | 62 | ] 63 | 64 | { #category : #testing } 65 | LoSortedCollectionAutomaticEventGenerationTest >> testElementsStaySorted [ 66 | subject afterChangeOfCollection: #collection do: []. 67 | #(10 5 1) do: [ : each | 68 | subject collection add: each ]. 69 | self assert: subject collection first equals: 1. 70 | self assert: subject collection last equals: 10. 71 | ] 72 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSubjectArray.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSubjectArray, 3 | #superclass : #Array, 4 | #type : #variable, 5 | #traits : 'LoTSubjectCollection + LoTMapAccessSubjectCollection', 6 | #classTraits : 'LoTSubjectCollection classTrait + LoTMapAccessSubjectCollection classTrait', 7 | #instVars : [ 8 | 'dispatcher' 9 | ], 10 | #category : #'LightweightObserver-Collections' 11 | } 12 | 13 | { #category : #accessing } 14 | LoSubjectArray >> dispatcher [ 15 | ^ dispatcher 16 | ] 17 | 18 | { #category : #accessing } 19 | LoSubjectArray >> dispatcher: anObject [ 20 | dispatcher := anObject 21 | ] 22 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSubjectBasicMethodChangeForbiddenError.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am an error signaled upon an attempt to modify or remove a subject basic method 3 | " 4 | Class { 5 | #name : #LoSubjectBasicMethodChangeForbiddenError, 6 | #superclass : #Error, 7 | #category : #'LightweightObserver-Kernel' 8 | } 9 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSubjectDictionary.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSubjectDictionary, 3 | #superclass : #Dictionary, 4 | #traits : 'LoTSubjectCollection + LoTMapAccessSubjectCollection', 5 | #classTraits : 'LoTSubjectCollection classTrait + LoTMapAccessSubjectCollection classTrait', 6 | #instVars : [ 7 | 'dispatcher' 8 | ], 9 | #category : #'LightweightObserver-Collections' 10 | } 11 | 12 | { #category : #accessing } 13 | LoSubjectDictionary >> dispatcher [ 14 | ^ dispatcher 15 | ] 16 | 17 | { #category : #accessing } 18 | LoSubjectDictionary >> dispatcher: anObject [ 19 | dispatcher := anObject 20 | ] 21 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSubjectForTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSubjectForTest, 3 | #superclass : #LoSubject, 4 | #instVars : [ 5 | 'a', 6 | 'b', 7 | 'set', 8 | 'array', 9 | 'dict', 10 | 'sortedCol', 11 | 'collection' 12 | ], 13 | #category : #'LightweightObserver-Test' 14 | } 15 | 16 | { #category : #accessing } 17 | LoSubjectForTest >> a [ 18 | ^ a 19 | ] 20 | 21 | { #category : #accessing } 22 | LoSubjectForTest >> a: anObject [ 23 | a := anObject 24 | ] 25 | 26 | { #category : #accessing } 27 | LoSubjectForTest >> a: objA b: objB [ 28 | a := objA. 29 | b := objB 30 | ] 31 | 32 | { #category : #accessing } 33 | LoSubjectForTest >> b [ 34 | ^ b 35 | ] 36 | 37 | { #category : #accessing } 38 | LoSubjectForTest >> b: anObject [ 39 | b := anObject 40 | ] 41 | 42 | { #category : #accessing } 43 | LoSubjectForTest >> collection [ 44 | ^ collection 45 | ] 46 | 47 | { #category : #accessing } 48 | LoSubjectForTest >> collection: anObject [ 49 | collection := anObject 50 | ] 51 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSubjectOrderedCollection.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSubjectOrderedCollection, 3 | #superclass : #OrderedCollection, 4 | #traits : 'LoTSequeceableSubjectCollection + LoTMapAccessSubjectCollection', 5 | #classTraits : 'LoTSequeceableSubjectCollection classTrait + LoTMapAccessSubjectCollection classTrait', 6 | #instVars : [ 7 | 'dispatcher' 8 | ], 9 | #category : #'LightweightObserver-Collections' 10 | } 11 | 12 | { #category : #adding } 13 | LoSubjectOrderedCollection >> addFirst: anObject [ 14 | super addFirst: anObject. 15 | self dispatchEventAdded: anObject at: 1. 16 | ^ anObject 17 | ] 18 | 19 | { #category : #accessing } 20 | LoSubjectOrderedCollection >> dispatcher [ 21 | ^ dispatcher 22 | ] 23 | 24 | { #category : #accessing } 25 | LoSubjectOrderedCollection >> dispatcher: anObject [ 26 | dispatcher := anObject 27 | ] 28 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSubjectSet.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSubjectSet, 3 | #superclass : #Set, 4 | #traits : 'LoTElasticSubjectCollection', 5 | #classTraits : 'LoTElasticSubjectCollection classTrait', 6 | #instVars : [ 7 | 'dispatcher' 8 | ], 9 | #category : #'LightweightObserver-Collections' 10 | } 11 | 12 | { #category : #adding } 13 | LoSubjectSet >> add: anObject [ 14 | | initialSize | 15 | initialSize := self size. 16 | super add: anObject. 17 | self size > initialSize ifTrue: [ self dispatchEventAdded: anObject]. 18 | ^anObject 19 | ] 20 | 21 | { #category : #accessing } 22 | LoSubjectSet >> dispatcher [ 23 | ^dispatcher 24 | ] 25 | 26 | { #category : #accessing } 27 | LoSubjectSet >> dispatcher: anObject [ 28 | ^dispatcher := anObject 29 | ] 30 | 31 | { #category : #removing } 32 | LoSubjectSet >> remove: anObject ifAbsent: aBlock [ 33 | super remove: anObject ifAbsent: [^aBlock value]. 34 | self dispatchEventRemoved: anObject. 35 | ^ anObject 36 | ] 37 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSubjectSortedCollection.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #LoSubjectSortedCollection, 3 | #superclass : #SortedCollection, 4 | #traits : 'LoTSequeceableSubjectCollection', 5 | #classTraits : 'LoTSequeceableSubjectCollection classTrait', 6 | #instVars : [ 7 | 'dispatcher' 8 | ], 9 | #category : #'LightweightObserver-Collections' 10 | } 11 | 12 | { #category : #adding } 13 | LoSubjectSortedCollection >> add: addedObject [ 14 | super add: addedObject. 15 | self dispatchEventAdded: addedObject at: (self indexOf: addedObject). 16 | ^addedObject 17 | ] 18 | 19 | { #category : #accessing } 20 | LoSubjectSortedCollection >> dispatcher [ 21 | ^dispatcher 22 | ] 23 | 24 | { #category : #accessing } 25 | LoSubjectSortedCollection >> dispatcher: anObject [ 26 | ^dispatcher := anObject 27 | ] 28 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoSubjectSupportMethod.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a compiled method transformed by a subject to hide boiler plate code by providing a nice ""source"" for the browser, while still providing an accurate AST. 3 | See : 4 | CompiledMethod>>#ast 5 | LoSubjectSupportMethod>>#parseTree 6 | " 7 | Class { 8 | #name : #LoSubjectSupportMethod, 9 | #superclass : #CompiledMethod, 10 | #type : #compiledMethod, 11 | #category : #'LightweightObserver-Kernel' 12 | } 13 | 14 | { #category : #parsing } 15 | LoSubjectSupportMethod >> ast [ 16 | "The source code is fake, just to hide boiler plate code and ease development" 17 | ^self parseTree doSemanticAnalysisIn: self methodClass 18 | ] 19 | 20 | { #category : #testing } 21 | LoSubjectSupportMethod >> isBasicMethod [ 22 | ^LoSubject isBasicMethodSelector: self selector 23 | ] 24 | 25 | { #category : #package } 26 | LoSubjectSupportMethod >> packageFromOrganizer: organizer [ 27 | | package | 28 | "This is a bad fix to the unpackaged code problem. Just avoids the debugger poping out during compilation." 29 | package := super packageFromOrganizer: organizer. 30 | package ifNotNil: [ ^package ]. 31 | ^LoNullPackage new 32 | ] 33 | 34 | { #category : #parsing } 35 | LoSubjectSupportMethod >> parseTree [ 36 | "The source code is fake, just to hide boiler plate code and ease development" 37 | ^ self decompile 38 | ] 39 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoTElasticSubjectCollection.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : #LoTElasticSubjectCollection, 3 | #traits : 'LoTSubjectCollection', 4 | #classTraits : 'LoTSubjectCollection classTrait', 5 | #category : #'LightweightObserver-Collections' 6 | } 7 | 8 | { #category : #adding } 9 | LoTElasticSubjectCollection >> dispatchEventAdded: anObject [ 10 | | event | 11 | self dispatcher ifNil: [ ^self ]. 12 | event := LoSingleElementAddEvent element: anObject. 13 | self dispatcher dispatch: event 14 | ] 15 | 16 | { #category : #adding } 17 | LoTElasticSubjectCollection >> dispatchEventAdded: anObject at: index [ 18 | | event | 19 | self dispatcher ifNil: [ ^self ]. 20 | event := LoSingleElementAddEvent element: anObject at: index. 21 | self dispatcher dispatch: event 22 | ] 23 | 24 | { #category : #removing } 25 | LoTElasticSubjectCollection >> dispatchEventRemoved: anObject [ 26 | | event | 27 | event := LoSingleElementRemoveEvent element: anObject. 28 | self dispatcher dispatch: event 29 | ] 30 | 31 | { #category : #removing } 32 | LoTElasticSubjectCollection >> dispatchEventRemoved: anObject at: index [ 33 | | event | 34 | event := LoSingleElementRemoveEvent element: anObject at: index. 35 | self dispatcher dispatch: event 36 | ] 37 | 38 | { #category : #accessing } 39 | LoTElasticSubjectCollection >> dispatcher [ 40 | self explicitRequirement 41 | ] 42 | 43 | { #category : #accessing } 44 | LoTElasticSubjectCollection >> dispatcher: anObject [ 45 | self explicitRequirement 46 | ] 47 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoTMapAccessSubjectCollection.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : #LoTMapAccessSubjectCollection, 3 | #traits : 'LoTSubjectCollection', 4 | #classTraits : 'LoTSubjectCollection classTrait', 5 | #category : #'LightweightObserver-Collections' 6 | } 7 | 8 | { #category : #accessing } 9 | LoTMapAccessSubjectCollection >> at: key put: addedObject [ 10 | | removedObject event | 11 | self dispatcher ifNil: [^super at: key put: addedObject]. 12 | removedObject := self at: key ifAbsent: [nil]. 13 | super at: key put: addedObject. 14 | event := LoSingleElementReplaceEvent at: key replaced: removedObject by: addedObject. 15 | self dispatcher dispatch: event. 16 | ^ addedObject 17 | ] 18 | 19 | { #category : #accessing } 20 | LoTMapAccessSubjectCollection >> dispatcher [ 21 | self explicitRequirement 22 | ] 23 | 24 | { #category : #accessing } 25 | LoTMapAccessSubjectCollection >> dispatcher: anObject [ 26 | self explicitRequirement 27 | ] 28 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoTSequeceableSubjectCollection.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : #LoTSequeceableSubjectCollection, 3 | #traits : 'LoTElasticSubjectCollection', 4 | #classTraits : 'LoTElasticSubjectCollection classTrait', 5 | #category : #'LightweightObserver-Collections' 6 | } 7 | 8 | { #category : #adding } 9 | LoTSequeceableSubjectCollection >> addLast: anObject [ 10 | super addLast: anObject. 11 | self dispatchEventAdded: anObject at: self size. 12 | ^ anObject 13 | ] 14 | 15 | { #category : #accessing } 16 | LoTSequeceableSubjectCollection >> dispatcher [ 17 | self explicitRequirement 18 | ] 19 | 20 | { #category : #accessing } 21 | LoTSequeceableSubjectCollection >> dispatcher: anObject [ 22 | self explicitRequirement 23 | ] 24 | 25 | { #category : #removing } 26 | LoTSequeceableSubjectCollection >> remove: anObject ifAbsent: aBlock [ 27 | | index | 28 | index := self indexOf: anObject. 29 | super remove: anObject ifAbsent: [^aBlock value]. 30 | self dispatchEventRemoved: anObject at: index. 31 | ^ anObject 32 | ] 33 | 34 | { #category : #removing } 35 | LoTSequeceableSubjectCollection >> removeAt: index [ 36 | | removedObject | 37 | removedObject := super removeAt: index. 38 | self dispatchEventRemoved: removedObject at: index. 39 | ^ removedObject 40 | ] 41 | 42 | { #category : #removing } 43 | LoTSequeceableSubjectCollection >> removeFirst [ 44 | | removedObject | 45 | removedObject := super removeFirst. 46 | self dispatchEventRemoved: removedObject at: 1. 47 | ^ removedObject 48 | ] 49 | 50 | { #category : #removing } 51 | LoTSequeceableSubjectCollection >> removeLast [ 52 | | removedObject index | 53 | index := self size. 54 | removedObject := super removeLast. 55 | self dispatchEventRemoved: removedObject at: index. 56 | ^ removedObject 57 | ] 58 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/LoTSubjectCollection.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : #LoTSubjectCollection, 3 | #category : #'LightweightObserver-Collections' 4 | } 5 | 6 | { #category : #converting } 7 | LoTSubjectCollection >> asSubject [ 8 | ^self 9 | ] 10 | 11 | { #category : #accessing } 12 | LoTSubjectCollection >> dispatcher [ 13 | self explicitRequirement 14 | ] 15 | 16 | { #category : #accessing } 17 | LoTSubjectCollection >> dispatcher: anObject [ 18 | self explicitRequirement 19 | ] 20 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/OrderedCollection.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #OrderedCollection } 2 | 3 | { #category : #'*LightweightObserver' } 4 | OrderedCollection >> asSubject [ 5 | LoSubjectOrderedCollection adoptInstance: self 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/Set.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Set } 2 | 3 | { #category : #'*LightweightObserver' } 4 | Set >> asSubject [ 5 | LoSubjectSet adoptInstance: self 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/SortedCollection.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #SortedCollection } 2 | 3 | { #category : #'*LightweightObserver' } 4 | SortedCollection >> asSubject [ 5 | LoSubjectSortedCollection adoptInstance: self 6 | 7 | ] 8 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/UndefinedObject.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #UndefinedObject } 2 | 3 | { #category : #'*LightweightObserver' } 4 | UndefinedObject >> asSubject [ 5 | ^self 6 | ] 7 | 8 | { #category : #'*LightweightObserver' } 9 | UndefinedObject >> dispatcher: aLoEventDispatcher [ 10 | ^self. 11 | ] 12 | -------------------------------------------------------------------------------- /Pharo/LightweightObserver/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #LightweightObserver } 2 | -------------------------------------------------------------------------------- /Pharo/NetNameResolverBugFix/NetNameResolver.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #NetNameResolver } 2 | 3 | { #category : #'*NetNameResolverBugFix' } 4 | NetNameResolver class >> localHostAddress [ 5 | "Return the local address of this host." 6 | "NetNameResolver localHostAddress" 7 | 8 | "On Mac the primitive is buggy and can return an empty IP address. Use a standard value in that case" 9 | 10 | | primAddress | 11 | Smalltalk os isMacOS ifTrue: [ ^self localHostAddressHackForMac ]. 12 | self initializeNetwork. 13 | [ primAddress := self primLocalAddress ] on: PrimitiveFailed do: [ :err | primAddress := #[0 0 0 0] ]. 14 | ^ (primAddress = #[0 0 0 0] ifTrue: [ #[127 0 0 1] ] ifFalse: [ primAddress ]) asSocketAddress 15 | ] 16 | 17 | { #category : #'*NetNameResolverBugFix' } 18 | NetNameResolver class >> localHostAddressHackForMac [ 19 | "This is a hack. The best solution should be done by fixing the primitive on Mac" 20 | | ipString | 21 | ipString := Smalltalk os resultOfCommand: 'ipconfig getifaddr en0'. 22 | ipString ifEmpty: [^self loopBackAddress]. 23 | ^SocketAddress fromDottedString: ipString 24 | 25 | ] 26 | -------------------------------------------------------------------------------- /Pharo/NetNameResolverBugFix/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #NetNameResolverBugFix } 2 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/ByteArray.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #ByteArray } 2 | 3 | { #category : #'*NetworkExtras-converting' } 4 | ByteArray >> asIpAddress [ 5 | ^NeIpV4Address newFrom: self 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeAllPortsUsedError.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am signaled when there are no free ports left for sockets of a given protocol. See NeUsedPortsTracker class>>#freePort 3 | " 4 | Class { 5 | #name : #NeAllPortsUsedError, 6 | #superclass : #NetworkError, 7 | #category : #'NetworkExtras-Kernel' 8 | } 9 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeAlreadyUsedSocketPort.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a network error signaled when attempting to create a socket that listens on a port already used by another socket 3 | " 4 | Class { 5 | #name : #NeAlreadyUsedSocketPort, 6 | #superclass : #NetworkError, 7 | #category : #'NetworkExtras-Kernel' 8 | } 9 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeBroadcastSocket.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am an UDP socket dedicated to broadcast communication. Broadcast is meant either for the wohole network, or a sub-network depending on the used broadcastIp address. 3 | 4 | Instance Variables 5 | broadcastIp: IP used as a traget of broadcasted data 6 | broadcastPort: port targeted with broadcasted data 7 | 8 | " 9 | Class { 10 | #name : #NeBroadcastSocket, 11 | #superclass : #NeUdpSocket, 12 | #instVars : [ 13 | 'broadcastPort', 14 | 'broadcastIp' 15 | ], 16 | #category : #'NetworkExtras-UDP-Kernel' 17 | } 18 | 19 | { #category : #'instance creation' } 20 | NeBroadcastSocket class >> ip: ip port: portNumber [ 21 | ^self new 22 | broadcastIp: ip port: portNumber; 23 | yourself 24 | ] 25 | 26 | { #category : #'instance creation' } 27 | NeBroadcastSocket class >> port: portNumber [ 28 | ^self 29 | ip: NeIpV4Address broadcast 30 | port: portNumber 31 | ] 32 | 33 | { #category : #accessing } 34 | NeBroadcastSocket >> broadcastIp [ 35 | ^broadcastIp 36 | ] 37 | 38 | { #category : #'initialize-release' } 39 | NeBroadcastSocket >> broadcastIp: anIp port: portNumber [ 40 | anIp last = 255 ifFalse: [^NeInvalidBroadcastIp signal]. 41 | self ensureValidPort: portNumber. 42 | broadcastIp := anIp asIpAddress. 43 | broadcastPort := portNumber. 44 | self setOption: 'SO_BROADCAST' value: true 45 | ] 46 | 47 | { #category : #accessing } 48 | NeBroadcastSocket >> broadcastPort [ 49 | ^broadcastPort 50 | ] 51 | 52 | { #category : #'initialize-release' } 53 | NeBroadcastSocket >> broadcastPort: portNumber [ 54 | self broadcastIp: self broadcastIp port: portNumber 55 | ] 56 | 57 | { #category : #printing } 58 | NeBroadcastSocket >> printSocketInfoOn: stream [ 59 | stream 60 | nextPutAll: 'Target IP: '; 61 | print: self targetIp; 62 | nextPutAll: ' - port: '; 63 | print: self targetPort 64 | ] 65 | 66 | { #category : #sending } 67 | NeBroadcastSocket >> targetIp [ 68 | ^self broadcastIp 69 | ] 70 | 71 | { #category : #sending } 72 | NeBroadcastSocket >> targetPort [ 73 | ^self broadcastPort 74 | ] 75 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeChunk.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A chunk is a fragment of information. It allows to reconstruct some large data (ByteArray) split in parts. 3 | 4 | There exist different kinds of chunks depending of the kind of information they embed. All they have in common sourceId to identify the entity that split data (NeDataSplitter) and when the split has been performed. This information allows reconstructing data coming from different sources (different spliters) at different times, even if chunks are delivered mixed. 5 | 6 | Every data is split in one or more instances of NeContentChunk as well as one single instance of NeChunkCollectionInfo. 7 | 8 | Each NeContentChunk includes a unique part (ByteArray) of the split data. 9 | The unique NeChunkCollectionInfo includes info about the NeContentChunks. 10 | 11 | Instance Variables 12 | timestamp When the data was split 13 | sourceId Allows identifying the source 14 | 15 | " 16 | Class { 17 | #name : #NeChunk, 18 | #superclass : #Object, 19 | #instVars : [ 20 | 'timestamp', 21 | 'sourceId' 22 | ], 23 | #category : #'NetworkExtras-UDP-LargeData' 24 | } 25 | 26 | { #category : #reconstructing } 27 | NeChunk >> addTo: reconstructor [ 28 | self subclassResponsibility 29 | ] 30 | 31 | { #category : #converting } 32 | NeChunk >> asByteArray [ 33 | ^FLSerializer serializeToByteArray: self 34 | ] 35 | 36 | { #category : #accessing } 37 | NeChunk >> sourceId [ 38 | ^ sourceId 39 | ] 40 | 41 | { #category : #accessing } 42 | NeChunk >> sourceId: anObject [ 43 | sourceId := anObject 44 | ] 45 | 46 | { #category : #accessing } 47 | NeChunk >> timestamp [ 48 | ^ timestamp 49 | ] 50 | 51 | { #category : #accessing } 52 | NeChunk >> timestamp: anObject [ 53 | timestamp := anObject 54 | ] 55 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeChunkCollectionInfo.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I provide info about a collection of content chunks (NeContentChunk) that are made out of some data by some splitter (NeDataSplitter) at some specific point in time. 3 | 4 | Instance Variables 5 | contentChunksCount: Number of content chunks 6 | 7 | " 8 | Class { 9 | #name : #NeChunkCollectionInfo, 10 | #superclass : #NeChunk, 11 | #instVars : [ 12 | 'contentChunksCount' 13 | ], 14 | #category : #'NetworkExtras-UDP-LargeData' 15 | } 16 | 17 | { #category : #reconstructing } 18 | NeChunkCollectionInfo >> addTo: reconstructor [ 19 | reconstructor addChunkCollectionInfo: self 20 | ] 21 | 22 | { #category : #accessing } 23 | NeChunkCollectionInfo >> contentChunksCount [ 24 | ^ contentChunksCount 25 | ] 26 | 27 | { #category : #accessing } 28 | NeChunkCollectionInfo >> contentChunksCount: anObject [ 29 | contentChunksCount := anObject 30 | ] 31 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeContentChunk.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent a unique part of some data split at some specific point in time by a specific spliter. 3 | 4 | Instance Variables 5 | contents: data fragment 6 | index: position relative to other content chunks belonging to the same collection 7 | 8 | " 9 | Class { 10 | #name : #NeContentChunk, 11 | #superclass : #NeChunk, 12 | #instVars : [ 13 | 'index', 14 | 'contents' 15 | ], 16 | #category : #'NetworkExtras-UDP-LargeData' 17 | } 18 | 19 | { #category : #reconstructing } 20 | NeContentChunk >> addTo: reconstructor [ 21 | reconstructor addContentChunk: self 22 | ] 23 | 24 | { #category : #accessing } 25 | NeContentChunk >> contents [ 26 | ^ contents 27 | ] 28 | 29 | { #category : #accessing } 30 | NeContentChunk >> contents: aCollection [ 31 | ^ contents := aCollection asByteArray 32 | ] 33 | 34 | { #category : #'initialize-release' } 35 | NeContentChunk >> contentsFrom: aReadStream maxFullSize: maxFullSize [ 36 | | maxContentsSize sizeWithoutContents | 37 | self resetContents. 38 | sizeWithoutContents := self asByteArray size. 39 | maxContentsSize := maxFullSize - sizeWithoutContents. 40 | self contents: (aReadStream next: maxContentsSize) 41 | ] 42 | 43 | { #category : #'initialize-release' } 44 | NeContentChunk >> defaultContents [ 45 | ^#[] 46 | ] 47 | 48 | { #category : #accessing } 49 | NeContentChunk >> index [ 50 | ^ index 51 | ] 52 | 53 | { #category : #accessing } 54 | NeContentChunk >> index: anInteger [ 55 | index := anInteger 56 | ] 57 | 58 | { #category : #'initialize-release' } 59 | NeContentChunk >> resetContents [ 60 | self contents: self defaultContents 61 | ] 62 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeInvalidBroadcastIp.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am an error signaled when an IP address that is not ending with 255 is used for broadcast. 3 | 4 | See NeBroadcastSocket 5 | " 6 | Class { 7 | #name : #NeInvalidBroadcastIp, 8 | #superclass : #NetworkError, 9 | #category : #'NetworkExtras-UDP-Kernel' 10 | } 11 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeInvalidMulticastGroupIpError.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am an error signaled when an IP address that does not belong to the multicast address range (224.0.0.0 - 239.255.255.255). 3 | 4 | See NeMulticastSocket 5 | " 6 | Class { 7 | #name : #NeInvalidMulticastGroupIpError, 8 | #superclass : #NetworkError, 9 | #category : #'NetworkExtras-UDP-Kernel' 10 | } 11 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeInvalidSocketPortError.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am an error signaled when a socket is provided a port (for sending or reception) outside the valid interval [0, 65535] 3 | " 4 | Class { 5 | #name : #NeInvalidSocketPortError, 6 | #superclass : #NetworkError, 7 | #category : #'NetworkExtras-UDP-Kernel' 8 | } 9 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeIpAddressTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeIpAddressTest, 3 | #superclass : #TestCase, 4 | #traits : 'CcTWaitPolling', 5 | #classTraits : 'CcTWaitPolling classTrait', 6 | #category : #'NetworkExtras-Test' 7 | } 8 | 9 | { #category : #testing } 10 | NeIpAddressTest >> testAddressFromString [ 11 | self assert: 'localhost' asIpAddress equals: '127.0.0.1' asIpAddress. 12 | self assert: '255.255.255.255' asIpAddress equals: 'broadcasthost' asIpAddress. 13 | 14 | ] 15 | 16 | { #category : #testing } 17 | NeIpAddressTest >> testAddressName [ 18 | self assert: NeIpV4Address loopback name equals: 'localhost'. 19 | self assert: NeIpV4Address broadcast name equals: 'broadcasthost'. 20 | self assert: (NeIpV4Address fromName: 'localhost') equals: NeIpV4Address loopback. 21 | self assert: (NeIpV4Address fromName: 'broadcasthost') equals: NeIpV4Address broadcast. 22 | 23 | 24 | ] 25 | 26 | { #category : #testing } 27 | NeIpAddressTest >> testCompareAddresses [ 28 | self assert: '1.1.1.1' asIpAddress < '2.2.2.2' asIpAddress. 29 | self assert: '2.2.2.2' asIpAddress > '1.1.1.1' asIpAddress. 30 | self assert: '0.2.0.0' asIpAddress < '1.0.0.0' asIpAddress. 31 | self assert: '1.1.1.1' asIpAddress > '0.2.0.0' asIpAddress. 32 | 33 | 34 | ] 35 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeIpV4Address.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represents an IPv4 address. 3 | 4 | I subclass of ByteArray for purpose of compatibility with the existing implementation of Socket 5 | 6 | Instances can be created either from a string or a byte array. 7 | Examples: 8 | '192.168.11.22' asIpAddress 9 | #[192 168 11 22] asIpAddress 10 | " 11 | Class { 12 | #name : #NeIpV4Address, 13 | #superclass : #SocketAddress, 14 | #type : #bytes, 15 | #category : #'NetworkExtras-Kernel' 16 | } 17 | 18 | { #category : #'instance creation' } 19 | NeIpV4Address class >> allNetworkInterfaces [ 20 | "INADDR_ANY = all available network interfaces on the current device" 21 | ^ self newFrom: #[0 0 0 0] 22 | ] 23 | 24 | { #category : #'instance creation' } 25 | NeIpV4Address class >> broadcast [ 26 | ^ self newFrom: #[255 255 255 255] 27 | ] 28 | 29 | { #category : #'instance creation' } 30 | NeIpV4Address class >> fromIpString: aString [ 31 | "return a new IP address from a string 32 | IPAddress fromIpString: '10.1.10.115'" 33 | 34 | ^ self newFrom: ((aString splitOn: $.) collect: [:s | s asInteger]) 35 | ] 36 | 37 | { #category : #'instance creation' } 38 | NeIpV4Address class >> fromName: aString [ 39 | "return a new IP address from a host name 40 | IPAddress fromName: 'localhost'" 41 | 42 | ^ (NetNameResolver addressForName: aString) asIpAddress 43 | ] 44 | 45 | { #category : #'instance creation' } 46 | NeIpV4Address class >> fromString: aString [ 47 | (aString includes: $.) ifTrue: [ ^self fromIpString: aString ]. 48 | ^self fromName: aString 49 | 50 | ] 51 | 52 | { #category : #'instance creation' } 53 | NeIpV4Address class >> local [ 54 | "return a new IP address from a string 55 | IPAddress local" 56 | 57 | ^ self newFrom: NetNameResolver localHostAddress 58 | ] 59 | 60 | { #category : #'instance creation' } 61 | NeIpV4Address class >> loopback [ 62 | ^ self newFrom: NetNameResolver loopBackAddress 63 | ] 64 | 65 | { #category : #comparing } 66 | NeIpV4Address >> < anIpAddress [ 67 | ^self asInteger < anIpAddress asInteger 68 | ] 69 | 70 | { #category : #comparing } 71 | NeIpV4Address >> > anIpAddress [ 72 | ^anIpAddress < self 73 | ] 74 | 75 | { #category : #converting } 76 | NeIpV4Address >> asIpAddress [ 77 | ^self 78 | ] 79 | 80 | { #category : #converting } 81 | NeIpV4Address >> asNumber [ 82 | ^self asInteger 83 | ] 84 | 85 | { #category : #converting } 86 | NeIpV4Address >> asString [ 87 | ^ NetNameResolver stringFromAddress: self 88 | ] 89 | 90 | { #category : #accessing } 91 | NeIpV4Address >> name [ 92 | self = self class loopback ifTrue: [^'localhost']. "Workaround for Windows where VM answers that actual machine name!" 93 | ^NetNameResolver nameForAddress: self timeout: 60 94 | ] 95 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeMultiSourceDataReconstructor.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I reconstruct data (byteArray) out of chunks coming from many sources. 3 | 4 | Reception order is not important. I am able to reconstruct data even if I receive chunks from different sources at random. 5 | 6 | Public API and Key Messages 7 | -addChunk: aChunk 8 | Handles a new data chunk 9 | 10 | -withReconstructedDataDo: aTwoArgsBlock 11 | Sets the data handling block valued each time a data is reconstructed. It must have two arguments one for the sourceId and the second for the reconstructed data 12 | 13 | Instance Variables 14 | dataReconstructorsDict on reconstructor for each source 15 | dataHandlingBlock Valued each time a data is reconstructed. It must have two arguments one for the sourceId and the second for the reconstructed data 16 | 17 | " 18 | Class { 19 | #name : #NeMultiSourceDataReconstructor, 20 | #superclass : #Object, 21 | #instVars : [ 22 | 'dataReconstructorsDict', 23 | 'dataHandlingBlock' 24 | ], 25 | #category : #'NetworkExtras-UDP-LargeData' 26 | } 27 | 28 | { #category : #'data handling' } 29 | NeMultiSourceDataReconstructor >> addChunk: newChunk [ 30 | | reconstructor | 31 | reconstructor := dataReconstructorsDict at: newChunk sourceId ifAbsentPut: [ self newDataReconstructorId: newChunk sourceId ]. 32 | reconstructor addChunk: newChunk 33 | ] 34 | 35 | { #category : #initialization } 36 | NeMultiSourceDataReconstructor >> initialize [ 37 | super initialize. 38 | dataReconstructorsDict := Dictionary new 39 | ] 40 | 41 | { #category : #'data handling' } 42 | NeMultiSourceDataReconstructor >> newDataReconstructorId: sourceId [ 43 | | reconstructor | 44 | reconstructor := NeSingleSourceDataReconstructor new. 45 | reconstructor withReconstructedDataDo: [: data | dataHandlingBlock value: sourceId value: data ]. 46 | ^reconstructor 47 | ] 48 | 49 | { #category : #'data handling' } 50 | NeMultiSourceDataReconstructor >> withReconstructedDataDo: aTwoArgBlockClosure [ 51 | dataHandlingBlock := aTwoArgBlockClosure 52 | ] 53 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeMultiSourceSplitReconstructLargeDataTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeMultiSourceSplitReconstructLargeDataTest, 3 | #superclass : #TestCase, 4 | #traits : 'NeTLargeDataProviderForTest', 5 | #classTraits : 'NeTLargeDataProviderForTest classTrait', 6 | #instVars : [ 7 | 'reconstructor', 8 | 'splitter1', 9 | 'splitter2' 10 | ], 11 | #category : #'NetworkExtras-Test' 12 | } 13 | 14 | { #category : #testing } 15 | NeMultiSourceSplitReconstructLargeDataTest >> setUp [ 16 | super setUp. 17 | reconstructor := NeMultiSourceDataReconstructor new. 18 | splitter1 := NeDataSplitter new. 19 | splitter1 id: #testSplitter1. 20 | splitter2 := NeDataSplitter new. 21 | splitter2 id: #testSplitter2. 22 | 23 | ] 24 | 25 | { #category : #testing } 26 | NeMultiSourceSplitReconstructLargeDataTest >> testReconstructingLargeDataFromChunksReceivedUnsorted [ 27 | | reconstructedDataDict originalData1 originalData2 remainingChunks aChunk | 28 | reconstructedDataDict := Dictionary new. 29 | reconstructor withReconstructedDataDo: [: sourceId : data | reconstructedDataDict at: sourceId put: data]. 30 | originalData1 := self get10KBytesOfSourceFile asByteArray. 31 | splitter1 dataBytes: originalData1. 32 | splitter1 maxChunkSize: 1000. 33 | originalData2 := (self get50KBytesOfSourceFile last: originalData1 size) asByteArray. 34 | splitter2 dataBytes: originalData2. 35 | splitter2 maxChunkSize: 1000. 36 | remainingChunks := splitter1 chunks asSet, splitter2 chunks asSet. 37 | [remainingChunks isEmpty] whileFalse: [ 38 | aChunk := remainingChunks atRandom. 39 | remainingChunks remove: aChunk. 40 | reconstructor addChunk: aChunk ]. 41 | self assert: (reconstructedDataDict at: splitter1 id) equals: originalData1. 42 | self assert: (reconstructedDataDict at: splitter2 id) equals: originalData2. 43 | ] 44 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeMulticastServer.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a UDP Multicast server. I handle incoming UDP data repeatedly in a dedicated thread. 3 | 4 | " 5 | Class { 6 | #name : #NeMulticastServer, 7 | #superclass : #NeUdpServer, 8 | #instVars : [ 9 | 'groupIp', 10 | 'portNumber' 11 | ], 12 | #category : #'NetworkExtras-UDP-Kernel' 13 | } 14 | 15 | { #category : #'instance creation' } 16 | NeMulticastServer class >> group: ipOrName port: portNumber [ 17 | ^self new 18 | groupIp: ipOrName; 19 | portNumber: portNumber; 20 | yourself 21 | ] 22 | 23 | { #category : #activity } 24 | NeMulticastServer >> defaultServerName [ 25 | ^'Multicast server' 26 | ] 27 | 28 | { #category : #accessing } 29 | NeMulticastServer >> groupIp [ 30 | ^ groupIp 31 | ] 32 | 33 | { #category : #accessing } 34 | NeMulticastServer >> groupIp: anObject [ 35 | groupIp := anObject 36 | ] 37 | 38 | { #category : #building } 39 | NeMulticastServer >> newSocket [ 40 | ^NeMulticastSocket group: self groupIp port: self portNumber 41 | ] 42 | 43 | { #category : #accessing } 44 | NeMulticastServer >> portNumber [ 45 | ^ portNumber 46 | ] 47 | 48 | { #category : #accessing } 49 | NeMulticastServer >> portNumber: anObject [ 50 | portNumber := anObject 51 | ] 52 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeMulticastUdpServerTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeMulticastUdpServerTest, 3 | #superclass : #NeUdpServerTest, 4 | #instVars : [ 5 | 'multicastGroup', 6 | 'multicastPort' 7 | ], 8 | #category : #'NetworkExtras-Test' 9 | } 10 | 11 | { #category : #testing } 12 | NeMulticastUdpServerTest >> newServer [ 13 | multicastGroup := '236.1.2.13'. 14 | multicastPort := NeUsedPortsTracker freePortAtRandom. 15 | ^NeMulticastServer group: multicastGroup port: multicastPort. 16 | 17 | ] 18 | 19 | { #category : #testing } 20 | NeMulticastUdpServerTest >> startServer [ 21 | server start. 22 | server socket unregisterUsedPort. "Hack to allow having two multicast sockets on the same port!" 23 | "Order is important! Since we are on the same machine and use the default interface, 24 | receiver socket should be created first to ensure it will be fed packets by the OS. 25 | Remeber that sockets are bidirectional." 26 | sender := self newMulticastSocketOnGroup: multicastGroup port: multicastPort 27 | ] 28 | 29 | { #category : #testing } 30 | NeMulticastUdpServerTest >> stopServer [ 31 | super stopServer. 32 | sender closeAndDestroy. 33 | ] 34 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeServer.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeServer, 3 | #superclass : #Object, 4 | #instVars : [ 5 | 'serverName', 6 | 'socket', 7 | 'service' 8 | ], 9 | #category : #'NetworkExtras-Kernel' 10 | } 11 | 12 | { #category : #'initialize-release' } 13 | NeServer >> defaultServerName [ 14 | self subclassResponsibility 15 | ] 16 | 17 | { #category : #'initialize-release' } 18 | NeServer >> destroySocket [ 19 | self socket closeAndDestroy 20 | ] 21 | 22 | { #category : #'initialize-release' } 23 | NeServer >> initialize [ 24 | super initialize. 25 | service := CcService repeat: [ self servingStep ] ensure: [self destroySocket]. 26 | self name: self defaultServerName. 27 | ] 28 | 29 | { #category : #activity } 30 | NeServer >> isRunning [ 31 | ^ self isStarted 32 | ] 33 | 34 | { #category : #activity } 35 | NeServer >> isStarted [ 36 | ^ service isStarted 37 | ] 38 | 39 | { #category : #activity } 40 | NeServer >> isStopped [ 41 | ^ service isStopped 42 | ] 43 | 44 | { #category : #accessing } 45 | NeServer >> name [ 46 | ^serverName 47 | ] 48 | 49 | { #category : #accessing } 50 | NeServer >> name: aString [ 51 | ^serverName := aString 52 | ] 53 | 54 | { #category : #activity } 55 | NeServer >> newSocket [ 56 | self subclassResponsibility 57 | ] 58 | 59 | { #category : #printing } 60 | NeServer >> printOn: aStream [ 61 | self printServiceNameOn: aStream 62 | ] 63 | 64 | { #category : #activity } 65 | NeServer >> printServiceNameOn: stream [ 66 | stream 67 | nextPutAll: self name; 68 | nextPut: $(. 69 | self socket 70 | ifNil: [ stream nextPutAll: 'No Socket' ] 71 | ifNotNil: [self socket printSocketInfoOn: stream]. 72 | stream nextPut: $) 73 | ] 74 | 75 | { #category : #accessing } 76 | NeServer >> priority [ 77 | ^service priority 78 | ] 79 | 80 | { #category : #accessing } 81 | NeServer >> priority: aPriority [ 82 | service priority: aPriority 83 | ] 84 | 85 | { #category : #printing } 86 | NeServer >> serviceName [ 87 | ^String streamContents: [: stream | 88 | self printServiceNameOn: stream] 89 | ] 90 | 91 | { #category : #activity } 92 | NeServer >> servingStep [ 93 | self subclassResponsibility 94 | ] 95 | 96 | { #category : #accessing } 97 | NeServer >> socket [ 98 | ^socket 99 | ] 100 | 101 | { #category : #activity } 102 | NeServer >> start [ 103 | self isStarted 104 | ifTrue: [ ^ self ]. 105 | socket := self newSocket. 106 | service name: self serviceName. 107 | service start 108 | ] 109 | 110 | { #category : #activity } 111 | NeServer >> stop [ 112 | service stop 113 | ] 114 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeSocket.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeSocket, 3 | #superclass : #Socket, 4 | #instVars : [ 5 | 'receptionPort' 6 | ], 7 | #category : #'NetworkExtras-Kernel' 8 | } 9 | 10 | { #category : #'instance creation' } 11 | NeSocket class >> new [ 12 | ^self newIfFail: [ 13 | UIManager default 14 | abort: 'Either network is not available, or no resources left to create another socket' 15 | title: self name, ' creation failed!' ] 16 | ] 17 | 18 | { #category : #'instance creation' } 19 | NeSocket class >> newIfFail: aBlock [ 20 | self subclassResponsibility 21 | ] 22 | 23 | { #category : #'reception ports tracking' } 24 | NeSocket >> destroy [ 25 | [ super destroy ] ensure: [ self unregisterUsedPort] 26 | ] 27 | 28 | { #category : #'reception ports tracking' } 29 | NeSocket >> ensureValidPort: portNumber [ 30 | self usedPortsTracker ensureValidPort: portNumber 31 | ] 32 | 33 | { #category : #receiving } 34 | NeSocket >> receptionPort [ 35 | ^receptionPort 36 | ] 37 | 38 | { #category : #initialization } 39 | NeSocket >> receptionPort: portNumber [ 40 | self registerUsedPort: portNumber. 41 | receptionPort := portNumber. 42 | 43 | ] 44 | 45 | { #category : #'reception ports tracking' } 46 | NeSocket >> registerUsedPort: portNumber [ 47 | self usedPortsTracker registerUsedPort: portNumber 48 | ] 49 | 50 | { #category : #'reception ports tracking' } 51 | NeSocket >> unregisterUsedPort [ 52 | self usedPortsTracker unregisterUsedPort: self receptionPort 53 | ] 54 | 55 | { #category : #'reception ports tracking' } 56 | NeSocket >> usedPortsTracker [ 57 | self subclassResponsibility 58 | ] 59 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeSocketTest.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Shared behavior for UDP socket classes 3 | " 4 | Class { 5 | #name : #NeSocketTest, 6 | #superclass : #TestCase, 7 | #instVars : [ 8 | 'allSockets' 9 | ], 10 | #category : #'NetworkExtras-Test' 11 | } 12 | 13 | { #category : #testing } 14 | NeSocketTest class >> isAbstract [ 15 | ^self == NeSocketTest 16 | ] 17 | 18 | { #category : #testing } 19 | NeSocketTest >> createSocket: aBlock [ 20 | | newSocket | 21 | newSocket := aBlock value. 22 | allSockets add: newSocket. 23 | ^newSocket 24 | ] 25 | 26 | { #category : #testing } 27 | NeSocketTest >> runCaseManaged [ 28 | "This library does manage its own forked processes" 29 | self runCase 30 | ] 31 | 32 | { #category : #testing } 33 | NeSocketTest >> setUp [ 34 | super setUp. 35 | allSockets := Set new. 36 | 37 | ] 38 | 39 | { #category : #testing } 40 | NeSocketTest >> tearDown [ 41 | super tearDown. 42 | allSockets do: [: each | each closeAndDestroy]. 43 | 44 | ] 45 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeTLargeDataProviderForTest.trait.st: -------------------------------------------------------------------------------- 1 | " 2 | I provide data of multiple size useful for test purpose 3 | " 4 | Trait { 5 | #name : #NeTLargeDataProviderForTest, 6 | #category : #'NetworkExtras-Test' 7 | } 8 | 9 | { #category : #testing } 10 | NeTLargeDataProviderForTest >> get100KBytesOfSourceFile [ 11 | ^ SmalltalkImage current sourcesFile readStream next: 100000 12 | ] 13 | 14 | { #category : #testing } 15 | NeTLargeDataProviderForTest >> get10KBytesOfSourceFile [ 16 | ^SmalltalkImage current sourcesFile readStream next: 10000 17 | ] 18 | 19 | { #category : #testing } 20 | NeTLargeDataProviderForTest >> get50KBytesOfSourceFile [ 21 | ^ SmalltalkImage current sourcesFile readStream next: 50000 22 | ] 23 | 24 | { #category : #testing } 25 | NeTLargeDataProviderForTest >> get5KBytesOfSourceFile [ 26 | ^ self get50KBytesOfSourceFile last: 5000 27 | ] 28 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeTResetTrackedUsedPortsOnStartUp.trait.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a trait that provides behavior to track ports used for reception to avoid having 2 sockets listening on the same port. 3 | 4 | I am used for both TCP and UDP. See 5 | NeTcpUsedPortsTracker 6 | NeUdpUsedPortsTracker 7 | " 8 | Trait { 9 | #name : #NeTResetTrackedUsedPortsOnStartUp, 10 | #category : #'NetworkExtras-Kernel' 11 | } 12 | 13 | { #category : #initialization } 14 | NeTResetTrackedUsedPortsOnStartUp classSide >> initialize [ 15 | Smalltalk addToStartUpList: self 16 | ] 17 | 18 | { #category : #'system startup' } 19 | NeTResetTrackedUsedPortsOnStartUp classSide >> resetUsedPorts [ 20 | self explicitRequirement 21 | ] 22 | 23 | { #category : #'system startup' } 24 | NeTResetTrackedUsedPortsOnStartUp classSide >> startUp: isImageStarting [ 25 | isImageStarting ifFalse: [ ^self ]. 26 | self resetUsedPorts. 27 | ] 28 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeTcpSocket.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeTcpSocket, 3 | #superclass : #NeSocket, 4 | #category : #'NetworkExtras-TCP-Kernel' 5 | } 6 | 7 | { #category : #'instance creation' } 8 | NeTcpSocket class >> listenOn: portNumber [ 9 | ^self new 10 | listenOn: portNumber; 11 | yourself 12 | ] 13 | 14 | { #category : #'instance creation' } 15 | NeTcpSocket class >> listenOnPort: portNumber backlogSize: backlog [ 16 | ^self new 17 | listenOn: portNumber backlogSize: backlog; 18 | yourself 19 | ] 20 | 21 | { #category : #'instance creation' } 22 | NeTcpSocket class >> listenOnPort: portNumber backlogSize: backlog interface: ifAddr [ 23 | ^self new 24 | listenOn: portNumber backlogSize: backlog interface: ifAddr; 25 | yourself 26 | ] 27 | 28 | { #category : #'instance creation' } 29 | NeTcpSocket class >> newIfFail: aBlock [ 30 | ^self tcpCreateIfFail: aBlock 31 | ] 32 | 33 | { #category : #'connection open/close' } 34 | NeTcpSocket >> listenOn: portNumber [ 35 | self receptionPort: portNumber. 36 | ^super listenOn: portNumber 37 | 38 | ] 39 | 40 | { #category : #'connection open/close' } 41 | NeTcpSocket >> listenOn: portNumber backlogSize: backlog [ 42 | self receptionPort: portNumber. 43 | ^super listenOn: portNumber backlogSize: backlog 44 | 45 | ] 46 | 47 | { #category : #'connection open/close' } 48 | NeTcpSocket >> listenOn: portNumber backlogSize: backlog interface: ifAddr [ 49 | self receptionPort: portNumber. 50 | ^super listenOn: portNumber backlogSize: backlog interface: ifAddr 51 | 52 | ] 53 | 54 | { #category : #printing } 55 | NeTcpSocket >> printSocketInfoOn: aWriteStream [ 56 | self receptionPort ifNil: [^self]. 57 | ^aWriteStream 58 | nextPutAll: 'Reception Port: '; 59 | print: self receptionPort 60 | 61 | ] 62 | 63 | { #category : #'reception ports tracking' } 64 | NeTcpSocket >> usedPortsTracker [ 65 | ^NeTcpUsedPortsTracker 66 | ] 67 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeTcpSocketPortTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeTcpSocketPortTest, 3 | #superclass : #NeTcpSocketTest, 4 | #category : #'NetworkExtras-Test' 5 | } 6 | 7 | { #category : #testing } 8 | NeTcpSocketPortTest >> testPortAvailability [ 9 | | freePort | 10 | freePort := NeTcpUsedPortsTracker freePortAtRandom. 11 | self newTcpSocketListeningOnPort: freePort. 12 | self should: [ self newTcpSocketListeningOnPort: freePort ] raise: NeAlreadyUsedSocketPort. 13 | 14 | ] 15 | 16 | { #category : #testing } 17 | NeTcpSocketPortTest >> testPortNumberValidityListenOn [ 18 | self should: [ self newTcpSocketListeningOnPort: -1 ] raise: NeInvalidSocketPortError. 19 | self shouldnt: [ self newTcpSocketListeningOnPort: 0 ] raise: NeInvalidSocketPortError. 20 | self shouldnt: [ self newTcpSocketListeningOnPort: 65535 ] raise: NeInvalidSocketPortError. 21 | self should: [ self newTcpSocketListeningOnPort: 65536 ] raise: NeInvalidSocketPortError. 22 | 23 | ] 24 | 25 | { #category : #testing } 26 | NeTcpSocketPortTest >> testPortNumberValidityListenOnBacklogSize [ 27 | self should: [ 28 | self newTcpSocketListeningOnPort: -1 backlogSize: 10] raise: NeInvalidSocketPortError. 29 | self shouldnt: [ 30 | self newTcpSocketListeningOnPort: 0 backlogSize: 10] raise: NeInvalidSocketPortError. 31 | self shouldnt: [ 32 | self newTcpSocketListeningOnPort: 65535 backlogSize: 10] raise: NeInvalidSocketPortError. 33 | self should: [ 34 | self newTcpSocketListeningOnPort: 65536 backlogSize: 10] raise: NeInvalidSocketPortError. 35 | 36 | ] 37 | 38 | { #category : #testing } 39 | NeTcpSocketPortTest >> testPortNumberValidityListenOnBacklogSizeInterface [ 40 | self should: [ 41 | self newTcpSocketListeningOnPort: -1 42 | backlogSize: 10 43 | interface: NeIpV4Address loopback] raise: NeInvalidSocketPortError. 44 | self shouldnt: [ 45 | self newTcpSocketListeningOnPort: 0 46 | backlogSize: 10 47 | interface: NeIpV4Address loopback] raise: NeInvalidSocketPortError. 48 | self shouldnt: [ 49 | self newTcpSocketListeningOnPort: 65535 50 | backlogSize: 10 51 | interface: NeIpV4Address loopback] raise: NeInvalidSocketPortError. 52 | self should: [ 53 | self newTcpSocketListeningOnPort: 65536 54 | backlogSize: 10 55 | interface: NeIpV4Address loopback] raise: NeInvalidSocketPortError. 56 | 57 | ] 58 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeTcpSocketTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeTcpSocketTest, 3 | #superclass : #NeSocketTest, 4 | #category : #'NetworkExtras-Test' 5 | } 6 | 7 | { #category : #testing } 8 | NeTcpSocketTest >> newTcpSocketListeningOnPort: port [ 9 | ^self createSocket: [NeTcpSocket listenOn: port] 10 | 11 | ] 12 | 13 | { #category : #testing } 14 | NeTcpSocketTest >> newTcpSocketListeningOnPort: port backlogSize: backlogSize [ 15 | ^self createSocket: [NeTcpSocket listenOnPort: port backlogSize: backlogSize] 16 | 17 | ] 18 | 19 | { #category : #testing } 20 | NeTcpSocketTest >> newTcpSocketListeningOnPort: port backlogSize: backlogSize interface: itf [ 21 | ^self createSocket: [NeTcpSocket listenOnPort: port backlogSize: backlogSize interface: itf] 22 | 23 | ] 24 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeTcpUsedPortsTracker.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I track TCP ports used for reception to avoid having 2 sockets listening on the same port. 3 | 4 | I am added to the image start up list to ensure that we start with an empty set of used ports, since we lose the references to system sockets once the image quits. 5 | " 6 | Class { 7 | #name : #NeTcpUsedPortsTracker, 8 | #superclass : #NeUsedPortsTracker, 9 | #traits : 'NeTResetTrackedUsedPortsOnStartUp', 10 | #classTraits : 'NeTResetTrackedUsedPortsOnStartUp classTrait', 11 | #category : #'NetworkExtras-TCP-Kernel' 12 | } 13 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeUdpServerTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeUdpServerTest, 3 | #superclass : #NeUdpSocketTest, 4 | #traits : 'CcTWaitPolling', 5 | #classTraits : 'CcTWaitPolling classTrait', 6 | #instVars : [ 7 | 'server', 8 | 'sender', 9 | 'allReceivedData' 10 | ], 11 | #category : #'NetworkExtras-Test' 12 | } 13 | 14 | { #category : #testing } 15 | NeUdpServerTest class >> isAbstract [ 16 | ^self == NeUdpServerTest 17 | ] 18 | 19 | { #category : #testing } 20 | NeUdpServerTest >> newServer [ 21 | self subclassResponsibility 22 | 23 | ] 24 | 25 | { #category : #testing } 26 | NeUdpServerTest >> setUp [ 27 | super setUp. 28 | allReceivedData := OrderedCollection new. 29 | server := self newServer. 30 | server onReceptionDo: [ :data | allReceivedData add: data asString ]. 31 | server priority: Processor userInterruptPriority. 32 | self startServer 33 | ] 34 | 35 | { #category : #testing } 36 | NeUdpServerTest >> startServer [ 37 | self subclassResponsibility 38 | ] 39 | 40 | { #category : #testing } 41 | NeUdpServerTest >> stopServer [ 42 | server stop. 43 | ] 44 | 45 | { #category : #testing } 46 | NeUdpServerTest >> tearDown [ 47 | super tearDown. 48 | self stopServer. 49 | 50 | ] 51 | 52 | { #category : #testing } 53 | NeUdpServerTest >> testRestartAfterStop [ 54 | | receivedData | 55 | server onReceptionDo: [ :data | receivedData := data asString ]. 56 | #('Hello' 'World' 'Pharo') do: [ : sentData | 57 | self startServer. 58 | sender send: sentData. 59 | 200 milliSeconds wait. 60 | self assert: receivedData equals: sentData. 61 | self stopServer. 62 | ]. 63 | 64 | ] 65 | 66 | { #category : #testing } 67 | NeUdpServerTest >> testSendReceive [ 68 | | allSentData | 69 | allSentData := #('Hello' 'World' 'Pharo'). 70 | allSentData withIndexDo: [ :each :index | 71 | sender send: each. 72 | self waitUntil: [ allReceivedData size = index ]. 73 | ]. 74 | self assert: allReceivedData asArray equals: allSentData 75 | ] 76 | 77 | { #category : #testing } 78 | NeUdpServerTest >> testStopShouldQuicklyReturn [ 79 | self should: [ server stop ] notTakeMoreThan: 500 milliSeconds 80 | ] 81 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeUdpSocketPortTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeUdpSocketPortTest, 3 | #superclass : #NeUdpSocketTest, 4 | #category : #'NetworkExtras-Test' 5 | } 6 | 7 | { #category : #testing } 8 | NeUdpSocketPortTest >> testValidBroadcastPort [ 9 | self should: [ self newBroadcastSocketOnPort: -1 ] raise: NeInvalidSocketPortError. 10 | self shouldnt: [ self newBroadcastSocketOnPort: 0 ] raise: NeInvalidSocketPortError. 11 | self shouldnt: [ self newBroadcastSocketOnPort: 65535 ] raise: NeInvalidSocketPortError. 12 | self should: [ self newBroadcastSocketOnPort: 65536 ] raise: NeInvalidSocketPortError. 13 | 14 | ] 15 | 16 | { #category : #testing } 17 | NeUdpSocketPortTest >> testValidMulticastPort [ 18 | self should: [ self newMulticastSocketOnGroup: '226.0.0.12' port: -1] raise: NeInvalidSocketPortError. 19 | self shouldnt: [ self newMulticastSocketOnGroup: '226.0.0.12' port: 0] raise: NeInvalidSocketPortError. 20 | self shouldnt: [ self newMulticastSocketOnGroup: '226.0.0.12' port: 65535] raise: NeInvalidSocketPortError. 21 | self should: [ self newMulticastSocketOnGroup: '226.0.0.12' port: 65536] raise: NeInvalidSocketPortError. 22 | 23 | ] 24 | 25 | { #category : #testing } 26 | NeUdpSocketPortTest >> testValidUnicastEmissionPort [ 27 | self should: [ self newUnicastUdpSocketEmittingToIp: '127.0.0.1' port: -1] raise: NeInvalidSocketPortError. 28 | self shouldnt: [ self newUnicastUdpSocketEmittingToIp: '127.0.0.1' port: 0] raise: NeInvalidSocketPortError. 29 | self shouldnt: [ self newUnicastUdpSocketEmittingToIp: '127.0.0.1' port: 65535] raise: NeInvalidSocketPortError. 30 | self should: [ self newUnicastUdpSocketEmittingToIp: '127.0.0.1' port: 65536] raise: NeInvalidSocketPortError. 31 | 32 | ] 33 | 34 | { #category : #testing } 35 | NeUdpSocketPortTest >> testValidUnicastReceptionPort [ 36 | self should: [ self newUnicastUdpSocketReceivingOnPort: -1 ] raise: NeInvalidSocketPortError. 37 | self shouldnt: [ self newUnicastUdpSocketReceivingOnPort: 0 ] raise: NeInvalidSocketPortError. 38 | self shouldnt: [ self newUnicastUdpSocketReceivingOnPort: 65535 ] raise: NeInvalidSocketPortError. 39 | self should: [ self newUnicastUdpSocketReceivingOnPort: 65536 ] raise: NeInvalidSocketPortError. 40 | 41 | ] 42 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeUdpSocketTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeUdpSocketTest, 3 | #superclass : #NeSocketTest, 4 | #category : #'NetworkExtras-Test' 5 | } 6 | 7 | { #category : #testing } 8 | NeUdpSocketTest >> newBroadcastSocketOnPort: port [ 9 | ^self createSocket: [NeBroadcastSocket port: port] 10 | 11 | ] 12 | 13 | { #category : #testing } 14 | NeUdpSocketTest >> newMulticastSocketOnGroup: groupIp port: port [ 15 | ^self createSocket: [NeMulticastSocket 16 | group: groupIp 17 | port: port]. 18 | 19 | ] 20 | 21 | { #category : #testing } 22 | NeUdpSocketTest >> newUnicastUdpSocketEmittingToIp: targetIp port: port [ 23 | ^self createSocket: [ 24 | NeUnicastUdpSocket target: targetIp port: port]. 25 | 26 | ] 27 | 28 | { #category : #testing } 29 | NeUdpSocketTest >> newUnicastUdpSocketReceivingOnPort: port [ 30 | ^self createSocket: [NeUnicastUdpSocket listenOn: port]. 31 | 32 | ] 33 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeUdpUsedPortsTracker.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I track UDP ports used for reception to avoid having 2 sockets listening on the same port. 3 | 4 | I am added to the image start up list to ensure that we start with an empty set of used ports, since we lose the references to system sockets once the image quits. 5 | " 6 | Class { 7 | #name : #NeUdpUsedPortsTracker, 8 | #superclass : #NeUsedPortsTracker, 9 | #traits : 'NeTResetTrackedUsedPortsOnStartUp', 10 | #classTraits : 'NeTResetTrackedUsedPortsOnStartUp classTrait', 11 | #category : #'NetworkExtras-UDP-Kernel' 12 | } 13 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeUnicastUdpServer.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a UDP Unicast server. I handle incoming UDP data repeatedly in a dedicated thread. 3 | 4 | " 5 | Class { 6 | #name : #NeUnicastUdpServer, 7 | #superclass : #NeUdpServer, 8 | #instVars : [ 9 | 'port' 10 | ], 11 | #category : #'NetworkExtras-UDP-Kernel' 12 | } 13 | 14 | { #category : #'instance creation' } 15 | NeUnicastUdpServer class >> port: portNumber [ 16 | ^self new 17 | port: portNumber; 18 | yourself 19 | ] 20 | 21 | { #category : #activity } 22 | NeUnicastUdpServer >> defaultServerName [ 23 | ^ 'UDP unicast server' 24 | ] 25 | 26 | { #category : #activity } 27 | NeUnicastUdpServer >> newSocket [ 28 | ^NeUnicastUdpSocket listenOn: self port 29 | ] 30 | 31 | { #category : #accessing } 32 | NeUnicastUdpServer >> port [ 33 | ^ port 34 | ] 35 | 36 | { #category : #accessing } 37 | NeUnicastUdpServer >> port: anObject [ 38 | port := anObject 39 | ] 40 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeUnicastUdpServerTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #NeUnicastUdpServerTest, 3 | #superclass : #NeUdpServerTest, 4 | #category : #'NetworkExtras-Test' 5 | } 6 | 7 | { #category : #testing } 8 | NeUnicastUdpServerTest >> newServer [ 9 | ^ NeUnicastUdpServer port: NeUdpUsedPortsTracker freePortAtRandom 10 | ] 11 | 12 | { #category : #testing } 13 | NeUnicastUdpServerTest >> setUp [ 14 | super setUp. 15 | sender := self newUnicastUdpSocketEmittingToIp: 'localhost' port: server port. 16 | 17 | 18 | ] 19 | 20 | { #category : #testing } 21 | NeUnicastUdpServerTest >> startServer [ 22 | server start 23 | ] 24 | 25 | { #category : #testing } 26 | NeUnicastUdpServerTest >> stopServer [ 27 | server stop 28 | ] 29 | 30 | { #category : #testing } 31 | NeUnicastUdpServerTest >> testBroadcastSendReceive [ 32 | | allSentData | 33 | allSentData := #('Hello' 'World' 'Pharo'). 34 | server start. 35 | sender := self newBroadcastSocketOnPort: server port. 36 | allSentData withIndexDo: [ :each :index | 37 | sender send: each. 38 | self waitUntil: [ allReceivedData size = index ]. 39 | ]. 40 | self assert: allReceivedData asArray equals: allSentData 41 | ] 42 | 43 | { #category : #testing } 44 | NeUnicastUdpServerTest >> testDefaultReceptionHandlingAction [ 45 | 46 | | allSentStrings expectedString | 47 | Transcript clear. 48 | allSentStrings := #( 'Hello' 'World' 'Pharo' ). 49 | allSentStrings do: [ :sentString | 50 | server defaultReceptionHandlingBlock value: sentString asByteArray. 51 | ]. 52 | expectedString := String streamContents: [ : str | 53 | allSentStrings do: [ : each | 54 | str << each; 55 | cr ] 56 | ]. 57 | self 58 | waitUntil: [ Transcript contents = expectedString ] 59 | timeout: 2 seconds 60 | ] 61 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeUnicastUdpSocket.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am an UDP socket dedicated to unicast communication. I store the target IP and the Port of the target, to make it easy to send different datagrams to the same target. 3 | 4 | Instance Variables 5 | targetIp: Ip of the socket to which I send data 6 | targetPort port of the socket to which I send data 7 | 8 | " 9 | Class { 10 | #name : #NeUnicastUdpSocket, 11 | #superclass : #NeUdpSocket, 12 | #instVars : [ 13 | 'targetIp', 14 | 'targetPort' 15 | ], 16 | #category : #'NetworkExtras-UDP-Kernel' 17 | } 18 | 19 | { #category : #'instance creation' } 20 | NeUnicastUdpSocket class >> listenOn: portNumber [ 21 | ^self newUDP 22 | listenOn: portNumber; 23 | yourself 24 | ] 25 | 26 | { #category : #'instance creation' } 27 | NeUnicastUdpSocket class >> target: ip port: portNumber [ 28 | ^self newUDP 29 | target: ip; 30 | targetPort: portNumber; 31 | yourself 32 | ] 33 | 34 | { #category : #printing } 35 | NeUnicastUdpSocket >> printSocketInfoOn: stream [ 36 | self targetPort ifNil: [ 37 | ^stream 38 | nextPutAll: 'Reception port: '; 39 | print: self receptionPort 40 | ]. 41 | stream 42 | nextPutAll: 'Target IP: '; 43 | print: self targetIp; 44 | nextPutAll: ' - port: '; 45 | print: self targetPort 46 | ] 47 | 48 | { #category : #sending } 49 | NeUnicastUdpSocket >> send: anObject targetIp: ipAddress port: portNumber [ 50 | self target: ipAddress. 51 | self targetPort: portNumber. 52 | ^self send: anObject 53 | ] 54 | 55 | { #category : #accessing } 56 | NeUnicastUdpSocket >> target: ipOrName [ 57 | self targetIp: ipOrName asIpAddress 58 | 59 | ] 60 | 61 | { #category : #sending } 62 | NeUnicastUdpSocket >> targetIp [ 63 | ^ targetIp 64 | ] 65 | 66 | { #category : #accessing } 67 | NeUnicastUdpSocket >> targetIp: anIpAddress [ 68 | targetIp := anIpAddress 69 | 70 | ] 71 | 72 | { #category : #sending } 73 | NeUnicastUdpSocket >> targetPort [ 74 | ^ targetPort 75 | ] 76 | 77 | { #category : #accessing } 78 | NeUnicastUdpSocket >> targetPort: anInteger [ 79 | self ensureValidPort: anInteger. 80 | targetPort := anInteger 81 | ] 82 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/NeUsedPortsTracker.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am an abstract class that provides behavior to track ports used for reception to avoid having 2 sockets listening on the same port. 3 | 4 | Use one of my subclases. 5 | " 6 | Class { 7 | #name : #NeUsedPortsTracker, 8 | #superclass : #Object, 9 | #classInstVars : [ 10 | 'usedPorts' 11 | ], 12 | #category : #'NetworkExtras-Kernel' 13 | } 14 | 15 | { #category : #'reception ports tracking' } 16 | NeUsedPortsTracker class >> ensureFreePort: portNumber [ 17 | (self isUsedPort: portNumber) ifTrue: [ 18 | NeAlreadyUsedSocketPort signal ]. 19 | 20 | ] 21 | 22 | { #category : #testing } 23 | NeUsedPortsTracker class >> ensureValidPort: portNumber [ 24 | (self isValidPort: portNumber) ifTrue: [ ^self ]. 25 | NeInvalidSocketPortError signal 26 | ] 27 | 28 | { #category : #accessing } 29 | NeUsedPortsTracker class >> freePortAtRandom [ 30 | | allFreePorts | 31 | self usedPorts size = self totalAvailablePorts ifTrue: [^NeAllPortsUsedError signal]. 32 | allFreePorts := (self minPortNumber to: self maxPortNumber) copyWithoutAll: self usedPorts. 33 | ^allFreePorts atRandom 34 | ] 35 | 36 | { #category : #'initialize-release' } 37 | NeUsedPortsTracker class >> initUsedPorts [ 38 | usedPorts := Set new 39 | ] 40 | 41 | { #category : #testing } 42 | NeUsedPortsTracker class >> isUsedPort: portNumber [ 43 | ^self usedPorts includes: portNumber 44 | ] 45 | 46 | { #category : #testing } 47 | NeUsedPortsTracker class >> isValidPort: portNumber [ 48 | portNumber < 0 ifTrue: [ ^false ]. 49 | portNumber > 65535 ifTrue: [ ^false ]. 50 | ^true 51 | ] 52 | 53 | { #category : #accessing } 54 | NeUsedPortsTracker class >> maxPortNumber [ 55 | ^65535 56 | ] 57 | 58 | { #category : #accessing } 59 | NeUsedPortsTracker class >> minPortNumber [ 60 | ^1024 61 | ] 62 | 63 | { #category : #tracking } 64 | NeUsedPortsTracker class >> registerUsedPort: portNumber [ 65 | self ensureValidPort: portNumber. 66 | self ensureFreePort: portNumber. 67 | self usedPorts add: portNumber 68 | ] 69 | 70 | { #category : #'initialize-release' } 71 | NeUsedPortsTracker class >> resetUsedPorts [ 72 | usedPorts := nil 73 | ] 74 | 75 | { #category : #accessing } 76 | NeUsedPortsTracker class >> totalAvailablePorts [ 77 | ^self maxPortNumber - self minPortNumber + 1 78 | ] 79 | 80 | { #category : #tracking } 81 | NeUsedPortsTracker class >> unregisterUsedPort: portNumber [ 82 | self usedPorts remove: portNumber ifAbsent: [ ] 83 | ] 84 | 85 | { #category : #accessing } 86 | NeUsedPortsTracker class >> usedPorts [ 87 | usedPorts ifNil: [ self initUsedPorts ]. 88 | ^usedPorts 89 | ] 90 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/String.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #String } 2 | 3 | { #category : #'*NetworkExtras-converting' } 4 | String >> asIpAddress [ 5 | ^NeIpV4Address fromString: self 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/ZdcAbstractSocketStream.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #ZdcAbstractSocketStream } 2 | 3 | { #category : #'*NetworkExtras' } 4 | ZdcAbstractSocketStream >> closeAndDestroy [ 5 | self close 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/NetworkExtras/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #NetworkExtras } 2 | -------------------------------------------------------------------------------- /Pharo/PharoExtra/DateAndTime.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #DateAndTime } 2 | 3 | { #category : #'*PharoExtra-Chronology' } 4 | DateAndTime >> milliSecond [ 5 | ^self nanoSecond // 1000000 6 | ] 7 | 8 | { #category : #'*PharoExtra-Chronology' } 9 | DateAndTime class >> todayHour: hour minute: minute [ 10 | ^self todayHour: hour minute: minute second: 0 11 | ] 12 | 13 | { #category : #'*PharoExtra-Chronology' } 14 | DateAndTime class >> todayHour: hour minute: minute second: second [ 15 | ^self date: Date today time: (Time hour: hour minute: minute second: second) 16 | ] 17 | 18 | { #category : #'*PharoExtra-Chronology' } 19 | DateAndTime class >> tomorrowHour: hour minute: minute [ 20 | ^self tomorrowHour: hour minute: minute second: 0 21 | ] 22 | 23 | { #category : #'*PharoExtra-Chronology' } 24 | DateAndTime class >> tomorrowHour: hour minute: minute second: second [ 25 | ^self date: Date tomorrow time: (Time hour: hour minute: minute second: second) 26 | ] 27 | -------------------------------------------------------------------------------- /Pharo/PharoExtra/Number.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Number } 2 | 3 | { #category : #'*PharoExtra-Chronology' } 4 | Number >> month [ 5 | ^self months 6 | ] 7 | 8 | { #category : #'*PharoExtra-Chronology' } 9 | Number >> months [ 10 | ^Duration months: self 11 | ] 12 | -------------------------------------------------------------------------------- /Pharo/PharoExtra/PhDateAndTimeTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #PhDateAndTimeTest, 3 | #superclass : #TestCase, 4 | #category : #'PharoExtra-Chronology' 5 | } 6 | 7 | { #category : #testing } 8 | PhDateAndTimeTest >> testToday [ 9 | | today | 10 | today := DateAndTime todayHour: 14 minute: 59 second: 33. 11 | self assert: today year equals: Date today year. 12 | self assert: today day equals: Date today day. 13 | self assert: today hour24 equals: 14. 14 | self assert: today minute equals: 59. 15 | self assert: today second equals: 33. 16 | 17 | ] 18 | -------------------------------------------------------------------------------- /Pharo/PharoExtra/README.md: -------------------------------------------------------------------------------- 1 | # PharoExtra 2 | I provide small extension to different Pharo libraries 3 | 4 | ## Install 5 | ``` 6 | Metacello new 7 | baseline: 'PharoExtra'; 8 | repository: 'github://bouraqadi/PharoMisc'; 9 | load 10 | ``` 11 | 12 | ## Usage 13 | Send messages implemented in this library. An example is the + (plus) message, that allows adding a duration to a time. 14 | 15 | ``` 16 | Time now + 3 hours. 17 | ``` 18 | -------------------------------------------------------------------------------- /Pharo/PharoExtra/SequenceableCollection.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #SequenceableCollection } 2 | 3 | { #category : #'*PharoExtra-Collections' } 4 | SequenceableCollection >> groupsOfAtMost: maxGroupSize atATimeCollect: aBlock [ 5 | "As opposite to groupsOf:atATimeCollect: I process all elements. The last group might be smaller than the others since it includes the leftovers." 6 | 7 | | newCollection | 8 | newCollection := OrderedCollection new. 9 | self groupsOfAtMost: maxGroupSize atATimeDo: [:each | newCollection add: (aBlock value: each)]. 10 | ^newCollection 11 | ] 12 | 13 | { #category : #'*PharoExtra-Collections' } 14 | SequenceableCollection >> groupsOfAtMost: maxGroupSize atATimeDo: aBlock [ 15 | "As opposite to groupsOf:atATimeDo: I process all elements. The last group might be smaller than the others since it includes the leftovers." 16 | | groupIndex firstIndex lastIndex group | 17 | groupIndex := 1. 18 | firstIndex := 1. 19 | [ firstIndex <= self size ] whileTrue: [ 20 | lastIndex := (firstIndex + maxGroupSize - 1) min: self size. 21 | "self halt." 22 | group := self copyFrom: firstIndex to: lastIndex. 23 | aBlock cull: group. 24 | firstIndex := lastIndex + 1. 25 | groupIndex := groupIndex + 1 ]. 26 | 27 | ] 28 | -------------------------------------------------------------------------------- /Pharo/PharoExtra/Time.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Time } 2 | 3 | { #category : #'*PharoExtra-Chronology' } 4 | Time >> + aDuration [ 5 | ^self asDateAndTime + aDuration 6 | ] 7 | 8 | { #category : #'*PharoExtra-instance creation' } 9 | Time class >> hour: hour minute: minute [ 10 | ^self hour: hour minute: minute second: 0 11 | ] 12 | 13 | { #category : #'*PharoExtra-instance creation' } 14 | Time class >> hour: hour0to23 minute: minute0to59 second: second0to59 milliSecond: millis0to999 [ 15 | ^self hour: hour0to23 minute: minute0to59 second: second0to59 nanoSecond: (millis0to999 * 1000000) 16 | ] 17 | -------------------------------------------------------------------------------- /Pharo/PharoExtra/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #PharoExtra } 2 | -------------------------------------------------------------------------------- /Pharo/PharoMisc/PmGitBridge.class.st: -------------------------------------------------------------------------------- 1 | " 2 | Gives access to PharoMisc Reopo properties and folder 3 | " 4 | Class { 5 | #name : #PmGitBridge, 6 | #superclass : #GitBridge, 7 | #category : #PharoMisc 8 | } 9 | 10 | { #category : #accessing } 11 | PmGitBridge class >> resourcesFolder [ 12 | 13 | ^ self root / 'Resources' 14 | ] 15 | -------------------------------------------------------------------------------- /Pharo/PharoMisc/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #PharoMisc } 2 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/Boolean.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Boolean } 2 | 3 | { #category : #'*SimpleMiddleware' } 4 | Boolean >> doMarshallingWith: marshaller [ 5 | ^marshaller marshallBasicObject: self 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/Character.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Character } 2 | 3 | { #category : #'*SimpleMiddleware' } 4 | Character >> doMarshallingWith: marshaller [ 5 | ^marshaller marshallBasicObject: self 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/Color.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Color } 2 | 3 | { #category : #'*SimpleMiddleware' } 4 | Color >> doMarshallingWith: marshaller [ 5 | ^marshaller marshallBasicObject: self 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/Number.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Number } 2 | 3 | { #category : #'*SimpleMiddleware' } 4 | Number >> doMarshallingWith: marshaller [ 5 | ^marshaller marshallBasicObject: self 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/Object.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Object } 2 | 3 | { #category : #'*SimpleMiddleware' } 4 | Object >> doMarshallingWith: marshaller [ 5 | ^marshaller marshallPlainObject: self. 6 | ] 7 | 8 | { #category : #'*SimpleMiddleware' } 9 | Object >> doUnmarshallingWith: marshaller [ 10 | ^marshaller unmarshallBasicObject: self. 11 | ] 12 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/Point.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #Point } 2 | 3 | { #category : #'*SimpleMiddleware' } 4 | Point >> doMarshallingWith: marshaller [ 5 | ^marshaller marshallBasicObject: self 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/SmDispatcher.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am in charge of exporting local objects and delivering to them messages received from romote middlewares. Exporting objects can be done explicitly by a developer. It can be done implicitly (the most frequent case) when passaing objects as parameters of remote messages. 3 | 4 | Instance Variables 5 | idCounter: counter of automatically exported objects 6 | targetObjectsDict: maps identifiers to local objects 7 | 8 | " 9 | Class { 10 | #name : #SmDispatcher, 11 | #superclass : #Object, 12 | #instVars : [ 13 | 'targetObjectsDict', 14 | 'idCounter' 15 | ], 16 | #category : #'SimpleMiddleware-Kernel' 17 | } 18 | 19 | { #category : #dispatching } 20 | SmDispatcher >> dispatch: aRemoteMessage [ 21 | | receiver | 22 | receiver := self objectAt: aRemoteMessage receiverId. 23 | ^receiver perform: aRemoteMessage selector withArguments: aRemoteMessage arguments. 24 | ] 25 | 26 | { #category : #exporting } 27 | SmDispatcher >> export: anObject [ 28 | | id | 29 | (self isExported: anObject) ifTrue: [ ^self idAt: anObject ]. 30 | id := self newId. 31 | self export: anObject as: id. 32 | ^id. 33 | ] 34 | 35 | { #category : #exporting } 36 | SmDispatcher >> export: anObject as: id [ 37 | targetObjectsDict at: id put: anObject. 38 | ] 39 | 40 | { #category : #accessing } 41 | SmDispatcher >> idAt: anObject [ 42 | ^targetObjectsDict keyAtValue: anObject. 43 | ] 44 | 45 | { #category : #initialization } 46 | SmDispatcher >> initialize [ 47 | super initialize. 48 | targetObjectsDict := Dictionary new. 49 | idCounter := 0. 50 | ] 51 | 52 | { #category : #exporting } 53 | SmDispatcher >> isExported: anObject [ 54 | ^targetObjectsDict values includes: anObject 55 | ] 56 | 57 | { #category : #exporting } 58 | SmDispatcher >> newId [ 59 | idCounter := idCounter + 1. 60 | ^idCounter 61 | ] 62 | 63 | { #category : #accessing } 64 | SmDispatcher >> objectAt: id [ 65 | ^targetObjectsDict at: id 66 | ] 67 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/SmDispatcherTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #SmDispatcherTest, 3 | #superclass : #TestCase, 4 | #instVars : [ 5 | 'dispatcher' 6 | ], 7 | #category : #'SimpleMiddleware-Test' 8 | } 9 | 10 | { #category : #testing } 11 | SmDispatcherTest >> setUp [ 12 | super setUp. 13 | dispatcher := SmMiddleware new dispatcher. 14 | ] 15 | 16 | { #category : #testing } 17 | SmDispatcherTest >> testDispatching [ 18 | | object id result message | 19 | object := #($a $b $c). 20 | id := dispatcher export: object. 21 | message := SmRemoteMessage receiverId: id selector: #at: arguments: #(2). 22 | result := dispatcher dispatch: message. 23 | self assert: result equals: $b. 24 | 25 | ] 26 | 27 | { #category : #testing } 28 | SmDispatcherTest >> testExportingWithId [ 29 | | object id result | 30 | object := #($a $b $c). 31 | id := #myObject. 32 | dispatcher export: object as: id. 33 | result := dispatcher objectAt: id. 34 | self assert: result == object. 35 | 36 | ] 37 | 38 | { #category : #testing } 39 | SmDispatcherTest >> testExportingWithoutId [ 40 | | object id result | 41 | object := #($a $b $c). 42 | id := dispatcher export: object. 43 | result := dispatcher objectAt: id. 44 | self assert: result == object. 45 | 46 | ] 47 | 48 | { #category : #testing } 49 | SmDispatcherTest >> testExportingWithoutIdSeveralTimes [ 50 | | object id result newId | 51 | object := #($a $b $c). 52 | id := dispatcher export: object. 53 | 2 timesRepeat: [ 54 | newId := dispatcher export: object. 55 | self assert: newId == id. 56 | result := dispatcher objectAt: newId. 57 | self assert: result == object. 58 | ] 59 | 60 | ] 61 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/SmProtocol.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I take care of converting an object into bytes that are sent over the network and converts bytes received to an object. 3 | 4 | Instance Variables 5 | marshaller: replaces objects by others before serialization or after materialization 6 | 7 | " 8 | Class { 9 | #name : #SmProtocol, 10 | #superclass : #Object, 11 | #instVars : [ 12 | 'marshaller' 13 | ], 14 | #category : #'SimpleMiddleware-Kernel' 15 | } 16 | 17 | { #category : #writing } 18 | SmProtocol >> marshall: anObject [ 19 | ^self marshaller marshall: anObject 20 | ] 21 | 22 | { #category : #accessing } 23 | SmProtocol >> marshaller [ 24 | ^ marshaller 25 | ] 26 | 27 | { #category : #'initialize-release' } 28 | SmProtocol >> marshaller: aSmMarshaller [ 29 | marshaller := aSmMarshaller 30 | ] 31 | 32 | { #category : #reading } 33 | SmProtocol >> materializeObjectFrom: socketStream [ 34 | | bytes bytesSize | 35 | bytesSize := socketStream nextLineCrLf asInteger. 36 | bytes := (socketStream next: bytesSize) asByteArray. 37 | ^ FLMaterializer materializeFromByteArray: bytes 38 | ] 39 | 40 | { #category : #reading } 41 | SmProtocol >> readObjectFrom: socketStream [ 42 | | rawObject | 43 | rawObject := self materializeObjectFrom: socketStream. 44 | ^ self unmarshall: rawObject 45 | ] 46 | 47 | { #category : #writing } 48 | SmProtocol >> serializeObject: replacement into: socketStream [ 49 | | bytes | 50 | bytes := FLSerializer serializeToByteArray: replacement. 51 | socketStream sendCommand: bytes size asString. 52 | socketStream nextPutAllFlush: bytes 53 | ] 54 | 55 | { #category : #reading } 56 | SmProtocol >> unmarshall: anObject [ 57 | ^self marshaller unmarshall: anObject 58 | ] 59 | 60 | { #category : #writing } 61 | SmProtocol >> writeObject: anObject into: socketStream [ 62 | | replacement | 63 | replacement := self marshall: anObject. 64 | self serializeObject: replacement into: socketStream 65 | ] 66 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/SmProxy.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am the placeholder of a remote object. Whenever I receive a message and forward it to the remote object through a socket using the protocol. Forwarded message is converted to a remote message. 3 | 4 | Instance Variables 5 | identifier: identifier of the remote object 6 | ip: Hostname or Ip of the host of the remote object 7 | port: port number at which listens the server that gives access tothe remote object 8 | protocol: Converts message to bytes and response byte to an actual object. 9 | 10 | " 11 | Class { 12 | #name : #SmProxy, 13 | #superclass : #Object, 14 | #instVars : [ 15 | 'ip', 16 | 'port', 17 | 'identifier', 18 | 'protocol' 19 | ], 20 | #category : #'SimpleMiddleware-Kernel' 21 | } 22 | 23 | { #category : #'instance creation' } 24 | SmProxy class >> ip: newIp port: newPort identifier: id protocol: aProtocol [ 25 | ^self new 26 | ip: newIp port: newPort identifier: id protocol: aProtocol; 27 | yourself 28 | ] 29 | 30 | { #category : #marshalling } 31 | SmProxy >> doMarshallingWith: marshaller [ 32 | ^marshaller marshallProxyIp: ip port: port identifier: identifier. 33 | ] 34 | 35 | { #category : #communication } 36 | SmProxy >> doesNotUnderstand: aMessage [ 37 | | socketStream remoteMessage response | 38 | remoteMessage := SmRemoteMessage receiverId: identifier selector: aMessage selector arguments: aMessage arguments. 39 | socketStream := SocketStream 40 | openConnectionToHostNamed: ip 41 | port: port. 42 | [ 43 | protocol writeObject: remoteMessage into: socketStream. 44 | response := protocol readObjectFrom: socketStream. 45 | ] ensure: [socketStream close]. 46 | ^response. 47 | 48 | ] 49 | 50 | { #category : #'initialize-release' } 51 | SmProxy >> ip: aString port: anInteger identifier: id protocol: aProtocol [ 52 | ip := aString. 53 | port := anInteger. 54 | identifier := id. 55 | protocol := aProtocol. 56 | ] 57 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/SmRemoteMessage.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I resent a message captured by a proxy. After reception by the middleware that hosts the target object, the dispatcher converts me to an actual message sent to the target. 3 | 4 | Instance Variables 5 | arguments: 6 | receiverId: identifier of the target object 7 | selector: 8 | " 9 | Class { 10 | #name : #SmRemoteMessage, 11 | #superclass : #Object, 12 | #instVars : [ 13 | 'receiverId', 14 | 'selector', 15 | 'arguments' 16 | ], 17 | #category : #'SimpleMiddleware-Kernel' 18 | } 19 | 20 | { #category : #'instance creation' } 21 | SmRemoteMessage class >> receiverId: id selector: aSymbol arguments: anArray [ 22 | ^self new 23 | receiverId: id; 24 | selector: aSymbol; 25 | arguments: anArray; 26 | yourself 27 | 28 | ] 29 | 30 | { #category : #accessing } 31 | SmRemoteMessage >> arguments [ 32 | ^ arguments 33 | ] 34 | 35 | { #category : #accessing } 36 | SmRemoteMessage >> arguments: anObject [ 37 | arguments := anObject 38 | ] 39 | 40 | { #category : #marshalling } 41 | SmRemoteMessage >> doMarshallingWith: marshaller [ 42 | ^marshaller marshallRemoteMessage: self. 43 | ] 44 | 45 | { #category : #unmarshalling } 46 | SmRemoteMessage >> doUnmarshallingWith: marshaller [ 47 | ^marshaller unmarshallRemoteMessage: self. 48 | ] 49 | 50 | { #category : #accessing } 51 | SmRemoteMessage >> receiverId [ 52 | ^ receiverId 53 | ] 54 | 55 | { #category : #accessing } 56 | SmRemoteMessage >> receiverId: anObject [ 57 | receiverId := anObject 58 | ] 59 | 60 | { #category : #accessing } 61 | SmRemoteMessage >> selector [ 62 | ^ selector 63 | ] 64 | 65 | { #category : #accessing } 66 | SmRemoteMessage >> selector: anObject [ 67 | selector := anObject 68 | ] 69 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/SmRemoteReference.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I represent a reference to a remote object. During marshalling/unmarshalling, I am replaced either by a proxy or by a local object. 3 | 4 | Instance Variables 5 | identifier: id of the remote object as defined when exporting the object. 6 | ip: Hostname or Ip string of the host of the remote object 7 | port: Port number of the server that gives access to the remote object 8 | 9 | " 10 | Class { 11 | #name : #SmRemoteReference, 12 | #superclass : #Object, 13 | #instVars : [ 14 | 'ip', 15 | 'port', 16 | 'identifier' 17 | ], 18 | #category : #'SimpleMiddleware-Kernel' 19 | } 20 | 21 | { #category : #'instance creation' } 22 | SmRemoteReference class >> ip: newIp port: newPort identifier: id [ 23 | ^self new 24 | ip: newIp port: newPort identifier: id; 25 | yourself 26 | ] 27 | 28 | { #category : #equality } 29 | SmRemoteReference >> = otherRef [ 30 | ^self identifier = otherRef identifier and: [ 31 | self ip = otherRef ip and: [ 32 | self port = otherRef port ] ] 33 | ] 34 | 35 | { #category : #unmarshalling } 36 | SmRemoteReference >> doUnmarshallingWith: marshaller [ 37 | ^marshaller unmarshallRemoteRefenrence: self 38 | ] 39 | 40 | { #category : #equality } 41 | SmRemoteReference >> hash [ 42 | ^self identifier hash bitXor: (self ip hash bitXor: self port hash) 43 | ] 44 | 45 | { #category : #accessing } 46 | SmRemoteReference >> identifier [ 47 | ^ identifier 48 | ] 49 | 50 | { #category : #accessing } 51 | SmRemoteReference >> ip [ 52 | ^ ip 53 | ] 54 | 55 | { #category : #'initialize-release' } 56 | SmRemoteReference >> ip: newIp port: newPort identifier: id [ 57 | ip := newIp. 58 | port := newPort. 59 | identifier := id. 60 | 61 | ] 62 | 63 | { #category : #accessing } 64 | SmRemoteReference >> port [ 65 | ^ port 66 | ] 67 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/SmSingleMiddlewareTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #SmSingleMiddlewareTest, 3 | #superclass : #TestCase, 4 | #instVars : [ 5 | 'middleware' 6 | ], 7 | #category : #'SimpleMiddleware-Test' 8 | } 9 | 10 | { #category : #testing } 11 | SmSingleMiddlewareTest >> setUp [ 12 | super setUp. 13 | middleware := SmMiddleware new. 14 | ] 15 | 16 | { #category : #testing } 17 | SmSingleMiddlewareTest >> tearDown [ 18 | super tearDown. 19 | middleware stop. 20 | ] 21 | 22 | { #category : #testing } 23 | SmSingleMiddlewareTest >> testCommunication [ 24 | | proxy result id | 25 | middleware start. 26 | id := #myObject. 27 | middleware export: #(1 2 3) as: id. 28 | proxy := middleware proxyIp: middleware ip port: middleware port identifier: id. 29 | self assert: (proxy isKindOf: SmProxy). 30 | self assert: proxy first equals: 1. 31 | self assert: proxy second equals: 2. 32 | result := proxy collect: [ :each | each * 2 ]. 33 | self assert: result first equals: 2. 34 | self assert: result last equals: 6 35 | ] 36 | 37 | { #category : #testing } 38 | SmSingleMiddlewareTest >> testDefaultIp [ 39 | self assert: middleware ip equals: '127.0.0.1'. 40 | ] 41 | 42 | { #category : #testing } 43 | SmSingleMiddlewareTest >> testStartStop [ 44 | self deny: middleware isStarted. 45 | middleware start. 46 | self assert: middleware isStarted. 47 | middleware stop. 48 | self deny: middleware isStarted. 49 | 50 | ] 51 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/SmThreeMiddlewareTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #SmThreeMiddlewareTest, 3 | #superclass : #TestCase, 4 | #instVars : [ 5 | 'middlewares', 6 | 'middleware1', 7 | 'middleware2', 8 | 'middleware3' 9 | ], 10 | #category : #'SimpleMiddleware-Test' 11 | } 12 | 13 | { #category : #testing } 14 | SmThreeMiddlewareTest >> setUp [ 15 | super setUp. 16 | middlewares := OrderedCollection new. 17 | 1 to: 3 do: [: index | 18 | middlewares add: (SmMiddleware port: index * 11111) ]. 19 | middlewares do: [ : each | each start]. 20 | middleware1 := middlewares first. 21 | middleware2 := middlewares second. 22 | middleware3 := middlewares third. 23 | ] 24 | 25 | { #category : #testing } 26 | SmThreeMiddlewareTest >> tearDown [ 27 | super tearDown. 28 | middlewares do: [ : each | each stop]. 29 | ] 30 | 31 | { #category : #testing } 32 | SmThreeMiddlewareTest >> testSendingProxyOfRemoteObjectAsParameter [ 33 | | interval proxyInterval orderedCol proxyOrderedCol proxyIntervalBis | 34 | interval := 1 to: 5. 35 | middleware1 export: interval as: #interval. 36 | proxyInterval := middleware2 proxyIp: middleware1 ip port: middleware1 port identifier: #interval. 37 | self assert: (proxyInterval isKindOf: SmProxy). 38 | 39 | orderedCol := OrderedCollection new. 40 | middleware3 export: orderedCol as: #orderedCol. 41 | proxyOrderedCol := middleware2 proxyIp: middleware3 ip port: middleware3 port identifier: #orderedCol. 42 | self assert: (proxyOrderedCol isKindOf: SmProxy). 43 | 44 | proxyOrderedCol add: proxyInterval. 45 | proxyIntervalBis := orderedCol first. 46 | self deny: proxyIntervalBis == proxyInterval. 47 | 48 | self assert: proxyIntervalBis last equals: 5. 49 | 50 | ] 51 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/String.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #String } 2 | 3 | { #category : #'*SimpleMiddleware' } 4 | String >> doMarshallingWith: marshaller [ 5 | ^marshaller marshallBasicObject: self 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/UndefinedObject.extension.st: -------------------------------------------------------------------------------- 1 | Extension { #name : #UndefinedObject } 2 | 3 | { #category : #'*SimpleMiddleware' } 4 | UndefinedObject >> doMarshallingWith: marshaller [ 5 | ^marshaller marshallBasicObject: self 6 | ] 7 | -------------------------------------------------------------------------------- /Pharo/SimpleMiddleware/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #SimpleMiddleware } 2 | -------------------------------------------------------------------------------- /Pharo/StateMachine/SmConditionalTransition.class.st: -------------------------------------------------------------------------------- 1 | " 2 | I am a transition which performs when a condition to be satisfied 3 | 4 | Instance Variables 5 | conditionBlock: 6 | 7 | conditionBlock 8 | - A block which value is a boolean. When it's value is true, the transition can be peformed, so the target state can be activated, and the source state can be desactivated. 9 | 10 | " 11 | Class { 12 | #name : #SmConditionalTransition, 13 | #superclass : #SmTransition, 14 | #instVars : [ 15 | 'conditionBlock' 16 | ], 17 | #category : #'StateMachine-Kernel' 18 | } 19 | 20 | { #category : #'instance creation' } 21 | SmConditionalTransition class >> from: sourceState to: targetState when: conditionBlock [ 22 | ^(self from: sourceState to: targetState) 23 | conditionBlock: conditionBlock; 24 | yourself 25 | ] 26 | 27 | { #category : #accessing } 28 | SmConditionalTransition >> conditionBlock [ 29 | ^ conditionBlock 30 | ] 31 | 32 | { #category : #accessing } 33 | SmConditionalTransition >> conditionBlock: anObject [ 34 | conditionBlock := anObject 35 | ] 36 | 37 | { #category : #stepping } 38 | SmConditionalTransition >> isActionable [ 39 | ^conditionBlock value 40 | ] 41 | -------------------------------------------------------------------------------- /Pharo/StateMachine/SmCustomStateForTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #SmCustomStateForTest, 3 | #superclass : #SmState, 4 | #category : #'StateMachine-Tests' 5 | } 6 | -------------------------------------------------------------------------------- /Pharo/StateMachine/SmTransition.class.st: -------------------------------------------------------------------------------- 1 | " 2 | A SmTransition is a connection between two states. 3 | 4 | Instance Variables 5 | sourceState: 6 | targetState: 7 | 8 | sourceState 9 | - State desactivated when performing the transition 10 | 11 | targetState 12 | - State activated when performing the transition 13 | 14 | " 15 | Class { 16 | #name : #SmTransition, 17 | #superclass : #Object, 18 | #instVars : [ 19 | 'sourceState', 20 | 'targetState' 21 | ], 22 | #category : #'StateMachine-Kernel' 23 | } 24 | 25 | { #category : #'instance creation' } 26 | SmTransition class >> from: sourceState to: targetState [ 27 | ^self new 28 | sourceState: sourceState; 29 | targetState: targetState; 30 | yourself 31 | ] 32 | 33 | { #category : #accessing } 34 | SmTransition >> automaton [ 35 | ^self sourceState automaton 36 | ] 37 | 38 | { #category : #testing } 39 | SmTransition >> isActionable [ 40 | ^true 41 | ] 42 | 43 | { #category : #stepping } 44 | SmTransition >> perform [ 45 | self sourceState exit. 46 | self targetState enter 47 | ] 48 | 49 | { #category : #accessing } 50 | SmTransition >> sourceState [ 51 | ^ sourceState 52 | ] 53 | 54 | { #category : #accessing } 55 | SmTransition >> sourceState: anObject [ 56 | sourceState := anObject 57 | ] 58 | 59 | { #category : #accessing } 60 | SmTransition >> targetState [ 61 | ^ targetState 62 | ] 63 | 64 | { #category : #accessing } 65 | SmTransition >> targetState: aState [ 66 | targetState := aState. 67 | 68 | ] 69 | -------------------------------------------------------------------------------- /Pharo/StateMachine/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #StateMachine } 2 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkActingTaskState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkActingTaskState, 3 | #superclass : #TkTaskState, 4 | #category : #'Tasks-Private-Tasks' 5 | } 6 | 7 | { #category : #acting } 8 | TkActingTaskState >> act [ 9 | self task valueActionBlock 10 | ] 11 | 12 | { #category : #testing } 13 | TkActingTaskState >> isDue [ 14 | ^ self isDueTimePassed 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkDoneTaskState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkDoneTaskState, 3 | #superclass : #TkTaskState, 4 | #category : #'Tasks-Private-Tasks' 5 | } 6 | 7 | { #category : #testing } 8 | TkDoneTaskState >> isDone [ 9 | ^true 10 | ] 11 | 12 | { #category : #testing } 13 | TkDoneTaskState >> isDue [ 14 | ^false 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkDoneThreadState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkDoneThreadState, 3 | #superclass : #TkThreadState, 4 | #category : #'Tasks-Private-Thread' 5 | } 6 | 7 | { #category : #testing } 8 | TkDoneThreadState >> isDone [ 9 | ^true 10 | ] 11 | 12 | { #category : #accessing } 13 | TkDoneThreadState >> name [ 14 | ^#Done 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkFiniteDurationTask.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkFiniteDurationTask, 3 | #superclass : #TkFiniteTask, 4 | #instVars : [ 5 | 'duration', 6 | 'endTime' 7 | ], 8 | #category : #'Tasks-Private-Tasks' 9 | } 10 | 11 | { #category : #accessing } 12 | TkFiniteDurationTask >> duration [ 13 | ^ duration 14 | ] 15 | 16 | { #category : #accessing } 17 | TkFiniteDurationTask >> duration: aDuration [ 18 | duration := aDuration 19 | ] 20 | 21 | { #category : #accessing } 22 | TkFiniteDurationTask >> endTime [ 23 | ^ endTime 24 | ] 25 | 26 | { #category : #accessing } 27 | TkFiniteDurationTask >> endTime: aDateAndTime [ 28 | endTime := aDateAndTime 29 | ] 30 | 31 | { #category : #initialization } 32 | TkFiniteDurationTask >> initEndTime [ 33 | self endTime: self now + self duration 34 | ] 35 | 36 | { #category : #initialization } 37 | TkFiniteDurationTask >> initialize [ 38 | super initialize. 39 | pendingState addExitAction: [ self initEndTime ] 40 | ] 41 | 42 | { #category : #accessing } 43 | TkFiniteDurationTask >> isEndConditionMet [ 44 | self endTime ifNil: [ ^false ]. 45 | ^self now >= self endTime 46 | ] 47 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkFiniteIterationsTask.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkFiniteIterationsTask, 3 | #superclass : #TkFiniteTask, 4 | #instVars : [ 5 | 'totalIterations', 6 | 'iterationsCount' 7 | ], 8 | #category : #'Tasks-Private-Tasks' 9 | } 10 | 11 | { #category : #initialization } 12 | TkFiniteIterationsTask >> initialize [ 13 | super initialize. 14 | self resetIterationsCount 15 | ] 16 | 17 | { #category : #testing } 18 | TkFiniteIterationsTask >> isEndConditionMet [ 19 | ^self iterationsCount = self totalIterations 20 | ] 21 | 22 | { #category : #accessing } 23 | TkFiniteIterationsTask >> iterationsCount [ 24 | ^ iterationsCount 25 | ] 26 | 27 | { #category : #accessing } 28 | TkFiniteIterationsTask >> iterationsCount: anObject [ 29 | iterationsCount := anObject 30 | ] 31 | 32 | { #category : #acting } 33 | TkFiniteIterationsTask >> reset [ 34 | super reset. 35 | self resetIterationsCount 36 | ] 37 | 38 | { #category : #initialization } 39 | TkFiniteIterationsTask >> resetIterationsCount [ 40 | self iterationsCount: 0 41 | ] 42 | 43 | { #category : #accessing } 44 | TkFiniteIterationsTask >> totalIterations [ 45 | ^totalIterations 46 | ] 47 | 48 | { #category : #accessing } 49 | TkFiniteIterationsTask >> totalIterations: anInteger [ 50 | totalIterations := anInteger. 51 | 52 | ] 53 | 54 | { #category : #acting } 55 | TkFiniteIterationsTask >> valueActionBlock [ 56 | super valueActionBlock. 57 | self iterationsCount: self iterationsCount + 1. 58 | 59 | ] 60 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkFiniteTask.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkFiniteTask, 3 | #superclass : #TkTask, 4 | #instVars : [ 5 | 'doneState', 6 | 'tearDownState', 7 | 'tearDownBlock' 8 | ], 9 | #category : #'Tasks-Private-Tasks' 10 | } 11 | 12 | { #category : #initialization } 13 | TkFiniteTask >> initialize [ 14 | super initialize. 15 | tearDownState := self newState: TkTearDownTaskState. 16 | doneState := self newState: TkDoneTaskState. 17 | actionState transitionTo: tearDownState when: [ 18 | self isEndConditionMet and: [self tearDownBlock notNil] ]. 19 | actionState transitionTo: doneState when: [ 20 | self isEndConditionMet and: [self tearDownBlock isNil] ]. 21 | tearDownState transitionTo: doneState. 22 | ] 23 | 24 | { #category : #accessing } 25 | TkFiniteTask >> isEndConditionMet [ 26 | ^self subclassResponsibility 27 | ] 28 | 29 | { #category : #accessing } 30 | TkFiniteTask >> tearDownBlock [ 31 | ^ tearDownBlock 32 | ] 33 | 34 | { #category : #accessing } 35 | TkFiniteTask >> tearDownBlock: aBlockClosure [ 36 | tearDownBlock := aBlockClosure 37 | ] 38 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkFixedIterationsCountTaskTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkFixedIterationsCountTaskTest, 3 | #superclass : #TkTaskTest, 4 | #category : #'Tasks-Tests' 5 | } 6 | 7 | { #category : #tests } 8 | TkFixedIterationsCountTaskTest >> testPeriodFromFrequency [ 9 | task := bench taskRepeating3Times. 10 | bench setFrequency10Hz. 11 | self assert: task period equals: 100 milliSeconds. 12 | bench setPeriod100Milliseconds. 13 | self assert: task frequency equals: 10 14 | ] 15 | 16 | { #category : #tests } 17 | TkFixedIterationsCountTaskTest >> testRepeatingAtGivenFrequency [ 18 | task := bench taskRepeating3Times. 19 | bench setFrequency10Hz. 20 | self assert: task isDue. 21 | task step. 22 | self deny: task isDue. 23 | 100 milliSeconds wait. 24 | self assert: task isDue. 25 | 26 | ] 27 | 28 | { #category : #tests } 29 | TkFixedIterationsCountTaskTest >> testResetTaskDoneRepeatingForFixedIterationsCount [ 30 | task := bench taskRepeating3Times. 31 | 4 timesRepeat: [task step]. 32 | self deny: task isDue. 33 | self assert: task isDone. 34 | self assert: bench actionCount equals: 3. 35 | task reset. 36 | self assert: task isDue. 37 | self deny: task isDone. 38 | 4 timesRepeat: [task step]. 39 | self deny: task isDue. 40 | self assert: task isDone. 41 | self assert: bench actionCount equals: 6. 42 | self assert: bench resetCount equals: 1. 43 | ] 44 | 45 | { #category : #tests } 46 | TkFixedIterationsCountTaskTest >> testTaskDoneRepeatingForFixedIterationsCount [ 47 | task := bench taskRepeating3Times. 48 | self assert: bench actionCount equals: 0. 49 | 1 to: 3 do: [: expectedCount | 50 | self assert: task isDue. 51 | self deny: task isDone. 52 | task step. 53 | self assert: bench actionCount equals: expectedCount. 54 | ]. 55 | self assert: task isDue. 56 | self deny: task isDone. 57 | task step. 58 | self deny: task isDue. 59 | self assert: task isDone. 60 | self assert: bench actionCount equals: 3. 61 | 62 | 63 | ] 64 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkGenericFiniteTask.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkGenericFiniteTask, 3 | #superclass : #TkFiniteTask, 4 | #instVars : [ 5 | 'endConditionBlock' 6 | ], 7 | #category : #'Tasks-Private-Tasks' 8 | } 9 | 10 | { #category : #accessing } 11 | TkGenericFiniteTask >> endConditionBlock [ 12 | ^ endConditionBlock 13 | ] 14 | 15 | { #category : #accessing } 16 | TkGenericFiniteTask >> endConditionBlock: aBlock [ 17 | endConditionBlock := aBlock 18 | ] 19 | 20 | { #category : #testing } 21 | TkGenericFiniteTask >> isEndConditionMet [ 22 | ^self endConditionBlock value 23 | ] 24 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkKilledThreadState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkKilledThreadState, 3 | #superclass : #TkThreadState, 4 | #category : #'Tasks-Private-Thread' 5 | } 6 | 7 | { #category : #testing } 8 | TkKilledThreadState >> isKilled [ 9 | ^true 10 | ] 11 | 12 | { #category : #accessing } 13 | TkKilledThreadState >> name [ 14 | ^'Killed' 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkNewThreadState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkNewThreadState, 3 | #superclass : #TkStartableThreadState, 4 | #category : #'Tasks-Private-Thread' 5 | } 6 | 7 | { #category : #accessing } 8 | TkNewThreadState >> name [ 9 | ^'New' 10 | ] 11 | 12 | { #category : #public } 13 | TkNewThreadState >> restart [ 14 | self start 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkOneShotTaskTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkOneShotTaskTest, 3 | #superclass : #TkTaskTest, 4 | #category : #'Tasks-Tests' 5 | } 6 | 7 | { #category : #tests } 8 | TkOneShotTaskTest >> testOneShotTask [ 9 | task := bench taskOneShot. 10 | self assert: task isDue. 11 | self deny: task isDone. 12 | self assert: bench actionCount equals: 0. 13 | task step. 14 | self assert: task isDue. 15 | self deny: task isDone. 16 | self assert: bench actionCount equals: 1. 17 | 2 timesRepeat: [ 18 | task step. 19 | self deny: task isDue. 20 | self assert: task isDone. 21 | self assert: bench actionCount equals: 1 22 | ]. 23 | 24 | 25 | ] 26 | 27 | { #category : #tests } 28 | TkOneShotTaskTest >> testResetOneShotTask [ 29 | task := bench taskOneShot. 30 | 2 timesRepeat: [task step]. 31 | self deny: task isDue. 32 | self assert: task isDone. 33 | task reset. 34 | self assert: task isDue. 35 | self deny: task isDone. 36 | 2 timesRepeat: [task step]. 37 | self deny: task isDue. 38 | self assert: task isDone. 39 | self assert: bench actionCount equals: 2. 40 | 41 | 42 | ] 43 | 44 | { #category : #tests } 45 | TkOneShotTaskTest >> testSetStartTimeInTheFuture [ 46 | task := bench taskOneShot. 47 | bench setActionTime100MillisecondsInTheFuture. 48 | self deny: task isDue. 49 | self deny: task isDone. 50 | 100 milliSeconds wait. 51 | self assert: task isDue. 52 | self deny: task isDone. 53 | 54 | ] 55 | 56 | { #category : #tests } 57 | TkOneShotTaskTest >> testSetStartTimeInThePast [ 58 | task := bench taskOneShot. 59 | bench setActionTime100MillisecondsInThePast. 60 | self assert: task isDue. 61 | self deny: task isDone. 62 | 63 | ] 64 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkPendingTaskState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkPendingTaskState, 3 | #superclass : #TkTaskState, 4 | #category : #'Tasks-Private-Tasks' 5 | } 6 | 7 | { #category : #initialization } 8 | TkPendingTaskState >> actAfter: aDuration [ 9 | self dueTime: self now + aDuration 10 | ] 11 | 12 | { #category : #testing } 13 | TkPendingTaskState >> isDue [ 14 | ^self isDueTimePassed 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkSetUpTaskState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkSetUpTaskState, 3 | #superclass : #TkTaskState, 4 | #category : #'Tasks-Private-Tasks' 5 | } 6 | 7 | { #category : #acting } 8 | TkSetUpTaskState >> act [ 9 | self task valueSetUpBlock 10 | ] 11 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkStartableThreadState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkStartableThreadState, 3 | #superclass : #TkThreadState, 4 | #category : #'Tasks-Private-Thread' 5 | } 6 | 7 | { #category : #living } 8 | TkStartableThreadState >> start [ 9 | self automaton step 10 | ] 11 | 12 | { #category : #living } 13 | TkStartableThreadState >> startAfter: aDuration [ 14 | self thread actAfter: aDuration. 15 | self start. 16 | ] 17 | 18 | { #category : #living } 19 | TkStartableThreadState >> startOn: aDateAndTime [ 20 | self thread actOn: aDateAndTime. 21 | self start. 22 | ] 23 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkStartedThreadState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkStartedThreadState, 3 | #superclass : #TkThreadState, 4 | #category : #'Tasks-Private-Thread' 5 | } 6 | 7 | { #category : #testing } 8 | TkStartedThreadState >> isStarted [ 9 | ^true 10 | ] 11 | 12 | { #category : #living } 13 | TkStartedThreadState >> kill [ 14 | self thread terminateProcess. 15 | self automaton step 16 | ] 17 | 18 | { #category : #accessing } 19 | TkStartedThreadState >> name [ 20 | ^'Started' 21 | ] 22 | 23 | { #category : #living } 24 | TkStartedThreadState >> restart [ 25 | self kill. 26 | super restart. 27 | ] 28 | 29 | { #category : #living } 30 | TkStartedThreadState >> restartAfter: aDuration [ 31 | self kill. 32 | super restartAfter: aDuration. 33 | ] 34 | 35 | { #category : #living } 36 | TkStartedThreadState >> restartOn: aDateAndTime [ 37 | self kill. 38 | super restartOn: aDateAndTime. 39 | ] 40 | 41 | { #category : #living } 42 | TkStartedThreadState >> start [ 43 | ^self 44 | ] 45 | 46 | { #category : #living } 47 | TkStartedThreadState >> stop [ 48 | self thread isStopRequested: true 49 | ] 50 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkStoppedThreadState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkStoppedThreadState, 3 | #superclass : #TkStartableThreadState, 4 | #category : #'Tasks-Private-Thread' 5 | } 6 | 7 | { #category : #testing } 8 | TkStoppedThreadState >> isStopped [ 9 | ^true 10 | ] 11 | 12 | { #category : #accessing } 13 | TkStoppedThreadState >> name [ 14 | ^'Stopped' 15 | ] 16 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkTConcurrencyTest.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : #TkTConcurrencyTest, 3 | #traits : 'TkTWaitPolling', 4 | #classTraits : 'TkTWaitPolling classTrait', 5 | #category : #'Tasks-Public' 6 | } 7 | 8 | { #category : #tests } 9 | TkTConcurrencyTest >> assert: aBlock takesMoreThan: minExpectedDuration [ 10 | | startTime endTime actualDuration | 11 | startTime := DateAndTime now. 12 | self waitUntil: aBlock. 13 | endTime := DateAndTime now. 14 | actualDuration := endTime - startTime. 15 | self assert: actualDuration >= minExpectedDuration description: 'Became true after ', actualDuration humanReadablePrintString, ' instead of ', minExpectedDuration humanReadablePrintString 16 | 17 | ] 18 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkTWaitPolling.trait.st: -------------------------------------------------------------------------------- 1 | Trait { 2 | #name : #TkTWaitPolling, 3 | #category : #'Tasks-Public' 4 | } 5 | 6 | { #category : #waiting } 7 | TkTWaitPolling >> defaultActionOnTimeout [ 8 | TkTimeout signal 9 | ] 10 | 11 | { #category : #waiting } 12 | TkTWaitPolling >> defaultTimeoutDuration [ 13 | ^500 milliSeconds 14 | ] 15 | 16 | { #category : #waiting } 17 | TkTWaitPolling >> iterationDuration [ 18 | ^ 50 milliSeconds 19 | ] 20 | 21 | { #category : #waiting } 22 | TkTWaitPolling >> waitUntil: conditionBlock [ 23 | self waitUntil: conditionBlock timeout: self defaultTimeoutDuration 24 | ] 25 | 26 | { #category : #waiting } 27 | TkTWaitPolling >> waitUntil: conditionBlock onTimeout: aDuration do: aBlock [ 28 | self waitWhile: [ conditionBlock value not ] onTimeout: aDuration do: aBlock 29 | ] 30 | 31 | { #category : #waiting } 32 | TkTWaitPolling >> waitUntil: conditionBlock timeout: aDuration [ 33 | self waitUntil: conditionBlock onTimeout: aDuration do: [ self fail: 'Timeout' ] 34 | ] 35 | 36 | { #category : #waiting } 37 | TkTWaitPolling >> waitWhile: conditionBlock [ 38 | self waitWhile: conditionBlock timeout: self defaultTimeoutDuration 39 | ] 40 | 41 | { #category : #waiting } 42 | TkTWaitPolling >> waitWhile: conditionBlock onTimeout: aDuration do: aBlock [ 43 | | iterationCount iterationDuration | 44 | iterationDuration := self iterationDuration. 45 | iterationCount := (aDuration / iterationDuration) ceiling max: 1. 46 | iterationCount 47 | timesRepeat: [ conditionBlock value 48 | ifFalse: [ ^ self ]. 49 | iterationDuration wait ]. 50 | aBlock value 51 | ] 52 | 53 | { #category : #waiting } 54 | TkTWaitPolling >> waitWhile: conditionBlock timeout: aDuration [ 55 | self waitWhile: conditionBlock onTimeout: aDuration do: [self defaultActionOnTimeout] 56 | ] 57 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkTaskState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkTaskState, 3 | #superclass : #SmState, 4 | #instVars : [ 5 | 'task' 6 | ], 7 | #category : #'Tasks-Private-Tasks' 8 | } 9 | 10 | { #category : #acting } 11 | TkTaskState >> act [ 12 | ^self 13 | ] 14 | 15 | { #category : #initialization } 16 | TkTaskState >> actAfter: aDuration [ 17 | ^self 18 | ] 19 | 20 | { #category : #testing } 21 | TkTaskState >> dueTime [ 22 | ^self task dueTime 23 | ] 24 | 25 | { #category : #testing } 26 | TkTaskState >> dueTime: aDateAndTime [ 27 | ^self task dueTime: aDateAndTime 28 | ] 29 | 30 | { #category : #testing } 31 | TkTaskState >> isDone [ 32 | ^false 33 | ] 34 | 35 | { #category : #testing } 36 | TkTaskState >> isDue [ 37 | ^true 38 | ] 39 | 40 | { #category : #testing } 41 | TkTaskState >> isDueTimePassed [ 42 | self dueTime ifNil: [ ^ true ]. 43 | ^ self dueTime <= self now 44 | ] 45 | 46 | { #category : #testing } 47 | TkTaskState >> now [ 48 | ^self task now 49 | ] 50 | 51 | { #category : #accessing } 52 | TkTaskState >> task [ 53 | ^ task 54 | ] 55 | 56 | { #category : #accessing } 57 | TkTaskState >> task: anObject [ 58 | task := anObject 59 | ] 60 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkTaskTest.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkTaskTest, 3 | #superclass : #TestCase, 4 | #instVars : [ 5 | 'bench', 6 | 'task' 7 | ], 8 | #category : #'Tasks-Tests' 9 | } 10 | 11 | { #category : #testing } 12 | TkTaskTest class >> isAbstract [ 13 | ^self == TkTaskTest 14 | ] 15 | 16 | { #category : #tests } 17 | TkTaskTest >> setUp [ 18 | super setUp. 19 | bench := TkTaskTestBench new 20 | ] 21 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkTearDownTaskState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkTearDownTaskState, 3 | #superclass : #TkTaskState, 4 | #category : #'Tasks-Private-Tasks' 5 | } 6 | 7 | { #category : #acting } 8 | TkTearDownTaskState >> act [ 9 | self task valueTearDownBlock 10 | ] 11 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkTestBench.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkTestBench, 3 | #superclass : #Object, 4 | #instVars : [ 5 | 'setUpCount', 6 | 'tearDownCount', 7 | 'resetCount', 8 | 'flag', 9 | 'actionCount' 10 | ], 11 | #category : #'Tasks-Tests' 12 | } 13 | 14 | { #category : #accessing } 15 | TkTestBench >> actionBlock [ 16 | ^ [ actionCount := actionCount + 1 ] 17 | ] 18 | 19 | { #category : #accessing } 20 | TkTestBench >> actionCount [ 21 | ^ actionCount 22 | ] 23 | 24 | { #category : #creating } 25 | TkTestBench >> flagBlock [ 26 | ^ [ flag ] 27 | ] 28 | 29 | { #category : #initialization } 30 | TkTestBench >> initialize [ 31 | super initialize. 32 | actionCount := 0. 33 | setUpCount := 0. 34 | tearDownCount := 0. 35 | resetCount := 0 36 | ] 37 | 38 | { #category : #creating } 39 | TkTestBench >> resetBlock [ 40 | ^ [ resetCount := resetCount + 1 ] 41 | ] 42 | 43 | { #category : #accessing } 44 | TkTestBench >> resetCount [ 45 | ^ resetCount 46 | ] 47 | 48 | { #category : #accessing } 49 | TkTestBench >> setFlagFalse [ 50 | flag := false 51 | ] 52 | 53 | { #category : #accessing } 54 | TkTestBench >> setFlagTrue [ 55 | flag := true 56 | ] 57 | 58 | { #category : #creating } 59 | TkTestBench >> setUpBlock [ 60 | ^ [ setUpCount := setUpCount + 1 ] 61 | ] 62 | 63 | { #category : #accessing } 64 | TkTestBench >> setUpCount [ 65 | ^ setUpCount 66 | ] 67 | 68 | { #category : #creating } 69 | TkTestBench >> tearDownBlock [ 70 | ^ [ tearDownCount := tearDownCount + 1 ] 71 | ] 72 | 73 | { #category : #accessing } 74 | TkTestBench >> tearDownCount [ 75 | ^ tearDownCount 76 | ] 77 | 78 | { #category : #creating } 79 | TkTestBench >> time100MillisecondsInTheFuture [ 80 | ^ DateAndTime now + 100 milliSeconds 81 | ] 82 | 83 | { #category : #creating } 84 | TkTestBench >> time100MillisecondsInThePast [ 85 | ^ DateAndTime now - 100 milliSeconds 86 | ] 87 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkThreadFinalizer.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkThreadFinalizer, 3 | #superclass : #Object, 4 | #instVars : [ 5 | 'thread' 6 | ], 7 | #category : #'Tasks-Private-Thread' 8 | } 9 | 10 | { #category : #'instance creation' } 11 | TkThreadFinalizer class >> thread: aThread [ 12 | ^self new 13 | thread: aThread; 14 | yourself 15 | ] 16 | 17 | { #category : #'reflective operations' } 18 | TkThreadFinalizer >> doesNotUnderstand: aMessage [ 19 | self thread ifNil: [ ^super doesNotUnderstand: aMessage ]. 20 | ^aMessage sendTo: self thread 21 | ] 22 | 23 | { #category : #initialization } 24 | TkThreadFinalizer >> finalize [ 25 | self thread isFinalizationEnabled ifFalse: [ ^self ]. 26 | self thread kill 27 | ] 28 | 29 | { #category : #printing } 30 | TkThreadFinalizer >> printOn: aString [ 31 | self thread ifNil: [ ^super printOn: aString ]. 32 | self thread printOn: aString 33 | ] 34 | 35 | { #category : #printing } 36 | TkThreadFinalizer >> printString [ 37 | self thread ifNil: [ ^super printString]. 38 | ^self thread printString 39 | ] 40 | 41 | { #category : #accessing } 42 | TkThreadFinalizer >> process [ 43 | ^self thread process 44 | ] 45 | 46 | { #category : #initialization } 47 | TkThreadFinalizer >> registerForFinalization [ 48 | self finalizationRegistry add: self 49 | ] 50 | 51 | { #category : #accessing } 52 | TkThreadFinalizer >> thread [ 53 | ^thread 54 | ] 55 | 56 | { #category : #accessing } 57 | TkThreadFinalizer >> thread: aThread [ 58 | thread := aThread. 59 | self registerForFinalization 60 | ] 61 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkThreadState.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkThreadState, 3 | #superclass : #SmState, 4 | #instVars : [ 5 | 'thread' 6 | ], 7 | #category : #'Tasks-Private-Thread' 8 | } 9 | 10 | { #category : #testing } 11 | TkThreadState >> isDone [ 12 | ^false 13 | ] 14 | 15 | { #category : #testing } 16 | TkThreadState >> isKilled [ 17 | ^false 18 | ] 19 | 20 | { #category : #testing } 21 | TkThreadState >> isStarted [ 22 | ^false 23 | ] 24 | 25 | { #category : #testing } 26 | TkThreadState >> isStopped [ 27 | ^false 28 | ] 29 | 30 | { #category : #living } 31 | TkThreadState >> kill [ 32 | ^self 33 | ] 34 | 35 | { #category : #accessing } 36 | TkThreadState >> name [ 37 | ^self subclassResponsibility 38 | ] 39 | 40 | { #category : #living } 41 | TkThreadState >> restart [ 42 | self thread resetTask. 43 | self automaton step. 44 | ] 45 | 46 | { #category : #living } 47 | TkThreadState >> restartAfter: aDuration [ 48 | self thread resetTask. 49 | self thread actAfter: aDuration. 50 | self automaton step. 51 | 52 | ] 53 | 54 | { #category : #living } 55 | TkThreadState >> restartOn: aDateAndTime [ 56 | self thread resetTask. 57 | self thread actOn: aDateAndTime. 58 | self automaton step. 59 | 60 | ] 61 | 62 | { #category : #living } 63 | TkThreadState >> start [ 64 | ^self 65 | ] 66 | 67 | { #category : #living } 68 | TkThreadState >> startAfter: aDuration [ 69 | ^self 70 | ] 71 | 72 | { #category : #living } 73 | TkThreadState >> startOn: aDateAndTime [ 74 | ^self 75 | ] 76 | 77 | { #category : #living } 78 | TkThreadState >> stop [ 79 | ^self 80 | ] 81 | 82 | { #category : #accessing } 83 | TkThreadState >> thread [ 84 | ^ thread 85 | ] 86 | 87 | { #category : #accessing } 88 | TkThreadState >> thread: anObject [ 89 | thread := anObject 90 | ] 91 | -------------------------------------------------------------------------------- /Pharo/Tasks/TkTimeout.class.st: -------------------------------------------------------------------------------- 1 | Class { 2 | #name : #TkTimeout, 3 | #superclass : #Error, 4 | #category : #'Tasks-Public' 5 | } 6 | -------------------------------------------------------------------------------- /Pharo/Tasks/package.st: -------------------------------------------------------------------------------- 1 | Package { #name : #Tasks } 2 | -------------------------------------------------------------------------------- /Resources/EasyUI/rocket-small.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bouraqadi/PharoMisc/23c09a5094fc6054c46b5101306ae2a4f0fe5c0e/Resources/EasyUI/rocket-small.png -------------------------------------------------------------------------------- /Resources/EasyUI/rocket.txt: -------------------------------------------------------------------------------- 1 | Rocket PNG File downloaded from PNG All 2 | License: Creative Commons 4.0 BY-NC 3 | https://www.pngall.com/rocket-png/download/27793 4 | --------------------------------------------------------------------------------