"
 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)"

    |clr 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:[
        aView start:args.
        ^ self
    ].
    'start ignored' printCR.

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

yStep:args view:aView frame:frameView
    'step ignored' printCR.

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

yStop:args view:aView frame:frameView
    (aView isKindOf:Scroller) ifTrue:[
        aView stop:args.
        ^ self
    ].
    'stop ignored' printCR.

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

yStyle:args view:aView frame:frameView
    'name ignored' printCR.

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

ySubmenu:aSpec view:menu frame:frameView
    |items lines selectors labels|

    aSpec first ~~ #Menu ifTrue:[
        self halt:'unexpected'.
    ].
    items := (aSpec at:2).
    lines := aSpec at:3.
    selectors := aSpec at:4.

    "collect labels & selectors"
    labels := OrderedCollection new.
    items do:[:item |
        item first ~~ #MenuItem ifTrue:[
            self halt:'unexpected'
        ].
        (item at:2) ~~ #'label:' ifTrue:[
            self halt:'unexpected'
        ].
        labels add:(item at:3).
    ].

    menu at:currentMenuSelector
        putLabels:labels
        selectors:selectors
        receiver:nil.

    "Created: 9.12.1995 / 23:06:39 / cg"
    "Modified: 9.12.1995 / 23:08:15 / cg"
!

yTabable:args view:aView frame:frameView
    args == true ifTrue:[
        focusSequence isNil ifTrue:[
            focusSequence := OrderedCollection new.
        ].
        focusSequence add:aView.
        'tabable element added' printCR.
    ]

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

yType:args view:aView frame:frameView
    (aView isMemberOf:EditField) ifTrue:[
        args == #number ifTrue:[
            aView converter:(PrintConverter new initForNumber).
            ^ self
        ]
    ].

    'type ignored' printCR.

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

yWindow:args view:aView frame:frameView
    self readSpec:args view:aView frame:frameView.
! !

!UIBuilder methodsFor:'private spec component parsing'!

xActionButtonSpec:aSpec view:aView
    |b|

    b := Button in:aView.
    self fixFontFor:b.
    self doSpec:aSpec for:b 
!

xArbitraryComponentSpec:aSpec view:aView
    |v|

    v := View in:aView.
"/    v := Label label:'ArbitraryView' in:aView.
    v origin:0.0@0.0 corner:1.0@1.0.
    v level:-1.
    self doSpec:aSpec for:v

    "Modified: 2.9.1995 / 15:26:03 / claus"
!

xCheckBoxSpec:aSpec view:aView
    |b|

    b := CheckBox in:aView.
    self fixFontFor:b.
    self doSpec:aSpec for:b 

!

xCompositeSpecCollection:aSpec view:aView
    |v|

"/ 'compositeSpecCollection ignored' printNL.
"/ ^ self.
    v := View in:aView.
    self doSpec:aSpec for:v 

!

xDividerSpec:aSpec view:aView
    |l|

    l := View in:aView.
    self doSpec:aSpec for:l 
!

xFramedBoxSpec:aSpec view:aView
    |v|

    v := FramedBox in:aView.
    self doSpec:aSpec for:v

    "Modified: 5.9.1995 / 21:05:38 / claus"
!

xFullSpec:aSpec
    topView isNil ifTrue:[
	topView := StandardSystemView new.
	topView controller:(ApplicationController new).
	topView application:application.
    ].

    view := View new.
    self doSpec:aSpec for:view.

    topView extent:(view extent).
    view origin:0.0@0.0 corner:1.0@1.0.
    topView add:view.

    ^ topView
!

xGroupBoxSpec:aSpec view:aView
    |l|

    l := FramedBox in:aView.
    self doSpec:aSpec for:l 
!

xHorizontalPanelViewSpec:aSpec view:aView
    |v|

    v := HorizontalPanelView in:aView.
    self doSpec:aSpec for:v

    "Modified: 5.9.1995 / 21:06:25 / claus"
!

xInputFieldSpec:aSpec view:aView
    |l|

    l := EditField in:aView.
    self fixFontFor:l.
    l aspect:#value; change:#value:.
    self doSpec:aSpec for:l 
!

xLabelSpec:aSpec view:aView
    |l|

    l := Label in:aView.
    self fixFontFor:l.
    self doSpec:aSpec for:l 

!

xMenu:aSpec
    |items numItems unknown prevCurrent labels|

    topView := PullDownMenu new.

    items := aSpec at:2.
    numItems := (aSpec at:3) at:1.
    unknown := (aSpec at:4).

    prevCurrent := currentMenuSelector.

    "precollect labels ..."
    labels := OrderedCollection new.
    items do:[:item |
        (item at:1) ~~ #MenuItem ifTrue:[
            self halt:'unexpected'
        ].
        (item at:2) ~~ #'label:' ifTrue:[
            self halt:'unexpected'
        ].
        labels add:(item at:3)
    ].

    topView labels:labels.

    items with:(1 to:numItems) do:[:item :index |
        currentMenuSelector := index.
        self doSpec:item for:topView.
    ].

    currentMenuSelector := prevCurrent.
    ^ topView

    "Created: 9.12.1995 / 23:06:31 / cg"
    "Modified: 9.12.1995 / 23:08:11 / cg"
