'From Smalltalk/X, Version:2.10.5 on 11-apr-1995 at 9:42:52 am'!

WindowBuilder subclass:#UIBuilder 
	 instanceVariableNames:''
	 classVariableNames:'Verbose'
	 poolDictionaries:''
	 category:'Interface-Support-UI'
!

!UIBuilder class methodsFor:'documentation'!

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.
"
! !

!UIBuilder class methodsFor:'initialization'!

initialize
    Verbose := false    "/ debugging flag
! !

!UIBuilder methodsFor:'operation'!

buildFromSpec:aSpec
    self readSpec:aSpec.
    ^ topView
! !

!UIBuilder methodsFor:'private spec component parsing'!

xLabelSpec:aSpec view:aView
    |l|

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

!

xFullSpec:aSpec
    topView := StandardSystemView new.
    topView controller:(ApplicationController new).
    topView application:application.

    self doSpec:aSpec for:topView.
    ^ topView
!

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

!

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

!

xInputFieldSpec:aSpec view:aView
    |l|

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

xActionButtonSpec:aSpec view:aView
    |b|

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

xSequenceViewSpec:aSpec view:aView
    |f s|

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

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 
!

xProgressIndicatorSpec:aSpec view:aView
    |s|

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

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 
!

xCompositeSpecCollection:aSpec view:aView
    |v|

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

!

xArbitraryComponentSpec:aSpec view:aView
    |v|

"/    v := View in:aView.
    v := Label label:'ArbitraryView' in:aView.
    v level:-1.
    self doSpec:aSpec for:v 
!

xCheckBoxSpec:aSpec view:aView
    |b|

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

!

xTableViewSpec:aSpec view:aView
    |l|

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

xGroupBoxSpec:aSpec view:aView
    |l|

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

xDividerSpec:aSpec view:aView
    |l|

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

!UIBuilder methodsFor:'private spec attribute parsing'!

yMultipleSelections:args view:aView
    aView multipleSelectOk:args
!

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.
    ].
!

yComponent:args view:aView frame:frameView
    |v|

    args isSymbol ifTrue:[
	v := application perform:args.
	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.
    ]
!

yColors:args view:aView frame:frameView
    |value|

    value := self getArg:args.
    self halt:'unimplemented'.
!

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' printNL
!

yLabel:args view:aView frame:frameView
    aView label:args.

!

yLayout:args view:aView frame:frameView
    |value r org corn orgInset cornInset what|

    value := self getArg:args.

    what := value at:1.
    what == #point ifTrue:[
	Verbose ifTrue:[frameView print. ' ' print. 'origin: ' print. (value at:2) printNL].
	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 printNL.
	].
	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 printNL
	].
	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 printNL.
	].
	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 printNL].
	frameView origin:org.
	^ self
    ].

    self halt:'unimplemented'.
!

yFlags:args view:aView frame:frameView
    'flags ignored' printNL
!

yIsDefault:args view:aView frame:frameView
    aView isReturnButton: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:[
	model := application perform:args
    ].
    aView model:model.
!

yIsOpaque:args view:aView frame:frameView
    'isOpaque ignored' printNL.
!

yIsReadOnly:args view:aView frame:frameView
    args ifTrue:[
	aView readOnly
    ]
!

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
    'menu ignored' printNL
!

yName:args view:aView frame:frameView
    bindings isNil ifTrue:[
	bindings := IdentityDictionary new.
    ].
    bindings at:args put:aView
!

yOrientation:args view:aView frame:frameView
    'orientation ignored' printNL.
!

ySelectionStyle:args view:aView frame:frameView
    'selectionStyle ignored' printNL.

!

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

yStart:args view:aView frame:frameView
    'start ignored' printNL.

!

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

!

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

yStop:args view:aView frame:frameView
    'stop ignored' printNL.

!

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

!

yType:args view:aView frame:frameView
    'type ignored' printNL.
! !

!UIBuilder methodsFor:'private arg parsing'!

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

    |what|

    what := spec at:1.
    ^ self perform:('get' , what , ':') asSymbol with:spec
!

getPoint:spec
    "called for #(Point x y)"

    ^ Array with:#point 
	    with:((spec at:2) @ (spec at:3))
!

getLayoutFrame:spec
    "called for #(LayoutFrame absOrgX relOrgX absOrgY relOrgY absCornX relCornX absCornY relCornY)"
    "             1           2       3       4        5      6        7        8        9"
    ^ 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 

!

getRectangle:spec
    "called for #(Rectangle x y)"

    ^ Array with:#rectangle
	    with:(((spec at:2) @ (spec at:3)) corner:((spec at:4) @ (spec at:5)))
!

getLayoutOrigin:spec
    "called for #(LayoutOrigin xInset relX yInset relY)"

    ^ Array with:#layoutOrigin
	    with:((spec at:3) @ (spec at:5))     "/ rels
	    with:((spec at:2) @ (spec at:4))     "/ insets
!

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'.
!

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

    ^ 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 ?


!

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.
!

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)


! !

!UIBuilder methodsFor:'private spec parsing'!

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

add:aSpec
    self readSpec:aSpec
!

readSpec:aSpec
    |what|

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

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.
	] 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
	]
    ]
!

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

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

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

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

! !

!UIBuilder methodsFor:'private special kludges'!

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

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

UIBuilder  initialize!