Bloc is ready for your experiments. Here is my first one.
Please let me know what and how to improve.
Bloc allows for the creation of beautiful widgets.
Here is a panel containing collapsible subpanels
that can be reordered with drag-and-drop.
https://vimeo.com/235934701
Stephan
BlElement subclass: #PrExpanderPane
instanceVariableNames: 'expanded title pane'
classVariableNames: ''
poolDictionaries: ''
category: 'Presentations-Widgets'!
!PrExpanderPane methodsFor: 'accessing' stamp: 'StephanEggermont 9/27/2017
17:25'!
title
^ title! !
!PrExpanderPane methodsFor: 'accessing' stamp: 'StephanEggermont 9/27/2017
22:20'!
title: anObject
|text|
title := anObject.
text := BrRopedText string: title.
text attributes: {
BrFontSizeAttribute size: 16} from: 1 to: text size.
self children first text: text.
! !
!PrExpanderPane methodsFor: 'drawing' stamp: 'StephanEggermont 9/28/2017 17:19'!
drawExpanderTriangleOn: aCanvas
|path|
expanded ifTrue: [
path := aCanvas path
moveTo: 5@10;
lineTo: 25@10;
lineTo: 15@25;
close;
finish]
ifFalse: [
path := aCanvas path
moveTo: 10@5;
lineTo: 25@15;
lineTo: 10@25;
close;
finish].
aCanvas fill
paint: Color paleBlue;
path: path;
draw.
aCanvas stroke
paint: Color lightGray;
path: path;
width: 0.5;
draw
! !
!PrExpanderPane methodsFor: 'drawing' stamp: 'StephanEggermont 9/27/2017 17:01'!
drawOnSpartaCanvas: aCanvas
super drawOnSpartaCanvas: aCanvas.
self drawExpanderTriangleOn: aCanvas! !
!PrExpanderPane methodsFor: 'as yet unclassified' stamp: 'StephanEggermont
9/28/2017 16:57'!
switchExpanded
expanded := expanded not.
pane isVisible ifFalse: [ pane visibility: BlVisibility visible. self
height: 100]
ifTrue: [ pane visibility: BlVisibility hidden. self height: 30].
self changed! !
!PrExpanderPane methodsFor: 'initialization' stamp: 'StephanEggermont 9/28/2017
16:52'!
defaultPaneBackground
^Color white darker! !
!PrExpanderPane methodsFor: 'initialization' stamp: 'StephanEggermont 9/27/2017
16:59'!
defaultBorder
^ BlBorder paint: Color lightGray width: 1! !
!PrExpanderPane methodsFor: 'initialization' stamp: 'StephanEggermont 9/27/2017
16:58'!
defaultSize
^150@30
! !
!PrExpanderPane methodsFor: 'initialization' stamp: 'StephanEggermont 9/28/2017
16:57'!
initialize
| textElement |
super initialize.
self size: self defaultSize;
background: self defaultBackground;
border: self defaultBorder.
self geometry cornerRadius: 3.
expanded := false.
textElement := (BlTextElement new text: (BrRopedText string: '');
yourself)
position: 30@7;
mouseTransparent: true;
yourself.
self addChild: textElement.
self addEventHandlerOn: BlClickEvent do: [ :evt | self switchExpanded
].
pane := BlElement new
position: 0@30;
size: 150@200;
background: self defaultPaneBackground;
border: self defaultBorder;
constraintsDo: [ :c |
c vertical matchParent ];
visibility: BlVisibility gone;
yourself.
self addChild: pane
! !
!PrExpanderPane methodsFor: 'initialization' stamp: 'StephanEggermont 9/27/2017
16:59'!
defaultBackground
^Color lightGray lighter lighter! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
PrExpanderPane class
instanceVariableNames: ''!
!PrExpanderPane class methodsFor: 'instance creation' stamp: 'StephanEggermont
9/27/2017 17:18'!
titled: aTitle
^self new
title: aTitle;
yourself! !
BlElement subclass: #PrInspector
instanceVariableNames: 'textPane shapePane fontPane colorPane'
classVariableNames: ''
poolDictionaries: ''
category: 'Presentations-Widgets'!
!PrInspector methodsFor: 'initialization' stamp: 'StephanEggermont 9/28/2017
11:19'!
addPane: aPane
aPane addEventHandler: (PrInspectorPanesDragInteraction inspector:
self).
self addChild: aPane! !
!PrInspector methodsFor: 'initialization' stamp: 'StephanEggermont 9/28/2017
17:15'!
initialize
super initialize.
self constraintsDo: [ :c |
c horizontal fitContent.
c vertical fitContent.
c padding: (BlInsets top: 20 right: 1 bottom: 1 left: 1)].
self background: Color lightGray.
self border: (BlBorder paint: Color gray width: 0.5).
self layout: (BlFlowLayout vertical).
textPane := PrExpanderPane titled: 'Text '.
shapePane := PrExpanderPane titled: 'Shape '.
fontPane := PrExpanderPane titled: 'Font '.
colorPane := PrExpanderPane titled: 'Color '.
self addPane: textPane.
self addPane: shapePane.
self addPane: fontPane.
self addPane: colorPane.! !
BlElementEventListener subclass: #PrInspectorPanesDragInteraction
instanceVariableNames: 'inspector pane placeHolder dragOffset
startIndex dragIndex'
classVariableNames: ''
poolDictionaries: ''
category: 'Presentations-Widgets'!
!PrInspectorPanesDragInteraction methodsFor: 'dnd handlers' stamp:
'StephanEggermont 9/28/2017 17:17'!
dragEvent: anEvent
| dragOver |
anEvent consumed: true.
dragOver := inspector children first.
inspector childrenDo: [ :c |
c boundsInSpace center y < (anEvent position y + dragOffset y)
ifTrue: [ dragOver := c ] ].
dragOver ~= placeHolder ifTrue: [
(inspector childIndexOf: placeHolder) > 0 ifTrue: [inspector
removeChild: placeHolder].
inspector addChild: placeHolder at: (inspector childIndexOf:
dragOver)].
anEvent currentTarget position: (anEvent position - dragOffset).
! !
!PrInspectorPanesDragInteraction methodsFor: 'dnd handlers' stamp:
'StephanEggermont 9/28/2017 16:00'!
dragStartEvent: anEvent
anEvent consumed: true.
pane := anEvent currentTarget.
dragOffset := anEvent position - anEvent currentTarget position.
startIndex := inspector childIndexOf: pane.
dragIndex := startIndex.
placeHolder := BlElement new.
placeHolder
position: pane position;
size: pane geometry extent;
background: Color white darker;
border: (BlBorderBuilder new paint: Color gray; dashed; width:
1; build ).
placeHolder geometry cornerRadius: 3.
inspector removeChildAt: startIndex.
inspector space root addChild: pane.
inspector addChild: placeHolder at: startIndex .
! !
!PrInspectorPanesDragInteraction methodsFor: 'dnd handlers' stamp:
'StephanEggermont 9/28/2017 16:48'!
dragEndEvent: anEvent
|dropIndex|
anEvent consumed: true.
dropIndex := inspector childIndexOf: placeHolder.
inspector removeChild: placeHolder.
inspector space root removeChild: pane.
inspector addChild: pane at: dropIndex .
! !
!PrInspectorPanesDragInteraction methodsFor: 'accessing' stamp:
'StephanEggermont 9/28/2017 09:47'!
inspector: anInspector
inspector := anInspector! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
PrInspectorPanesDragInteraction class
instanceVariableNames: ''!
!PrInspectorPanesDragInteraction class methodsFor: 'inspecting' stamp:
'StephanEggermont 9/28/2017 09:47'!
inspector: anInspector
^self new
inspector: anInspector;
yourself! !
