ROShape subclass: #ROTranslatingShape
instanceVariableNames: 'offset'
classVariableNames: ''
poolDictionaries: ''
category: 'RoassalTest'!
!ROTranslatingShape methodsFor: 'rendering' stamp: 'BenComan 9/16/2012
13:35'!
chainedDrawOn: aCanvas for: aROElement
aROElement translateBy: self offset negated.
super chainedDrawOn: aCanvas for: aROElement.
aROElement translateBy: self offset.
! !
!ROTranslatingShape methodsFor: 'initialize' stamp: 'AlexandreBergel 9/15/2012
09:51'!
initialize
super initialize.
offset := 0 @ 0! !
!ROTranslatingShape methodsFor: 'accessing' stamp: 'BenComan 9/16/2012
11:24'!
offset
^ offset value! !
!ROTranslatingShape methodsFor: 'accessing' stamp: 'BenComan 9/16/2012
11:24'!
offset: aBlockReturningPoint
offset := aBlockReturningPoint! !
!ROTranslatingShape methodsFor: 'accessing' stamp: 'BenComan 9/16/2012
12:35'!
usecase1
"
self new usecase1
"
"
More showing how it operates than a use case. Showing that all shapes to the right of
ROTranslatingShape are shifted.
However cannot drag element using the point just below top border.
"
| rawView el |
rawView := ROView new.
el := ROElement new + ROBorder + (ROTranslatingShape new offset: 20 @ 20) + (ROCircle
color: Color blue) + (ROBox) .
el extent: 50 @ 50.
el @ RODraggable.
rawView add: el.
rawView open! !
!ROTranslatingShape methodsFor: 'accessing' stamp: 'BenComan 9/16/2012
13:19'!
usecase2
"
self new usecase2
"
"
At the moment, the prime need for offset capability is showing the parent label above
child elements.
It is good that when dragging a child element upwards the label also moves up.
However the dragging of elements is offset, eg the point just above bottom border does
not drag the element.
Note the ROBorder that is commented out. Not critical, but it would be good to put
border around the ROLabel where it sits above the ROChildrenContainer, except without the
bottom of it cutting across child container.
Might be useful to be able to re-use that Shape>>draw:For: methods with a custom
bounds rather than getting it from the element.
"
| rawView outer outerLabel |
rawView := ROView new.
outer := (ROElement on: 'Child nodes should not overlap this heading text') +
ROBorder + (ROTranslatingShape new offset: 0 @ -20) + ROLabel "+ ROBorder".
1 to: 6 do:
[ :n |
outer add: (ROElement spriteOn: n).
].
outer extent: 50 @ 50.
outer @ RODraggable.
rawView add: outer.
ROGridLayout new applyOn: outer elements.
rawView open! !
!ROTranslatingShape methodsFor: 'accessing' stamp: 'BenComan 9/16/2012
13:27'!
usecase3
"
self new usecase3
"
"
Also later may want to put put labels below the child element area.
"
| view outer outerLabel |
view := ROView new.
outer := (ROElement on: 'Child nodes should not overlap this HEADER text. Try menu on
view background.').
outerLabel := ROLabel new.
outer + ROBorder + (ROTranslatingShape new offset: [ 0 @ (outerLabel heightFor: outer)
negated ] ) + (ROLabel new text: [ :el | el model asString]) .
1 to: 2 do:
[ :n |
outer add: (ROElement spriteOn: n).
].
outer extent: 50 @ 50.
outer @ RODraggable.
view add: outer.
view @ (ROMenuActivable new item: 'Change text' action: [
outer model: 'Child nodes should not overlap this HEADER text
even when
it dynamically changes
to multiple lines'.
outer signalUpdate] ).
ROVerticalLineLayout new applyOn: outer elements.
view open.! !
!ROTranslatingShape methodsFor: 'accessing' stamp: 'BenComan 9/16/2012
13:27'!
usecase4
"
self new usecase4
"
"
Dragging elements 1 & 2 upwards moves doesn't overlap labels with outer label -
good.
However inital layout has element 2 label overlapped by bottoms of element 1.
"
| view outer outerLabel |
view := ROView new.
outer := (ROElement on: 'Child nodes should not overlap this HEADER text').
outerLabel := ROLabel new.
outer + ROBorder + (ROTranslatingShape new offset: [ 0 @ (outerLabel heightFor: outer)
negated ] ) + (ROLabel new text: [ :el | el model asString]) .
1 to: 2 do:
[ :n | | el |
el := (ROElement spriteOn: n).
el + (ROTranslatingShape new offset: [ 0 @ (ROLabel new heightFor: el) negated ] ) +
(ROLabel new text: [ :el3 | el3 model asString, ' should not be overlapped' ]).
outer add: el.
1 to: 2 do:
[ :n2 | | el2 |
el2 := (ROElement spriteOn: n*n2).
el add: el2.
].
ROHorizontalLineLayout new applyOn: el elements.
].
outer extent: 50 @ 50.
outer @ RODraggable.
view add: outer.
view @ (ROMenuActivable new item: 'Change text' action: [
outer model: outer model, '
even when
it dynamically changes
to multiple lines'.
outer signalUpdate] ).
ROVerticalLineLayout new applyOn: outer elements.
view open.! !
!ROTranslatingShape methodsFor: 'accessing' stamp: 'BenComan 9/16/2012
13:37'!
usecase5
"
self new usecase5
"
"
Maybe later want to put labels below the child element area.
Probably want to reference 'ROChildrenShape>>extent' rather than 'outer
extent' since other shaps translations may alter the extent of the element.
This doesn't opearte as expected, which should be to have three elements laid out in
the column
"
| view outer outerLabel |
view := ROView new.
outer := (ROElement on: 'Child nodes should not overlap this FOOTER text, even when
nodes are added - see menu. ').
outerLabel := ROLabel new.
outer + ROBorder + (ROTranslatingShape new offset: [ 0 @ (outer extent y) ] ) + (ROLabel
new text: [ :el | el model asString]) .
1 to: 2 do:
[ :n |
outer add: (ROElement spriteOn: n) + ROLabel.
].
outer extent: 50 @ 50.
outer @ RODraggable.
view add: outer.
view @ (ROMenuActivable new item: 'Add node' action:
[ outer add: (ROElement spriteOn: 'extra') + ROBorder + ROLabel.
ROVerticalLineLayout new applyOn: outer elements.
outer signalUpdate
] ).
ROVerticalLineLayout new applyOn: outer elements.
view open.! !