"
 COPYRIGHT (c) 1989 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.
"

Button subclass:#Toggle
       instanceVariableNames:'showLamp lampColor lampWidth lampHeight'
       classVariableNames:''
       poolDictionaries:''
       category:'Views-Interactors'
!

Toggle comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libwidg/Toggle.st,v 1.8 1994-11-17 14:38:44 claus Exp $
'!

!Toggle class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 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/libwidg/Toggle.st,v 1.8 1994-11-17 14:38:44 claus Exp $
"
!

documentation
"
    this button changes state whenever pressed and stays pressed until pressed
    again. All the main action is in Button, Toggle just redefines buttonpress/
    release behavior.

    The toggle may optionally display a little kind-of-lamp (or LED), which
    is turned on when the toggle is pressed. (i.e. as in the Interviews toolkit).

    whenever the Toggle changes its change, it will evaluate one of
    pressAction or releaseAction.

    For ST-80 compatibility, if the model is nonNil, this one gets a new
    value and is sent a changed message.
    If nonNil, the model is supposed to be a ValueHolder holding true or false.


    instance variables:
	showLamp    <Boolean>       true if a lamp should be displayed
	lampColor   <Color>         color of the lamp
	lampWidth   <Integer>       width of the lamp in pixel
	lampHeight  <Integer>       height of the lamp in pixel
"
!

examples
"
    Examples:
	Try these, to see what is possible.

	(notice, that these examples are meant to show what can be done;
	 usually, all style-related stuff id preinitialized - you should not
	 normally play around with onLevel, offLevel, showLamp: etc)

      simple:

	|v t|

	v := View new.
	t := Toggle label:'press here' in:v.
	t origin:10 @ 10.
	t pressAction:[Transcript showCr:'toggle pressed'.].
	t releaseAction:[Transcript showCr:'toggle released'.].
	v realize

      changing logo:

	|v t|

	v := View new.
	t := Toggle label:'eat me' in:v.
	t origin:10 @ 10.
	t pressAction:[Transcript showCr:'smaller'. t label:'drink me'].
	t releaseAction:[Transcript showCr:'larger'. t label:'eat me'].
	v realize

      changing logo and freezing size (looks better):

	|v t|

	v := View new.
	'create with large logo; freeze; change to small logo'.
	t := Toggle label:'drink me' in:v. 
	t sizeFixed:true.
	t label:'eat me'.

	t origin:10 @ 10.
	t pressAction:[Transcript showCr:'smaller'. t label:'drink me'].
	t releaseAction:[Transcript showCr:'larger'. t label:'eat me'].
	v realize

      adding lamp (on by default in some view styles):

	|v t|

	v := View new.
	t := Toggle label:'off' in:v.
	t showLamp:true.
	t origin:10 @ 10.
	t pressAction:[Transcript showCr:'on'. t label:'on'].
	t releaseAction:[Transcript showCr:'off'. t label:'off'].
	v realize

      lamp only - no 'going-in'

	|v t|

	v := View new.
	t := Toggle label:'off' in:v.
	t showLamp:true.
	t onLevel:(t offLevel).
	t origin:10 @ 10.
	t pressAction:[Transcript showCr:'on'. t label:'on'].
	t releaseAction:[Transcript showCr:'off'. t label:'off'].
	v realize

      lamp and freezing size of the label (looks better):

	|v t|

	v := View new.
	t := Toggle label:'off' in:v.
	t showLamp:true.
	t sizeFixed:true.
	t origin:10 @ 10.
	t pressAction:[Transcript showCr:'on'. t label:'on'].
	t releaseAction:[Transcript showCr:'off'. t label:'off'].
	v realize

      another variation:

	|v t|

	v := View new.
	t := Toggle label:'off' in:v.
	t showLamp:true.
	t sizeFixed:true.
	t onLevel:(t offLevel).
	t origin:10 @ 10.
	t pressAction:[Transcript showCr:'on'. t label:'on'].
	t releaseAction:[Transcript showCr:'off'. t label:'off'].
	v realize

      and another one:

	|v t|

	v := View new.
	t := Toggle label:'off' in:v.
	t showLamp:true.
	t sizeFixed:true.

	t showLamp:false.
	t offLevel:3.
	t onLevel:3.
	t origin:10 @ 10.
	t pressAction:[Transcript showCr:'on'. t showLamp:true. t label:'on'].
	t releaseAction:[Transcript showCr:'off'. t showLamp:false. t label:'off'].
	v realize

      another font:

	|v t|

	v := View new.
	t := Toggle label:'off' in:v.
	t font:(Font family:'times' face:'bold' style:'roman' size:24).
	t label:'hello'.
	t origin:10 @ 10.
	t pressAction:[Transcript showCr:'on'.].
	t releaseAction:[Transcript showCr:'off'.].
	v realize

      another font (no, I dont know what it means :-):

	|v t|

	v := View new.
	t := Toggle label:'off' in:v.
	t font:(Font family:'k14' face:nil style:nil size:nil).
	t label:(TwoByteString with:(Character value:16r3021)).

	t origin:10 @ 10.
	t pressAction:[Transcript showCr:'on'.].
	t releaseAction:[Transcript showCr:'off'.].
	v realize
