.
authorclaus
Thu, 24 Aug 1995 05:02:53 +0200
changeset 145 6a191e0606e5
parent 144 a86f474be012
child 146 7726707ac980
.
ButtonC.st
ButtonController.st
Label.st
TextColl.st
TextCollector.st
--- a/ButtonC.st	Wed Aug 23 20:06:29 1995 +0200
+++ b/ButtonC.st	Thu Aug 24 05:02:53 1995 +0200
@@ -13,7 +13,8 @@
 'From Smalltalk/X, Version:2.10.5 on 4-may-1995 at 6:17:35 am'!
 
 Controller subclass:#ButtonController
-	 instanceVariableNames:'enableChannel pressed active entered isTriggerOnDown autoRepeat
+	 instanceVariableNames:'enableChannel pressChannel releaseChannel
+		pressed active entered isTriggerOnDown autoRepeat
 		repeatBlock initialDelay repeatDelay pressActionBlock
 		releaseActionBlock isToggle'
 	 classVariableNames:''
@@ -39,7 +40,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libwidg/Attic/ButtonC.st,v 1.13 1995-07-23 03:01:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ButtonC.st,v 1.14 1995-08-24 03:02:02 claus Exp $
 "
 !
 
@@ -141,6 +142,36 @@
     pressed := aBoolean
 ! !
 
+!ButtonController methodsFor:'accessing-channels'!
+
+enableChannel
+    "return the valueHolder which holdes the enable
+     boolean value"
+
+    ^ enableChannel
+!
+
+enableChannel:aValueHolder
+    "set the valueHolder, which holds the enable boolean value"
+
+    enableChannel notNil ifTrue:[
+	enableChannel retractInterrestFor:self. 
+    ].
+    enableChannel := aValueHolder.
+    aValueHolder onChangeSend:#enableStateChange to:self.
+    view notNil ifTrue:[
+	view redraw
+    ]
+!
+
+pressChannel:aChannel
+    pressChannel := aChannel
+!
+
+releaseChannel:aChannel
+    releaseChannel := aChannel
+! !
+
 !ButtonController methodsFor:'accessing-behavior'!
 
 beTriggerOnDown
@@ -262,26 +293,6 @@
 	enableChannel value:false.
 	"/ view redraw    - not needed; button listenes to enableChannel
     ]
-!
-
-enableChannel
-    "return the valueHolder which holdes the enable
-     boolean value"
-
-    ^ enableChannel
-!
-
-enableChannel:aValueHolder
-    "set the valueHolder, which holds the enable boolean value"
-
-    enableChannel notNil ifTrue:[
-	enableChannel retractInterrestFor:self. 
-    ].
-    enableChannel := aValueHolder.
-    aValueHolder onChangeSend:#enableStateChange to:self.
-    view notNil ifTrue:[
-	view redraw
-    ]
 ! !
 
 !ButtonController methodsFor:'event handling'!
@@ -407,7 +418,7 @@
 !
 
 performAction
-    |action value|
+    |action value channel|
 
     isToggle ifTrue:[
 	value := pressed
@@ -416,12 +427,14 @@
     ].
 
     "
-     ST/X style actionBlock evaluation ...
+     ST/X style actionBlock evaluation & channel notification ...
     "
     pressed ifTrue:[
-	action := pressActionBlock
+	action := pressActionBlock.
+	channel := pressChannel.
     ] ifFalse:[
-	action := releaseActionBlock
+	action := releaseActionBlock.
+	channel := releaseChannel.
     ].
     action notNil ifTrue:[
 	active := true.
@@ -432,6 +445,9 @@
 	].
 	active := false.
     ].
+    channel notNil ifTrue:[
+	channel value:true
+    ].
 
     "
      ST-80 style model notification ...
--- a/ButtonController.st	Wed Aug 23 20:06:29 1995 +0200
+++ b/ButtonController.st	Thu Aug 24 05:02:53 1995 +0200
@@ -13,7 +13,8 @@
 'From Smalltalk/X, Version:2.10.5 on 4-may-1995 at 6:17:35 am'!
 
 Controller subclass:#ButtonController
-	 instanceVariableNames:'enableChannel pressed active entered isTriggerOnDown autoRepeat
+	 instanceVariableNames:'enableChannel pressChannel releaseChannel
+		pressed active entered isTriggerOnDown autoRepeat
 		repeatBlock initialDelay repeatDelay pressActionBlock
 		releaseActionBlock isToggle'
 	 classVariableNames:''
