"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 2015 by Claus Gittinger / eXept Software AG

              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.

"

"{ Package: 'stx:libview' }"

"{ NameSpace: Smalltalk }"

SimpleBorder subclass:#RoundedBorder

	instanceVariableNames:'imgTopLeft imgTopRight imgBottomRight imgBottomLeft'

	classVariableNames:'TemplateTopLeft TemplateTopRight TemplateBottomRight

		TemplateBottomLeft'

	poolDictionaries:''

	category:'Graphics-Support'

!

!RoundedBorder class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2015 by Claus Gittinger / eXept Software AG

              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.

"

!

documentation

"

    a rounded border as in modern yosemite and new adwaita

    [see also:]

        Border

    [author:]

        Claus Gittinger

"

!

examples

"

                                                        [exBegin]

     |v b|

     v := StandardSystemView extent:200@100.

     v openAndWait.

     b := RoundedBorder width:5 color:Color red.

     b displayOn:v forDisplayBox:(0@0 extent:100@100).

                                                        [exEnd]

                                                        [exBegin]

     |t v b|

     t := StandardSystemView extent:200@100.

     t viewBackground:Color green.

     v := View in:t.

     v viewBackground:Color red.

     v origin:10@10 corner:90@90.

     t openAndWait.

     b := RoundedBorder width:10 color:Color red.

     v border:b

                                                        [exEnd]

"

! !

!RoundedBorder class methodsFor:'image specs'!

templateBottomLeftImage

    <resource: #programImage>

    TemplateBottomLeft isNil ifTrue:[

        TemplateBottomLeft := self templateBottomRightImage rotated:90

    ].    

    ^ TemplateBottomLeft

    "

     self templateBottomLeftImage

    "

    "Modified: / 28-07-2018 / 09:53:47 / Claus Gittinger"

!

templateBottomRightImage

    <resource: #programImage>

    TemplateBottomRight isNil ifTrue:[

        TemplateBottomRight := self templateTopRightImage rotated:90

    ].    

    ^ TemplateBottomRight

    "

     self templateBottomRightImage

    "

    "Modified: / 28-07-2018 / 09:53:43 / Claus Gittinger"

!

templateTopLeftImage    

    <resource: #programImage>

    TemplateTopLeft isNil ifTrue:[

        TemplateTopLeft := self topLeftImageUnfilledMasked4

    ].    

    ^ TemplateTopLeft

    "

     TemplateTopLeft := TemplateTopRight := nil.

     TemplateBottomLeft := TemplateBottomRight := nil.

    "

    "Modified: / 28-07-2018 / 09:53:40 / Claus Gittinger"

!

templateTopRightImage

    <resource: #programImage>

    TemplateTopRight isNil ifTrue:[

        TemplateTopRight := self templateTopLeftImage rotated:90

    ].    

    ^ TemplateTopRight

    "

     self templateTopRightImage

    "

    "Modified: / 28-07-2018 / 09:53:31 / Claus Gittinger"

!

topLeftImageUnfilledMasked

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self topLeftImageUnfilledMasked inspect

     ImageEditor openOnClass:self andSelector:#topLeftImageUnfilledMasked

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:'RoundedBorder topLeftImageUnfilledMasked'

        ifAbsentPut:[(Depth1Image width:4 height:4) bits:(ByteArray fromPackedString:'@@@@@@@a') colorMapFromArray:#[0 0 0] mask:((ImageMask width:4 height:4) bits:(ByteArray fromPackedString:'8LB@@@@a'); yourself); yourself]

!

topLeftImageUnfilledMasked2

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self topLeftImageUnfilledMasked2 inspect

     ImageEditor openOnClass:self andSelector:#topLeftImageUnfilledMasked2

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:'RoundedBorder topLeftImageUnfilledMasked2'

        ifAbsentPut:[(Depth1Image width:4 height:4) bits:(ByteArray fromPackedString:'@@@@@@@a') colorMapFromArray:#[0 0 0] mask:((ImageMask width:4 height:4) bits:(ByteArray fromPackedString:'<LB@ @@a'); yourself); yourself]

!

topLeftImageUnfilledMasked3

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self topLeftImageUnfilledMasked3 inspect

     ImageEditor openOnClass:self andSelector:#topLeftImageUnfilledMasked3

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:'RoundedBorder topLeftImageUnfilledMasked3'

        ifAbsentPut:[(Depth1Image width:4 height:4) bits:(ByteArray fromPackedString:'DFA@ @@a') colorMapFromArray:#[0 0 0 127 127 127] mask:((ImageMask width:4 height:4) bits:(ByteArray fromPackedString:'<NC@ @@a'); yourself); yourself]

!

topLeftImageUnfilledMasked4

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self topLeftImageUnfilledMasked4 inspect

     ImageEditor openOnClass:self andSelector:#topLeftImageUnfilledMasked4

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:'RoundedBorder topLeftImageUnfilledMasked4'

        ifAbsentPut:[(Depth1Image width:4 height:4) bits:(ByteArray fromPackedString:'LDB@ @@a') colorMapFromArray:#[0 0 0 127 127 127] mask:((ImageMask width:4 height:4) bits:(ByteArray fromPackedString:'<LB@ @@a'); yourself); yourself]

! !

!RoundedBorder methodsFor:'displaying'!

displayOn:aGC forDisplayBox:aRectangle

    |imgDim boxLeft boxRight boxTop boxBottom boxWidth boxHeight|

    color isNil ifTrue:[ ^ self].

    super displayOn:aGC forDisplayBox:aRectangle.

    imgTopLeft isNil ifTrue:[

        self makeImages.

        imgTopLeft isNil ifTrue:[

            ^ self

        ].    

    ].    

    imgDim :=4.

    boxLeft := aRectangle left + width.

    boxTop := aRectangle top + width.

    boxWidth := aRectangle width.

    boxHeight := aRectangle height.

    boxRight := boxLeft + boxWidth - width - 1.

    boxBottom := boxTop + boxHeight - width - 1.

    aGC displayImage:imgTopLeft x:boxLeft y:boxTop.

    aGC displayImage:imgTopRight x:boxRight-imgDim-imgDim y:boxTop.

    aGC displayImage:imgBottomRight x:boxRight-imgDim-imgDim y:boxBottom-imgDim-imgDim.

    aGC displayImage:imgBottomLeft x:boxLeft y:boxBottom-imgDim-imgDim.

! !

!RoundedBorder methodsFor:'private'!

makeImages

    |lightColor|

    imgTopLeft := self class templateTopLeftImage copy.

    imgTopRight := self class templateTopRightImage copy.

    imgBottomLeft := self class templateBottomLeftImage copy.

    imgBottomRight := self class templateBottomRightImage copy.

    lightColor := color lightened.

    imgTopLeft colorMap 

        at:1 put:color; at:2 put:lightColor.

    imgTopRight colorMap 

        at:1 put:color; at:2 put:lightColor.

    imgBottomLeft colorMap 

        at:1 put:color; at:2 put:lightColor.

    imgBottomRight colorMap 

        at:1 put:color; at:2 put:lightColor.

! !

!RoundedBorder class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !