Bloc is ready for your experiments. Here is my second one.
Please let me know what and how to improve.
Bloc allows for the easy creation of beautiful widgets.
Here is a simple color panel that allows custom colors to be added
(using the current Morphic color selector dialog) and allows colors to
be applied using drag-and-drop.
https://vimeo.com/236419682
Stephan
BlElement subclass: #DrColorPanel
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'BlocDragPanels'!
!DrColorPanel methodsFor: 'initialization' stamp: 'StephanEggermont 10/2/2017
15:04'!
initialize
super initialize.
self background: Color white;
size: 100@100;
border: (BlBorder paint: Color gray width: 1);
layout: BlFlowLayout new horizontal;
constraintsDo: [ :c |
c horizontal exact: 100.
c vertical fitContent ];
padding: (BlInsets top: 20 right: 2 bottom: 2 left: 2 ).
self addEventHandler: DrColorPanelListener new! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
DrColorPanel class
instanceVariableNames: ''!
!DrColorPanel class methodsFor: 'examples' stamp: 'StephanEggermont 10/2/2017
14:54'!
chooseAColor
| dialog |
dialog := ColorSelectorDialogWindow new
title: 'Choose color'.
World openModal: dialog.
dialog cancelled
ifFalse: [^dialog selectedColor]
ifTrue: [ ^nil ]
! !
!DrColorPanel class methodsFor: 'examples' stamp: 'StephanEggermont 10/2/2017
16:03'!
panelWithSomeColors
<example>
| space panel |
space := BlSpace new.
space extent: 500@500.
panel := self new.
panel addChild: (DrPlusWell new
addEventHandlerOn: BlClickEvent do: [ :evt |
self chooseAColor ifNotNil: [ :color |
panel addChild: (DrColorWell colored: color )].
evt consumed: true];
yourself) .
#(yellow paleGreen paleBlue green) do: [ :colorName | |well|
well := DrColorWell colored: (Color perform: colorName).
panel addChild: well].
space root addChild: panel.
space show
! !
BlElementEventListener subclass: #DrColorPanelListener
instanceVariableNames: 'dragOffset'
classVariableNames: ''
poolDictionaries: ''
category: 'BlocDragPanels'!
!DrColorPanelListener methodsFor: 'dnd handlers' stamp: 'StephanEggermont
10/2/2017 14:30'!
dragEvent: anEvent
anEvent currentTarget position: anEvent position - dragOffset.
anEvent consumed: true.! !
!DrColorPanelListener methodsFor: 'dnd handlers' stamp: 'StephanEggermont
10/2/2017 14:28'!
dragStartEvent: anEvent
dragOffset := (anEvent position - anEvent currentTarget position).
anEvent consumed: true.! !
!DrColorPanelListener methodsFor: 'dnd handlers' stamp: 'StephanEggermont
10/2/2017 14:30'!
dragEndEvent: anEvent
dragOffset := nil.
anEvent consumed: true.! !
BlElementEventListener subclass: #DrColorWellListener
instanceVariableNames: 'dragOffset'
classVariableNames: ''
poolDictionaries: ''
category: 'BlocDragPanels'!
!DrColorWellListener methodsFor: 'dnd handlers' stamp: 'StephanEggermont
10/2/2017 14:58'!
dragEvent: anEvent
anEvent consumed: true.
anEvent currentTarget position: anEvent position - dragOffset
! !
!DrColorWellListener methodsFor: 'dnd handlers' stamp: 'StephanEggermont
10/2/2017 15:43'!
dragStartEvent: anEvent
|colorPanel colorWell colorWellCopy index|
dragOffset := (anEvent position - anEvent currentTarget position -
anEvent currentTarget parent position).
colorWell := anEvent currentTarget.
colorPanel := colorWell parent.
index := colorPanel childIndexOf: colorWell.
colorPanel removeChild: colorWell.
colorPanel space root addChild: colorWell.
colorWellCopy := DrColorWell colored: colorWell color.
colorPanel addChild: colorWellCopy at: index.
anEvent consumed: true.! !
!DrColorWellListener methodsFor: 'dnd handlers' stamp: 'StephanEggermont
10/2/2017 15:22'!
dragEndEvent: anEvent
|me space target|
dragOffset := nil.
me := anEvent currentTarget.
space := me space.
space root removeChild: me.
target := space root findMouseEventTargetAt: anEvent position.
target ifNotNil: [ (target respondsTo: #background:) ifTrue: [
target background: me color ] ].
anEvent consumed: true.! !
!DrColorWellListener methodsFor: 'mouse handlers' stamp: 'StephanEggermont
10/2/2017 14:40'!
mouseEnterEvent: anEvent
anEvent currentTarget showBorder! !
!DrColorWellListener methodsFor: 'mouse handlers' stamp: 'StephanEggermont
10/2/2017 14:40'!
mouseLeaveEvent: anEvent
anEvent currentTarget hideBorder! !
BlElement subclass: #DrDragWell
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'BlocDragPanels'!
!DrDragWell methodsFor: 'initialization' stamp: 'StephanEggermont 10/2/2017
15:17'!
initialize
super initialize.
self background: Color veryVeryLightGray;
size: 25@25;
hideBorder.
self geometry cornerRadius: 3.
self constraintsDo: [:c | c margin: (BlInsets all: 1)].
! !
!DrDragWell methodsFor: 'event handling' stamp: 'StephanEggermont 10/2/2017
14:38'!
showBorder
self border: (BlBorder paint: Color white width: 1) ! !
!DrDragWell methodsFor: 'event handling' stamp: 'StephanEggermont 10/2/2017
14:38'!
hideBorder
self border: (BlBorder paint: Color veryVeryLightGray width: 1) ! !
DrDragWell subclass: #DrColorWell
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'BlocDragPanels'!
!DrColorWell methodsFor: 'accessing' stamp: 'StephanEggermont 10/2/2017 15:23'!
color
^ self background paint color! !
!DrColorWell methodsFor: 'initialization' stamp: 'StephanEggermont 10/2/2017
15:18'!
initialize
super initialize.
self addEventHandler: DrColorWellListener new.
! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
DrColorWell class
instanceVariableNames: ''!
!DrColorWell class methodsFor: 'as yet unclassified' stamp: 'StephanEggermont
10/2/2017 14:41'!
colored: aColor
^self new
background: aColor;
yourself! !
DrDragWell subclass: #DrPlusWell
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'BlocDragPanels'!
!DrPlusWell methodsFor: 'drawing' stamp: 'StephanEggermont 10/2/2017 14:42'!
drawOnSpartaCanvas: aCanvas
|plusPath|
super drawOnSpartaCanvas: aCanvas.
plusPath := aCanvas path
moveTo: self width/3.0 @ 0;
lineTo: self width * 2.0 /3.0 @ 0;
lineTo: self width * 2.0 /3.0 @ (self height/3.0);
lineTo: self width @ (self height/3.0);
lineTo: self width @ (self height*2/3.0);
lineTo: self width * 2.0 /3.0 @ (self height*2/3.0);
lineTo: self width * 2.0 /3.0 @ self height;
lineTo: self width /3.0 @ self height;
lineTo: self width /3.0 @ (self height*2/3.0);
lineTo: 0 @ (self height*2/3.0);
lineTo: 0 @ (self height/3.0);
lineTo: self width /3.0 @ (self height/3.0);
close;
finish.
aCanvas fill
alpha: self border opacity;
paint: Color gray;
path: plusPath;
draw! !
