initial checkin
authorClaus Gittinger <cg@exept.de>
Fri, 19 Jul 2019 15:14:00 +0200
changeset 3700 34af8cf33242
parent 3699 1070017213b7
child 3701 6f4df83da9b7
initial checkin
ShowMeHowItWorks.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/ShowMeHowItWorks.st	Fri Jul 19 15:14:00 2019 +0200
@@ -0,0 +1,680 @@
+"{ Package: 'stx:libtool2' }"
+
+"{ NameSpace: Smalltalk }"
+
+Object subclass:#ShowMeHowItWorks
+	instanceVariableNames:'opStream lastComponentName lastComponent'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Interface-Help'
+!
+
+!ShowMeHowItWorks class methodsFor:'documentation'!
+
+documentation
+"
+    documentation to be added.
+
+    class:
+        <a short class summary here, describing what instances represent>
+
+    responsibilities:    
+        <describing what my main role is>
+
+    collaborators:    
+        <describing with whom and how I talk to>
+
+    API:
+        <public api and main messages>
+        
+    example:
+        <a one-line examples on how to use - can also be in a separate example method>
+
+    implementation:
+        <implementation points>
+
+    [author:]
+        Claus Gittinger
+
+    [instance variables:]
+
+    [class variables:]
+
+    [see also:]
+
+"
+!
+
+example
+    ShowMeHowItWorks do:#(
+        ( showing: 'Choose the number of arguments' do:(
+            moveTo: NumberOfArguments
+            select: '1' 
+        ))  
+        (showing: 'Click into the "receiver" field' do:(
+            moveTo: ReceiverEditor
+            click: ReceiverEditor 
+        ))
+        (showing: 'Enter a value (or expression) into "receiver" field' do:(
+            enter: '100'
+        ))
+        (showing: 'Click into the "first argument" field' do:(
+            moveTo: Arg1Editor
+            click: ReceiverEditor
+        ))
+        (showing: 'Enter a value (or expression) into "receiver" field' do:(
+            enter: '100'
+        ))
+
+    )
+! !
+
+!ShowMeHowItWorks class methodsFor:'running'!
+
+do:specArray
+    self doStream:specArray readStream
+
+    "Created: / 19-07-2019 / 10:52:59 / Claus Gittinger"
+    "Modified: / 19-07-2019 / 14:30:43 / Claus Gittinger"
+!
+
+doStream:specStream
+    "must run as a separate process;
+     otherwise - if started by the app itself -
+     no events will be processed while running"
+     
+    [
+        self new doStream:specStream
+    ] fork.
+
+    "Created: / 19-07-2019 / 10:53:07 / Claus Gittinger"
+    "Modified (comment): / 19-07-2019 / 14:30:29 / Claus Gittinger"
+! !
+
+!ShowMeHowItWorks methodsFor:'commands'!
+
+pause
+    <action>
+    
+    Dialog information:'Show Paused.\Click on "OK" to proceed'
+
+    "Created: / 19-07-2019 / 15:03:17 / Claus Gittinger"
+!
+
+showing:message do:operations
+    "execute operations while showing (and speaking) some message."
+
+    <action>
+    
+    |messageView talkDone|
+
+    self assert:operations isSequenceable.
+
+    messageView := ActiveHelpView for:message.
+    "/ messageView shapeStyle:#cartoon.
+    [
+        messageView realize.
+
+        self talking ifTrue:[
+            talkDone := Semaphore new.
+            [
+                self tell:message.
+                talkDone signal
+            ] fork.
+            
+            "/
+            "/ allow speaker some headoff
+            Delay waitForSeconds:(message size / 20).
+        ].
+
+        self doStream:(operations readStream).
+    ] ensure:[
+        messageView destroy
+    ].
+    self talking ifTrue:[
+        talkDone wait.
+    ].
+
+    "Created: / 19-07-2019 / 11:19:27 / Claus Gittinger"
+    "Modified (format): / 19-07-2019 / 15:02:12 / Claus Gittinger"
+!
+
+wait:seconds
+    <action>
+    
+    Delay waitForSeconds:seconds
+
+    "Created: / 19-07-2019 / 15:09:45 / Claus Gittinger"
+! !
+
+!ShowMeHowItWorks methodsFor:'commands - mouse'!
+
+click:buttonNr
+    "press-release"
+    
+    <action>
+
+    self click:buttonNr inComponent:lastComponent
+
+    "Created: / 19-07-2019 / 13:21:20 / Claus Gittinger"
+    "Modified: / 19-07-2019 / 14:55:18 / Claus Gittinger"
+!
+
+enter:aString
+    "enter text into the last component"
+
+    <action>
+
+    lastComponent simulateTextInput:aString at:(lastComponent extent // 2) sendDisplayEvent:false
+
+    "Created: / 19-07-2019 / 14:29:27 / Claus Gittinger"
+!
+
+moveTo:componentName
+    "move the mouse to componentName,
+     then circle around it a few times"
+
+    <action>
+
+    |component|
+
+    lastComponentName := componentName.
+    
+    component := self findComponent:componentName.
+    component isNil ifTrue:[
+        self error:'no component found for: ',componentName.
+    ].
+    lastComponent := component.
+
+    self movePointerToComponent:component.
+    self circlePointerAroundComponent:component.
+
+    "Created: / 19-07-2019 / 11:20:42 / Claus Gittinger"
+    "Modified (format): / 19-07-2019 / 14:55:27 / Claus Gittinger"
+!
+
+select:itemsLabel
+    "select an item by label,
+     allowed after moving to:
+        aComboBox
+        aSelectionInListView
+    "    
+
+    <action>
+
+    |idx|
+    
+    (lastComponent isKindOf:ComboView) ifTrue:[
+        "/ click on the menubutton
+        self movePointerToComponent:lastComponent menuButton.
+        self click:1 inComponent:lastComponent menuButton.
+        Delay waitForSeconds:0.3.
+        (idx := lastComponent list indexOf:itemsLabel ifAbsent:[nil]) isNil ifTrue:[
+            self error:'no such item in comboList: ',itemsLabel
+        ].
+        lastComponent select:idx.
+        Delay waitForSeconds:0.3.
+        lastComponent shownMenu notNil ifTrue:[
+            lastComponent shownMenu hide.
+        ].    
+        ^ self
+    ].    
+    self error:'cannot select this component'
+
+    "Created: / 19-07-2019 / 12:34:25 / Claus Gittinger"
+    "Modified (format): / 19-07-2019 / 14:55:34 / Claus Gittinger"
+!
+
+selectIndex:itemsIndex
+    "select an item by index,
+     allowed after moving to:
+        aComboBox
+        aSelectionInListView
+    "    
+
+    <action>
+
+    (lastComponent isKindOf:ComboView) ifTrue:[
+        "/ click on the menubutton
+        self movePointerToComponent:lastComponent menuButton.
+        self click:1 inComponent:lastComponent menuButton.
+        Delay waitForSeconds:0.5.
+        lastComponent select:itemsIndex.
+        Delay waitForSeconds:0.5.
+self halt.
+        ^ self
+    ].    
+    self error:'cannot select this component'
+
+    "Created: / 19-07-2019 / 14:20:11 / Claus Gittinger"
+! !
+
+!ShowMeHowItWorks methodsFor:'defaults'!
+
+circlingCount
+    "circle around move-end position that many times"
+
+    ^ 3
+
+    "Created: / 19-07-2019 / 13:03:45 / Claus Gittinger"
+!
+
+circlingRadius 
+    "radius when circling"
+    
+    ^ 30 "/ pixels
+
+    "Created: / 19-07-2019 / 13:07:59 / Claus Gittinger"
+!
+
+circlingSpeed 
+    "time per round when circling"
+    
+    ^ 0.3 seconds.       "/ time per round
+
+    "Created: / 19-07-2019 / 13:02:34 / Claus Gittinger"
+!
+
+clickTime
+    "when clicking"
+
+    ^ 100 milliseconds
+
+    "Created: / 19-07-2019 / 13:17:20 / Claus Gittinger"
+!
+
+pointerAnimationDelay
+    ^ 50 milliseconds.   "/ 20 updates per second
+
+    "Created: / 19-07-2019 / 13:04:45 / Claus Gittinger"
+!
+
+pointerMoveSpeed
+    ^ 400.   "/ pixels per second
+
+    "Created: / 19-07-2019 / 13:05:40 / Claus Gittinger"
+!
+
+talking
+    ^ true
+
+    "Created: / 19-07-2019 / 14:31:14 / Claus Gittinger"
+! !
+
+!ShowMeHowItWorks methodsFor:'helper'!
+
+findComponent:componentName
+    "find a component by name - in the active and possibly in any app"
+    
+    |app component candidates|
+
+    app := WindowGroup activeMainApplication.
+    app notNil ifTrue:[ 
+        component := self findComponent:componentName in:app.
+    ].
+    
+    component isNil ifTrue:[
+        "/ search through all current applications
+        candidates := OrderedCollection new.
+        WindowGroup scheduledWindowGroups do:[:eachWG |
+            |eachApp|
+
+            (eachApp := eachWG application) notNil ifTrue:[
+                component := self findComponent:componentName in:eachApp.
+                component notNil ifTrue:[ 
+                    candidates add:component
+                ].
+            ].
+        ].
+        
+        candidates size == 1 ifTrue:[
+            component := candidates first
+        ] ifFalse:[    
+            candidates notEmpty ifTrue:[
+                self error:'multiple components found by name: ',componentName.
+            ]    
+        ].    
+    ].    
+    ^ component
+
+    "Created: / 19-07-2019 / 12:02:30 / Claus Gittinger"
+!
+
+findComponent:componentName in:anApplication
+    |component componentNameSymbol foundByName foundByTitle foundByLabel|
+
+    (component := anApplication componentAt:componentName) notNil ifTrue:[^ component].
+    (componentNameSymbol := componentName asSymbolIfInterned) notNil ifTrue:[
+        (component := anApplication componentAt:componentNameSymbol) notNil ifTrue:[^ component].
+    ].
+    
+    "/ mhmh - search through all widgets of anApplication; 
+    "/ maybe it was not created via the builder/spec,
+    "/ or it has changed its name.
+    "/ look for: widget's name, widget's title, widget's label
+    foundByName := OrderedCollection new. 
+    foundByTitle := OrderedCollection new. 
+    foundByLabel := OrderedCollection new.
+    
+    anApplication window allSubViewsDo:[:each |
+        [
+            each name = componentName ifTrue:[ foundByName add:each ].
+        ] on:MessageNotUnderstood do:[:ex | ].
+        [
+            each title = componentName ifTrue:[ foundByTitle add:each ].
+        ] on:MessageNotUnderstood do:[:ex | ].
+        [
+            each label = componentName ifTrue:[ foundByLabel add:each ].
+        ] on:MessageNotUnderstood do:[:ex | ].
+    ].
+    foundByName notEmpty ifTrue:[
+        self assert:(foundByName size == 1) message:'multiple components found by name'.
+        ^ foundByName first.
+    ].
+    foundByTitle notEmpty ifTrue:[
+        self assert:(foundByTitle size == 1) message:'multiple components found by title'.
+        ^ foundByTitle first.
+    ].
+    foundByLabel notEmpty ifTrue:[
+        self assert:(foundByLabel size == 1) message:'multiple components found by label'.
+        ^ foundByLabel first.
+    ].
+    ^ component
+
+    "Created: / 19-07-2019 / 11:36:21 / Claus Gittinger"
+!
+
+tell:message
+    self talking ifTrue:[
+        OperatingSystem speak:message.
+    ].
+
+    "Created: / 19-07-2019 / 14:57:50 / Claus Gittinger"
+! !
+
+!ShowMeHowItWorks methodsFor:'helpers - broken'!
+
+click:buttonNr atPosition:position
+    "press-release at position"
+    
+    |screen|
+
+    screen := Screen current.
+    
+    screen setPointerPosition:position.    
+    screen flush.
+    self click:buttonNr
+
+    "Created: / 19-07-2019 / 13:14:51 / Claus Gittinger"
+! !
+
+!ShowMeHowItWorks methodsFor:'helpers - mouse movement'!
+
+circlePointerAroundComponent:component
+    "circle around it a few times"
+    
+    self circlePointerAroundPosition:(component screenBounds center rounded)
+
+    "Created: / 19-07-2019 / 13:12:35 / Claus Gittinger"
+!
+
+circlePointerAroundPosition:position
+    "circle around it a few times"
+    
+    |screen stepDelayTime numCircles circlingSpeed radius|
+
+    screen := Screen current.
+    
+    circlingSpeed := self circlingSpeed.    "/ time per round
+    numCircles := self circlingCount.
+    stepDelayTime := self pointerAnimationDelay.   "/ update interval
+    
+    radius := self circlingRadius.
+
+    "/ move it around a few times
+    1 to:numCircles do:[:round |
+        |n angle|
+
+        n := circlingSpeed / stepDelayTime. "/ nr of steps per circle
+        angle := 360 / n.                   "/ angle-delta per step
+        1 to:n do:[:step |
+            |a x y|
+            
+            a := angle * step.
+            "/ clockwise starting above the center
+            x := position x + (radius * a degreesToRadians sin).
+            y := position y + (radius * a degreesToRadians cos).
+"/ Transcript showCR:(x@y).
+            screen setPointerPosition:(x@y) rounded.
+            screen flush.
+            Delay waitFor:stepDelayTime.
+        ].    
+        "/ and back
+        screen setPointerPosition:position rounded.
+        screen flush.
+        Delay waitFor:stepDelayTime.
+    ].
+
+    "Created: / 19-07-2019 / 13:12:40 / Claus Gittinger"
+!
+
+click:buttonNr inComponent:component
+    "press-release in a component"
+
+    component simulateButtonPress:buttonNr at:(component extent // 2) sendDisplayEvent:false.
+    Delay waitForSeconds:(self clickTime).
+    component simulateButtonRelease:buttonNr at:(component extent // 2) sendDisplayEvent:false.
+
+"/    self click:buttonNr atPosition:(component extent // 2)
+
+    "Created: / 19-07-2019 / 13:18:27 / Claus Gittinger"
+!
+
+movePointerToComponent:aWidget
+    "move the mouse to aWidget's center"
+    
+    self movePointerToPosition:(aWidget screenBounds center rounded).
+
+    "Created: / 19-07-2019 / 13:11:33 / Claus Gittinger"
+!
+
+movePointerToPosition:newPosition
+    "move the mouse to newPosition"
+    
+    |screen distance start numSteps moveTime stepDelayTime delta|
+
+    screen := Screen current.
+    start := screen pointerPosition.   
+
+    distance := start dist:newPosition.
+    moveTime := (distance / self pointerMoveSpeed) seconds. "/ time to move
+    stepDelayTime := self pointerAnimationDelay.            "/ update every 50ms
+    
+    numSteps := moveTime / stepDelayTime.
+    numSteps = 0 ifTrue:[
+        "/ already there
+        ^ self
+    ].
+    
+    delta := (newPosition - start) / numSteps.
+    1 to:numSteps do:[:step |
+        |p|
+        
+        p := (start + (delta * step)) rounded.
+"/ Transcript showCR:p.
+        screen setPointerPosition:p.
+        screen flush.
+        Delay waitFor:stepDelayTime.
+    ].
+
+    "Created: / 19-07-2019 / 12:57:30 / Claus Gittinger"
+!
+
+press:buttonNr
+    "press at the current position"
+    
+    |position screen x y|
+
+    screen := Screen current.
+    position := screen pointerPosition.
+    x := position x.
+    y := position y.
+    
+    self movePointerToPosition:position.
+
+    false "OperatingSystem isOSXlike" ifTrue:[
+        |osxPos|
+
+        osxPos := OperatingSystem getMousePosition.
+        x := osxPos x rounded.
+        y := osxPos y rounded.
+        OperatingSystem generateButtonEvent:buttonNr down:true x:x y:y.
+        ^ self.
+    ].
+
+    screen sendKeyOrButtonEvent:#buttonPress x:x y:y keyOrButton:buttonNr state:0 toViewId:(screen rootWindowId).
+    screen flush.
+
+    "Created: / 19-07-2019 / 13:52:38 / Claus Gittinger"
+!
+
+release:buttonNr
+    "press-release at the current position"
+    
+    |position screen x y|
+
+    screen := Screen current.
+    position := screen pointerPosition.
+    x := position x.
+    y := position y.
+    
+    self movePointerToPosition:position.
+
+    false "OperatingSystem isOSXlike" ifTrue:[
+        |osxPos|
+
+        osxPos := OperatingSystem getMousePosition.
+        x := osxPos x rounded.
+        y := osxPos y rounded.
+        OperatingSystem generateButtonEvent:buttonNr down:false x:x y:y.
+        ^ self.
+    ].
+
+    screen sendKeyOrButtonEvent:#buttonRelease x:x y:y keyOrButton:buttonNr state:0 toViewId:(screen rootWindowId).
+    screen flush.
+
+    "Created: / 19-07-2019 / 13:53:05 / Claus Gittinger"
+! !
+
+!ShowMeHowItWorks methodsFor:'running'!
+
+doStream:specStream
+    |previousStream|
+
+    previousStream := opStream.
+    [
+        opStream := specStream.
+        [opStream atEnd] whileFalse:[
+            self nextCommand.
+            Display shiftDown ifTrue:[
+                self tell:'Shou stopped by shiftkee'.
+                ^ AbortOperationRequest raise
+            ].    
+        ].    
+    ] ensure:[
+        opStream := previousStream
+    ].
+    
+"<<END
+     ShowMeHowItWorks do:#(
+        showing: 'Choose the number of arguments'
+        do: (
+            moveTo: NumberOfArguments
+            select: '1'
+        )    
+        showing: 'Click into the "receiver" field'
+        do: (
+            moveTo: ReceiverEditor
+            click: ReceiverEditor
+        )
+        showing: 'Enter a value (or expression) into "receiver" field'
+        do: (
+            enter: '100'
+        )
+        showing: 'Click into the "first argument" field'
+        do: (
+            moveTo: Arg1Editor
+            click: ReceiverEditor
+        )
+        showing: 'Enter a value (or expression) into "receiver" field'
+        do: (
+            enter: '100'
+        )
+     )
+END"
+
+    "Created: / 19-07-2019 / 10:52:24 / Claus Gittinger"
+    "Modified: / 19-07-2019 / 15:00:44 / Claus Gittinger"
+!
+
+nextCommand
+    |op numArgs sel args method|
+
+    op := opStream next.
+    op isArray ifTrue:[
+        "/ construct a selector from keyword parts at odd indices
+        sel := ((op with:(1 to:op size) select:[:el :idx | idx odd]) asStringWith:'') asSymbol.
+        "/ construct arg vector from parts at even indices
+        args := op with:(1 to:op size) select:[:el :idx | idx even].
+    ] ifFalse:[
+        sel := op.
+        numArgs := sel argumentCount.
+        args := opStream next:numArgs.
+    ].
+    
+    (self respondsTo:sel) ifFalse:[
+        self error:'bad operation: ',sel
+    ].
+    method := self class lookupMethodFor:sel.
+    (method hasAnnotation:#action) ifFalse:[self halt].
+    
+    self perform:sel withArguments:args.
+
+"<<END
+     ShowMeHowItWorks do:#(
+        showing: 'Choose the number of arguments'
+        do: (
+            moveTo: NumberOfArguments
+            select: '1'
+        )    
+        showing: 'Click into the "receiver" field'
+        do: (
+            moveTo: ReceiverEditor
+            click: ReceiverEditor
+        )
+        showing: 'Enter a value (or expression) into "receiver" field'
+        do: (
+            enter: '100'
+        )
+        showing: 'Click into the "first argument" field'
+        do: (
+            moveTo: Arg1Editor
+            click: ReceiverEditor
+        )
+        showing: 'Enter a value (or expression) into "receiver" field'
+        do: (
+            enter: '100'
+        )
+     )
+END"
+
+    "Created: / 19-07-2019 / 10:54:04 / Claus Gittinger"
+    "Modified: / 19-07-2019 / 14:53:15 / Claus Gittinger"
+! !
+
+!ShowMeHowItWorks class methodsFor:'documentation'!
+
+version_CVS
+    ^ '$Header$'
+! !
+