Programmer's Reference

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.
Composite extended widget

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


[ Top of Page | Previous Page | Next Page | Table of Contents | Index ]