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

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.

Related

Graphivz does not render edge label when it's connecting two nodes with shape=point

I have the following graph description:
graph G {
{rank=same a b}
a[shape=point]
b[shape=point]
a -- b [label=e];
}
However, it outputs a single edge without a label (running graphviz with dot -Tpdf -o test.pdf test.dot):
Rendering to PNG yields same result. If I render it to PDF and then look for an "e" in the document, the following are is highlighted:
So, the edge label is here but it's invisible somewhy.
Surprisingly, if I switch rank direction, everything works:
graph G {
rankdir=LR;
a[shape=point]
b[shape=point]
a -- b [label=e];
}
Not an answer really as I cannot provide any explanation but what I have observed is: As long as there is any other character / label rendered in the graph,
the e will also be rendered.
Interestingly enough this even applies for labels that are explicitly set to invisible, so if you compile
graph G
{
{ rank=same; a; b; }
a [ shape = point ];
b [ shape = point ];
a -- b [ label = "e" ];
\\ add this
c [ style = invis ];
}
you get what you want:
The graph area will increase, though.

Smalltalk Input/Output

I am having trouble regarding Smalltalk. I am attempting to populate an array with the numbers that are read from the file, but it doesn't seem to work. I've tried numerous options and I was hoping someone would explain to me what I'm doing wrong.
Object subclass: #MyStack
instanceVariableNames:'anArray aStack'
classVariableNames:''
poolDictionaries:''
!
MyStack class comment: 'Creates a Stack Class.'
!
!
MyStack methodsFor: 'initialize Stack'
!
new "instance creation"
^ super new.
!
init "initialization"
anArray := Array new: 32.
aStack := 0.
! !
!MyStack methodsFor: 'methods for stacks' !
pop "Removes the top entry from the stack"
| item |
item := anArray at: aStack.
aStack := aStack - 1.
!
push: x "Pushes a new entry onto the stack"
aStack := aStack + 1.
anArray at:aStack put:x.
!
top "Returns the current top of the stack"
^anArray at: aStack.
!
empty "True if the stack is empty"
^aStack = 0.
!
full "True if the stack is full"
^aStack = 32.
!
printOn: aStream "Prints entire stack one entry per line, starting the top entry"
aStream show: 'Stack:'.
aStack to:1 by:-1 do:[:i |(anArray at:i) printOn:aStream. ].
aStream show: ''
! !
"----------------------------------------------------------------------------------"
Object subclass: #IOExample
instanceVariableNames: 'input output'
classVariableNames: ''
poolDictionaries: ''
!
IOExample class comment: '
basic I/O.
'
!
!
IOExample methodsFor: 'initialize'
!
new
^ super new.
!
init
[ input := FileSelectionBrowser open asFilename readStream. ]
on: Error
do: [ :exception |
Dialog warn: 'Unable to open file'.
exception retry.
].
[ output := FileSelectionBrowser open asFilename writeStream. ]
on: Error
do: [ :exception |
Dialog warn: 'Unable to open file'.
exception retry.
].
! !
!
IOExample methodsFor: 'copy input to output turning :: into :'
!
copy
| data lookAhead theStack myStack|
[ input atEnd ] whileFalse: [
data := input next.
(data isKindOf: Integer)
ifTrue: [
(input atEnd) ifFalse: [
"myStack push: data."
lookAhead = input peek.
(lookAhead asCharacter isDigit)
ifTrue: [
]
].
].
output show: myStack.
].
input close.
output close.
! !
Did you try to run this code? If you did, I'm surprised you didn't get a compilation warning due to #2 below.
There are a number of problems in #copy (besides the fact that I don't understand exactly what it's trying to do)...
First you seems to expect the data to be numbers: data isKindOf: Integer. But then later you treat it as a stream of Characters: lookAhead asCharacter isDigit. If the first condition is true to get you past that point, the second one never can be, as you would've matched [0-9], which aren't ASCII values for digits.
lookAhead = input peek. Here you're comparing uninitialized lookAhead (nil) with the peeked value, and then throwing away the result. I assume you meant lookAhead := input peek.
Then there is the empty inner condition ifTrue: [ ]. What are you trying to do there?
Then there's the odd protocol name, 'copy input to output turning :: into :'. What does that mean, and what does that have to do with copying numbers between streams?
Justin, let me try to help you with the class MyStack and defer to another answer any comments on your example.
I've divided your code into fragments and appended my comments.
Fragment A:
Object subclass: #MyStack
instanceVariableNames:'anArray aStack'
classVariableNames:''
poolDictionaries:''
Comments for A:
A Smalltalker would have used instance variable names without indeterminate articles a or an
Object subclass: #MyStack
instanceVariableNames:'array stack'
classVariableNames:''
poolDictionaries:''
Fragment B:
MyStack class comment: 'Creates a Stack Class.'
Comments for B:
This is weird. I would have expected this instead (with no class):
MyStack comment: 'Creates a Stack Class.'
Fragment C:
MyStack methodsFor: 'initialize Stack'
new "instance creation"
^ super new.
Comments for C:*
This code puts new on the instance side of the class, which makes no sense because you usually send new to the class rather than its instances. The correct form requires adding class:
MyStack class methodsFor: 'initialize Stack'
new
^super new.
You forgot to send the initialization method (however, see Fragment D below)
new
^super new init.
Fragment D:
init "initialization"
anArray := Array new: 32.
aStack := 0.
Comments for D:
In Smalltalk people use the selector initialize so it can send super first
initialize
super initialize.
array := Array new: 32.
stack := 0.
Note that this change would require also writing new as
new
^super new initialize.
However, if your dialect already sends the initialize method by default, you should remove the implementation of new from your class.
Fragment E:
pop "Removes the top entry from the stack"
| item |
item := anArray at: aStack.
aStack := aStack - 1.
Comments for E:
You forgot to answer the item just popped out
pop
| item |
item := array at: stack.
stack := stack - 1.
^item
Fragment F:
push: x "Pushes a new entry onto the stack"
aStack := aStack + 1.
anArray at:aStack put:x.
Comments for F:
This is ok. Note however that the stack will refuse to push any item beyond the limit of 32.
push: x
stack := stack + 1.
array at: stack put: x.
Fragment G:
top "Returns the current top of the stack"
^anArray at: aStack.
empty "True if the stack is empty"
^aStack = 0.
full "True if the stack is full"
^aStack = 32.
Comments for G:
These are ok too. However, a more appropraite name for empty would have been isEmpty because all collections understand this polymorphic message. Similarly, the recommended selector for full would be isFull:
top
^array at: aStack.
isEmpty
^stack = 0.
isFull
^stack = 32.
Note also that isFull repeats the magic constant 32, which you used in the initialization code. That's not a good idea because if you change your mind in the future and decide to change 32 with, say, 64 you will have to modify two methods an not just one. You can eliminate this duplication in this way
isFull
^stack = array size.
Fragment H:
printOn: aStream
"Prints entire stack one entry per line, starting the top entry"
aStream show: 'Stack:'.
aStack to:1 by:-1 do:[:i |(anArray at:i) printOn:aStream. ].
aStream show: ''
Comments for H:
The last line of this code is superfluous and I would get rid of it. However, you may want to separate every item from the next with a space
printOn: aStream
stream show: 'Stack:'.
stack to: 1 by: -1 do:[:i |
aStream space.
(array at: i) printOn: aStream].

