VDBInstructionListApplication.st
changeset 80 7a9cf1d6be50
parent 77 163d914fae79
child 92 fa04de209c69
--- a/VDBInstructionListApplication.st	Tue Jun 26 14:17:50 2018 +0100
+++ b/VDBInstructionListApplication.st	Tue Jun 26 13:19:02 2018 +0100
@@ -11,7 +11,9 @@
 "{ NameSpace: Smalltalk }"
 
 VDBAbstractTreeApplication subclass:#VDBInstructionListApplication
-	instanceVariableNames:'instructionListHolder selectedInstructionHolder'
+	instanceVariableNames:'instructionListHolder instructionBasicBlocks
+		selectedInstructionHolder selectedInstructionBranchTargetAddress
+		selectedInstructionBasicBlock'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'VDB-UI-Others'
@@ -38,6 +40,17 @@
     "Created: / 22-06-2018 / 12:25:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!VDBInstructionListApplication class methodsFor:'utilities'!
+
+instructions: aCollection title: aString
+    ^ self new  
+        instructionList: aCollection;
+        title: aString;
+        yourself
+
+    "Created: / 26-06-2018 / 11:03:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !VDBInstructionListApplication methodsFor:'accessing'!
 
 instructionList: aCollection
@@ -48,6 +61,33 @@
 
 !VDBInstructionListApplication methodsFor:'aspects'!
 
+backgroundColorFor: aVDBPresenter 
+    selectedInstructionBranchTargetAddress notNil ifTrue:[ 
+        aVDBPresenter isInstructionPresenter ifTrue:[ 
+            aVDBPresenter instruction address = selectedInstructionBranchTargetAddress ifTrue:[ 
+                ^ Color blue lighter lighter
+            ].
+        ].
+    ].
+    selectedInstructionBasicBlock notNil ifTrue:[ 
+        (selectedInstructionBasicBlock includesAddress: aVDBPresenter address) ifTrue:[ 
+            ^ Color yellow lighter lighter
+        ].
+    ].
+    ^ nil
+
+    "Created: / 26-06-2018 / 11:26:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified (format): / 27-06-2018 / 16:08:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+foregroundColorFor: aVDBAbstractPresenter
+    ^ aVDBAbstractPresenter isInstructionsAndSourcePresenter 
+        ifTrue:[ Color gray ]
+        ifFalse:[ nil ]
+
+    "Created: / 26-06-2018 / 13:07:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 instructionListHolder
     "return/create the 'instructionListHolder' value holder (automatically generated)"
 
@@ -108,6 +148,12 @@
 
 !VDBInstructionListApplication methodsFor:'change & update'!
 
+enqueueDelayedUpdateBasicBlocks
+    self enqueueDelayedUpdate: #delayedUpdateBasicBlocks
+
+    "Created: / 26-06-2018 / 12:20:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 update:aspect with:param from:sender
     "Invoked when an object that I depend upon sends a change notification."
 
@@ -115,13 +161,52 @@
          self enqueueDelayedUpdateInternalList.
          ^ self.
     ].
+    sender == selectedInstructionHolder ifTrue:[ 
+        self updateAfterSelectedInstructionChanged.
+    ].
     super update:aspect with:param from:sender
 
-    "Modified: / 22-06-2018 / 12:38:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 26-06-2018 / 12:46:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+updateAfterSelectedInstructionChanged
+    | selected |
+
+    selected := self selectedInstructionHolder value.
+    selected notNil ifTrue:[
+        selected isBranchInstruction ifTrue:[ 
+            selectedInstructionBranchTargetAddress := selected branchTargetAddress.
+        ] ifFalse:[ 
+            selectedInstructionBranchTargetAddress := nil.
+        ].
+        instructionBasicBlocks size > 1 ifTrue:[
+            selectedInstructionBasicBlock := instructionBasicBlocks detect:[:e | e includesAddress: selected address ] ifNone: [ nil ]
+        ] ifFalse:[ 
+            selectedInstructionBasicBlock := nil.
+        ].
+    ] ifFalse:[ 
+        selectedInstructionBranchTargetAddress := nil.
+        selectedInstructionBasicBlock := nil.
+
+    ].
+
+    self enqueueDelayedInvalidateInternalList.
+
+    "Created: / 26-06-2018 / 11:33:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 03-07-2018 / 14:56:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !VDBInstructionListApplication methodsFor:'change & update-delayed'!
 
+delayedUpdateBasicBlocks
+    instructionBasicBlocks := VDBInstructionBasicBlock analyze: instructionListHolder value.
+    self enqueueDelayedInvalidateInternalList.
+
+    "Created: / 26-06-2018 / 12:20:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 27-06-2018 / 14:47:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified (format): / 27-06-2018 / 16:04:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 delayedUpdateInternalList
     | root |
 
@@ -142,10 +227,11 @@
     root children do:[:each | each expand ].
     internalListView notNil ifTrue:[
         internalListView invalidate.
-    ]
+    ].
+    self enqueueDelayedUpdateBasicBlocks.
 
     "Created: / 27-02-2015 / 15:47:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 25-06-2018 / 17:19:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 26-06-2018 / 12:45:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 delayedUpdateSelection
@@ -161,6 +247,20 @@
     "Modified: / 22-06-2018 / 15:08:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!VDBInstructionListApplication methodsFor:'private'!
+
+instructionPresentersDo: aBlock
+    self internalListHolder root children do:[:each |
+        each isInstructionPresenter ifTrue:[ 
+            aBlock value: each
+        ] ifFalse:[ 
+            each children do: aBlock
+        ].
+    ]
+
+    "Created: / 26-06-2018 / 12:30:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !VDBInstructionListApplication methodsFor:'queries'!
 
 canSelect: anItem