.
authorclaus
Fri, 12 May 1995 20:34:25 +0200
changeset 56 aa651da467e2
parent 55 75c4a8031e66
child 57 126745871373
.
CheckBox.st
LEnterFld.st
LabelledEnterField.st
Separator.st
--- a/CheckBox.st	Tue May 09 03:58:26 1995 +0200
+++ b/CheckBox.st	Fri May 12 20:34:25 1995 +0200
@@ -24,7 +24,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libwidg2/CheckBox.st,v 1.3 1995-05-09 01:57:57 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/CheckBox.st,v 1.4 1995-05-12 18:34:07 claus Exp $
 "
 !
 
@@ -49,7 +49,18 @@
      b open
 
 
-  changing colors (a demo only: it is no good style to fight the styleSheet):
+  no-op checkBox, disabled:
+
+     |b|
+
+     b := CheckBox new.
+     b label:'foo'.
+     b disable.
+     b open
+
+
+  changing colors 
+  (a demo only: it is no good style to fight the styleSheet):
 
      |panel b|
 
@@ -92,6 +103,7 @@
      b open.
      model inspect.
 
+
   with a model and different changeSelector
   (using a plug here, for demonstration only):
 
@@ -105,6 +117,42 @@
      b model:model; change:#changeCheck:.
      b open.
 
+
+  with models, one checkBox disabling the others:
+
+     |dialog translator enableChannel val1 val2 val3 eBox box1 box2 box3|
+
+     translator := Plug new.
+     translator respondTo:#enableDisable 
+		with:[enableChannel value
+			 ifTrue:[box1 enable.
+				 box2 enable.
+				 box3 enable.]
+			 ifFalse:[box1 disable.
+				  box2 disable.
+				  box3 disable.]].
+
+     enableChannel := true asValue.
+     enableChannel onChangeSend:#enableDisable to:translator.
+     val1 := true asValue.
+     val2 := false asValue.
+     val3 := true asValue.
+
+     dialog := Dialog new.
+     dialog addCheckBox:'enable' on:enableChannel.
+     dialog addVerticalSpace.
+     dialog leftIndent:30.
+     box1 := dialog addCheckBox:'value1' on:val1.
+     dialog addVerticalSpace.
+     box2 := dialog addCheckBox:'value2' on:val2.
+     dialog addVerticalSpace.
+     box3 := dialog addCheckBox:'value3' on:val3.
+     dialog addVerticalSpace.
+     dialog addOkButton.
+
+     dialog open.
+
+
   multiple checkBoxes on a single model (using different aspects)
 
      |top panel b model value1 value2 ok|
@@ -158,37 +206,64 @@
 
 ! !
 
-!CheckBox methodsFor:'accessing'!
+!CheckBox methodsFor:'accessing-mvc'!
 
-label:aString
-    labelView label:aString.
-    labelView forceResize.
-    mustRearrange := true.
+changeMessage:aChangeSelector
+    "forward to toggle"
+
+    toggleView changeMessage:aChangeSelector
 !
 
-font:aFont
-    labelView font:aFont.
-    labelView forceResize.
-    mustRearrange := true.
-!
+aspect:aspectSymbol
+    "forward to label & toggle"
 
-font
-    ^ labelView font
-!
-
-change:aChangeSelector
-    toggleView change:aChangeSelector
-!
-
-label
-    ^ labelView label
+    labelView aspect:aspectSymbol.
+    toggleView aspect:aspectSymbol
 !
 
 model:aModel
+    "forward to label & toggle"
+
     labelView model:aModel.
     toggleView model:aModel
+! !
+
+!CheckBox methodsFor:'accessing-behavior'!
+
+action:aBlock
+    "forward to toggle"
+
+    toggleView action:aBlock
 !
 
+enable
+    "forward to toggle & change labels color"
+
+    toggleView enable.
+    labelView foregroundColor:(toggleView foregroundColor).
+!
+
+disable
+    "forward to toggle & change labels color"
+
+    toggleView disable.
+    labelView foregroundColor:(toggleView disabledForegroundColor).
+!
+
+turnOff
+    "forward to toggle"
+
+    toggleView turnOff
+!
+
+turnOn
+    "forward to toggle"
+
+    toggleView turnOn
+! !
+
+!CheckBox methodsFor:'accessing'!
+
 labelView
     "return the labelView; allows manipulation of the
      labels attributes (colors etc.)"
