core: add utility funcs

hpi-swa · Sep 27, 2023 · 008b33b · 008b33b
1 parent 0c63888
commit 008b33b
Show file tree

Hide file tree

Showing 6 changed files with 69 additions and 4 deletions.
diff --git a/packages/Sandblocks-Core/Morph.extension.st b/packages/Sandblocks-Core/Morph.extension.st
@@ -60,7 +60,7 @@ Morph >> basicCursorPositionsDo: aBlock shallow: aBoolean [
 	self visibleSubmorphsDo: [:morph |
 		morph isSandblock ifTrue: [self containingSandblock insertCursorNear: morph before: true do: aBlock].
 		morph isTextMorph ifTrue: [
-			morph containingSandblock startInputCommand ifNotNil: [:command |
+			(morph containingSandblock startInputCommandIn: morph) ifNotNil: [:command |
 				aBlock value: (SBCursorText new
 					block: morph containingSandblock;
 					currentCommand: command)]].
@@ -344,6 +344,12 @@ Morph >> morphAfterThat: aBlock [
 	(aBlock value: next) ifTrue: [^ next]] repeat
 ]
 
+{ #category : #'*Sandblocks-Core-hierarchy' }
+Morph >> morphBeforeOrAfter: aBeforeBoolean [
+
+	^ aBeforeBoolean ifTrue: [self submorphBefore] ifFalse: [self submorphAfter]
+]
+
 { #category : #'*Sandblocks-Core' }
 Morph >> morphBeforeThat: aBlock [
 

diff --git a/packages/Sandblocks-Core/SBBlock.class.st b/packages/Sandblocks-Core/SBBlock.class.st
@@ -86,7 +86,7 @@ SBBlock >> actions [
 SBBlock >> activeTextMorph [
 
 	| candidate |
-	candidate := self sandblockEditor currentInputCommand ifNotNil: #textMorph.
+	candidate := (self sandblockEditor ifNil: [^ nil]) currentInputCommand ifNotNil: #textMorph.
 	candidate ifNil: [^ nil].
 	(self textMorphs includes: candidate) ifFalse: [^ nil].
 	^ candidate
@@ -2073,7 +2073,7 @@ SBBlock >> objectInterfaceNear: aBlock at: aSymbol [
 SBBlock >> open [
 	" tries to find the current SBEditor and open our block in it "
 
-	SBExecutionEnvironment value sandblockEditor
+	(SBExecutionEnvironment value ifNotNil: #sandblockEditor)
 		ifNotNil: [:editor | editor openMorphInView: self]
 		ifNil: [self error: 'No editor found in execution context']
 ]

diff --git a/packages/Sandblocks-Core/SBFlashDecorator.class.st b/packages/Sandblocks-Core/SBFlashDecorator.class.st
@@ -0,0 +1,47 @@
+Class {
+	#name : #SBFlashDecorator,
+	#superclass : #SBBlockDecorator,
+	#instVars : [
+		'endTime'
+	],
+	#category : #'Sandblocks-Core'
+}
+
+{ #category : #'as yet unclassified' }
+SBFlashDecorator >> attached: aMorph [
+
+	super attached: aMorph.
+	endTime := Time millisecondClock + self duration
+]
+
+{ #category : #'as yet unclassified' }
+SBFlashDecorator >> color [
+
+	^ (Color r: 1 g: 1 b: 0.0) alpha: (endTime - Time millisecondClock / self duration) asFloat
+]
+
+{ #category : #'as yet unclassified' }
+SBFlashDecorator >> duration [
+
+	^ 400
+]
+
+{ #category : #'as yet unclassified' }
+SBFlashDecorator >> postDrawOn: aCanvas [
+
+	self color alpha.
+	aCanvas frameRectangle: self morph bounds width: 4 color: self color
+]
+
+{ #category : #'as yet unclassified' }
+SBFlashDecorator >> step [
+
+	Time millisecondClock > endTime ifTrue: [self detach].
+	self morph changed
+]
+
+{ #category : #'as yet unclassified' }
+SBFlashDecorator >> stepTime [
+
+	^ 0
+]
diff --git a/packages/Sandblocks-Core/SBHoverDecorator.class.st b/packages/Sandblocks-Core/SBHoverDecorator.class.st
@@ -64,7 +64,7 @@ SBHoverDecorator >> position: aPoint [
 { #category : #'as yet unclassified' }
 SBHoverDecorator >> postDrawOn: aCanvas [
 
-	(self shown and: [SBPreferences showHoverDecorator and: [cursor notNil and: [ActiveHand hasSubmorphs not]]]) ifTrue: [ | c |
+	(self shown and: [SBPreferences showHoverDecorator and: [cursor notNil and: [ActiveHand hasSubmorphs not and: [morph sandblockEditor ~= morph]]]]) ifTrue: [ | c |
 		c := (cursor isKindOf: SBCursorText)
 			ifTrue: [SBCursorSelect new block: cursor block]
 			ifFalse: [cursor].

diff --git a/packages/Sandblocks-Morphs/SBMultilineOwnTextMorph.class.st b/packages/Sandblocks-Morphs/SBMultilineOwnTextMorph.class.st
@@ -9,6 +9,12 @@ Class {
 	#category : #'Sandblocks-Morphs'
 }
 
+{ #category : #'as yet unclassified' }
+SBMultilineOwnTextMorph >> adjustTextAnchor: aMorph [
+
+
+]
+
 { #category : #'as yet unclassified' }
 SBMultilineOwnTextMorph >> applyUserInterfaceTheme [
 

diff --git a/packages/Sandblocks-Morphs/SBOwnTextMorph.class.st b/packages/Sandblocks-Morphs/SBOwnTextMorph.class.st
@@ -38,6 +38,12 @@ SBOwnTextMorph >> bold [
 	self emphasis: TextEmphasis bold
 ]
 
+{ #category : #'as yet unclassified' }
+SBOwnTextMorph >> characterBeforeCursor [
+
+	^ self cursor = 1 ifTrue: [nil] ifFalse: [self contents at: self cursor - 1]
+]
+
 { #category : #'as yet unclassified' }
 SBOwnTextMorph >> clear [