is there an object constructor in rebol

I usually program by functions in an "instinctive" manner, but my current problem can be easily solved by objects, so I go ahead with this method.
Doing so, I am trying to find a way to give an object a constructor method, the equivalent of init() in python, for example.
I looked in the http://www.rebol.com/docs/core-fr/fr-index.html documentation, but I couldn't find anything relevant.
There is no special constructor function in Rebol, but there is a possibility to write ad hoc init code if you need it on object's creation in the spec block. For example:
a: context [x: 123]
b: make a [
y: x + 1
x: 0
]
So, if you define your own "constructor" function by convention in the base object, you can call it the spec block on creation. If you want to make it automatic, you can wrap that in a function, like this:
a: context [
x: 123
init: func [n [integer!]][x: n]
]
new-a: func [n [integer!]][make a [init n]]
b: new-a 456
A more robust (but bit longer) version of new-a that would avoid the possible collision of passed arguments to init with object's own words would be:
new-a: func [n [integer!] /local obj][
also
obj: make a []
obj/init n
]
You could also write a more generic new function that would take a base object as first argument and automatically invoke a constructor-by-convention function after cloning the object, but supporting optional constructor arguments in a generic way is then more tricky.
Remember that the object model of Rebol is prototype-based (vs class-based in Python and most other OOP languages), so the "constructor" function gets duplicated for each new object created. You might want to avoid such cost if you are creating a huge number of objects.
To my knowledge, there is no formal method/convention for using object constructors such as init(). There is of course the built-in method of constructing derivative objects:
make prototype [name: "Foo" description: "Bar"]
; where type? prototype = object!
My best suggestion would be to define a function that inspects an object for a constructor method, then applies that method, here's one such function that I've proposed previously:
new: func [prototype [object!] args [block! none!]][
prototype: make prototype [
if in self 'new [
case [
function? :new [apply :new args]
block? :new [apply func [args] :new [args]]
]
]
]
]
The usage is quite straightforward: if a prototype object has a new value, then it will be applied in the construction of the derivative object:
thing: context [
name: description: none
new: [name: args/1 description: args/2]
]
derivative: new thing ["Foo" "Bar"]
note that this approach works in both Rebol 2 and 3.
Actually, by reading again the Rebol Core documentation (I just followed the good old advice: "Read The French Manual"), there is another way to implement a constructor, quite simple:
http://www.rebol.com/docs/core-fr/fr-rebolcore-10.html#section-8
Of course it is also in The English Manual:
http://www.rebol.com/docs/core23/rebolcore-10.html#section-7
=>
Another example of using the self variable is a function that clones
itself:
person: make object! [
name: days-old: none
new: func [name' birthday] [
make self [
name: name'
days-old: now/date - birthday
]
]
]
lulu: person/new "Lulu Ulu" 17-May-1980
print lulu/days-old
7366
I find this quite convenient, and this way, the constructor lies within the object. This fact makes the object more self-sufficient.
I just implemented that successfully for some geological stuff, and it works well:
>> source orientation
orientation: make object! [
matrix: []
north_reference: "Nm"
plane_quadrant_dip: ""
new: func [{Constructor, builds an orientation object! based on a measurement, as given by GeolPDA device, a rotation matrix represented by a suite of 9 values} m][
make self [
foreach [a b c] m [append/only matrix to-block reduce [a b c]]
a: self/matrix/1/1
b: self/matrix/1/2
c: self/matrix/1/3
d: self/matrix/2/1
e: self/matrix/2/2
f: self/matrix/2/3
g: self/matrix/3/1
h: self/matrix/3/2
i: self/matrix/3/3
plane_normal_vector: reduce [matrix/1/3
matrix/2/3
matrix/3/3
]
axis_vector: reduce [self/matrix/1/2
self/matrix/2/2
self/matrix/3/2
]
plane_downdip_azimuth: azimuth_vector plane_normal_vector
plane_direction: plane_downdip_azimuth - 90
if (plane_direction < 0) [plane_direction: plane_direction - 180]
plane_dip: arccosine (plane_normal_vector/3)
case [
((plane_downdip_azimuth > 315) or (plane_downdip_azimuth <= 45)) [plane_quadrant_dip: "N"]
((plane_downdip_azimuth > 45) and (plane_downdip_azimuth <= 135)) [plane_quadrant_dip: "E"]
((plane_downdip_azimuth > 135) and (plane_downdip_azimuth <= 225)) [plane_quadrant_dip: "S"]
((plane_downdip_azimuth > 225) and (plane_downdip_azimuth <= 315)) [plane_quadrant_dip: "W"]
]
line_azimuth: azimuth_vector axis_vector
line_plunge: 90 - (arccosine (axis_vector/3))
]
]
repr: func [][
print rejoin ["Matrix: " tab self/matrix
newline
"Plane: " tab
north_reference to-string to-integer self/plane_direction "/" to-string to-integer self/plane_dip "/" self/plane_quadrant_dip
newline
"Line: " tab
rejoin [north_reference to-string to-integer self/line_azimuth "/" to-string to-integer self/line_plunge]
]
]
trace_te: func [diagram [object!]][
len_queue_t: 0.3
tmp: reduce [
plane_normal_vector/1 / (square-root (((plane_normal_vector/1 ** 2) + (plane_normal_vector/2 ** 2))))
plane_normal_vector/2 / (square-root (((plane_normal_vector/1 ** 2) + (plane_normal_vector/2 ** 2))))
]
O: [0 0]
A: reduce [- tmp/2
tmp/1
]
B: reduce [tmp/2 0 - tmp/1]
C: reduce [tmp/1 * len_queue_t
tmp/2 * len_queue_t
]
L: reduce [- axis_vector/1 0 - axis_vector/2]
append diagram/plot [pen black]
diagram/trace_line A B
diagram/trace_line O C
diagram/trace_line O L
]
]
>> o: orientation/new [0.375471 -0.866153 -0.32985 0.669867 0.499563 -0.549286 0.640547 -0.0147148 0.767778]
>> o/repr
Matrix: 0.375471 -0.866153 -0.32985 0.669867 0.499563 -0.549286 0.640547 -0.0147148 0.767778
Plane: Nm120/39/S
Line: Nm299/0
Another advantage of this way is that variables defined by the "new" method directly belongs to the object "instance" (I ran into some trouble, with the other methods, having to mention self/ sometimes, having to initialize variables or not).
I'm trying to find out how OO works in REBOL. Prototypical indeed. Yesterday I came across this page, which inspired me to the classical OO model below, without duplication of functions:
;---- Generic function for class or instance method invocation ----;
invoke: func [
obj [object!]
fun [word!]
args [block!]
][
fun: bind fun obj/.class
;---- Class method names start with a dot and instance method names don't:
unless "." = first to-string fun [args: join args obj]
apply get fun args
]
;---- A class definition ----;
THIS-CLASS: context [
.class: self ; the class refers to itself
;---- Class method: create new instance ----;
.new: func [x' [integer!] /local obj] [
obj: context [x: x' .class: none] ; this is the object definition
obj/.class: self/.class ; the object will refer to the class
; it belongs to
return obj
]
;---- An instance method (last argument must be the instance itself) ----;
add: func [y obj] [
return obj/x + y
]
]
Then you can do this:
;---- First instance, created from its class ----;
this-object: THIS-CLASS/.new 1
print invoke this-object 'add [2]
;---- Second instance, created from from a prototype ----;
that-object: this-object/.class/.new 2
print invoke that-object 'add [4]
;---- Third instance, created from from a prototype in another way ----;
yonder-object: invoke that-object '.new [3]
print invoke yonder-object 'add [6]
;---- Fourth instance, created from from a prototype in a silly way ----;
silly-object: yonder-object/.class/.class/.class/.class/.new 4
print silly-object/.class/add 8 silly-object
print this-object/.class/add 8 silly-object
print THIS-CLASS/add 8 silly-object
(It works in REBOL 2, and prints 3, 6, 9, 12, 12, 12 successively.) Hardly any overhead. Probably it won't be difficult to find a dozen of other solutions. Exactly that is the real problem: there are too many ways to do it. (Maybe we'd better use LoyalScript.)

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