@@ -201,43 +276,53 @@
      toggles attributes (colors etc.)"
 
     ^ toggleView
-!
+! !
+
+!CheckBox methodsFor:'accessing-look'!
 
-aspect:aspectSymbol
-    labelView aspect:aspectSymbol.
-    toggleView aspect:aspectSymbol
+label:aString
+    "forward to label & resize"
+
+    labelView label:aString.
+    labelView forceResize.
+    mustRearrange := true.
 !
 
-turnOn
-    toggleView turnOn
-!
+font:aFont
+    "forward to label & resize"
 
-action:aBlock
-    toggleView action:aBlock
+    labelView font:aFont.
+    labelView forceResize.
+    mustRearrange := true.
 !
 
-enable
-    toggleView enable
+font
+    "forward from label"
+
+    ^ labelView font
 !
 
-turnOff
-    toggleView turnOff
-!
+label
+    "forward from label"
+
+    ^ labelView label
+! !
+
+!CheckBox methodsFor:'private'!
 
 sendChangeMessageWith:aValue
-    toggleView sendChangeMessageWith:aValue
-!
+    "redefined to have mimic changes being sent from the toggle
+     instead of myself"
 
-disable
-    toggleView disable
+    toggleView sendChangeMessageWith:aValue
 ! !
 
 !CheckBox methodsFor:'initialization'!
 
 initialize
-    |panel|
+    super initialize.
 
-    super initialize.
+    borderWidth := 0.
 
     hLayout := #fixLeftSpace.
     vLayout := #center.
@@ -249,9 +334,11 @@
     labelView forceResize.
     labelView adjust:#left.
     self height:labelView preferedExtent y + ViewSpacing.
-"/    self delegate:(KeyboardForwarder toView:toggleView).
 
-    self controller:(toggleView controller view:toggleView).
+    "
+     all of my input goes to the toggle
+    "
+    self delegate:(KeyboardForwarder toView:toggleView).
 
     "
      |b|
@@ -261,4 +348,3 @@
      b open
     "
 ! !
-
--- a/LEnterFld.st	Tue May 09 03:58:26 1995 +0200
+++ b/LEnterFld.st	Fri May 12 20:34:25 1995 +0200
@@ -10,7 +10,7 @@
  hereby transferred.
 "
 
-SimpleView subclass:#LabelledEnterField
+View subclass:#LabelledEnterField
 	 instanceVariableNames:'labelField textField'
 	 classVariableNames:''
 	 poolDictionaries:''
@@ -21,7 +21,7 @@
 COPYRIGHT (c) 1991 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libwidg2/Attic/LEnterFld.st,v 1.6 1995-05-07 00:18:17 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/Attic/LEnterFld.st,v 1.7 1995-05-12 18:34:16 claus Exp $
 written winter 91 by claus
 '!
 
@@ -29,14 +29,62 @@
 
 documentation
 "
-    An EnterField with a name.
+    An EnterField with a name. Its protocol mimics that of an
+    inputfield for the most common cases. However, for access to
+    some specific things, you have to get the components 
+    (labelField and inputField)
+    and send those message directly.
+"
+!
+
+examples 
+"
+    |top panel f1 f2 f3 f4 model data|
+
+    data := #('John' 'F' 'Smith' '1234567').
+    model := Plug new.
+    model respondTo:#firstName with:[data at:1].
+    model respondTo:#firstName: with:[:arg | data at:1 put:arg].
+    model respondTo:#middleInitial with:[data at:2].
+    model respondTo:#middleInitial: with:[:arg | data at:2 put:arg].
+    model respondTo:#lastName with:[data at:3].
+    model respondTo:#lastName: with:[:arg | data at:3 put:arg].
+    model respondTo:#telNo with:[data at:4].
+    model respondTo:#telNo: with:[:arg | data at:4 put:arg].
 
+    top := StandardSystemView new.
+    top extent:300@300.
+
+    panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
+    panel verticalLayout:#topSpace.
+
+    f1 := LabelledEnterField new.
+    f1 label:'Firstname:'.
+    f1 model:model; aspect:#firstName; change:#firstName:.
+    panel add:f1.
+
+    f2 := LabelledEnterField new.
+    f2 label:'Middle Initial:'.
+    f2 model:model; aspect:#middleInitial; change:#middleInitial:.
+    panel add:f2.
+
+    f3 := LabelledEnterField new.
+    f3 label:'Lastname:'.
+    f3 model:model; aspect:#lastName; change:#lastName:.
+    panel add:f3.
+
+    f4 := LabelledEnterField new.
+    f4 label:'Telephone:'.
+    f4 model:model; aspect:#telNo; change:#telNo:.
+    panel add:f4.
+
+    top open
 "
 !
 
 version
 "