!

xPopUpMenu:aSpec
    |menu values|

    menu := PopUpMenu 
		labels:(aSpec at:2).
    values := Array new:((aSpec at:2) size).

    (aSpec at:4) keysAndValuesDo:[:index :item |
	((item size > 0)
	and:[(item at:1) == #PopUpMenu]) ifTrue:[
	    menu subMenuAt:index put:(self xPopUpMenu:item)
	] ifFalse:[
	    values at:index put:item
	]
    ].

    menu values:values.
    ^ menu
!

xProgressIndicatorSpec:aSpec view:aView
    |s|

    s := ProgressIndicator in:aView.
    self doSpec:aSpec for:s 
!

xScrollerSpec:aSpec view:aView
    |s idx orientation|

    idx := aSpec indexOf:#orientation:.
    idx == 0 ifTrue:[
	orientation := #vertical
    ] ifFalse:[
	orientation := aSpec at:(idx + 1)
    ].
    orientation == #horizontal ifTrue:[
	s := HorizontalScroller in:aView
    ] ifFalse:[
	s := Scroller in:aView
    ].
    self doSpec:aSpec for:s 
!

xSequenceViewSpec:aSpec view:aView
    |f s|

    f := ScrollableView for:SelectionInListView in:aView.
    s := f scrolledView.
    self doSpec:aSpec for:s frame:f.
!

xSliderSpec:aSpec view:aView
    |s idx orientation|

    idx := aSpec indexOf:#orientation:.
    idx == 0 ifTrue:[
	orientation := #vertical
    ] ifFalse:[
	orientation := aSpec at:(idx + 1)
    ].
    orientation == #horizontal ifTrue:[
	s := HorizontalSlider in:aView
    ] ifFalse:[
	s := Slider in:aView
    ].
    self doSpec:aSpec for:s 
!

xSpecCollection:aSpec view:aView
    self doSpec:aSpec for:aView

!

xSubCanvasSpec:aSpec view:aView
    |v|

    v := SubCanvas in:aView.
    v origin:0.0@0.0 corner:1.0@1.0.
    self doSpec:aSpec for:v

    "Modified: 2.9.1995 / 15:26:15 / claus"
!

xTableViewSpec:aSpec view:aView
    |l|

    'tableView ignored' printCR.
    l := Label label:'TableView' in:aView.
    l level:-1.
    self doSpec:aSpec for:l

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

xVerticalPanelViewSpec:aSpec view:aView
    |v|

    v := VerticalPanelView in:aView.
    self doSpec:aSpec for:v

    "Modified: 5.9.1995 / 21:06:19 / claus"
!

xWindowSpec:aSpec view:aView
    self doSpec:aSpec for:aView

! !

!UIBuilder methodsFor:'private spec parsing'!

add:aSpec
    self readSpec:aSpec
!

doSingleSpec:selector args:args for:aView frame:frame
    Verbose ifTrue:[
        'doSingle (' print. aView print. ' -> ' print. selector print.
        ' ' print. args printString printCR.
    ].

    self perform:('y' , selector asString asUppercaseFirst , 'view:frame:') asSymbol 
            with:args
            with:aView
            with:frame.

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

doSpec:aSpec for:aView
    ^ self doSpec:aSpec for:aView frame:aView
!

doSpec:aSpec for:aView frame:frame 
    |state selector args argsToRead|

    argsToRead := 0.
    args := #().
    aSpec from:2 to:(aSpec size) do:[:element |
        argsToRead > 1 ifTrue:[
            self halt:'invalid spec'.
        ] ifFalse:[
            argsToRead == 1 ifTrue:[
                args := element.
                argsToRead := argsToRead - 1
            ] ifFalse:[
                selector := element.
                argsToRead := selector numArgs.
            ].
        ].
        argsToRead == 0 ifTrue:[
            self doSingleSpec:selector args:args for:aView frame:frame
        ]
    ]

    "Created: 9.12.1995 / 23:06:18 / cg"
!

readSpec:aSpec
    |what|

    what := aSpec first.
    ^ self perform:('x' , what , ':') asSymbol with:aSpec
!

readSpec:aSpec view:aView frame:frameView
    |what|

    what := aSpec first.
    self perform:('x' , what , ':view:') asSymbol with:aSpec with:aView
! !

!UIBuilder methodsFor:'private special kludges'!

fixExtentFor:aPoint
    ^ aPoint "/ (aPoint * (1 @ 1.5)) truncated
!

fixFontFor:aComponent
    "since ST-80 seems to use a smaller default font,
     and component sizes are often given in pixels in winSpecs,
     make the font smaller for less ugly looking elements."

"/   aComponent font:(aComponent font size:8)
! !

!UIBuilder class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/UIBuilder.st,v 1.14 1996-05-20 08:40:29 cg Exp $'
! !
UIBuilder initialize!