@@ -39,7 +40,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libwidg/ButtonController.st,v 1.13 1995-07-23 03:01:00 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ButtonController.st,v 1.14 1995-08-24 03:02:02 claus Exp $
 "
 !
 
@@ -141,6 +142,36 @@
     pressed := aBoolean
 ! !
 
+!ButtonController methodsFor:'accessing-channels'!
+
+enableChannel
+    "return the valueHolder which holdes the enable
+     boolean value"
+
+    ^ enableChannel
+!
+
+enableChannel:aValueHolder
+    "set the valueHolder, which holds the enable boolean value"
+
+    enableChannel notNil ifTrue:[
+	enableChannel retractInterrestFor:self. 
+    ].
+    enableChannel := aValueHolder.
+    aValueHolder onChangeSend:#enableStateChange to:self.
+    view notNil ifTrue:[
+	view redraw
+    ]
+!
+
+pressChannel:aChannel
+    pressChannel := aChannel
+!
+
+releaseChannel:aChannel
+    releaseChannel := aChannel
+! !
+
 !ButtonController methodsFor:'accessing-behavior'!
 
 beTriggerOnDown
@@ -262,26 +293,6 @@
 	enableChannel value:false.
 	"/ view redraw    - not needed; button listenes to enableChannel
     ]
-!
-
-enableChannel
-    "return the valueHolder which holdes the enable
-     boolean value"
-
-    ^ enableChannel
-!
-
-enableChannel:aValueHolder
-    "set the valueHolder, which holds the enable boolean value"
-
-    enableChannel notNil ifTrue:[
-	enableChannel retractInterrestFor:self. 
-    ].
-    enableChannel := aValueHolder.
-    aValueHolder onChangeSend:#enableStateChange to:self.
-    view notNil ifTrue:[
-	view redraw
-    ]
 ! !
 
 !ButtonController methodsFor:'event handling'!
@@ -407,7 +418,7 @@
 !
 
 performAction
-    |action value|
+    |action value channel|
 
     isToggle ifTrue:[
 	value := pressed
@@ -416,12 +427,14 @@
     ].
 
     "
-     ST/X style actionBlock evaluation ...
+     ST/X style actionBlock evaluation & channel notification ...
     "
     pressed ifTrue:[
-	action := pressActionBlock
+	action := pressActionBlock.
+	channel := pressChannel.
     ] ifFalse:[
-	action := releaseActionBlock
+	action := releaseActionBlock.
+	channel := releaseChannel.
     ].
     action notNil ifTrue:[
 	active := true.
@@ -432,6 +445,9 @@
 	].
 	active := false.
     ].
+    channel notNil ifTrue:[
+	channel value:true
+    ].
 
     "
      ST-80 style model notification ...
--- a/Label.st	Wed Aug 23 20:06:29 1995 +0200
+++ b/Label.st	Thu Aug 24 05:02:53 1995 +0200
@@ -15,7 +15,7 @@
 View subclass:#Label
 	 instanceVariableNames:'logo labelWidth labelHeight labelOriginX labelOriginY adjust
 		hSpace vSpace bgColor fgColor fixSize labelMsg converter
-		logoChannel foregroundChannel backgroundChannel'
+		labelChannel foregroundChannel backgroundChannel'
 	 classVariableNames:'DefaultFont DefaultForegroundColor DefaultBackgroundColor'
 	 poolDictionaries:''
 	 category:'Views-Layout'
@@ -25,7 +25,7 @@
 COPYRIGHT (c) 1989 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.28 1995-08-23 18:05:44 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.29 1995-08-24 03:02:26 claus Exp $
 '!
 
 !Label class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libwidg/Label.st,v 1.28 1995-08-23 18:05:44 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Label.st,v 1.29 1995-08-24 03:02:26 claus Exp $
 "
 !
 
@@ -85,7 +85,7 @@
     where how is one of the symbols left, #right, #center, #centerLeft or
     #centerRight (see the comment in Label>>adjust:). The default is #center.
 
-    model-less operation:
+    model-less operation (ok for static labels):
       if no model is set, the labels contents is set with:
 
 	aLabel label:aStringOrImage
@@ -93,7 +93,7 @@
       and stays constant unless changed by new calls to #label:.
 
 
-    model operation:
+    model operation (ST-80 style):
       labels with a model, aspectMsg and labelMsg react to 
       changes of the aspect, and send a labelMsg-message 
       to the model in order to aquire a new labelString or image.
@@ -114,6 +114,15 @@
       The aspectMsg defaults to #value.
 
 
