Example: a composite extended widget

The CewTitleFrame widget draws a rounded-corner rectangle around its single child, and displays its title in the upper-left portion of the rectangle. This widget is similar to CwFrame, and, like CwFrame, does not support any special callbacks. Its purpose is to provide decoration, not interactive behavior.

The extended widget is implemented using a CwDrawingArea for the primary widget, with an expose callback to draw the frame and title, and a resize callback to make sure the child always fits inside the frame.

CwExtendedComposite subclass: #CewTitleFrame

instanceVariableNames: 'title borderInset childInset radius angles gc

lineSegments arcOrigins'

classVariableNames: ''

poolDictionaries: ''

createPrimaryWidget: theName parent: parent argBlock: argBlock

"Private - Create and answer the basic widget that is the root of

the widget hierarchy for the receiver's widget system."

^parent

createDrawingArea: theName , 'DrawingArea'

argBlock: argBlock

initialize

"Private - Perform any private widget-specific state initialization. This is sent

before any other initialization begins. borderInset, radius, and angles are needed

for drawing the frame. lineSegments is set to nil to ensure that the lineSegments

and arcOrigins collections are calculated on first expose. childInset used to size

child in resize callback."

self

radius: 15;

angles: #(90 0 270 180);

borderInset: (CgFontStruct default height) // 2 + 4;

childInset: self borderInset * 2.

initializeResources

"Private - Set the default extended widget resource values. This is sent during

create with isCreated set to false. All extended resource variables should be

initialized to default values here."

title := String new.

initializeAfterCreate

"Private - Perform any widget-specific post-create initialization."

self primaryWidget

marginHeight: self childInset;

marginWidth: self childInset;

addCallback: XmNexposeCallback

receiver: self

selector: #expose:clientData:callData:

clientData: nil;

addCallback: XmNresizeCallback

receiver: self

selector: #resize:clientData:callData:

clientData: nil.

 

title

"Answer the value of the title resource.

Resource type: String

Default setting: ''

Resource access: CSG

Description:

Specifies the string for the CewTitleFrame's title.

This title is displayed in the upper left portion of the

rounded-corner rectangle that frames the child widget."

^title

 

title: resourceValue

"Set the value of the title resource to resourceValue.

Resource type: String

Default setting: ''

Resource access: CSG

Description:

Specifies the string for the CewTitleFrame's title.

This title is displayed in the upper left portion of the

rounded-corner rectangle that frames the child widget."

title := resourceValue.

 

borderInset

"Private - Answer the value of borderInset."

^borderInset

borderInset: anInteger

"Private - Set the value of borderInset to anInteger."

borderInset := anInteger.

 

childInset

"Private - Answer the value of childInset."

^childInset

childInset: anInteger

"Private - Set the value of childInset to anInteger."

childInset := anInteger.

 

radius

"Private - Answer the value of radius."

^radius

radius: anInteger

"Private - Set the value of radius to anInteger."

radius := anInteger.

 

angles

"Private - Answer the value of angles."

^angles

angles: anArray

"Private - Set the value of angles to anArray."

angles := anArray.

 

lineSegments

"Private - Answer the value of lineSegments."

^lineSegments

lineSegments: anOrderedCollection

"Private - Set the value of lineSegments to anOrderedCollection."

lineSegments := anOrderedCollection.

 

arcOrigins

"Private - Answer the value of arcOrigins."

^arcOrigins

arcOrigins: anArray

"Private - Set the value of arcOrigins to anArray."

arcOrigins := anArray.

 

gc

"Private - Answer the value of gc. Create if not already created."

gc isNil

ifTrue: [self initializeGraphics].

^gc

gc: aCgGC

"Private - Set the value of gc to aCgGC."

gc := aCgGC

 

initializeGraphics

"Private - Set the receiver's palette and create a GC. This method is called

by the #gc method if gc is nil."

| pw colors |

pw := self primaryWidget.

colors := Array

with: pw backgroundColor "pixel 0"

with: pw foregroundColor. "pixel 1"

"The palette must be set on the shell window."

pw shell window

setPalette: (CgIndexedPalette colors: colors).

self gc: (pw window

createGC: GCForeground | GCBackground | GCFont

values: (CgGCValues new

background: 0;

foreground: 1;

font: pw display defaultFont)).

 

recalculateSegmentsAndArcs

"Private - Calculate the line segments and arc origins to draw the frame around

the child widget at the current size."

| border offset diam width height |

border := self borderInset.

offset := border + self radius.

diam := self radius * 2.

width := self width.

height := self height.

self lineSegments: (OrderedCollection new

add: (CgSegment

point1: offset @ border

point2: (width - offset) @ border);

add: (CgSegment

point1: (width - border) @ offset

point2: (width - border) @ (height - offset));

add: (CgSegment

point1: (width - offset) @ (height - border)

point2: offset @ (height - border));

add: (CgSegment

point1: border @ (height - offset)

point2: border @ offset)).

self arcOrigins: (Array

with: (border @ border)

with: (width - (diam + border)) @ border

with: (width @ height) - (diam + border)

with: border @ (height - (diam + border))).

 

expose: widget clientData: clientData callData: callData

"Private - Process an expose callback for the primary widget by

drawing the rounded-corner rectangle frame and title."

| border offset diam |

border := self borderInset.

offset := border + self radius.

diam := self radius * 2.

self lineSegments isNil

ifTrue: self recalculateSegmentsAndArcs].

widget window

drawSegments: self gc segments: self lineSegments.

self arcOrigins

with: self angles do: [:p :angle |

widget window

drawArc: self gc

x: p x

y: p y

width: diam

height: diam

angle1: 64 * angle

angle2: 64 * 90].

widget window

drawImageString: self gc

x: offset + 20

y: border + (widget display defaultFontStruct ascent // 2)

string: ' ' , self title , ' '.

 

resize: widget clientData: clientData callData: callData

"Private - Process a resize callback for the primary widget by

resizing the primary widget's child to fit inside the frame."

| child offset |

(child := widget children) notEmpty

ifTrue:

offset := self childInset * 2.

child first

resizeWidget: self width - offset

height: self height - offset

borderWidth: child first borderWidth ].

"Force a recalculation of line segments and arc origin based on the new size.

Recalculation will occur at next expose."

self lineSegments: nil.

"Clear the widget and force an expose event."

widget window clearArea: 0 y: 0 width: 0 height: 0 exposures: true.

Using the CewTitleFrame composite extended widget

The following code creates a CewTitleFrame instance with a radio-box child (a CwRowColumn with radioBehaviour set to true). The radio box then creates two CwToggleButton children. This is shown in the diagram at the beginning of this section, on page Example: a composite extended widget.

| shell titleFrame radioBox |

shell := CwTopLevelShell

createApplicationShell: 'CewTitleFrame Test'

argBlock: nil.

titleFrame := CewTitleFrame

createManagedWidget: 'titleFrame'

parent: shell

argBlock: :w | w title: 'Direction'].

(radioBox := titleFrame

createRadioBox: 'radio'

argBlock: nil)

manageChild.

(radioBox

createToggleButton: 'Up'

argBlock: [:w | w set: true])

manageChild.

(radioBox

createToggleButton: 'Down'

argBlock: nil)

manageChild.

shell realizeWidget