Smalltalk › Squeak › Squeak VM

VM Maker: VMMakerUI-eem.1.mcz

_‹ Previous Topic Next Topic _›

Classic

List

Threaded

1 message

commits-2

VM Maker: VMMakerUI-eem.1.mcz

Eliot Miranda uploaded a new version of VMMakerUI to project VM Maker:
http://source.squeak.org/VMMaker/VMMakerUI-eem.1.mcz

==================== Summary ====================

Name: VMMakerUI-eem.1
Author: eem
Time: 22 December 2019, 10:21:35.048794 am
UUID: dbfca451-fef5-4248-8f2e-49793e2910f6
Ancestors:

Move the Morphic GUI methods to VMMakerUI.
Add Marcel's gorgeous CogProcessorAlienInspector.

==================== Snapshot ====================

SystemOrganization addCategory: #'VMMakerUI-SqueakInspectors'!
SystemOrganization addCategory: #'VMMakerUI-InterpreterSimulation-Morphic'!

Model subclass: #CogProcessorAlienInspector
instanceVariableNames: 'cogit coInterpreter objectMemory processor registerSelectors windowTitle registerCache'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMakerUI-SqueakInspectors'!

!CogProcessorAlienInspector commentStamp: 'eem 12/22/2019 08:27' prior: 0!
A CogProcessorAlienInspector is an inspector for a CogProcessorAlien processor simulator that displays the processor simulator's register state.

Instance Variables
processor: <CogProcessorAlien>
registerCache: <Array of Integer>
registerSelectors: <Array of Symbol>
windowTitle: <String>!

----- Method: CogProcessorAlienInspector class>>open (in category 'instance creation') -----
open
^ToolBuilder open:
(self new
processor: (Cogit classPool at: #ProcessorClass) new;
yourself)!

----- Method: CogProcessorAlienInspector class>>openFor: (in category 'instance creation') -----
openFor: aCogit
^ToolBuilder open: (self new cogit: aCogit; yourself)!

----- Method: CogProcessorAlienInspector>>bitsPerDigit (in category 'defaults') -----
bitsPerDigit
"How to format the register state?"

^ 4!

----- Method: CogProcessorAlienInspector>>buildWith: (in category 'building') -----
buildWith: builder

| window registers |
window := builder pluggableWindowSpec new.
window
model: self;
label: #windowTitle;
extent: 400@200;
children: OrderedCollection new.
registers := builder pluggableTextSpec new.
registers
model: self;
font: Preferences standardFixedFont;
getText: #text;
frame: (0@0 corner: 1@1);
yourself.
window children add: registers.
^(builder build: window)
paneColor: coInterpreter windowColorToUse;
yourself!

----- Method: CogProcessorAlienInspector>>cogit: (in category 'initialization') -----
cogit: aCogit
cogit := aCogit.
coInterpreter := cogit coInterpreter.
objectMemory := coInterpreter objectMemory.
processor := cogit processor.
registerSelectors := OrderedCollection withAll: processor registerStateGetters!

----- Method: CogProcessorAlienInspector>>defaultWindowColor (in category 'accessing - ui') -----
defaultWindowColor

^ Color fromString: '#6bca61'!

----- Method: CogProcessorAlienInspector>>digitsPerGroup (in category 'defaults') -----
digitsPerGroup
"How to format the register state?"

^ 2!

----- Method: CogProcessorAlienInspector>>evaluateExpression: (in category 'evaluation') -----
evaluateExpression: exp
"Callback from text widget after do-it, print-it, inspect-it, etc... The return value will be fed back."

| register value |
register := (exp asString findTokens: '=') first withBlanksTrimmed asLowercase asSymbol.
value := self registerCache at: register.

self interpret: register.

^ value!

----- Method: CogProcessorAlienInspector>>initialize (in category 'initialization') -----
initialize

super initialize.

self registerSelectors: OrderedCollection new.

self registerCache: IdentityDictionary new.!

----- Method: CogProcessorAlienInspector>>inspect: (in category 'initialization') -----
inspect: aRegisterSelector

self registerSelectors add: aRegisterSelector.
self changed: #text.!

----- Method: CogProcessorAlienInspector>>inspectAll: (in category 'initialization') -----
inspectAll: someRegisterSelectors

self registerSelectors addAll: someRegisterSelectors.
self changed: #text.!

----- Method: CogProcessorAlienInspector>>inspectNone (in category 'initialization') -----
inspectNone

self registerSelectors removeAll.
self changed: #text.!

----- Method: CogProcessorAlienInspector>>interpret: (in category 'evaluation') -----
interpret: registerSelector
"Offer some ways of interpretation."

| value options choice |

self flag: #updates. "mt: The cache value corresponds maybe to the value at interaction time. In case the register changes quickly and it takes the user some time to make a choice?"
value := self registerCache at: registerSelector.

options := OrderedDictionary newFrom: {
'Object' -> #interpret:asObject:.
'Stack frame' -> #interpret:asStackFrame:.
'Code address' -> #interpret:asCodeAddress:.
'Integer' -> #interpret:asInteger:.
'Character' -> #interpret:asCharacter:.
}.

choice := Project uiManager
chooseFrom: options keys
values: options values
title: ('{1} {2}' format: {registerSelector asUppercase. coInterpreter whereIs: value}).

choice ifNotNil:
[:selector | self perform: selector with: registerSelector with: value]!

----- Method: CogProcessorAlienInspector>>interpret:asCharacter: (in category 'evaluation') -----
interpret: registerSelector asCharacter: registerValue

registerValue asCharacter explore.!

----- Method: CogProcessorAlienInspector>>interpret:asCodeAddress: (in category 'evaluation') -----
interpret: registerSelector asCodeAddress: registerValue

cogit disassembleCodeAt: registerValue!

----- Method: CogProcessorAlienInspector>>interpret:asInteger: (in category 'evaluation') -----
interpret: registerSelector asInteger: registerValue

registerValue explore.!

----- Method: CogProcessorAlienInspector>>interpret:asObject: (in category 'evaluation') -----
interpret: registerSelector asObject: registerValue

coInterpreter printOop: registerValue!

----- Method: CogProcessorAlienInspector>>interpret:asStackFrame: (in category 'evaluation') -----
interpret: registerSelector asStackFrame: registerValue

coInterpreter printFrame: registerValue!

----- Method: CogProcessorAlienInspector>>interpret:asWhoKnows: (in category 'evaluation') -----
interpret: registerSelector asWhoKnows: registerValue

UserDialogBoxMorph inform: (coInterpreter whereIs: registerValue) title: registerSelector!

----- Method: CogProcessorAlienInspector>>pcText (in category 'accessing - ui') -----
pcText

^processor pc hex allButFirst: 3!

----- Method: CogProcessorAlienInspector>>processor (in category 'accessing') -----
processor
^processor!

----- Method: CogProcessorAlienInspector>>processor: (in category 'accessing') -----
processor: aCogProcessorAlien
processor := aCogProcessorAlien.
registerSelectors := processor registerStateGetters.
windowTitle := nil.
self changed: #windowTitle.!

----- Method: CogProcessorAlienInspector>>registerAt: (in category 'accessing - ui') -----
registerAt: aRegisterSelector

^ self alien perform: aRegisterSelector!

----- Method: CogProcessorAlienInspector>>registerCache (in category 'accessing') -----
registerCache

^ registerCache!

----- Method: CogProcessorAlienInspector>>registerCache: (in category 'accessing') -----
registerCache: anObject

registerCache := anObject.!

----- Method: CogProcessorAlienInspector>>registerSelectors (in category 'accessing') -----
registerSelectors

^ registerSelectors!

----- Method: CogProcessorAlienInspector>>registerSelectors: (in category 'accessing') -----
registerSelectors: anObject

registerSelectors := anObject.
self changed: #text.!

----- Method: CogProcessorAlienInspector>>registerTextAt: (in category 'accessing - ui') -----
registerTextAt: aRegisterSelector

| raw current last text |
current := processor perform: aRegisterSelector.
last := self registerCache at: aRegisterSelector ifAbsent: [].
self registerCache at: aRegisterSelector put: current.

raw := String streamContents:
[:s |
current
printOn: s
base: (2 raisedTo: self bitsPerDigit)
length: processor class wordSize * 8 / self bitsPerDigit
padded: true].

text := (String streamContents:
[:s |
raw groupsOf: self digitsPerGroup atATimeCollect:
[:group |
s nextPutAll: group; space]])
asText.

last ~= current ifTrue:
[text addAllAttributes: {TextEmphasis bold. TextColor color: Color salmon}].
^text!

----- Method: CogProcessorAlienInspector>>stepIn: (in category 'stepping') -----
stepIn: window
self changed: #text.!

----- Method: CogProcessorAlienInspector>>stepTimeIn: (in category 'stepping') -----
stepTimeIn: window
"The minimum update time in milliseconds."
^500!

----- Method: CogProcessorAlienInspector>>text (in category 'accessing - ui') -----
text

^Text streamContents:
[:s | | max exclude fpstate |
max := (self registerSelectors ifEmpty: [1] ifNotEmpty: [:selector | (selector collect: #size) max]).
s
nextPutAll: ('PC' padded: #right to: max with: Character space);
nextPutAll: ' = ';
nextPutAll: self pcText;
cr.
exclude := Set new.
1 to: (fpstate := processor floatingPointRegisterStateGetters) size by: 4 do:
[:index|
((index to: index + 3) allSatisfy: [:fpri| (processor perform: (fpstate at: fpri)) isZero]) ifTrue:
[exclude addAll: (fpstate copyFrom: index to: index + 3)]].
self registerSelectors do: [:selector |
(exclude includes: selector) ifFalse:
[s
nextPutAll: ((selector asUppercase padded: #right to: max with: Character space)
asText addAttribute: (PluggableTextAttribute evalBlock: [self interpret: selector]));
nextPutAll: ' = ';
nextPutAll: (self registerTextAt: selector);
cr]]]!

----- Method: CogProcessorAlienInspector>>wantsStepsIn: (in category 'stepping') -----
wantsStepsIn: window
^ true!

----- Method: CogProcessorAlienInspector>>windowTitle (in category 'accessing - ui') -----
windowTitle

^windowTitle ifNil: ['Register State of ', (String streamContents: [:s| processor printNameOn: s])]!

----- Method: CogProcessorAlienInspector>>windowTitle: (in category 'accessing - ui') -----
windowTitle: newTitle

windowTitle = newTitle ifTrue: [^ self].
windowTitle := newTitle.
self changed: #windowTitle.!

Model subclass: #SimulatorMorphicModel
instanceVariableNames: 'vm title stepping morph'
classVariableNames: ''
poolDictionaries: 'EventSensorConstants'
category: 'VMMakerUI-InterpreterSimulation-Morphic'!

!SimulatorMorphicModel commentStamp: 'eem 7/14/2015 17:07' prior: 0!
A SimulatorMorphicModel handles Morphic callbacks and UI for (some parts of ) the simulator.

I handle event forwarding management..

Currently, I am a listener to HandMorphs>>addPrimitiveEventListener.
I am added as a listener by SimulatorMorph>>displayView (which probably needs to change. tty)!

----- Method: SimulatorMorphicModel class>>initialize (in category 'class initialization') -----
initialize
"I want to keep it launchable by script only for now.
Eliot has a bunch of options that aren't really feasible for a Morphic first approach.
"
"self
registerWindowColor;
registerInOpenMenu;
registerInFlaps"!

----- Method: SimulatorMorphicModel class>>on:title:transcript: (in category 'instance creation') -----
on: aStackInterpreterSimulator title: aString transcript: aTranscriptStream
| simmodel |
simmodel := self new.
simmodel
vm: aStackInterpreterSimulator;
title: aString;
transcript: aTranscriptStream.
^simmodel. !

----- Method: SimulatorMorphicModel class>>registerInFlaps (in category 'class initialization') -----
registerInFlaps
" Flaps
registerQuad:
{ #StackInterpreterSimulator.
#prototypicalToolWindow.
'StackInterpreter Simulator' translated.
'A Morphic Wrapper for VM Simulations' translated }
forFlapNamed: 'Tools' translated.
Flaps replaceToolsFlap"!

----- Method: SimulatorMorphicModel class>>registerInOpenMenu (in category 'class initialization') -----
registerInOpenMenu
(TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [
TheWorldMenu unregisterOpenCommand: 'StackInterpreter Simulator'.
TheWorldMenu registerOpenCommand: {'StackInterpreter Simulator'. {self. #open}}].
!

----- Method: SimulatorMorphicModel class>>unload (in category 'class initialization') -----
unload
self
unregisterFromOpenMenu;
unregisterFromFlaps.!

----- Method: SimulatorMorphicModel class>>unregisterFromFlaps (in category 'class initialization') -----
unregisterFromFlaps
"Flaps
unregisterQuadsWithReceiver: self;
replaceToolsFlap"!

----- Method: SimulatorMorphicModel class>>unregisterFromOpenMenu (in category 'class initialization') -----
unregisterFromOpenMenu
(TheWorldMenu respondsTo: #registerOpenCommand:)
ifTrue: [TheWorldMenu unregisterOpenCommand: 'StackInterpreter Simulator'].
!

----- Method: SimulatorMorphicModel>>bounds (in category 'accessing') -----
bounds
^morph bounds.!

----- Method: SimulatorMorphicModel>>byteCountText (in category 'user interface') -----
byteCountText
^vm byteCountText!

----- Method: SimulatorMorphicModel>>currentContextStack (in category 'user interface - squeakJS') -----
currentContextStack
self flag: 'tty'.
^ 'Current Context Stack' printString asText!

----- Method: SimulatorMorphicModel>>defaultWindowColor (in category 'user interface') -----
defaultWindowColor
^ (Color r: 0.645 g: 1.0 b: 1.0)!

----- Method: SimulatorMorphicModel>>displayForm (in category 'accessing') -----
displayForm
^ vm displayForm!

----- Method: SimulatorMorphicModel>>displayView (in category 'accessing') -----
displayView
^ vm displayView!

----- Method: SimulatorMorphicModel>>displayView: (in category 'accessing') -----
displayView: anImageMorph
vm displayView: anImageMorph!

----- Method: SimulatorMorphicModel>>forceInterruptCheck (in category 'buttons callbacks') -----
forceInterruptCheck
vm forceInterruptCheck
"^UserDialogBoxMorph inform: 'Toggle Transcript' title: 'TODO:'"!

----- Method: SimulatorMorphicModel>>fullDisplayUpdate (in category 'buttons callbacks') -----
fullDisplayUpdate
vm fullDisplayUpdate
"^UserDialogBoxMorph inform: 'Toggle Transcript' title: 'TODO:'"!

----- Method: SimulatorMorphicModel>>hack (in category 'buttons callbacks') -----
hack
UserDialogBoxMorph inform: (morph bounds printString) title: 'Hack:'!

----- Method: SimulatorMorphicModel>>handleListenEvent: (in category 'event-forwarding') -----
handleListenEvent: aMorphicEvent
"The SimulatorImageMorph regsitered me (a SimulatorMorphicModel ) with HandMorph>>addEventListener
HandMorph then broadcasts events to all registered listeners at this method. See HandMorph>>sendListenPrimitiveEvent
"
morph ifNotNil:
[(SimulatorEventTransformer default degenerateEvent: aMorphicEvent) ifNotNil:
[:evtBuf|
((evtBuf at: 1) = EventTypeMouse and: [morph bounds containsPoint: aMorphicEvent position]) ifTrue:
[| xtranslated ytranslated |
xtranslated := (evtBuf at:3) - (morph bounds left) - 2 . "<--heh"
ytranslated := (evtBuf at:4) - (morph bounds top).
evtBuf at: 3 put: xtranslated.
evtBuf at: 4 put: ytranslated].
vm queueForwardedEvent: evtBuf]]!

----- Method: SimulatorMorphicModel>>help (in category 'buttons callbacks') -----
help
"Open up a workspace with explanatory info in it about the StackInterpreterSimulator"
Workspace new
contents: self helpText;
openLabel: self windowTitle, ' Help'.!

----- Method: SimulatorMorphicModel>>helpText (in category 'buttons callbacks') -----
helpText
^(String streamContents: [:str |
str nextPutAll:
'Stack Intepreter Simulator Help Contents Go Here.']) translated!

----- Method: SimulatorMorphicModel>>initialExtent (in category 'user interface') -----
initialExtent
^ 1286@938!

----- Method: SimulatorMorphicModel>>initialize (in category 'initialize-release') -----
initialize

title := 'StackInterpreter Simulator (Beta))'.!

----- Method: SimulatorMorphicModel>>ioExit (in category 'buttons callbacks') -----
ioExit
vm ioExit
displayView activeHand removeEventListener: self model. "This is a bug as the user in vm ioExit may have cancelled the confirm t.m."
"^UserDialogBoxMorph inform: 'Toggle Transcript' title: 'TODO:'"!

----- Method: SimulatorMorphicModel>>loadImage (in category 'buttons callbacks') -----
loadImage
^UserDialogBoxMorph inform: 'load image' title: 'TODO:'!

----- Method: SimulatorMorphicModel>>morph (in category 'accessing') -----
morph
"I need the bounds of my morph for filtering mouse events.
If there is a canned way of doing this besides this tight binding to my SimulatorMorph,
then please refactor me.

see my protocol event-forwarding for the gory details"
self flag:'tty'.
^morph.!

----- Method: SimulatorMorphicModel>>morph: (in category 'accessing') -----
morph: aMorph
"I need the bounds of my morph for filtering mouse events.
If there is a canned way of doing this besides this tight binding to my SimulatorMorph,
then please refactor me.

see my protocol event-forwarding for the gory details"
self flag:'tty'.
morph := aMorph.!

----- Method: SimulatorMorphicModel>>onItemClicked: (in category 'user interface - squeakJS') -----
onItemClicked: anItem
"I am an item in the current context display on the SqueakJS tree view".!

----- Method: SimulatorMorphicModel>>options (in category 'buttons callbacks') -----
options
^UserDialogBoxMorph inform: 'Options Popup--need checkboxes?' title: 'TODO:'!

----- Method: SimulatorMorphicModel>>over (in category 'buttons callbacks') -----
over
stepping:=true.
^UserDialogBoxMorph inform: 'Step Over' title: 'TODO:'!

----- Method: SimulatorMorphicModel>>processesAndContextStack (in category 'user interface - squeakJS') -----
processesAndContextStack
"just a stub. see top right panel at http://lively-web.org/users/bert/squeak.html for what I intend to present"
self flag: 'tty'.
^ 'Processes and ContextStack' printString asText
!

----- Method: SimulatorMorphicModel>>reset (in category 'buttons callbacks') -----
reset
^UserDialogBoxMorph inform: 'Reset' title: 'TODO:'!

----- Method: SimulatorMorphicModel>>return (in category 'buttons callbacks') -----
return
^UserDialogBoxMorph inform: 'Return' title: 'TODO:'!

----- Method: SimulatorMorphicModel>>run (in category 'buttons callbacks') -----
run
stepping:=false.
vm run
"^UserDialogBoxMorph inform: 'Run' title: 'TODO:'"!

----- Method: SimulatorMorphicModel>>send (in category 'buttons callbacks') -----
send
^UserDialogBoxMorph inform: 'Send' title: 'TODO:'!

----- Method: SimulatorMorphicModel>>specialObjectsAndActiveContext (in category 'user interface - squeakJS') -----
specialObjectsAndActiveContext
"just a stub. see top left panel at http://lively-web.org/users/bert/squeak.html for what I intend to present"
self flag: 'tty'.
^ 'Special Objects and Active Context' printString asText
!

----- Method: SimulatorMorphicModel>>step (in category 'buttons callbacks') -----
step
stepping:=true.
^UserDialogBoxMorph inform: 'Step' title: 'TODO:'!

----- Method: SimulatorMorphicModel>>stepping (in category 'accessing') -----
stepping
^stepping!

----- Method: SimulatorMorphicModel>>stepping: (in category 'accessing') -----
stepping: aBoolean
stepping := aBoolean!

----- Method: SimulatorMorphicModel>>title: (in category 'accessing') -----
title: aString
title := aString!

----- Method: SimulatorMorphicModel>>toggleTranscript (in category 'buttons callbacks') -----
toggleTranscript
vm toggleTranscriptForSimulatorMorph: self transcript.
"^UserDialogBoxMorph inform: 'Toggle Transcript' title: 'TODO:'"!

----- Method: SimulatorMorphicModel>>transcript (in category 'accessing') -----
transcript
^vm transcript!

----- Method: SimulatorMorphicModel>>transcript: (in category 'accessing') -----
transcript: aTranscriptStream
vm transcript: aTranscriptStream.!

----- Method: SimulatorMorphicModel>>utilitiesMenu: (in category 'user interface') -----
utilitiesMenu: aMenuMorph
^vm utilitiesMenu: aMenuMorph!

----- Method: SimulatorMorphicModel>>vm (in category 'accessing') -----
vm
^vm!

----- Method: SimulatorMorphicModel>>vm: (in category 'accessing') -----
vm: aVMSimulator
vm := aVMSimulator!

----- Method: SimulatorMorphicModel>>windowTitle (in category 'user interface') -----
windowTitle
^ title translated!

ImageMorph subclass: #SimulatorImageMorph
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'VMMakerUI-InterpreterSimulation-Morphic'!

!SimulatorImageMorph commentStamp: 'eem 7/15/2015 09:48' prior: 0!
A SimulatorImageMorph is an ImageMorph that suppresses halos.!

----- Method: SimulatorImageMorph>>extent: (in category 'geometry') -----
extent: aPoint
"Override to restore the default resizing behaviour."
^self perform: #extent: withArguments: {aPoint} inSuperclass: ImageMorph superclass!

----- Method: SimulatorImageMorph>>handleMouseDown: (in category 'event handling') -----
handleMouseDown: anEvent
anEvent wasHandled: true!

----- Method: SimulatorImageMorph>>handleMouseEnter: (in category 'event handling') -----
handleMouseEnter: anEvent
anEvent wasHandled: true!

----- Method: SimulatorImageMorph>>handleMouseLeave: (in category 'event handling') -----
handleMouseLeave: anEvent
^super handleMouseLeave: anEvent!

----- Method: SimulatorImageMorph>>handleMouseOver: (in category 'event handling') -----
handleMouseOver: anEvent
anEvent wasHandled: true!

----- Method: SimulatorImageMorph>>handleMouseUp: (in category 'event handling') -----
handleMouseUp: anEvent
anEvent wasHandled: true!

----- Method: SimulatorImageMorph>>handlerForMouseDown: (in category 'event handling') -----
handlerForMouseDown: anEvent
"Override all mouse button shenanigans like halos by handling any and all mouse down events."
^self!

SystemWindow subclass: #SimulatorMorph
instanceVariableNames: 'loadButton helpButton resetButton stepButton overButton sendButton returnButton runButton toggleTranscriptButton optionsButton transcriptPanel commandPanel contextPanel stackPanel callStackPanel displayForm displayView eventEncoder ioExitButton fullDisplayUpdateButton forceInterruptCheckButton hackButton'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMakerUI-InterpreterSimulation-Morphic'!

!SimulatorMorph commentStamp: 'eem 7/14/2015 17:06' prior: 0!
A SimulatorMorph is a copy of PreferenceBrowserMorph that has been mangled into something that will support the simulator. I provide some UI features inspired by Bert Freudenberg's Lively Squeak VM at http://lively-web.org/users/bert/squeak.html.

See class protocol 'documentation' for examples of invoking me.

My model is SimulatorMorphicModel.
My model has a reference to the Simulator and itermediates all (?) interaction with it.

The simulator renders the simulated World on a SimulatorImageMorph that I contain.

There is some cruft (tight coupling via direct references along all three layers UI-Model-VM) in me that exists to support Eliot's original Simulator>>openAsMorph functionality and use-case.
Rumors that said cruft is an artifact of tty's rudimentary Morphic skills are entirely credible.

I hold out the barest glimmer of hope that Bert Freudenberg's SqueakJS functionality can be integrated into my functionality as well.
see http://lively-web.org/users/bert/squeak.html for the inspiration.

I am not amenable to Flaps or the WorldMenu as there is a lot of pre-run configuration that is done to the Simulator prior to its being run.
Managing that ability with a GUI is counter-productive. If said functionality is desired in the future, then inspiration can be gleaned by cut-n-paste from PreferenceBrowser and PreferenceBrowserModel.!

----- Method: SimulatorMorph class>>ttyOne (in category 'documentation') -----
ttyOne
"Script tty uses to run the stackIntepreter using this class"
| vm |
Transcript clear.
vm := StackInterpreterSimulator newWithOptions: #(#STACKVM).
vm openOn: '/home/tty/usr/src/smalltalk/buildCogDevelopmentImageCog.app/Contents/Resources/targets/Squeak4.5.image'.
"vm setBreakSelector: #&."
vm
openAsSimulatorMorph ";
toggleTranscript;
halt;
run"
!

----- Method: SimulatorMorph class>>withVMSimulator:title:transcript: (in category 'instance creation') -----
withVMSimulator: aSimulatorMorphicModel title: aString transcript: aTranscript
^self new initializeWithVMSimulator: aSimulatorMorphicModel title: aString aTranscript: aTranscript;
yourself.

!

----- Method: SimulatorMorph>>basicButton (in category 'submorphs - buttons') -----
basicButton
| button |
button := SimpleButtonMorph new.
button
borderWidth: 2;
borderColor: #raised;
on: #mouseEnter send: #value to: [button borderColor: self paneColor];
on: #mouseLeave send: #value to: [button borderColor: #raised];
vResizing: #spaceFill;
useRoundedCorners;
clipSubmorphs: true;
color: self paneColor muchLighter;
target: self model.
^button!

----- Method: SimulatorMorph>>buttonRowLayoutFrame (in category 'submorphs - buttons') -----
buttonRowLayoutFrame
^LayoutFrame fractions: (0@0 corner: 1@0) offsets: (0@0 corner: 0@ (TextStyle defaultFont height * 2.5))
!

----- Method: SimulatorMorph>>callStackPanel (in category 'submorphs - squeakJS') -----
callStackPanel
"If any Morphic gurus exist, please have at it."
^callStackPanel ifNil:
[callStackPanel := (PluggableTextMorph
on: self model
text: #processesAndContextStack
accept: nil
readSelection: nil
menu: nil) hideScrollBarsIndefinitely.
callStackPanel
color: Color transparent;
hResizing: #spaceFill;
vResizing: #spaceFill;
cellInset: 5;
yourself].

!

----- Method: SimulatorMorph>>commandPanel (in category 'submorphs - simulator panel') -----
commandPanel
self flag: 'tty'. "does this hybrid of PreferenceBrowser layout and Simulato openAsMorph stuff make sense?"
^commandPanel ifNil:
[commandPanel := (PluggableTextMorph
on: self model vm
text: #byteCountText
accept: nil
readSelection: nil
menu: #utilitiesMenu:) hideScrollBarsIndefinitely.
commandPanel
color: Color transparent;
hResizing: #spaceFill;
vResizing: #spaceFill;
cellInset: 5;
yourself].
!

----- Method: SimulatorMorph>>contextPanel (in category 'submorphs - squeakJS') -----
contextPanel
"This should show the currentContext and Special Objects array. as seen at SqueakJS
Doing that requires real talent. talent tty is lacking at the moment
on: [ Array with: (MorphWithSubmorphsWrapper with: self) ]
Array with: (ObjectExplorerWrapper with: rootObject name: 'root' model: self parent: nil)
"
^contextPanel ifNil:
[contextPanel := (SimpleHierarchicalListMorph
on: [ Array with: (ObjectExplorerWrapper with: (self model vm) name: 'root' model: (self model vm) parent: nil) ]
list: #value
selected: nil
changeSelected: nil
menu: nil
keystroke: nil) showScrollBarsOnlyWhenNeeded: true.
contextPanel
color: Color transparent;
hResizing: #spaceFill;
vResizing: #spaceFill;
cellInset: 5;
yourself]

!

----- Method: SimulatorMorph>>displayView (in category 'submorphs - simulator display view') -----
displayView
"The VM SImulator draws directly on an imageMorph named displayView
displayView is housed on a Form named displayForm
displayForm is initialized in StackInterpreterSimulator >> initialize.
see StackInterpreterSimulator >>openAsMorph for original constructs."
^displayView ifNil:
[displayView := SimulatorImageMorph new image: model vm displayForm.
self model displayView: displayView.
self model morph: displayView. "<-- N.B.. morph bounds are used to filter events in the model. tty"
displayView activeHand addEventListener: self model.

displayView
color: Color transparent;
hResizing: #spaceFill;
vResizing: #spaceFill;
cellInset: 5;
yourself]!

----- Method: SimulatorMorph>>displayViewLayoutFrame (in category 'submorphs - simulator display view') -----
displayViewLayoutFrame
| squeakJSFrame buttonFrame simulatorFrame|
"if any Morphic guru's understand layouts and offsets, please fix this. tty"
buttonFrame := self buttonRowLayoutFrame.
squeakJSFrame := self squeakJSRowLayoutFrame.
simulatorFrame := self simulatorLayoutFrame.
^LayoutFrame fractions: (0@0 corner: 1@1)
offsets: (0@(buttonFrame bottomOffset) corner: simulatorFrame leftOffset@squeakJSFrame topOffset)!

----- Method: SimulatorMorph>>extent: (in category 'geometry') -----
extent: aPoint
super extent: aPoint.
self fullBounds.
!

----- Method: SimulatorMorph>>forceInterruptCheckButton (in category 'submorphs - buttons') -----
forceInterruptCheckButton
self flag: 'tty'.
^forceInterruptCheckButton ifNil:
[forceInterruptCheckButton := self basicButton
label: 'vm forceInterruptCheck' translated;
actionSelector: #forceInterruptCheck;
setBalloonText:
'Invoke forceInterruptCheck on Simulator.' translated]!

----- Method: SimulatorMorph>>fullDisplayUpdateButton (in category 'submorphs - buttons') -----
fullDisplayUpdateButton
self flag: 'tty'.
^fullDisplayUpdateButton ifNil:
[fullDisplayUpdateButton := self basicButton
label: 'vm fullDisplayUpdate' translated;
actionSelector: #fullDisplayUpdate;
setBalloonText:
'Invoke fullDisplayUpdate on Simulator.' translated]!

----- Method: SimulatorMorph>>hackButton (in category 'submorphs - buttons') -----
hackButton
self flag: 'tty'.
^hackButton ifNil:
[hackButton := self basicButton
label: 'Display ImageMorph Bounds' translated;
actionSelector: #hack;
setBalloonText:
'tty needs a hack button.' translated]!

----- Method: SimulatorMorph>>helpButton (in category 'submorphs - buttons') -----
helpButton
^helpButton ifNil:
[helpButton := self basicButton
label: 'help' translated;
setBalloonText:
'Click here to get some hints on use of me ',
'Panel' translated;
actionSelector: #help]!

----- Method: SimulatorMorph>>initializeWithVMSimulator:title:aTranscript: (in category 'initialization') -----
initializeWithVMSimulator: aStackInterpreterSimulator title: aString aTranscript: aTranscript
self flag: 'tty'. "need to get the layout right at this point. resizers and scroll bars would be nice. Layout offsets need a gimlet eye as well"
self
model: (SimulatorMorphicModel on: aStackInterpreterSimulator title: aString transcript: aTranscript);
clipSubmorphs: true;
setLabel: self model windowTitle;
name: aString;
addMorph: self newButtonRow fullFrame: self buttonRowLayoutFrame;
addMorph: self squeakJSRow fullFrame: self squeakJSRowLayoutFrame;
addMorph: self simulatorPanel fullFrame: self simulatorLayoutFrame;
addMorph: self displayView fullFrame: self displayViewLayoutFrame.
^self!

----- Method: SimulatorMorph>>ioExitButton (in category 'submorphs - buttons') -----
ioExitButton
self flag: 'tty'.
^ioExitButton ifNil:
[ioExitButton := self basicButton
label: 'vm ioExit' translated;
actionSelector: #ioExit;
setBalloonText:
'Invoke ioExit on Simulator.' translated]!

----- Method: SimulatorMorph>>loadButton (in category 'submorphs - buttons') -----
loadButton
^loadButton ifNil:
[loadButton := self basicButton
label: 'Load Image' translated;
actionSelector: #loadImage;
setBalloonText:
'Select an image to load.' translated]!

----- Method: SimulatorMorph>>newButtonRow (in category 'submorphs - buttons') -----
newButtonRow
^BorderedMorph new
color: Color transparent;
cellInset: 2;
layoutInset: 2;
layoutPolicy: TableLayout new;
listDirection: #leftToRight;
listCentering: #topLeft;
cellPositioning: #topLeft;
on: #mouseEnter send: #paneTransition: to: self;
on: #mouseLeave send: #paneTransition: to: self;
addMorphBack: self hackButton;
addMorphBack: self newSeparator;

" addMorphBack: self resetButton;
addMorphBack: self newSeparator;
addMorphBack: self forceInterruptCheckButton;
addMorphBack: self newSeparator;
addMorphBack: self fullDisplayUpdateButton;
addMorphBack: self newSeparator;
addMorphBack: self toggleTranscriptButton;"
addMorphBack: self runButton;
addMorphBack: self newSeparator;
addMorphBack: self ioExitButton;
addMorphBack: self newTransparentFiller;
addMorphBack: self stepButton;
addMorphBack: self newSeparator;
addMorphBack: self overButton;
addMorphBack: self newSeparator;
addMorphBack: self newSeparator;
addMorphBack: self sendButton;
addMorphBack: self newSeparator;
addMorphBack: self returnButton;
addMorphBack: self newTransparentFiller;
" addMorphBack: self loadButton;
addMorphBack: self newSeparator;
addMorphBack: self optionsButton; too complex to implement now. See StackInterpreterSimulator class comment for examples"
addMorphBack: self newTransparentFiller;
addMorphBack: self helpButton;
yourself.!

----- Method: SimulatorMorph>>newSeparator (in category 'submorphs - buttons') -----
newSeparator
^BorderedMorph new
borderWidth: 2;
borderColor: Color transparent;
color: self paneColor;
hResizing: #rigid;
width: 5;
vResizing: #spaceFill;
yourself!

----- Method: SimulatorMorph>>newTransparentFiller (in category 'submorphs - buttons') -----
newTransparentFiller
^Morph new
color: Color transparent;
vResizing: #spaceFill;
hResizing: #spaceFill;
yourself.!

----- Method: SimulatorMorph>>optionsButton (in category 'submorphs - buttons') -----
optionsButton
^optionsButton ifNil:
[optionsButton := self basicButton
label: 'VM Options' translated;
actionSelector: #options;
setBalloonText:
'VM Options.' translated]!

----- Method: SimulatorMorph>>overButton (in category 'submorphs - buttons') -----
overButton
^overButton ifNil:
[overButton := self basicButton
label: 'Over' translated;
actionSelector: #over;
setBalloonText:
'Step Over.' translated]!

----- Method: SimulatorMorph>>resetButton (in category 'submorphs - buttons') -----
resetButton
^resetButton ifNil:
[resetButton := self basicButton
label: 'Reset' translated;
actionSelector: #reset;
setBalloonText:
'Reset running simulation.' translated]!

----- Method: SimulatorMorph>>returnButton (in category 'submorphs - buttons') -----
returnButton
self flag: 'tty'.
^returnButton ifNil:
[returnButton := self basicButton
label: 'Return' translated;
actionSelector: #return;
setBalloonText:
'Return from what?.' translated]!

----- Method: SimulatorMorph>>runButton (in category 'submorphs - buttons') -----
runButton
self flag: 'tty'.
^runButton ifNil:
[runButton := self basicButton
label: 'vm run' translated;
actionSelector: #run;
setBalloonText:
'Run Simulation.' translated]!

----- Method: SimulatorMorph>>sendButton (in category 'submorphs - buttons') -----
sendButton
self flag: 'tty'.
^sendButton ifNil:
[sendButton := self basicButton
label: 'Send' translated;
actionSelector: #send;
setBalloonText:
'Send what exactly?.' translated]!

----- Method: SimulatorMorph>>simulatorLayoutFrame (in category 'submorphs - simulator panel') -----
simulatorLayoutFrame
| squeakJSFrame buttonFrame |
"I don't understand offsets in the LayoutFrame. I just fiddled until it looked ok. If anybody knows what they are doing, please refactor."
self flag: 'tty'.
buttonFrame := self buttonRowLayoutFrame.
squeakJSFrame := self squeakJSRowLayoutFrame.
^LayoutFrame fractions: (0.7@0 corner: 1@squeakJSFrame topOffset)
offsets: (0@(buttonFrame bottomOffset) corner: 0.70@squeakJSFrame topOffset)
!

----- Method: SimulatorMorph>>simulatorPanel (in category 'submorphs - simulator panel') -----
simulatorPanel
"standard controls from StackInterpreterSimulator >> openAsMorph"
^BorderedMorph new
color: Color transparent;
layoutInset: 10;
cellInset: 10;
layoutPolicy: TableLayout new;
listDirection: #topToBottom;
listCentering: #topLeft;
cellPositioning: #topLeft;
on: #mouseEnter send: #paneTransition: to: self;
on: #mouseLeave send: #paneTransition: to: self;
addMorphBack: self transcriptPanel;
addMorphBack: self commandPanel;
yourself.!

----- Method: SimulatorMorph>>squeakJSRow (in category 'submorphs - squeakJS') -----
squeakJSRow
"row fo SqueakJS context, stack and call-stack panels"
^BorderedMorph new
color: Color blue;
cellInset: 2;
layoutInset: 2;
layoutPolicy: TableLayout new;
listDirection: #leftToRight;
listCentering: #topLeft;
cellPositioning: #topLeft;
on: #mouseEnter send: #paneTransition: to: self;
on: #mouseLeave send: #paneTransition: to: self;
addMorphBack: self callStackPanel;
addMorphBack: self contextPanel;
addMorphBack: self stackPanel;
yourself.!

----- Method: SimulatorMorph>>squeakJSRowLayoutFrame (in category 'submorphs - squeakJS') -----
squeakJSRowLayoutFrame
^LayoutFrame fractions: (0@0.8 corner: 1@1) offsets: (0@0.8 corner: 1@ (TextStyle defaultFont height * 2.5))
!

----- Method: SimulatorMorph>>stackPanel (in category 'submorphs - squeakJS') -----
stackPanel
"If any Morphic gurus exist, please have at it."
^stackPanel ifNil:
[stackPanel := (PluggableTextMorph
on: self model
text: #currentContextStack
accept: nil
readSelection: nil
menu: nil) hideScrollBarsIndefinitely.
stackPanel
color: Color transparent;
hResizing: #spaceFill;
vResizing: #spaceFill;
cellInset: 5;
yourself].

!

----- Method: SimulatorMorph>>stepButton (in category 'submorphs - buttons') -----
stepButton
self flag: 'tty'.
^stepButton ifNil:
[stepButton := self basicButton
label: 'Step' translated;
actionSelector: #step;
setBalloonText:
'Step Into.' translated]!

----- Method: SimulatorMorph>>toggleTranscriptButton (in category 'submorphs - buttons') -----
toggleTranscriptButton
"tty I dont like this. I have diabled the button"
self flag: 'tty'.
^toggleTranscriptButton ifNil:
[toggleTranscriptButton := self basicButton
label: 'Toggle Transcript' translated;
actionSelector: #toggleTranscript;
setBalloonText:
'Use External Transcript Instead of Internal.' translated]!

----- Method: SimulatorMorph>>transcriptPanel (in category 'submorphs - simulator panel') -----
transcriptPanel
self flag: 'tty'. "does this hybrid of PreferenceBrowser layout and Simulato openAsMorph stuff make sense?"
^transcriptPanel ifNil:
[transcriptPanel := (PluggableTextMorph
on: self model vm transcript
text: nil
accept: nil
readSelection: nil
menu: #codePaneMenu:shifted:).
transcriptPanel
name: 'transcriptPanel';
color: Color transparent;
hResizing: #spaceFill;
vResizing: #spaceFill;
cellInset: 5;
yourself].
!

TestCase subclass: #SimulatorMorphicEventTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: 'EventSensorConstants'
category: 'VMMakerUI-InterpreterSimulation-Morphic'!

----- Method: SimulatorMorphicEventTests>>testKeyEventDegeneration (in category 'test event') -----
testKeyEventDegeneration
|aMorphicEvent evtBuf type|
aMorphicEvent := HandMorph new generateKeyboardEvent: {2 . 0. 0. 0. 0. 0. 0. 0}.
evtBuf := SimulatorEventTransformer default degenerateEvent: aMorphicEvent.
type := evtBuf at:1.
self assert:(type = EventTypeKeyboard).
!

----- Method: SimulatorMorphicEventTests>>testMouseEventDegeneration (in category 'test event') -----
testMouseEventDegeneration
|aMorphicEvent evtBuf type|
"see class comment in EventSensor browse"
aMorphicEvent := HandMorph new generateMouseEvent: {1 . 0. 0. 0. 0. 0. 0. 0}.
evtBuf := SimulatorEventTransformer default degenerateEvent: aMorphicEvent.
type := evtBuf at:1.
self assert:(type = EventTypeMouse).
!

----- Method: SimulatorMorphicEventTests>>testNullEventDegeneration (in category 'test event') -----
testNullEventDegeneration
|aMorphicEvent evtBuf type|
"Test a bad morphic event returns a null event" "see class comment in EventSensor browse"
aMorphicEvent := UserInputEvent new.
evtBuf := SimulatorEventTransformer default degenerateEvent: aMorphicEvent.
type := evtBuf at:1.
self assert:(type = EventTypeNone).

!

----- Method: SimulatorMorphicEventTests>>testSimulatorDisplayViewAccess (in category 'test tight coupling') -----
testSimulatorDisplayViewAccess
"There is tight coupling between the morph,model and vm simulator on the simulators displayView variable
this test makes sure it is accesible and is an ImageMorph."

self assert: ((SystemNavigation allImplementorsOf: #displayView localTo: StackInterpreterSimulator) size = 1).
self assert: ((SystemNavigation allImplementorsOf: #displayView: localTo: StackInterpreterSimulator)size = 1).

!

----- Method: SimulatorMorphicEventTests>>testStackInterpreterSimulatorDisplayViewAccess (in category 'test tight coupling') -----
testStackInterpreterSimulatorDisplayViewAccess
"There is tight coupling between the morph,model and vm simulator on the simulators displayView variable
this test makes sure it is accesible and is an ImageMorph."

self assert: ((SystemNavigation allImplementorsOf: #displayView localTo: StackInterpreterSimulator) size = 1).
self assert: ((SystemNavigation allImplementorsOf: #displayView: localTo: StackInterpreterSimulator)size = 1).

!

----- Method: CogVMSimulator>>openAsMorph (in category '*VMMakerUI-InterpreterSimulation-Morphic') -----
openAsMorph
"Open a morphic view on this simulation."
| localImageName borderWidth window |
localImageName := imageName
ifNotNil: [self localNameFor: imageName]
ifNil: [' synthetic image'].
window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
window paneColor: self windowColorToUse.

window addMorph: (displayView := SimulatorImageMorph new image: displayForm)
frame: (0@0 corner: 1@0.8).
displayView activeHand addEventListener: self.
eventTransformer := SimulatorEventTransformer new.

transcript := TranscriptStream on: (String new: 10000).
window addMorph: (PluggableTextMorph
on: transcript text: nil accept: nil
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0@0.8 corner: 0.7@1).
window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0.7@0.8 corner: 1@1).

borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
on: MessageNotUnderstood
do: [:ex| 0]. "3.8"
borderWidth := borderWidth + window borderWidth.
window openInWorldExtent: (self desiredDisplayExtent
+ (2 * borderWidth @ borderWidth)
+ (0@window labelHeight)
* (1@(1/0.8))) rounded.
^window!

----- Method: CogVMSimulator>>openAsMorphNoTranscript (in category '*VMMakerUI-InterpreterSimulation-Morphic') -----
openAsMorphNoTranscript
"Open a morphic view on this simulation."
| localImageName borderWidth window |
localImageName := imageName
ifNotNil: [self localNameFor: imageName]
ifNil: [' synthetic image'].
window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
window paneColor: self windowColorToUse.

window addMorph: (displayView := SimulatorImageMorph new image: displayForm)
frame: (0@0 corner: 1@0.95).
displayView activeHand addEventListener: self.
eventTransformer := SimulatorEventTransformer new.

window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0@0.95 corner: 1@1).

borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
on: MessageNotUnderstood
do: [:ex| 0]. "3.8"
borderWidth := borderWidth + window borderWidth.
window openInWorldExtent: (self desiredDisplayExtent
+ (2 * borderWidth@borderWidth)
+ (0@window labelHeight)
* (1@(1/0.95))) rounded!

Object subclass: #SimulatorEventTransformer
instanceVariableNames: 'buttons modifiers'
classVariableNames: 'Default'
poolDictionaries: 'EventSensorConstants'
category: 'VMMakerUI-InterpreterSimulation-Morphic'!

!SimulatorEventTransformer commentStamp: 'eem 7/14/2015 17:05' prior: 0!
A SimulatorEventTransformer takes events as wrapped by HandMorph and converts them to a form a StackInterpreterSimulator can deal with.

See HandMorph >> handleEvent to see what the wrapping entails.
See HandMorph >> ProcessEvents or EventSensor >> fetchMoreEvents for examples of what an unwrapped event looks like when given to the system for pre-wrapping.

Instance Variables
!

----- Method: SimulatorEventTransformer class>>default (in category 'initialize-release') -----
default
^Default ifNil:[Default := self new]!

----- Method: SimulatorEventTransformer class>>eventTypeMouse (in category 'accessing') -----
eventTypeMouse
^EventTypeMouse!

----- Method: SimulatorEventTransformer>>degenerateEvent: (in category 'event transformation') -----
degenerateEvent: aMorphicEvent
"tty. Bert had mentioned a distinction between events and polling events and that Morphic could handle both.
I don't know what he is talking about."
aMorphicEvent isMouse ifTrue:
[^self degenerateMouseEvent: aMorphicEvent].
aMorphicEvent isKeyboard ifTrue:
[^self degenerateKeyboardEvent: aMorphicEvent].
" type = EventTypeDragDropFiles ifTrue: [evt := self generateDropFilesEvent: evtBuf].
type = EventTypeWindow ifTrue:[evt := self generateWindowEvent: evtBuf]."

^nil!

----- Method: SimulatorEventTransformer>>degenerateEvent:for: (in category 'event transformation') -----
degenerateEvent: aMorphicEvent for: client
"Handle ''degenerating'' events for aClient. This interface gets the client
to queue the event via queueForwardedEvent:, and may generate more
than one event for the input event (i.e. a fake mouse move before a
button down), in addition to filtering-out excessive mouse moves."
aMorphicEvent isMouse ifTrue:
[^self degenerateMouseEvent: aMorphicEvent for: client].
aMorphicEvent isKeyboard ifTrue:
[^self degenerateKeyboardEvent: aMorphicEvent for: client].
^self degenerateUnknownEvent: aMorphicEvent for: client!

----- Method: SimulatorEventTransformer>>degenerateKeyboardEvent: (in category 'event transformation') -----
degenerateKeyboardEvent: aMorphicEvent
"see HandMorph>>generateKeyboardEvent and EventSensor class comment"
^{ 2.
aMorphicEvent timeStamp.
aMorphicEvent keyValue. "<--this is wrong. See Sensor FirstEvt: for what needs to happen. hooo boy"
aMorphicEvent type caseOf: {
[#keyDown] -> [EventKeyDown].
[#keyUp] -> [EventKeyUp].
[#keystroke] -> [EventKeyChar] }.
modifiers.
aMorphicEvent keyValue.
0.
0 }!

----- Method: SimulatorEventTransformer>>degenerateKeyboardEvent:for: (in category 'event transformation') -----
degenerateKeyboardEvent: aMorphicEvent for: aClient
"Convert the keyboard event into a low-level event for the VM simulator (aClient).
See HandMorph>>generateKeyboardEvent and EventSensor class comment"
aClient queueForwardedEvent:
{ 2.
aMorphicEvent timeStamp.
aMorphicEvent keyValue. "<--this is wrong. See Sensor FirstEvt: for what needs to happen. hooo boy"
aMorphicEvent type caseOf: {
[#keyDown] -> [EventKeyDown].
[#keyUp] -> [EventKeyUp].
[#keystroke] -> [EventKeyChar] }.
modifiers.
aMorphicEvent keyValue.
0.
self windowIndex }!

----- Method: SimulatorEventTransformer>>degenerateMouseEvent: (in category 'event transformation') -----
degenerateMouseEvent: aMorphicEvent
"see HandMorph>>generateMouseEvent"

modifiers := aMorphicEvent buttons >> 3. "Sad, but modifiers come in on mouse move events..."
aMorphicEvent type == #mouseMove
ifTrue: [buttons = 0 ifTrue: [^nil]] "filter-out mouse moves unless buttons are pressed, so simulation doersn't get window leave events when we leave its window"
ifFalse: [buttons := aMorphicEvent buttons].
^{ 1.
aMorphicEvent timeStamp.
aMorphicEvent position x.
aMorphicEvent position y.
buttons bitAnd: 7. "thanks Ron T."
buttons >> 3. "Thanks dtl"
0.
0 }!

----- Method: SimulatorEventTransformer>>degenerateMouseEvent:for: (in category 'event transformation') -----
degenerateMouseEvent: aMorphicEvent for: aClient
"Convert the mouse event into low-level events for the VM simulator (aClient). Filter-out mouse moves,
and generate a fake mouse move before each button press.
See HandMorph>>generateMouseEvent"
| translated |
translated := aMorphicEvent position - aClient displayView bounds origin.
modifiers := aMorphicEvent buttons >> 3. "Sad, but modifiers come in on mouse move events..."

aMorphicEvent type == #mouseMove
ifTrue: "filter-out mouse moves unless buttons are pressed, so simulation doesn't get window leave events when we leave its window"
[buttons = 0 ifTrue: [^nil]]
ifFalse:"If the buttons are going down, make sure to add a mouse move event to the current position before the buttons are pressed."
[((buttons bitAnd: 7) = 0 and: [(aMorphicEvent buttons bitAnd: 7) ~= 0]) ifTrue:
[aClient queueForwardedEvent:
{ 1.
aMorphicEvent timeStamp.
translated x.
translated y.
0.
buttons >> 3. "Thanks dtl"
0.
self windowIndex }].
buttons := aMorphicEvent buttons].
aClient queueForwardedEvent:
{ 1.
aMorphicEvent timeStamp.
translated x.
translated y.
buttons bitAnd: 7. "thanks Ron T."
buttons >> 3. "Thanks dtl"
0.
self windowIndex }!

----- Method: SimulatorEventTransformer>>initialize (in category 'initialize-release') -----
initialize
buttons := modifiers := 0!

----- Method: SimulatorEventTransformer>>windowIndex (in category 'event transformation') -----
windowIndex
^1!

Inspector subclass: #VMObjectInspector
instanceVariableNames: 'memory coInterpreter objectMemory cogit'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMakerUI-SqueakInspectors'!

----- Method: VMObjectInspector class>>memory:coInterpreter:objectMemory: (in category 'instance creation') -----
memory: aByteArray coInterpreter: aStackInterpreter objectMemory: anObjectMemory
^self new memory: aByteArray coInterpreter: aStackInterpreter objectMemory: anObjectMemory cogit: nil!

----- Method: VMObjectInspector class>>memory:coInterpreter:objectMemory:cogit: (in category 'instance creation') -----
memory: aByteArray coInterpreter: aStackInterpreter objectMemory: anObjectMemory cogit: aCogit
^self new memory: aByteArray coInterpreter: aStackInterpreter objectMemory: anObjectMemory cogit: aCogit!

----- Method: VMObjectInspector>>memory:coInterpreter:objectMemory:cogit: (in category 'initialization') -----
memory: aByteArray coInterpreter: aStackInterpreter objectMemory: anObjectMemory cogit: aCogit
memory := aByteArray.
coInterpreter := aStackInterpreter.
objectMemory := anObjectMemory.
cogit := aCogit!

----- Method: StackInterpreterSimulator>>openAsMorph (in category '*VMMakerUI-InterpreterSimulation-Morphic') -----
openAsMorph
"Open a morphic view on this simulation."
| localImageName borderWidth window |
localImageName := imageName
ifNotNil: [self localNameFor: imageName]
ifNil: [' synthetic image'].
window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
window paneColor: self windowColorToUse.

window addMorph: (displayView := SimulatorImageMorph new image: displayForm)
frame: (0@0 corner: 1@0.8).
displayView activeHand addEventListener: self.
eventTransformer := SimulatorEventTransformer new.

transcript := TranscriptStream on: (String new: 10000).
window addMorph: (PluggableTextMorph
on: transcript text: nil accept: nil
readSelection: nil menu: #codePaneMenu:shifted:)
frame: (0@0.8 corner: 0.7@1).
window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0.7@0.8 corner: 1@1).

borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
on: MessageNotUnderstood
do: [:ex| 0]. "3.8"
borderWidth := borderWidth + window borderWidth.
window openInWorldExtent: (self desiredDisplayExtent
+ (2 * borderWidth@borderWidth)
+ (0@window labelHeight)
* (1@(1/0.8))) rounded.
^window!

----- Method: StackInterpreterSimulator>>openAsMorphNoTranscript (in category '*VMMakerUI-InterpreterSimulation-Morphic') -----
openAsMorphNoTranscript
"Open a morphic view on this simulation."
| localImageName borderWidth window |
localImageName := imageName
ifNotNil: [self localNameFor: imageName]
ifNil: [' synthetic image'].
window := (SystemWindow labelled: 'Simulation of ', localImageName) model: self.
window paneColor: self windowColorToUse.

window addMorph: (displayView := SimulatorImageMorph new image: displayForm)
frame: (0@0 corner: 1@0.95).
displayView activeHand addEventListener: self.
eventTransformer := SimulatorEventTransformer new.

window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu: #utilitiesMenu:) hideScrollBarsIndefinitely
frame: (0@0.95 corner: 1@1).

borderWidth := [SystemWindow borderWidth] "Squeak 4.1"
on: MessageNotUnderstood
do: [:ex| 0]. "3.8"
borderWidth := borderWidth + window borderWidth.
window openInWorldExtent: (self desiredDisplayExtent
+ (2 * borderWidth@borderWidth)
+ (0@window labelHeight)
* (1@(1/0.95))) rounded!

----- Method: StackInterpreterSimulator>>openAsSimulatorMorph (in category '*VMMakerUI-InterpreterSimulation-Morphic') -----
openAsSimulatorMorph
"Open a morphic view on this simulation. ala Bert Freudenberg's
SqueakJS http://lively-web.org/users/bert/squeak.html "
| localImageName borderWidth window |
localImageName := imageName
ifNil: [' synthetic image']
ifNotNil: [self localNameFor: imageName].

transcript := TranscriptStream on: (String new: 10000).

window := SimulatorMorph
withVMSimulator: self
title: 'Simulation of ' , localImageName, ' (beta)'
transcript: transcript.

borderWidth := [SimulatorMorph borderWidth] "Squeak 4.1"
on: MessageNotUnderstood
do: [:ex | 0].
"3.8"
borderWidth := borderWidth + window borderWidth.
window openInWorldExtent: (self desiredDisplayExtent + (2 * borderWidth) + (0 @ window labelHeight) * (1 @ (1 / 0.8))) rounded.
^window!