How to create dynamic panel layout for this logo creation wizard?

I want to create a wizard for the logo badge below with 3 parameters. I can make the title dynamic but for image and gradient it's hardcoded because I can't see how to make them dynamic. Code follows after pictures:
alt text http://reboltutorial.com/bugs/wizard1.png
alt text http://reboltutorial.com/bugs/wizard2.png
custom-styles: stylize [
lab: label 60x20 right bold middle font-size 11
btn: button 64x20 font-size 11 edge [size: 1x1]
fld: field 200x20 font-size 11 middle edge [size: 1x1]
inf: info font-size 11 middle edge [size: 1x1]
ari: field wrap font-size 11 edge [size: 1x1] with [flags: [field tabbed]]
]
panel1: layout/size [
origin 0 space 2x2 across
styles custom-styles
h3 "Parameters" font-size 14 return
lab "Title" fld_title: fld "EXPERIMENT" return
lab "Logo" fld_logo: fld "http://www.rebol.com/graphics/reb-logo.gif" return
lab "Gradient" fld_gradient: fld "5 55 5 10 10 71.0.6 30.10.10 71.0.6"
] 278x170
panel2: layout/size [
;layout (window client area) size is 278x170 at the end of the spec block
at 0x0 ;put the banner on the top left corner
box 278x170 effect [ ; default box face size is 100x100
draw [
anti-alias on
line-width 2.5 ; number of pixels in width of the border
pen black ; color of the edge of the next draw element
fill-pen radial 100x50 5 55 5 10 10 71.0.6 30.10.10 71.0.6
; the draw element
box ; another box drawn as an effect
15 ; size of rounding in pixels
0x0 ; upper left corner
278x170 ; lower right corner
]
]
pad 30x-150
Text fld_title/text font [name: "Impact" size: 24 color: white]
image http://www.rebol.com/graphics/reb-logo.gif
] 278x170
main: layout [
vh2 "Logo Badge Wizard"
guide
pad 20
button "Parameters" [panels/pane: panel1 show panels ]
button "Rendering" [show panel2 panels/pane: panel2 show panels]
button "Quit" [Unview]
return
box 2x170 maroon
return
panels: box 278x170
]
panel1/offset: 0x0
panel2/offset: 0x0
panels/pane: panel1
view main
Make the block for the 2nd layout a template.
Put the variables you want there and surround with ( )
When rendering, do a copy/deep to make a template copy, then compose/deep to replace the variables as taken from the parameters screen, create the layout from your copy of the template and set the pane to the new layout.