+
+    channel operation (new ST/X style):
+
+      the label will react on changes of the token found in the
+      channels: foregroundChannel, backgroundChannel and labelChannel.
+      These are valueHolders and can be shared between labels.
+
+
+        
     Instance variables:
 
 	logo                <Object>        the logo, can be a Form, String or Text
@@ -404,7 +413,48 @@
 	top open
 
 
+     Channel operation 
+     -----------------
+
+	|top panel logoChannel fgChannel bgChannel l b|
+
+	top := StandardSystemView new.
+	top extent:(450 @ 200).
+
+	panel := HorizontalPanelView origin:0.0@0.0 corner:1.0@1.0 in:top.
+
+	l := Label in:panel.
+	l level:-1.
+	l label:'change my colors'.
+	l origin:50@100.
+	l sizeFixed:true.
+
+	fgChannel := Color blue asValue.
+	bgChannel := Color white asValue.
+	logoChannel := 'change me' asValue.
+
+	b := Toggle label:'change fg' in:panel. b showLamp:false; onLevel:-2.
+	b pressAction:[fgChannel value:Color red].
+	b releaseAction:[fgChannel value:Color blue].
+
+	b := Toggle label:'change bg' in:panel.
+	b pressAction:[bgChannel value:Color yellow].
+	b releaseAction:[bgChannel value:Color grey].
+
+	b := Toggle label:'change text' in:panel.
+	b pressAction:[logoChannel value:'wow'].
+	b releaseAction:[logoChannel value:'not bad' ].
+
+	l labelChannel:logoChannel.
+	l foregroundChannel:fgChannel.
+	l backgroundChannel:bgChannel.
+
+	top open
+
+
      MVC operation 
+     -------------
+
        model provides the label):
        (have to use a plug to simulate a model which responds to
 	the #someAspect message):
@@ -678,6 +728,23 @@
     ]
 ! !
 
+!Label methodsFor:'accessing-channels'!
+
+foregroundChannel:aValueHolder
+    foregroundChannel := aValueHolder.
+    self setupChannel:aValueHolder for:#foregroundChannelChanged withOld:foregroundChannel
+!
+
+backgroundChannel:aValueHolder
+    backgroundChannel := aValueHolder.
+    self setupChannel:aValueHolder for:#backgroundChannelChanged withOld:backgroundChannel
+!
+
+labelChannel:aValueHolder
+    labelChannel := aValueHolder.
+    self setupChannel:aValueHolder for:#labelChannelChanged withOld:labelChannel
+! !
+
 !Label methodsFor:'accessing-mvc'!
 
 model:aModel
@@ -1207,6 +1274,18 @@
 
 !Label methodsFor:'change & update'!
 
+foregroundChannelChanged
+    self foregroundColor:(foregroundChannel value)
+!
+
+backgroundChannelChanged
+    self backgroundColor:(backgroundChannel value)
+!
+
+labelChannelChanged
+    self label:(labelChannel value)
+!
+
 update:something with:aParameter from:changedObject
     "the MVC way of changing the label ..."
 
--- a/TextColl.st	Wed Aug 23 20:06:29 1995 +0200
+++ b/TextColl.st	Thu Aug 24 05:02:53 1995 +0200
@@ -23,7 +23,7 @@
 COPYRIGHT (c) 1989 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.21 1995-08-03 01:35:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.22 1995-08-24 03:02:53 claus Exp $
 '!
 
 !TextCollector class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.21 1995-08-03 01:35:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/TextColl.st,v 1.22 1995-08-24 03:02:53 claus Exp $
 "
 !
 
@@ -290,6 +290,7 @@
 	].
 	self checkLineLimit.
 	inFlush := false.
+	device synchronizeOutput.
     ].
     flushPending ifTrue:[
 	flushPending := false.
--- a/TextCollector.st	Wed Aug 23 20:06:29 1995 +0200
+++ b/TextCollector.st	Thu Aug 24 05:02:53 1995 +0200
@@ -23,7 +23,7 @@
 COPYRIGHT (c) 1989 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.21 1995-08-03 01:35:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.22 1995-08-24 03:02:53 claus Exp $
 '!
 
 !TextCollector class methodsFor:'documentation'!
@@ -44,7 +44,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.21 1995-08-03 01:35:39 claus Exp $
+$Header: /cvs/stx/stx/libwidg/TextCollector.st,v 1.22 1995-08-24 03:02:53 claus Exp $
 "
 !
 
@@ -290,6 +290,7 @@
 	].
 	self checkLineLimit.
 	inFlush := false.
+	device synchronizeOutput.
     ].
     flushPending ifTrue:[
 	flushPending := false.