"

 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.

"

WindowBuilder subclass:#UIBuilder

	instanceVariableNames:'view currentMenuSelector menuAspect spec'

	classVariableNames:'Verbose'

	poolDictionaries:''

	category:'Interface-Support-UI'

!

!UIBuilder class methodsFor:'documentation'!

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.

"

!

documentation

"

    this class will (eventually) allow parsing windowSpecs as

    created by ST-80's UIPainter, and thereby allow to run applications

    built with this tool.

    It was created to allow execution of PD applications which were

    written using that tool (and more and more are appearing ...).

    The class is not completed yet and certainly not bug free.

    Also, it is not quaranteed that all winSpecs are understood.

    [author:]

        Claus Gittinger

"

! !

!UIBuilder class methodsFor:'initialization'!

initialize

    Verbose := false    "/ debugging flag

! !

!UIBuilder methodsFor:'accessing'!

menuAspect

    ^ menuAspect

! !

!UIBuilder methodsFor:'operation'!

buildFromSpec:aSpecArray

    |m spec|

"/ old:

"/    self readSpec:aSpecArray.

    spec := UISpecification from:aSpecArray.

    topView := view := spec buildViewFor:self.

    menuAspect notNil ifTrue:[

	m := self componentAt:menuAspect.

	m notNil ifTrue:[

	    m := m value.

	    m notNil ifTrue:[

		m receiver:application.

		topView add:m.

		view topInset:(m heightIncludingBorder).

	    ]

	]

    ].

    ^ topView

    "Modified: 5.9.1995 / 21:43:29 / claus"

!

buildFromSpec:aSpecArray in:aView

    |m spec|

    spec := UISpecification from:aSpecArray.

    view := spec buildViewFor:self in:aView.

    menuAspect notNil ifTrue:[

	m := self componentAt:menuAspect.

	m notNil ifTrue:[

	    m := m value.

	    m notNil ifTrue:[

		m receiver:application.

		topView add:m.

		view topInset:(m heightIncludingBorder).

	    ]

	]

    ].

    ^ topView

    "Modified: 5.9.1995 / 21:48:09 / claus"

! !

!UIBuilder methodsFor:'private arg parsing'!

getAlignmentOrigin:spec

    "called for #(AlignmentOrigin ?x ?relX ?x ?y ?relY ?y)"

    ^ AlignmentOrigin new fromLiteralArrayEncoding:spec.

"/    ^ Array with:#alignmentOrigin

"/            with:((spec at:2) @ (spec at:5))     "/ ?

"/            with:((spec at:3) @ (spec at:6))     "/ rels ?

"/            with:((spec at:4) @ (spec at:7))     "/ insets ?

!

getArg:spec

    "take something like #(Point 50 100) and return the value"

    |what|

    what := spec at:1.

    ^ self perform:('get' , what , ':') asSymbol with:spec

!

getColorValue:spec

    "called for #(ColorValue #sym)

	     or #(ColorValue red green blue)"

    |arg|

    (arg := spec at:2) isSymbol ifTrue:[

	(Color respondsTo:arg) ifTrue:[

	    ^ Color perform:arg

	].

	^ Color name:arg asString ifIllegal:[Color black]

    ].

    arg isInteger ifTrue:[

	^ ColorValue scaledRed:arg

		     scaledGreen:(spec at:3)

		     scaledBlue:(spec at:4)

    ].

    ^ ColorValue red:arg

		 green:(spec at:3)

		 blue:(spec at:4)

!

getCompositeSpec:spec

    "called for #(CompositeSpec layout: #(orgx orgy cornx corny)"

    |layout|

    (spec at:2) == #layout: ifTrue:[

	layout := spec at:3.

	(layout at:1) == #Rectangle ifTrue:[

	    ^ Rectangle

		    origin:(layout at:2) @ (layout at:3)

		    corner:(layout at:4) @ (layout at:5)

	].

    ].

    self halt:'unimplemented'.

!

getLayoutFrame:spec

    "called for #(LayoutFrame absOrgX relOrgX absOrgY relOrgY absCornX relCornX absCornY relCornY)"

    "             1           2       3       4        5      6        7        8        9"

    ^ LayoutFrame new fromLiteralArrayEncoding:spec.

"/    ^ Array with:#layoutFrame

