How to remove an attachMorph of HandleMorph in smalltalk from self - smalltalk

i need your help
i am creating a line from a spesific location to mouse location with this code.
after click i am trying to remove this line but i have no idea how
please help me remove the live after click what should i change ?
stk:= (LineMorph from: 100#100 to: 1300#1300 color: Color red width: 2) openInWorld.
handle := HandleMorph new forEachPointDo: [:newPoint | stk setVertices: {whiteBallinHole position. (newPoint-(10#10)). }.
stk on: #mouseDown send: #value: to:[:evt|
evt redButtonPressed ifTrue:[ self handlesMouseDown: evt.
"DELETE THE STICK AFTER MOUSE CLICK THIS DOSNT WORK PLEASE HELP"
stk color: Color transparent.
stk delete.
""
].
].
].
" (self currentHand attachMorph: handle)."
" self currentHand addMorph:handle. "
self currentHand attachMorph:handle.

The code is a bit of a mess. One thing that is out of place is
self handlesMouseDown: evt.
That is supposed to return true if you want to receive mouseDown: messages.
In a workspace, that self does not exist. And the result is never used. Just delete it. The resulting code would be something like
whiteBallinHole := CircleMorph new openInWorld .
stk := (LineMorph
from: 100#100 to: 1300#1300
color: Color red
width: 4) openInWorld.
handle := HandleMorph new forEachPointDo: [ :newPoint |
stk setVertices: {whiteBallinHole center. (newPoint-(10#10)). }.
stk on: #mouseDown send: #value: to: [:evt|
evt redButtonPressed ifTrue:[
stk color: Color transparent.
stk delete]]].
self currentHand attachMorph: handle.

Related

How to add a bounding box to a composite shape in Roassal 3?

I'm trying to draw a bounding box around a group of shapes. I get everything in the scene, but I don't know how to make the bounding box and the text get correctly aligned:
c := RSCanvas new.
text := RSGroup new.
foo := RSLabel new text: 'foo'.
bar := RSLabel new text: 'bar'.
text add: foo; add: bar.
RSVerticalLineLayout on: text.
bound := RSShapeFactory box
model: self;
border: (RSBorder new width: 1; color: Color black);
cornerRadius: 5;
width: text encompassingRectangle width + 15;
height: text encompassingRectangle height + 10.
all := RSComposite new shapes: { bound. text asShape }.
c add: all.
c # RSCanvasController.
^ c
So here is how I did it. The missing key point was to put an RSLocation.
c := RSCanvas new.
text := RSGroup new.
foo := RSLabel new text: 'foo'.
bar := RSLabel new text: 'bar'.
text add: foo; add: bar.
RSVerticalLineLayout on: text.
bound := RSShapeFactory box
model: self;
border: (RSBorder new width: 1; color: Color black);
cornerRadius: 5;
width: text encompassingRectangle width + 15;
height: text encompassingRectangle height + 10.
contents := text asShape.
all := RSComposite new shapes: { bound. contents }.
RSLocation new center; outer; stick: contents on: bound.
c add: all.
c # RSCanvasController.
^ c
here is another solution
text := 'Foo
bar'.
label := RSMultilineLabelBuilder new shapeFor: text.
box := RSBox new
fromRectangle: label encompassingRectangle;
cornerRadius: 10;
noPaint
withBorder.
box extent: box extent + 15.
all := { box . label} asGroup asShape.
canvas := RSCanvas new.
canvas add: all.
canvas # RSCanvasController
Maybe in a future we can add an extension method for strings 'hello world' asRoassalShape.

Adding Text to a Smalltalk Cell

I'm doing a project in which I am adapting the Lights Out program in Pharo to a Minesweeper program, but I can't figure out how to add text to the cells so it shows up on-click like the color change does when it's "turned on". I've looked everywhere for a method for it with no dice.
Initialization method:
initialize
super initialize.
self label: ''.
self borderWidth: 4.
mineState := false.
cellValue := 0.
bounds := 0#0 corner: 32#32.
offColor := Color paleYellow.
onColor := Color paleBlue darker.
self useSquareCorners.
self turnOff
New Cell code:
newCellAt: i at: j
"Create a cell for position (i,j) and add it to my on-screen
representation at the appropriate screen position. Answer the new cell"
| c origin |
c := MFCell new.
"self labelString: 'hidden'."
origin := self innerBounds origin.
self addMorph: c.
c position: ((i - 1) * c width) # ((j - 1) * c height) + origin.
c mouseAction: [self checkMineAt: i at: j].
^ c
Maybe you are approaching your issue in too complex manner. You need to overload two selectors and you are done (not with the minesweeper, but the string on Cell).
I have taken the original code and just applied the label.
You have to just redefine turnOn and turnOff, which are in SimpleSwitchMorph which you are using, and apply a selector label: which can be found in super class SimpleButtonMorph. You can even have the same logic as the in the superclass.
In LOCell you can do (create a new protocol switching for them):
turnOn
super turnOn.
self label: 'X'
turnOff
super turnOff.
self label: ''
When running the example now, the X String will be added to the cells that are turned on.
It will look like this:
The protocol:
The morph now:

Add imagemorph to rectangle

I have a rectangle in smalltalk like this
cell := RectangleMorph new
extent: 70#70;
position: (500 + (aPositionWidth))#(100 + (aPositionHeight));
color: lastCellColor.
I'm trying to add an image to each rectangle like this:
queen := ImageReadWriter formFromFileNamed: '9813.gif'.
cell addMorph: queen.
queen position: cell position.
It's not working how can I add an image?
Thank you in advanced
ImageReadWriter class>>formFromFileNamed: returns a Form object. A form doesn't understand #position:. You need to convert it first to a morph. Try:
queen := (ImageReadWriter formFromFileNamed: 'queen.jpg') asMorph.

Make edges not clickable in Roassal visualization from within a Glamour browser

I draw a dynamic callgraph with Roassal from within a Glamour browser in Pharo 2.0.
By default not only the nodes, but also the edges are clickable.
As i have no further information to display for the edges, i want them not to be clickable. How do i remove the "clickability"?
That's how i draw the callgraph from within a Glamour browser:
methodsUnderTestAsCallGraphIn: constructor
constructor roassal
painting: [ :view :testFailure |
view shape rectangle
size: 30;
fillColor: ThreeColorLinearNormalizer new.
view nodes: (tests methodsUnderTest: testFailure).
view shape arrowedLine.
view edges: (tests methodsUnderTest: testFailure) from: #yourself toAll: #outgoingCalls.
view treeLayout ];
title: 'Callgraph of methods under test'
I think GLMRoassalPresentation>>renderOn: is responsible for adding the "clickability":
[...]
self shouldPopulateSelection ifTrue: [
aView raw allElementsDo: [:each |
each on: ROMouseClick do: [:event | self selection: each model ]] ].
[...]
I want to to keep this behaviour for the nodes, but not for the edges.
It helps to have a self contained example to clarify the behaviour you want, so I've re-framed your question.
With the two commented-out lines , I guess is the behaviour you don't want. Does uncommmenting those two lines provide the behaviour you want?
browser := GLMTabulator new.
browser column: #myRoassal ; column: #mySelection.
browser transmit
to: #myRoassal ;
andShow:
[ : aGLMPresentation |
aGLMPresentation roassal
painting:
[ : view : numbers | |edges|
view shape rectangle ; withText ; size: 30.
view nodes: numbers.
view interaction noPopup.
view edges: numbers from: [ :x | x / 2] to: [ :x | x ].
" view edges do: [ :edge | edge model:#doNotSelectMe ]."
view treeLayout.
].
].
browser transmit
to: #mySelection ;
from: #myRoassal ;
" when: [ :selection | selection ~= #doNotSelectMe ] ;"
andShow:
[ : aGLMPresentation |
aGLMPresentation text
display: [ : selectedItem | selectedItem asString ]
].
browser openOn: (1 to: 10).
Unfortunately, this is not possible at the moment because the clicking is hardcoded in GLMRoassalPresentation. However, you are right that we should find a solution, so I opened an issue:
http://code.google.com/p/moose-technology/issues/detail?id=981
I am not sure what you mean by "clickability". You have no interaction defined, so the default interaction is a simple popup. If you want to remove the popup, then just insert a "view interaction noPopup". Try this in a fresh Roassal easel:
view shape rectangle size: 40.
view nodes: #(1 2).
view interaction noPopup.
view edgesFrom: 1 to: 2.

How to get vertical labels with Roassal?

I could not find a way to get vertical labels in a Roassal visualization. Is there a way? Or a general way to rotate elements?
The new version, Roassal2, does supports rotated labels.
In the case of the example above, now you can do:
| view |
view := RTView new.
-15 to: 10 do: [ :i |
view add: ((RTRotatedLabel new angleInDegree: -90) elementOn: 'hello world').
].
RTHorizontalLineLayout on: view elements.
view open
You will get:
Another example:
| v shape |
v := RTView new.
shape := RTRotatedLabel new.
shape angleInDegree: [ :cls | cls numberOfMethods negated / 1.5 ].
shape text: [ :cls | ' ', cls name ].
shape color: (Color black alpha: 0.2).
v addAll: (shape elementsOn: Collection withAllSubclasses).
v canvas color: Color white.
v open
You will have:
I hope it helps :-)
Currently, Roassal does not support such a feature. However you can get something close to.
| view |
view := ROView new.
-15 to: 10 do: [ :i |
view add: ((ROLabel verticalText interlineSpace: i) elementOn: 'hello world').
].
ROHorizontalLineLayout on: view elements.
view open
In Roassal 1.422