"
! !

!Toggle methodsFor:'initialization'!

initialize
    super initialize.
    actionWhenPressed := true
!

initStyle
    super initStyle.

    showLamp := StyleSheet at:#toggleShowLamp default:false.
    showLamp ifTrue:[
	onLevel := offLevel.

	"dont know, if I like this ..."
	"
	activeBgColor := bgColor
	"
    ].

    lampColor := StyleSheet at:#toggleLampColor default:Color yellow.
    lampWidth := (device horizontalPixelPerMillimeter * 1.8) rounded.
    lampHeight := (device verticalPixelPerMillimeter * 3.5) rounded.
! !

!Toggle methodsFor:'accessing'!

showLamp
    "return true, if I show a lamp"

    ^ showLamp
!

showLamp:aBoolean
    "enable/disable drawing of the lamp"

    showLamp ~~ aBoolean ifTrue:[
	showLamp := aBoolean.
	self computeLabelSize.
	fixSize ifFalse:[
	    self resize
	]
    ]
!

lampColor:aColor
    "change the color of the toggle-lamp"

    lampColor := aColor.
    (shown and:[showLamp and:[pressed]]) ifTrue:[
	self redraw
    ]
! !


!Toggle methodsFor:'private'!

computeLabelOrigin
    "compute the origin of the form/text.
     redefined to move label to the right if there is a lamp."

    super computeLabelOrigin.
    showLamp ifTrue:[
	labelOriginX := labelOriginX + hSpace + lampWidth + hSpace.
    ]
!

computeLabelSize
    "compute the extent needed to hold the label plus the lamp"

    super computeLabelSize.
    showLamp ifTrue:[
	labelWidth := labelWidth + hSpace + lampWidth + hSpace.
	labelHeight := labelHeight max: lampHeight
    ]
! !

!Toggle methodsFor:'changing state'!

toggleNoAction
    "toggle, but do NOT perform any action - can be used to change a toggle
     under program control (i.e. turn one toggle off from another one)"

    |newLevel|

    pressed := pressed not.
    pressed ifTrue:[
	newLevel := onLevel.
    ] ifFalse:[
	newLevel := offLevel.
    ].
    self level:newLevel.

    shown ifTrue:[
	self redraw
    ].
    model notNil ifTrue:[
	model value:pressed
    ]
!

toggle
    "toggle and perform the action"

    |action|

    enabled ifTrue:[
	self toggleNoAction.
	pressed ifTrue:[
	    action := pressActionBlock
	] ifFalse:[
	    action := releaseActionBlock
	].
	action notNil ifTrue:[action value].
	model notNil ifTrue:[
	    model value:pressed.
	    model changed
	].
	self changed
    ]
! !

!Toggle methodsFor:'events'!

buttonPress:button x:x y:y
    ((button == 1) or:[button == #select]) ifTrue:[
	self toggle
    ] ifFalse:[
	^ super buttonPress:button x:x y:y
    ].
!

buttonRelease:button x:x y:y
    ((button == 1) or:[button == #select]) ifFalse:[
	^ super buttonRelease:button x:x y:y
    ].
    "ignore"
! !

!Toggle methodsFor:'redrawing'!

drawWith:fg and:bg
    "redraw myself with fg/bg. Use super to draw the label, 
     drawing of the lamp is done here."

    |x y|

    super drawWith:fg and:bg.   "this draws the text"

    showLamp ifTrue:[
	x := hSpace + margin.
	y := (height - lampHeight) // 2.
	self drawEdgesForX:x y:y width:lampWidth height:lampHeight level:-1.
	pressed ifTrue:[
	    self paint:lampColor.
	] ifFalse:[
	    self paint:bgColor.
	].
	self fillRectangleX:x+2 y:y+2 width:lampWidth - 4 height:lampHeight - 4
    ]
! !