"/            with:((spec at:2) @ (spec at:4))     "/ org inset

"/            with:((spec at:6) @ (spec at:8))     "/ corner inset

"/            with:((spec at:3) @ (spec at:5))     "/ rel org

"/            with:((spec at:7) @ (spec at:9))     "/ rel corn 

!

getLayoutOrigin:spec

    "called for #(LayoutOrigin xInset relX yInset relY)"

    ^ LayoutOrigin new fromLiteralArrayEncoding:spec.

"/    ^ Array with:#layoutOrigin

"/            with:((spec at:3) @ (spec at:5))     "/ rels

"/            with:((spec at:2) @ (spec at:4))     "/ insets

!

getLookPreferences:spec

    "called for #(LookPreferences setForegroundColor: (...) setBackgroundColor: (...) ...)"

    |coll|

    coll := OrderedCollection new.

    2 to:spec size by:2 do:[:index |

	coll add: 

	    (Array with:(spec at:index)

		  with:(self getArg:(spec at:index+1)))

    ].

    ^ coll.

!

getPoint:spec

    "called for #(Point x y)"

    ^ Array with:#point 

	    with:((spec at:2) @ (spec at:3))

!

getRectangle:spec

    "called for #(Rectangle x y)"

    ^ Array with:#rectangle

	    with:(((spec at:2) @ (spec at:3)) corner:((spec at:4) @ (spec at:5)))

! !

!UIBuilder methodsFor:'private spec attribute parsing'!

XXyMultipleSelections:args view:aView

    aView multipleSelectOk:args

!

doesNotUnderstand:aMessage

    |rest sel|

    ((sel := aMessage selector) startsWith:'y') ifTrue:[

	rest := sel copyFrom:2 to:(sel indexOf:$:).

	rest at:1 put:(rest at:1) asLowercase.

	rest := rest asSymbolIfInterned.

	rest notNil ifTrue:[

	    (aMessage arguments at:2) perform:rest with:(aMessage arguments at:1).

	    ^ self.

	]

    ].

    super doesNotUnderstand:aMessage

    "Modified: 5.9.1995 / 21:13:16 / claus"

!

yBounds:args view:aView frame:frameView

    |value r|

    value := self getArg:args.

    (value at:1) == #rectangle ifTrue:[

	r := value at:2.

	aView origin:r origin corner:r corner.

	^ self

    ].

    self halt:'unimplemented'.

!

yCollection:args view:aView frame:frameView

    args do:[:aSpec |

	self readSpec:aSpec view:aView frame:frameView.

    ].

!

yColors:args view:aView frame:frameView

    |value|

    value := self getArg:args.

    self halt:'unimplemented'.

!

yComponent:args view:aView frame:frameView

    |v|

    args isSymbol ifTrue:[

	v := application perform:args.

	v origin:0.0@0.0 corner:1.0@1.0.

	aView addSubView:v

    ] ifFalse:[

"/        v := View origin:0.0@0.0 corner:1.0@1.0 in:aView.

"/        self readSpec:args view:v frame:frameView.

	self readSpec:args view:aView frame:frameView.

    ]

!

yCompositeSpec:args view:aView frame:frameView

    |value r|

    self doSpec:args for:aView.

"/

"/    value := self getArg:args.

"/    (value at:1) == #rectangle ifTrue:[

"/	r := value at:2.

"/	aView origin:r origin corner:r corner.

"/	^ self

"/    ].

"/

"/self halt.

!

yDefaultable:args view:aView frame:frameView

    'defaultable ignored' printCR

    "Modified: 20.5.1996 / 10:29:24 / cg"

!

yFlags:args view:aView frame:frameView

    'flags: ' print. args print. ' for ' print. aView print. ' ignored' printCR

"

32 : initially disabled

16 : initially invisible

 8 : border

 4 : menuBar

 2 : hScroll

 1 : vScroll

"

    "Modified: 2.9.1995 / 15:44:15 / claus"

    "Modified: 20.5.1996 / 10:29:26 / cg"

!

yIsDefault:args view:aView frame:frameView

    aView isReturnButton:args

!

yIsOpaque:args view:aView frame:frameView

    'isOpaque ignored' printCR.

    "Modified: 20.5.1996 / 10:29:29 / cg"

!

yIsReadOnly:args view:aView frame:frameView

    args ifTrue:[

	aView readOnly

    ]

