Mercurial Mercurial > hg > stx-libview2 / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
UIBuilder.st
changeset 66 6ee963fd8e27
child 69 225a9efd50f5 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/UIBuilder.st	Wed May 03 02:26:52 1995 +0200
@@ -0,0 +1,626 @@
+'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'
+!
+
+!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.
+    s
+	aspect:#value;
+	change:#value:;
+	listSymbol:#list 
+!
+
+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
+    components isNil ifTrue:[
+	components := Dictionary new.
+    ].
+    components 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 components."
+
+"/   aComponent font:(aComponent font size:8)
+!
+
+fixExtentFor:aPoint
+    ^ aPoint "/ (aPoint * (1 @ 1.5)) truncated
+! !
+
+UIBuilder  initialize!
hg/stx-libview2