-$Header: /cvs/stx/stx/libwidg2/Attic/LEnterFld.st,v 1.6 1995-05-07 00:18:17 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/Attic/LEnterFld.st,v 1.7 1995-05-12 18:34:16 claus Exp $
 "
 !
 
@@ -61,11 +109,13 @@
 
     super initialize.
 
-    labelField := Label in:self.
+    labelField := Label label:'l' in:self.
+    textField := EditField in:self.
+
+    labelField resize.
     labelField level:0.
-    labelField origin:[margin @ (margin + textField margin)].
+    labelField origin:(margin @ (margin + textField margin)).
 
-    textField := EditField in:self.
     textField origin:[(labelField origin x + labelField width) @ level]
 	      extent:[(self width 
 		      - margin - margin
@@ -81,16 +131,81 @@
     "
 ! !
 
+!LabelledEnterField methodsFor:'queries'!
+
+preferedExtent
+    |p lx ly ix iy|
+
+    p := labelField preferedExtent.
+    lx := p x. ly := p y.
+    p := textField preferedExtent.
+    ix := p x. iy := p y.
+    ^ (lx + ix) @ (ly max:iy)
+! !
+
 !LabelledEnterField methodsFor:'accessing'!
 
+labelView
+    "return the label component"
+
+    ^ labelField
+!
+
+inputField
+    "return the input field component"
+
+    ^ textField
+! !
+
+!LabelledEnterField methodsFor:'accessing-behavior'!
+
 disable
-   textField disable
+    textField disable
+!
+
+enable
+    textField enable
+! !
+
+!LabelledEnterField methodsFor:'accessing-mvc'!
+
+model:aModel
+    textField model:aModel.
+    labelField model:aModel
+!
+
+changeMessage:aSymbol
+    textField changeMessage:aSymbol
 !
 
+aspect:aspectSymbol 
+    textField aspect:aspectSymbol.
+    labelField aspect:aspectSymbol
+!
+
+labelMessage:aSymbol 
+    labelField labelMessage:aSymbol
+!
+
+addModelInterfaceTo:aDictionary
+    labelField addModelInterfaceTo:aDictionary.
+    textField addModelInterfaceTo:aDictionary
+! !
+
+!LabelledEnterField methodsFor:'accessing-look'!
+
 label:aString
     labelField label:aString
 !
 
+editValue 
+    ^ textField editValue 
+!
+
+editValue:something 
+    textField editValue:something 
+!
+
 contents
     ^ textField contents
 !
--- a/LabelledEnterField.st	Tue May 09 03:58:26 1995 +0200
+++ b/LabelledEnterField.st	Fri May 12 20:34:25 1995 +0200
@@ -10,7 +10,7 @@
  hereby transferred.
 "
 
-SimpleView subclass:#LabelledEnterField
+View subclass:#LabelledEnterField
 	 instanceVariableNames:'labelField textField'
 	 classVariableNames:''
 	 poolDictionaries:''
@@ -21,7 +21,7 @@
 COPYRIGHT (c) 1991 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libwidg2/LabelledEnterField.st,v 1.6 1995-05-07 00:18:17 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/LabelledEnterField.st,v 1.7 1995-05-12 18:34:16 claus Exp $
 written winter 91 by claus
 '!
 
@@ -29,14 +29,62 @@
 
 documentation
 "
-    An EnterField with a name.
+    An EnterField with a name. Its protocol mimics that of an
+    inputfield for the most common cases. However, for access to
+    some specific things, you have to get the components 
+    (labelField and inputField)
+    and send those message directly.
+"
+!
+
+examples 
+"
+    |top panel f1 f2 f3 f4 model data|
+
+    data := #('John' 'F' 'Smith' '1234567').
+    model := Plug new.
+    model respondTo:#firstName with:[data at:1].
+    model respondTo:#firstName: with:[:arg | data at:1 put:arg].
+    model respondTo:#middleInitial with:[data at:2].
+    model respondTo:#middleInitial: with:[:arg | data at:2 put:arg].
+    model respondTo:#lastName with:[data at:3].
+    model respondTo:#lastName: with:[:arg | data at:3 put:arg].
+    model respondTo:#telNo with:[data at:4].
+    model respondTo:#telNo: with:[:arg | data at:4 put:arg].
 
+    top := StandardSystemView new.
+    top extent:300@300.
+
+    panel := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
+    panel verticalLayout:#topSpace.
+
+    f1 := LabelledEnterField new.
+    f1 label:'Firstname:'.
+    f1 model:model; aspect:#firstName; change:#firstName:.
+    panel add:f1.
+
+    f2 := LabelledEnterField new.
+    f2 label:'Middle Initial:'.
+    f2 model:model; aspect:#middleInitial; change:#middleInitial:.
+    panel add:f2.
+
+    f3 := LabelledEnterField new.
+    f3 label:'Lastname:'.
+    f3 model:model; aspect:#lastName; change:#lastName:.
+    panel add:f3.
+
+    f4 := LabelledEnterField new.
+    f4 label:'Telephone:'.
+    f4 model:model; aspect:#telNo; change:#telNo:.
+    panel add:f4.
+
+    top open
 "
 !
 
 version
 "
-$Header: /cvs/stx/stx/libwidg2/LabelledEnterField.st,v 1.6 1995-05-07 00:18:17 claus Exp $
+$Header: /cvs/stx/stx/libwidg2/LabelledEnterField.st,v 1.7 1995-05-12 18:34:16 claus Exp $
 "
 !
 
@@ -61,11 +109,13 @@
 
     super initialize.
 
-    labelField := Label in:self.
+    labelField := Label label:'l' in:self.
+    textField := EditField in:self.
+
+    labelField resize.
     labelField level:0.
-    labelField origin:[margin @ (margin + textField margin)].
+    labelField origin:(margin @ (margin + textField margin)).
 
-    textField := EditField in:self.
     textField origin:[(labelField origin x + labelField width) @ level]
 	      extent:[(self width 
 		      - margin - margin
@@ -81,16 +131,81 @@
     "
 ! !
 
+!LabelledEnterField methodsFor:'queries'!
+
+preferedExtent
+    |p lx ly ix iy|
+
+    p := labelField preferedExtent.
+    lx := p x. ly := p y.
+    p := textField preferedExtent.
+    ix := p x. iy := p y.
+    ^ (lx + ix) @ (ly max:iy)
+! !
+
 !LabelledEnterField methodsFor:'accessing'!
 
+labelView
+    "return the label component"
+
+    ^ labelField
+!
+
+inputField
+    "return the input field component"
+
+    ^ textField
+! !
+
+!LabelledEnterField methodsFor:'accessing-behavior'!
+
 disable
-   textField disable
+    textField disable
+!
+
+enable
+    textField enable
+! !
+
+!LabelledEnterField methodsFor:'accessing-mvc'!
+
+model:aModel
+    textField model:aModel.
+    labelField model:aModel
+!
+
+changeMessage:aSymbol
+    textField changeMessage:aSymbol
 !
 
+aspect:aspectSymbol 
+    textField aspect:aspectSymbol.
+    labelField aspect:aspectSymbol
+!
+
+labelMessage:aSymbol 
+    labelField labelMessage:aSymbol
+!
+
+addModelInterfaceTo:aDictionary
+    labelField addModelInterfaceTo:aDictionary.
+    textField addModelInterfaceTo:aDictionary
+! !
+
+!LabelledEnterField methodsFor:'accessing-look'!
+
 label:aString
     labelField label:aString
 !
 
+editValue 
+    ^ textField editValue 
+!
+
+editValue:something 
+    textField editValue:something 
+!
+
 contents
     ^ textField contents
 !
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Separator.st	Fri May 12 20:34:25 1995 +0200
@@ -0,0 +1,186 @@
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+
+'From Smalltalk/X, Version:2.10.5 on 11-may-1995 at 2:19:42 am'!
+
+SimpleView subclass:#Separator
+	 instanceVariableNames:'orientation'
+	 classVariableNames:''
+	 poolDictionaries:''
+	 category:'Views-Layout'
+!
+
+!Separator class methodsFor:'documentation'!
+
+examples
+"
+  a separator between two button-panels:
+
+    |top p1 p2 sep|
+
+    top := StandardSystemView new.
+    top extent:300@300.
+
+    p1 := VerticalPanelView origin:0.0@0.0 corner:1.0@0.5 in:top.
+    p1 bottomInset:5; borderWidth:0.
+    p2 := VerticalPanelView origin:0.0@0.5 corner:1.0@1.0 in:top.
+    p2 topInset:5; borderWidth:0.
+
+    (Button label:'one' in:p1) width:0.2.
+    (Button label:'two' in:p1) width:0.2.
+    (Button label:'three' in:p1) width:0.2.
+
+    sep := Separator in:top.
+    sep orientation:#horizontal.
+    sep origin:0.0@0.5 extent:1.0@10.
+    sep topInset:-5; bottomInset:-5.
+
+    (Button label:'four' in:p2) width:0.2.
+    (Button label:'five' in:p2) width:0.2.
+    (Button label:'six' in:p2) width:0.2.
+
+    top open
+
+
+  vertical:
+
+    |top p1 p2 sep|
+
+    top := StandardSystemView new.
+    top extent:300@300.
+
+    p1 := VerticalPanelView origin:0.0@0.0 corner:0.5@1.0 in:top.
+    p1 rightInset:5; borderWidth:0.
+    p2 := VerticalPanelView origin:0.5@0.0 corner:1.0@1.0 in:top.
+    p2 leftInset:5; borderWidth:0.
+
+    (Button label:'one' in:p1) width:0.4.
+    (Button label:'two' in:p1) width:0.4.
+    (Button label:'three' in:p1) width:0.4.
+
+    sep := Separator in:top.
+    sep orientation:#vertical.
+    sep origin:0.5@0.0 extent:10@1.0.
+    sep leftInset:-5; rightInset:-5.
+
+    (Button label:'four' in:p2) width:0.4.
+    (Button label:'five' in:p2) width:0.4.
+    (Button label:'six' in:p2) width:0.4.
+
+    top open
+
+
+  with multiple horizontal seps in a panel:
+
+    |top p sep|
+
+    top := StandardSystemView new.
+    top extent:300@300.
+
+    p := VerticalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
+    p verticalLayout:#spreadSpace.
+    p horizontalLayout:#center.
+
+    (Button label:'one' in:p).
+    (Button label:'two' in:p).
+    (Button label:'three' in:p).
+
+    sep := Separator in:p.
+    sep orientation:#horizontal.
+    sep extent:0.9@10.
+
+    (Button label:'four' in:p).
+    (Button label:'five' in:p).
+
+    sep := Separator in:p.
+    sep orientation:#horizontal.
+    sep extent:0.9@10.
+
+    (Button label:'six' in:p).
+
+    top open
+"
+!
+
+copyright
+"
+ COPYRIGHT (c) 1995 by Claus Gittinger
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+!
+
+version 
+"
+$Header: /cvs/stx/stx/libwidg2/Separator.st,v 1.1 1995-05-12 18:34:25 claus Exp $
+"
+
+!
+
+documentation 
+"
+    a simple widget for a separating line. 
+    To be placed between groups of other widgets.
+"
+
+! !
+
+!Separator methodsFor:'drawing'!
+
+redraw
+    |vCenter hCenter is3D|
+
+    self clear.
+    vCenter := self height // 2.
+    hCenter := self width // 2.
+
+    is3D := StyleSheet is3D.
+
+    self paint:shadowColor.
+    orientation == #vertical ifTrue:[
+        self displayLineFromX:hCenter y:0 toX:hCenter y:height-1.
+        is3D ifTrue:[
+            self paint:lightColor.
+            self displayLineFromX:hCenter+1 y:0 toX:hCenter+1 y:height-1.
+        ]
+    ] ifFalse:[
+        self displayLineFromX:0 y:vCenter toX:width-1 y:vCenter.
+        is3D ifTrue:[
+            self paint:lightColor.
+            self displayLineFromX:0 y:vCenter+1 toX:width-1 y:vCenter+1.
+        ]
+    ]
+! !
+
+!Separator methodsFor:'accessing'!
+
+orientation:aSymbol
+    "set the orientation to one of #horizontal or #vertical"
+
+    orientation := aSymbol
+! !
+
+!Separator methodsFor:'initialization'!
+
+initialize
+    super initialize.
+    borderWidth := 0
+! !
+