!

yLayout:args view:aView frame:frameView

    |value r org corn orgInset cornInset what|

    value := self getArg:args.

    value isLayout ifTrue:[

        frameView geometryLayout:value.

        ^ self

    ].

    what := value at:1.

    what == #point ifTrue:[

        Verbose ifTrue:[frameView print. ' ' print. 'origin: ' print. (value at:2) printCR].

        frameView origin:(value at:2).

        ^ self

    ].

    what == #rectangle ifTrue:[

        r := value at:2.

        Verbose ifTrue:[

            frameView print. ' ' print. 'origin: ' print. r origin print.

                             ' corner: ' print. r corner printCR.

        ].

        frameView origin:r origin corner:r corner.

        ^ self

    ].

    what == #layoutOrigin ifTrue:[

        "/ #layoutOrigin relOrg orgInset

        org := value at:2.       "/ relative origin

        org := org x asFloat @ org y asFloat.

        orgInset := self fixExtentFor:(value at:3).

        Verbose ifTrue:[

            frameView print. ' ' print. 'origin: ' print. org printCR

        ].

        frameView origin:org.

        frameView 

              leftInset:orgInset x;

              topInset:orgInset y.

        ^ self

    ].

    what == #layoutFrame ifTrue:[

        "/ #layoutFrame orgInset cornInset relOrg relCorner

        org := value at:4.       "/ relative origin

        orgInset := self fixExtentFor:(value at:2).

        org := org x asFloat @ org y asFloat.

"/        org = (0@0) ifTrue:[

"/            org := value at:2    "/ absolute origin

"/        ].

        corn := value at:5.      "/ relative corner

        cornInset := self fixExtentFor:(value at:3).

        corn := corn x asFloat @ corn y asFloat.

"/        corn = (0@0) ifTrue:[

"/            corn := value at:3   "/ absolute corner

"/        ].

        Verbose ifTrue:[

            frameView print. ' ' print. 'origin: ' print. org print.

                             ' corner: ' print. corn printCR.

        ].

        frameView origin:org corner:corn.

        frameView leftInset:orgInset x;

              topInset:orgInset y;

              rightInset:cornInset x negated;

              bottomInset:cornInset y negated.

        frameView sizeFixed:true.

        ^ self

    ].

    what == #alignmentOrigin ifTrue:[

        org := value at:3.       "/ relative origin

        org = (0@0) ifTrue:[

            org := value at:2    "/ absolute origin

        ].

        Verbose ifTrue:[frameView print. ' ' print. 'origin: ' print. org printCR].

        frameView origin:org.

        ^ self

    ].

    self halt:'unimplemented'.

    "Modified: 20.5.1996 / 10:29:35 / cg"

!

yMax:args view:aView frame:frameView

    |value|

    value := self getArg:args.

    (value at:1) == #point ifTrue:[

	aView maxExtent:(value at:2).

	^ self

    ].

    self halt:'unimplemented'.

!

yMenu:args view:aView frame:frameView

    menuAspect := args

!

yMin:args view:aView frame:frameView

    |value|

    value := self getArg:args.

    (value at:1) == #point ifTrue:[

	aView minExtent:(value at:2).

	^ self

    ].

    self halt:'unimplemented'.

!

yModel:args view:aView frame:frameView

    |model|

    (aspects notNil and:[aspects includesKey:args]) ifTrue:[

	model := aspects at:args

    ] ifFalse:[

	(aView isMemberOf:Button) ifTrue:[

	    model := application.

	    aView aspect:nil.

	    aView changeMessage:args.

	] ifFalse:[

	    model := application perform:args.

	].

    ].

    aView model:model.

!

yMultipleSelections:args view:aView frame:frameView

    args == true ifTrue:[

	aView multipleSelectOk:true

    ]

!

yName:args view:aView frame:frameView

    self componentAt:args put:aView

!

yOrientation:args view:aView frame:frameView

    'orientation ignored' printCR.

    "Modified: 20.5.1996 / 10:29:37 / cg"

!

ySelectionStyle:args view:aView frame:frameView

    'selectionStyle ignored' printCR.

    "Modified: 20.5.1996 / 10:29:41 / cg"

!

yStart:args view:aView frame:frameView

    (aView isKindOf:Scroller) ifTrue:[