UIBuilder.st
author claus
Sun, 23 Jul 1995 04:29:14 +0200
changeset 86 38cc61653cb2
parent 80 e029e7deed8b
child 88 f8a41aa4b34b
permissions -rw-r--r--
.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
66
claus
parents:
diff changeset
     1
'From Smalltalk/X, Version:2.10.5 on 11-apr-1995 at 9:42:52 am'!
claus
parents:
diff changeset
     2
claus
parents:
diff changeset
     3
WindowBuilder subclass:#UIBuilder 
86
claus
parents: 80
diff changeset
     4
	 instanceVariableNames:'view currentMenuSelector menuAspect'
66
claus
parents:
diff changeset
     5
	 classVariableNames:'Verbose'
claus
parents:
diff changeset
     6
	 poolDictionaries:''
80
claus
parents: 75
diff changeset
     7
	 category:'Interface-Support-UI'
66
claus
parents:
diff changeset
     8
!
claus
parents:
diff changeset
     9
claus
parents:
diff changeset
    10
!UIBuilder class methodsFor:'documentation'!
claus
parents:
diff changeset
    11
claus
parents:
diff changeset
    12
documentation
claus
parents:
diff changeset
    13
"
claus
parents:
diff changeset
    14
    this class will (eventually) allow parsing windowSpecs as
claus
parents:
diff changeset
    15
    created by ST-80's UIPainter, and thereby allow to run applications
claus
parents:
diff changeset
    16
    built with this tool.
claus
parents:
diff changeset
    17
    It was created to allow execution of PD applications which were
claus
parents:
diff changeset
    18
    written using that tool (and more and more are appearing ...).
claus
parents:
diff changeset
    19
claus
parents:
diff changeset
    20
    The class is not completed yet and certainly not bug free.
claus
parents:
diff changeset
    21
    Also, it is not quaranteed that all winSpecs are understood.
claus
parents:
diff changeset
    22
"
claus
parents:
diff changeset
    23
! !
claus
parents:
diff changeset
    24
claus
parents:
diff changeset
    25
!UIBuilder class methodsFor:'initialization'!
claus
parents:
diff changeset
    26
claus
parents:
diff changeset
    27
initialize
claus
parents:
diff changeset
    28
    Verbose := false    "/ debugging flag
claus
parents:
diff changeset
    29
! !
claus
parents:
diff changeset
    30
86
claus
parents: 80
diff changeset
    31
!UIBuilder methodsFor:'accessing'!
claus
parents: 80
diff changeset
    32
claus
parents: 80
diff changeset
    33
menuAspect
claus
parents: 80
diff changeset
    34
    ^ menuAspect
claus
parents: 80
diff changeset
    35
! !
claus
parents: 80
diff changeset
    36
66
claus
parents:
diff changeset
    37
!UIBuilder methodsFor:'operation'!
claus
parents:
diff changeset
    38
claus
parents:
diff changeset
    39
buildFromSpec:aSpec
86
claus
parents: 80
diff changeset
    40
    |m|
claus
parents: 80
diff changeset
    41
66
claus
parents:
diff changeset
    42
    self readSpec:aSpec.
86
claus
parents: 80
diff changeset
    43
claus
parents: 80
diff changeset
    44
    menuAspect notNil ifTrue:[
claus
parents: 80
diff changeset
    45
	m := self componentAt:menuAspect.
claus
parents: 80
diff changeset
    46
	m notNil ifTrue:[
claus
parents: 80
diff changeset
    47
	    m := m value.
claus
parents: 80
diff changeset
    48
	    m notNil ifTrue:[
claus
parents: 80
diff changeset
    49
		m receiver:application.
claus
parents: 80
diff changeset
    50
		topView add:m.
claus
parents: 80
diff changeset
    51
		view topInset:(m heightIncludingBorder).
claus
parents: 80
diff changeset
    52
	    ]
claus
parents: 80
diff changeset
    53
	]
claus
parents: 80
diff changeset
    54
    ].
claus
parents: 80
diff changeset
    55
66
claus
parents:
diff changeset
    56
    ^ topView
claus
parents:
diff changeset
    57
! !
claus
parents:
diff changeset
    58
claus
parents:
diff changeset
    59
!UIBuilder methodsFor:'private spec component parsing'!
claus
parents:
diff changeset
    60
claus
parents:
diff changeset
    61
xLabelSpec:aSpec view:aView
claus
parents:
diff changeset
    62
    |l|
claus
parents:
diff changeset
    63
claus
parents:
diff changeset
    64
    l := Label in:aView.
claus
parents:
diff changeset
    65
    self fixFontFor:l.
claus
parents:
diff changeset
    66
    self doSpec:aSpec for:l 
claus
parents:
diff changeset
    67
claus
parents:
diff changeset
    68
!
claus
parents:
diff changeset
    69
claus
parents:
diff changeset
    70
xFullSpec:aSpec
86
claus
parents: 80
diff changeset
    71
    topView isNil ifTrue:[
claus
parents: 80
diff changeset
    72
	topView := StandardSystemView new.
claus
parents: 80
diff changeset
    73
	topView controller:(ApplicationController new).
claus
parents: 80
diff changeset
    74
	topView application:application.
claus
parents: 80
diff changeset
    75
    ].
claus
parents: 80
diff changeset
    76
claus
parents: 80
diff changeset
    77
    view := View new.
claus
parents: 80
diff changeset
    78
    self doSpec:aSpec for:view.
66
claus
parents:
diff changeset
    79
86
claus
parents: 80
diff changeset
    80
    topView extent:(view extent).
claus
parents: 80
diff changeset
    81
    view origin:0.0@0.0 corner:1.0@1.0.
claus
parents: 80
diff changeset
    82
    topView add:view.
claus
parents: 80
diff changeset
    83
66
claus
parents:
diff changeset
    84
    ^ topView
claus
parents:
diff changeset
    85
!
claus
parents:
diff changeset
    86
86
claus
parents: 80
diff changeset
    87
xSubCanvasSpec:aSpec view:aView
claus
parents: 80
diff changeset
    88
    |v|
claus
parents: 80
diff changeset
    89
claus
parents: 80
diff changeset
    90
    v := SubCanvas in:aView.
claus
parents: 80
diff changeset
    91
    self doSpec:aSpec for:v 
claus
parents: 80
diff changeset
    92
!
claus
parents: 80
diff changeset
    93
66
claus
parents:
diff changeset
    94
xSpecCollection:aSpec view:aView
claus
parents:
diff changeset
    95
    self doSpec:aSpec for:aView
claus
parents:
diff changeset
    96
claus
parents:
diff changeset
    97
!
claus
parents:
diff changeset
    98
claus
parents:
diff changeset
    99
xWindowSpec:aSpec view:aView
claus
parents:
diff changeset
   100
    self doSpec:aSpec for:aView
claus
parents:
diff changeset
   101
claus
parents:
diff changeset
   102
!
claus
parents:
diff changeset
   103
86
claus
parents: 80
diff changeset
   104
xMenu:aSpec
claus
parents: 80
diff changeset
   105
    |items numItems unknown prevCurrent labels|
claus
parents: 80
diff changeset
   106
claus
parents: 80
diff changeset
   107
    topView := PullDownMenu new.
claus
parents: 80
diff changeset
   108
claus
parents: 80
diff changeset
   109
    items := aSpec at:2.
claus
parents: 80
diff changeset
   110
    numItems := (aSpec at:3) at:1.
claus
parents: 80
diff changeset
   111
    unknown := (aSpec at:4).
claus
parents: 80
diff changeset
   112
claus
parents: 80
diff changeset
   113
    prevCurrent := currentMenuSelector.
claus
parents: 80
diff changeset
   114
claus
parents: 80
diff changeset
   115
    "precollect labels ..."
claus
parents: 80
diff changeset
   116
    labels := OrderedCollection new.
claus
parents: 80
diff changeset
   117
    items do:[:item |
claus
parents: 80
diff changeset
   118
	(item at:1) ~~ #MenuItem ifTrue:[
claus
parents: 80
diff changeset
   119
	    self halt
claus
parents: 80
diff changeset
   120
	].
claus
parents: 80
diff changeset
   121
	(item at:2) ~~ #'label:' ifTrue:[
claus
parents: 80
diff changeset
   122
	    self halt
claus
parents: 80
diff changeset
   123
	].
claus
parents: 80
diff changeset
   124
	labels add:(item at:3)
claus
parents: 80
diff changeset
   125
    ].
claus
parents: 80
diff changeset
   126
claus
parents: 80
diff changeset
   127
    topView labels:labels.
claus
parents: 80
diff changeset
   128
claus
parents: 80
diff changeset
   129
    items with:(1 to:numItems) do:[:item :index |
claus
parents: 80
diff changeset
   130
	currentMenuSelector := index.
claus
parents: 80
diff changeset
   131
	self doSpec:item for:topView.
claus
parents: 80
diff changeset
   132
    ].
claus
parents: 80
diff changeset
   133
claus
parents: 80
diff changeset
   134
    currentMenuSelector := prevCurrent.
claus
parents: 80
diff changeset
   135
    ^ topView
claus
parents: 80
diff changeset
   136
!
claus
parents: 80
diff changeset
   137
claus
parents: 80
diff changeset
   138
xPopUpMenu:aSpec
claus
parents: 80
diff changeset
   139
    |menu values|
claus
parents: 80
diff changeset
   140
claus
parents: 80
diff changeset
   141
    menu := PopUpMenu 
claus
parents: 80
diff changeset
   142
		labels:(aSpec at:2).
claus
parents: 80
diff changeset
   143
    values := Array new:((aSpec at:2) size).
claus
parents: 80
diff changeset
   144
claus
parents: 80
diff changeset
   145
    (aSpec at:4) keysAndValuesDo:[:index :item |
claus
parents: 80
diff changeset
   146
	((item size > 0)
claus
parents: 80
diff changeset
   147
	and:[(item at:1) == #PopUpMenu]) ifTrue:[
claus
parents: 80
diff changeset
   148
	    menu subMenuAt:index put:(self xPopUpMenu:item)
claus
parents: 80
diff changeset
   149
	] ifFalse:[
claus
parents: 80
diff changeset
   150
	    values at:index put:item
claus
parents: 80
diff changeset
   151
	]
claus
parents: 80
diff changeset
   152
    ].
claus
parents: 80
diff changeset
   153
claus
parents: 80
diff changeset
   154
    menu values:values.
claus
parents: 80
diff changeset
   155
    ^ menu
claus
parents: 80
diff changeset
   156
!
claus
parents: 80
diff changeset
   157
66
claus
parents:
diff changeset
   158
xInputFieldSpec:aSpec view:aView
claus
parents:
diff changeset
   159
    |l|
claus
parents:
diff changeset
   160
claus
parents:
diff changeset
   161
    l := EditField in:aView.
claus
parents:
diff changeset
   162
    self fixFontFor:l.
claus
parents:
diff changeset
   163
    l aspect:#value; change:#value:.
claus
parents:
diff changeset
   164
    self doSpec:aSpec for:l 
claus
parents:
diff changeset
   165
!
claus
parents:
diff changeset
   166
claus
parents:
diff changeset
   167
xActionButtonSpec:aSpec view:aView
claus
parents:
diff changeset
   168
    |b|
claus
parents:
diff changeset
   169
claus
parents:
diff changeset
   170
    b := Button in:aView.
claus
parents:
diff changeset
   171
    self fixFontFor:b.
claus
parents:
diff changeset
   172
    self doSpec:aSpec for:b 
claus
parents:
diff changeset
   173
!
claus
parents:
diff changeset
   174
claus
parents:
diff changeset
   175
xSequenceViewSpec:aSpec view:aView
claus
parents:
diff changeset
   176
    |f s|
claus
parents:
diff changeset
   177
claus
parents:
diff changeset
   178
    f := ScrollableView for:SelectionInListView in:aView.
claus
parents:
diff changeset
   179
    s := f scrolledView.
claus
parents:
diff changeset
   180
    self doSpec:aSpec for:s frame:f.
claus
parents:
diff changeset
   181
!
claus
parents:
diff changeset
   182
claus
parents:
diff changeset
   183
xScrollerSpec:aSpec view:aView
claus
parents:
diff changeset
   184
    |s idx orientation|
claus
parents:
diff changeset
   185
claus
parents:
diff changeset
   186
    idx := aSpec indexOf:#orientation:.
claus
parents:
diff changeset
   187
    idx == 0 ifTrue:[
claus
parents:
diff changeset
   188
	orientation := #vertical
claus
parents:
diff changeset
   189
    ] ifFalse:[
claus
parents:
diff changeset
   190
	orientation := aSpec at:(idx + 1)
claus
parents:
diff changeset
   191
    ].
claus
parents:
diff changeset
   192
    orientation == #horizontal ifTrue:[
claus
parents:
diff changeset
   193
	s := HorizontalScroller in:aView
claus
parents:
diff changeset
   194
    ] ifFalse:[
claus
parents:
diff changeset
   195
	s := Scroller in:aView
claus
parents:
diff changeset
   196
    ].
claus
parents:
diff changeset
   197
    self doSpec:aSpec for:s 
claus
parents:
diff changeset
   198
!
claus
parents:
diff changeset
   199
claus
parents:
diff changeset
   200
xProgressIndicatorSpec:aSpec view:aView
claus
parents:
diff changeset
   201
    |s|
claus
parents:
diff changeset
   202
claus
parents:
diff changeset
   203
    s := ProgressIndicator in:aView.
claus
parents:
diff changeset
   204
    self doSpec:aSpec for:s 
claus
parents:
diff changeset
   205
!
claus
parents:
diff changeset
   206
claus
parents:
diff changeset
   207
xSliderSpec:aSpec view:aView
claus
parents:
diff changeset
   208
    |s idx orientation|
claus
parents:
diff changeset
   209
claus
parents:
diff changeset
   210
    idx := aSpec indexOf:#orientation:.
claus
parents:
diff changeset
   211
    idx == 0 ifTrue:[
claus
parents:
diff changeset
   212
	orientation := #vertical
claus
parents:
diff changeset
   213
    ] ifFalse:[
claus
parents:
diff changeset
   214
	orientation := aSpec at:(idx + 1)
claus
parents:
diff changeset
   215
    ].
claus
parents:
diff changeset
   216
    orientation == #horizontal ifTrue:[
claus
parents:
diff changeset
   217
	s := HorizontalSlider in:aView
claus
parents:
diff changeset
   218
    ] ifFalse:[
claus
parents:
diff changeset
   219
	s := Slider in:aView
claus
parents:
diff changeset
   220
    ].
claus
parents:
diff changeset
   221
    self doSpec:aSpec for:s 
claus
parents:
diff changeset
   222
!
claus
parents:
diff changeset
   223
claus
parents:
diff changeset
   224
xCompositeSpecCollection:aSpec view:aView
claus
parents:
diff changeset
   225
    |v|
claus
parents:
diff changeset
   226
86
claus
parents: 80
diff changeset
   227
"/ 'compositeSpecCollection ignored' printNL.
66
claus
parents:
diff changeset
   228
"/ ^ self.
claus
parents:
diff changeset
   229
    v := View in:aView.
claus
parents:
diff changeset
   230
    self doSpec:aSpec for:v 
claus
parents:
diff changeset
   231
claus
parents:
diff changeset
   232
!
claus
parents:
diff changeset
   233
claus
parents:
diff changeset
   234
xArbitraryComponentSpec:aSpec view:aView
claus
parents:
diff changeset
   235
    |v|
claus
parents:
diff changeset
   236
86
claus
parents: 80
diff changeset
   237
    v := View in:aView.
claus
parents: 80
diff changeset
   238
"/    v := Label label:'ArbitraryView' in:aView.
66
claus
parents:
diff changeset
   239
    v level:-1.
claus
parents:
diff changeset
   240
    self doSpec:aSpec for:v 
claus
parents:
diff changeset
   241
!
claus
parents:
diff changeset
   242
claus
parents:
diff changeset
   243
xCheckBoxSpec:aSpec view:aView
claus
parents:
diff changeset
   244
    |b|
claus
parents:
diff changeset
   245
claus
parents:
diff changeset
   246
    b := CheckBox in:aView.
claus
parents:
diff changeset
   247
    self fixFontFor:b.
claus
parents:
diff changeset
   248
    self doSpec:aSpec for:b 
claus
parents:
diff changeset
   249
claus
parents:
diff changeset
   250
!
claus
parents:
diff changeset
   251
claus
parents:
diff changeset
   252
xTableViewSpec:aSpec view:aView
claus
parents:
diff changeset
   253
    |l|
claus
parents:
diff changeset
   254
claus
parents:
diff changeset
   255
    'tableView ignored' printNL.
claus
parents:
diff changeset
   256
    l := Label label:'TableView' in:aView.
claus
parents:
diff changeset
   257
    l level:-1.
claus
parents:
diff changeset
   258
    self doSpec:aSpec for:l 
claus
parents:
diff changeset
   259
!
claus
parents:
diff changeset
   260
claus
parents:
diff changeset
   261
xGroupBoxSpec:aSpec view:aView
claus
parents:
diff changeset
   262
    |l|
claus
parents:
diff changeset
   263
claus
parents:
diff changeset
   264
    l := FramedBox in:aView.
claus
parents:
diff changeset
   265
    self doSpec:aSpec for:l 
claus
parents:
diff changeset
   266
!
claus
parents:
diff changeset
   267
claus
parents:
diff changeset
   268
xDividerSpec:aSpec view:aView
claus
parents:
diff changeset
   269
    |l|
claus
parents:
diff changeset
   270
claus
parents:
diff changeset
   271
    l := View in:aView.
claus
parents:
diff changeset
   272
    self doSpec:aSpec for:l 
claus
parents:
diff changeset
   273
! !
claus
parents:
diff changeset
   274
claus
parents:
diff changeset
   275
!UIBuilder methodsFor:'private spec attribute parsing'!
claus
parents:
diff changeset
   276
86
claus
parents: 80
diff changeset
   277
yMultipleSelections:args view:aView frame:frameView
claus
parents: 80
diff changeset
   278
    args == true ifTrue:[
claus
parents: 80
diff changeset
   279
	aView multipleSelectOk:true
claus
parents: 80
diff changeset
   280
    ]
claus
parents: 80
diff changeset
   281
!
claus
parents: 80
diff changeset
   282
claus
parents: 80
diff changeset
   283
XXyMultipleSelections:args view:aView
66
claus
parents:
diff changeset
   284
    aView multipleSelectOk:args
claus
parents:
diff changeset
   285
!
claus
parents:
diff changeset
   286
claus
parents:
diff changeset
   287
yBounds:args view:aView frame:frameView
claus
parents:
diff changeset
   288
    |value r|
claus
parents:
diff changeset
   289
claus
parents:
diff changeset
   290
    value := self getArg:args.
claus
parents:
diff changeset
   291
    (value at:1) == #rectangle ifTrue:[
claus
parents:
diff changeset
   292
	r := value at:2.
claus
parents:
diff changeset
   293
	aView origin:r origin corner:r corner.
claus
parents:
diff changeset
   294
	^ self
claus
parents:
diff changeset
   295
    ].
claus
parents:
diff changeset
   296
    self halt:'unimplemented'.
claus
parents:
diff changeset
   297
!
claus
parents:
diff changeset
   298
claus
parents:
diff changeset
   299
yCollection:args view:aView frame:frameView
claus
parents:
diff changeset
   300
    args do:[:aSpec |
claus
parents:
diff changeset
   301
	self readSpec:aSpec view:aView frame:frameView.
claus
parents:
diff changeset
   302
    ].
claus
parents:
diff changeset
   303
!
claus
parents:
diff changeset
   304
claus
parents:
diff changeset
   305
yComponent:args view:aView frame:frameView
claus
parents:
diff changeset
   306
    |v|
claus
parents:
diff changeset
   307
claus
parents:
diff changeset
   308
    args isSymbol ifTrue:[
claus
parents:
diff changeset
   309
	v := application perform:args.
86
claus
parents: 80
diff changeset
   310
	v origin:0.0@0.0 corner:1.0@1.0.
66
claus
parents:
diff changeset
   311
	aView addSubView:v
claus
parents:
diff changeset
   312
    ] ifFalse:[
86
claus
parents: 80
diff changeset
   313
"/        v := View origin:0.0@0.0 corner:1.0@1.0 in:aView.
claus
parents: 80
diff changeset
   314
"/        self readSpec:args view:v frame:frameView.
claus
parents: 80
diff changeset
   315
	self readSpec:args view:aView frame:frameView.
66
claus
parents:
diff changeset
   316
    ]
claus
parents:
diff changeset
   317
!
claus
parents:
diff changeset
   318
claus
parents:
diff changeset
   319
yColors:args view:aView frame:frameView
claus
parents:
diff changeset
   320
    |value|
claus
parents:
diff changeset
   321
claus
parents:
diff changeset
   322
    value := self getArg:args.
claus
parents:
diff changeset
   323
    self halt:'unimplemented'.
claus
parents:
diff changeset
   324
!
claus
parents:
diff changeset
   325
claus
parents:
diff changeset
   326
yCompositeSpec:args view:aView frame:frameView
claus
parents:
diff changeset
   327
    |value r|
claus
parents:
diff changeset
   328
claus
parents:
diff changeset
   329
    self doSpec:args for:aView.
claus
parents:
diff changeset
   330
"
claus
parents:
diff changeset
   331
    value := self getArg:args.
claus
parents:
diff changeset
   332
    (value at:1) == #rectangle ifTrue:[
claus
parents:
diff changeset
   333
	r := value at:2.
claus
parents:
diff changeset
   334
	aView origin:r origin corner:r corner.
claus
parents:
diff changeset
   335
	^ self
claus
parents:
diff changeset
   336
    ].
claus
parents:
diff changeset
   337
claus
parents:
diff changeset
   338
self halt.
claus
parents:
diff changeset
   339
"
claus
parents:
diff changeset
   340
!
claus
parents:
diff changeset
   341
claus
parents:
diff changeset
   342
yDefaultable:args view:aView frame:frameView
claus
parents:
diff changeset
   343
    'defaultable ignored' printNL
claus
parents:
diff changeset
   344
!
claus
parents:
diff changeset
   345
claus
parents:
diff changeset
   346
yLabel:args view:aView frame:frameView
claus
parents:
diff changeset
   347
    aView label:args.
claus
parents:
diff changeset
   348
claus
parents:
diff changeset
   349
!
claus
parents:
diff changeset
   350
claus
parents:
diff changeset
   351
yLayout:args view:aView frame:frameView
claus
parents:
diff changeset
   352
    |value r org corn orgInset cornInset what|
claus
parents:
diff changeset
   353
claus
parents:
diff changeset
   354
    value := self getArg:args.
claus
parents:
diff changeset
   355
claus
parents:
diff changeset
   356
    what := value at:1.
claus
parents:
diff changeset
   357
    what == #point ifTrue:[
claus
parents:
diff changeset
   358
	Verbose ifTrue:[frameView print. ' ' print. 'origin: ' print. (value at:2) printNL].
claus
parents:
diff changeset
   359
	frameView origin:(value at:2).
claus
parents:
diff changeset
   360
	^ self
claus
parents:
diff changeset
   361
    ].
claus
parents:
diff changeset
   362
    what == #rectangle ifTrue:[
claus
parents:
diff changeset
   363
	r := value at:2.
claus
parents:
diff changeset
   364
	Verbose ifTrue:[
claus
parents:
diff changeset
   365
	    frameView print. ' ' print. 'origin: ' print. r origin print.
claus
parents:
diff changeset
   366
			     ' corner: ' print. r corner printNL.
claus
parents:
diff changeset
   367
	].
claus
parents:
diff changeset
   368
	frameView origin:r origin corner:r corner.
claus
parents:
diff changeset
   369
	^ self
claus
parents:
diff changeset
   370
    ].
claus
parents:
diff changeset
   371
    what == #layoutOrigin ifTrue:[
claus
parents:
diff changeset
   372
	"/ #layoutOrigin relOrg orgInset
claus
parents:
diff changeset
   373
	org := value at:2.       "/ relative origin
claus
parents:
diff changeset
   374
	org := org x asFloat @ org y asFloat.
claus
parents:
diff changeset
   375
	orgInset := self fixExtentFor:(value at:3).
claus
parents:
diff changeset
   376
	Verbose ifTrue:[
claus
parents:
diff changeset
   377
	    frameView print. ' ' print. 'origin: ' print. org printNL
claus
parents:
diff changeset
   378
	].
claus
parents:
diff changeset
   379
	frameView origin:org.
claus
parents:
diff changeset
   380
	frameView 
claus
parents:
diff changeset
   381
	      leftInset:orgInset x;
claus
parents:
diff changeset
   382
	      topInset:orgInset y.
claus
parents:
diff changeset
   383
	^ self
claus
parents:
diff changeset
   384
    ].
claus
parents:
diff changeset
   385
    what == #layoutFrame ifTrue:[
claus
parents:
diff changeset
   386
	"/ #layoutFrame orgInset cornInset relOrg relCorner
claus
parents:
diff changeset
   387
claus
parents:
diff changeset
   388
	org := value at:4.       "/ relative origin
claus
parents:
diff changeset
   389
	orgInset := self fixExtentFor:(value at:2).
claus
parents:
diff changeset
   390
claus
parents:
diff changeset
   391
	org := org x asFloat @ org y asFloat.
claus
parents:
diff changeset
   392
"/        org = (0@0) ifTrue:[
claus
parents:
diff changeset
   393
"/            org := value at:2    "/ absolute origin
claus
parents:
diff changeset
   394
"/        ].
claus
parents:
diff changeset
   395
claus
parents:
diff changeset
   396
	corn := value at:5.      "/ relative corner
claus
parents:
diff changeset
   397
	cornInset := self fixExtentFor:(value at:3).
claus
parents:
diff changeset
   398
	corn := corn x asFloat @ corn y asFloat.
claus
parents:
diff changeset
   399
"/        corn = (0@0) ifTrue:[
claus
parents:
diff changeset
   400
"/            corn := value at:3   "/ absolute corner
claus
parents:
diff changeset
   401
"/        ].
claus
parents:
diff changeset
   402
	Verbose ifTrue:[
claus
parents:
diff changeset
   403
	    frameView print. ' ' print. 'origin: ' print. org print.
claus
parents:
diff changeset
   404
			     ' corner: ' print. corn printNL.
claus
parents:
diff changeset
   405
	].
claus
parents:
diff changeset
   406
	frameView origin:org corner:corn.
claus
parents:
diff changeset
   407
	frameView leftInset:orgInset x;
claus
parents:
diff changeset
   408
	      topInset:orgInset y;
claus
parents:
diff changeset
   409
	      rightInset:cornInset x negated;
claus
parents:
diff changeset
   410
	      bottomInset:cornInset y negated.
claus
parents:
diff changeset
   411
	frameView sizeFixed:true.
claus
parents:
diff changeset
   412
	^ self
claus
parents:
diff changeset
   413
    ].
claus
parents:
diff changeset
   414
    what == #alignmentOrigin ifTrue:[
claus
parents:
diff changeset
   415
	org := value at:3.       "/ relative origin
claus
parents:
diff changeset
   416
	org = (0@0) ifTrue:[
claus
parents:
diff changeset
   417
	    org := value at:2    "/ absolute origin
claus
parents:
diff changeset
   418
	].
claus
parents:
diff changeset
   419
	Verbose ifTrue:[frameView print. ' ' print. 'origin: ' print. org printNL].
claus
parents:
diff changeset
   420
	frameView origin:org.
claus
parents:
diff changeset
   421
	^ self
claus
parents:
diff changeset
   422
    ].
claus
parents:
diff changeset
   423
claus
parents:
diff changeset
   424
    self halt:'unimplemented'.
claus
parents:
diff changeset
   425
!
claus
parents:
diff changeset
   426
claus
parents:
diff changeset
   427
yFlags:args view:aView frame:frameView
claus
parents:
diff changeset
   428
    'flags ignored' printNL
claus
parents:
diff changeset
   429
!
claus
parents:
diff changeset
   430
claus
parents:
diff changeset
   431
yIsDefault:args view:aView frame:frameView
claus
parents:
diff changeset
   432
    aView isReturnButton:args
claus
parents:
diff changeset
   433
!
claus
parents:
diff changeset
   434
claus
parents:
diff changeset
   435
yMin:args view:aView frame:frameView
claus
parents:
diff changeset
   436
    |value|
claus
parents:
diff changeset
   437
claus
parents:
diff changeset
   438
    value := self getArg:args.
claus
parents:
diff changeset
   439
    (value at:1) == #point ifTrue:[
claus
parents:
diff changeset
   440
	aView minExtent:(value at:2).
claus
parents:
diff changeset
   441
	^ self
claus
parents:
diff changeset
   442
    ].
claus
parents:
diff changeset
   443
    self halt:'unimplemented'.
claus
parents:
diff changeset
   444
!
claus
parents:
diff changeset
   445
claus
parents:
diff changeset
   446
yModel:args view:aView frame:frameView
claus
parents:
diff changeset
   447
    |model|
claus
parents:
diff changeset
   448
claus
parents:
diff changeset
   449
    (aspects notNil and:[aspects includesKey:args]) ifTrue:[
claus
parents:
diff changeset
   450
	model := aspects at:args
claus
parents:
diff changeset
   451
    ] ifFalse:[
86
claus
parents: 80
diff changeset
   452
	(aView isMemberOf:Button) ifTrue:[
claus
parents: 80
diff changeset
   453
	    model := application.
claus
parents: 80
diff changeset
   454
	    aView aspect:nil.
claus
parents: 80
diff changeset
   455
	    aView changeMessage:args.
claus
parents: 80
diff changeset
   456
	] ifFalse:[
claus
parents: 80
diff changeset
   457
	    model := application perform:args.
claus
parents: 80
diff changeset
   458
	].
66
claus
parents:
diff changeset
   459
    ].
claus
parents:
diff changeset
   460
    aView model:model.
claus
parents:
diff changeset
   461
!
claus
parents:
diff changeset
   462
claus
parents:
diff changeset
   463
yIsOpaque:args view:aView frame:frameView
claus
parents:
diff changeset
   464
    'isOpaque ignored' printNL.
claus
parents:
diff changeset
   465
!
claus
parents:
diff changeset
   466
claus
parents:
diff changeset
   467
yIsReadOnly:args view:aView frame:frameView
claus
parents:
diff changeset
   468
    args ifTrue:[
claus
parents:
diff changeset
   469
	aView readOnly
claus
parents:
diff changeset
   470
    ]
claus
parents:
diff changeset
   471
!
claus
parents:
diff changeset
   472
claus
parents:
diff changeset
   473
yMax:args view:aView frame:frameView
claus
parents:
diff changeset
   474
    |value|
claus
parents:
diff changeset
   475
claus
parents:
diff changeset
   476
    value := self getArg:args.
claus
parents:
diff changeset
   477
    (value at:1) == #point ifTrue:[
claus
parents:
diff changeset
   478
	aView maxExtent:(value at:2).
claus
parents:
diff changeset
   479
	^ self
claus
parents:
diff changeset
   480
    ].
claus
parents:
diff changeset
   481
    self halt:'unimplemented'.
claus
parents:
diff changeset
   482
!
claus
parents:
diff changeset
   483
claus
parents:
diff changeset
   484
yMenu:args view:aView frame:frameView
86
claus
parents: 80
diff changeset
   485
    menuAspect := args
66
claus
parents:
diff changeset
   486
!
claus
parents:
diff changeset
   487
claus
parents:
diff changeset
   488
yName:args view:aView frame:frameView
86
claus
parents: 80
diff changeset
   489
    self componentAt:args put:aView
66
claus
parents:
diff changeset
   490
!
claus
parents:
diff changeset
   491
claus
parents:
diff changeset
   492
yOrientation:args view:aView frame:frameView
claus
parents:
diff changeset
   493
    'orientation ignored' printNL.
claus
parents:
diff changeset
   494
!
claus
parents:
diff changeset
   495
claus
parents:
diff changeset
   496
ySelectionStyle:args view:aView frame:frameView
claus
parents:
diff changeset
   497
    'selectionStyle ignored' printNL.
claus
parents:
diff changeset
   498
claus
parents:
diff changeset
   499
!
claus
parents:
diff changeset
   500
claus
parents:
diff changeset
   501
yTabable:args view:aView frame:frameView
claus
parents:
diff changeset
   502
    args == true ifTrue:[
claus
parents:
diff changeset
   503
	focusSequence isNil ifTrue:[
claus
parents:
diff changeset
   504
	    focusSequence := OrderedCollection new.
claus
parents:
diff changeset
   505
	].
claus
parents:
diff changeset
   506
	focusSequence add:aView.
claus
parents:
diff changeset
   507
	'tabable element added' printNL.
claus
parents:
diff changeset
   508
    ]
claus
parents:
diff changeset
   509
!
claus
parents:
diff changeset
   510
claus
parents:
diff changeset
   511
yStart:args view:aView frame:frameView
86
claus
parents: 80
diff changeset
   512
    (aView isKindOf:Scroller) ifTrue:[
claus
parents: 80
diff changeset
   513
	aView start:args.
claus
parents: 80
diff changeset
   514
	^ self
claus
parents: 80
diff changeset
   515
    ].
66
claus
parents:
diff changeset
   516
    'start ignored' printNL.
claus
parents:
diff changeset
   517
!
claus
parents:
diff changeset
   518
claus
parents:
diff changeset
   519
yStep:args view:aView frame:frameView
claus
parents:
diff changeset
   520
    'step ignored' printNL.
claus
parents:
diff changeset
   521
claus
parents:
diff changeset
   522
!
claus
parents:
diff changeset
   523
86
claus
parents: 80
diff changeset
   524
yStop:args view:aView frame:frameView
claus
parents: 80
diff changeset
   525
    (aView isKindOf:Scroller) ifTrue:[
claus
parents: 80
diff changeset
   526
	aView stop:args.
claus
parents: 80
diff changeset
   527
	^ self
claus
parents: 80
diff changeset
   528
    ].
claus
parents: 80
diff changeset
   529
    'stop ignored' printNL.
66
claus
parents:
diff changeset
   530
!
claus
parents:
diff changeset
   531
86
claus
parents: 80
diff changeset
   532
ySubmenu:aSpec view:menu frame:frameView
claus
parents: 80
diff changeset
   533
    |items lines selectors labels|
claus
parents: 80
diff changeset
   534
claus
parents: 80
diff changeset
   535
    aSpec first ~~ #Menu ifTrue:[
claus
parents: 80
diff changeset
   536
	self halt.
claus
parents: 80
diff changeset
   537
    ].
claus
parents: 80
diff changeset
   538
    items := (aSpec at:2).
claus
parents: 80
diff changeset
   539
    lines := aSpec at:3.
claus
parents: 80
diff changeset
   540
    selectors := aSpec at:4.
66
claus
parents:
diff changeset
   541
86
claus
parents: 80
diff changeset
   542
    "collect labels & selectors"
claus
parents: 80
diff changeset
   543
    labels := OrderedCollection new.
claus
parents: 80
diff changeset
   544
    items do:[:item |
claus
parents: 80
diff changeset
   545
	item first ~~ #MenuItem ifTrue:[
claus
parents: 80
diff changeset
   546
	    self halt
claus
parents: 80
diff changeset
   547
	].
claus
parents: 80
diff changeset
   548
	(item at:2) ~~ #'label:' ifTrue:[
claus
parents: 80
diff changeset
   549
	    self halt
claus
parents: 80
diff changeset
   550
	].
claus
parents: 80
diff changeset
   551
	labels add:(item at:3).
claus
parents: 80
diff changeset
   552
    ].
claus
parents: 80
diff changeset
   553
claus
parents: 80
diff changeset
   554
    menu at:currentMenuSelector
claus
parents: 80
diff changeset
   555
	putLabels:labels
claus
parents: 80
diff changeset
   556
	selectors:selectors
claus
parents: 80
diff changeset
   557
	receiver:nil.
claus
parents: 80
diff changeset
   558
!
claus
parents: 80
diff changeset
   559
claus
parents: 80
diff changeset
   560
yWindow:args view:aView frame:frameView
claus
parents: 80
diff changeset
   561
    self readSpec:args view:aView frame:frameView.
66
claus
parents:
diff changeset
   562
!
claus
parents:
diff changeset
   563
claus
parents:
diff changeset
   564
yStyle:args view:aView frame:frameView
claus
parents:
diff changeset
   565
    'name ignored' printNL.
claus
parents:
diff changeset
   566
claus
parents:
diff changeset
   567
!
claus
parents:
diff changeset
   568
claus
parents:
diff changeset
   569
yType:args view:aView frame:frameView
86
claus
parents: 80
diff changeset
   570
    (aView isMemberOf:EditField) ifTrue:[
claus
parents: 80
diff changeset
   571
	args == #number ifTrue:[
claus
parents: 80
diff changeset
   572
	    aView converter:(PrintConverter new initForNumber).
claus
parents: 80
diff changeset
   573
	    ^ self
claus
parents: 80
diff changeset
   574
	]
claus
parents: 80
diff changeset
   575
    ].
claus
parents: 80
diff changeset
   576
66
claus
parents:
diff changeset
   577
    'type ignored' printNL.
claus
parents:
diff changeset
   578
! !
claus
parents:
diff changeset
   579
claus
parents:
diff changeset
   580
!UIBuilder methodsFor:'private arg parsing'!
claus
parents:
diff changeset
   581
claus
parents:
diff changeset
   582
getArg:spec
claus
parents:
diff changeset
   583
    "take something like #(Point 50 100) and return the value"
claus
parents:
diff changeset
   584
claus
parents:
diff changeset
   585
    |what|
claus
parents:
diff changeset
   586
claus
parents:
diff changeset
   587
    what := spec at:1.
claus
parents:
diff changeset
   588
    ^ self perform:('get' , what , ':') asSymbol with:spec
claus
parents:
diff changeset
   589
!
claus
parents:
diff changeset
   590
claus
parents:
diff changeset
   591
getPoint:spec
claus
parents:
diff changeset
   592
    "called for #(Point x y)"
claus
parents:
diff changeset
   593
claus
parents:
diff changeset
   594
    ^ Array with:#point 
claus
parents:
diff changeset
   595
	    with:((spec at:2) @ (spec at:3))
claus
parents:
diff changeset
   596
!
claus
parents:
diff changeset
   597
claus
parents:
diff changeset
   598
getLayoutFrame:spec
claus
parents:
diff changeset
   599
    "called for #(LayoutFrame absOrgX relOrgX absOrgY relOrgY absCornX relCornX absCornY relCornY)"
claus
parents:
diff changeset
   600
    "             1           2       3       4        5      6        7        8        9"
claus
parents:
diff changeset
   601
    ^ Array with:#layoutFrame
claus
parents:
diff changeset
   602
	    with:((spec at:2) @ (spec at:4))     "/ org inset
claus
parents:
diff changeset
   603
	    with:((spec at:6) @ (spec at:8))     "/ corner inset
claus
parents:
diff changeset
   604
	    with:((spec at:3) @ (spec at:5))     "/ rel org
claus
parents:
diff changeset
   605
	    with:((spec at:7) @ (spec at:9))     "/ rel corn 
claus
parents:
diff changeset
   606
claus
parents:
diff changeset
   607
!
claus
parents:
diff changeset
   608
claus
parents:
diff changeset
   609
getRectangle:spec
claus
parents:
diff changeset
   610
    "called for #(Rectangle x y)"
claus
parents:
diff changeset
   611
claus
parents:
diff changeset
   612
    ^ Array with:#rectangle
claus
parents:
diff changeset
   613
	    with:(((spec at:2) @ (spec at:3)) corner:((spec at:4) @ (spec at:5)))
claus
parents:
diff changeset
   614
!
claus
parents:
diff changeset
   615
claus
parents:
diff changeset
   616
getLayoutOrigin:spec
claus
parents:
diff changeset
   617
    "called for #(LayoutOrigin xInset relX yInset relY)"
claus
parents:
diff changeset
   618
claus
parents:
diff changeset
   619
    ^ Array with:#layoutOrigin
claus
parents:
diff changeset
   620
	    with:((spec at:3) @ (spec at:5))     "/ rels
claus
parents:
diff changeset
   621
	    with:((spec at:2) @ (spec at:4))     "/ insets
claus
parents:
diff changeset
   622
!
claus
parents:
diff changeset
   623
claus
parents:
diff changeset
   624
getCompositeSpec:spec
claus
parents:
diff changeset
   625
    "called for #(CompositeSpec layout: #(orgx orgy cornx corny)"
claus
parents:
diff changeset
   626
claus
parents:
diff changeset
   627
    |layout|
claus
parents:
diff changeset
   628
claus
parents:
diff changeset
   629
    (spec at:2) == #layout: ifTrue:[
claus
parents:
diff changeset
   630
	layout := spec at:3.
claus
parents:
diff changeset
   631
	(layout at:1) == #Rectangle ifTrue:[
claus
parents:
diff changeset
   632
	    ^ Rectangle
claus
parents:
diff changeset
   633
		    origin:(layout at:2) @ (layout at:3)
claus
parents:
diff changeset
   634
		    corner:(layout at:4) @ (layout at:5)
claus
parents:
diff changeset
   635
	].
claus
parents:
diff changeset
   636
    ].
claus
parents:
diff changeset
   637
    self halt:'unimplemented'.
claus
parents:
diff changeset
   638
!
claus
parents:
diff changeset
   639
claus
parents:
diff changeset
   640
getAlignmentOrigin:spec
claus
parents:
diff changeset
   641
    "called for #(AlignmentOrigin ?x ?relX ?x ?y ?relY ?y)"
claus
parents:
diff changeset
   642
claus
parents:
diff changeset
   643
    ^ Array with:#alignmentOrigin
claus
parents:
diff changeset
   644
	    with:((spec at:2) @ (spec at:5))     "/ ?
claus
parents:
diff changeset
   645
	    with:((spec at:3) @ (spec at:6))     "/ rels ?
claus
parents:
diff changeset
   646
	    with:((spec at:4) @ (spec at:7))     "/ insets ?
claus
parents:
diff changeset
   647
claus
parents:
diff changeset
   648
claus
parents:
diff changeset
   649
!
claus
parents:
diff changeset
   650
claus
parents:
diff changeset
   651
getLookPreferences:spec
claus
parents:
diff changeset
   652
    "called for #(LookPreferences setForegroundColor: (...) setBackgroundColor: (...) ...)"
claus
parents:
diff changeset
   653
claus
parents:
diff changeset
   654
    |coll|
claus
parents:
diff changeset
   655
claus
parents:
diff changeset
   656
    coll := OrderedCollection new.
claus
parents:
diff changeset
   657
    2 to:spec size by:2 do:[:index |
claus
parents:
diff changeset
   658
	coll add: 
claus
parents:
diff changeset
   659
	    (Array with:(spec at:index)
claus
parents:
diff changeset
   660
		  with:(self getArg:(spec at:index+1)))
claus
parents:
diff changeset
   661
    ].
claus
parents:
diff changeset
   662
    ^ coll.
claus
parents:
diff changeset
   663
!
claus
parents:
diff changeset
   664
claus
parents:
diff changeset
   665
getColorValue:spec
claus
parents:
diff changeset
   666
    "called for #(ColorValue #sym)
claus
parents:
diff changeset
   667
	     or #(ColorValue red green blue)"
claus
parents:
diff changeset
   668
claus
parents:
diff changeset
   669
    |clr arg|
claus
parents:
diff changeset
   670
claus
parents:
diff changeset
   671
    (arg := spec at:2) isSymbol ifTrue:[
claus
parents:
diff changeset
   672
	(Color respondsTo:arg) ifTrue:[
claus
parents:
diff changeset
   673
	    ^ Color perform:arg
claus
parents:
diff changeset
   674
	].
claus
parents:
diff changeset
   675
	^ Color name:arg asString ifIllegal:[Color black]
claus
parents:
diff changeset
   676
    ].
claus
parents:
diff changeset
   677
    arg isInteger ifTrue:[
claus
parents:
diff changeset
   678
	^ ColorValue scaledRed:arg
claus
parents:
diff changeset
   679
		     scaledGreen:(spec at:3)
claus
parents:
diff changeset
   680
		     scaledBlue:(spec at:4)
claus
parents:
diff changeset
   681
    ].
claus
parents:
diff changeset
   682
    ^ ColorValue red:arg
claus
parents:
diff changeset
   683
		 green:(spec at:3)
claus
parents:
diff changeset
   684
		 blue:(spec at:4)
claus
parents:
diff changeset
   685
claus
parents:
diff changeset
   686
claus
parents:
diff changeset
   687
! !
claus
parents:
diff changeset
   688
claus
parents:
diff changeset
   689
!UIBuilder methodsFor:'private spec parsing'!
claus
parents:
diff changeset
   690
claus
parents:
diff changeset
   691
doSpec:aSpec for:aView
claus
parents:
diff changeset
   692
    ^ self doSpec:aSpec for:aView frame:aView
claus
parents:
diff changeset
   693
!
claus
parents:
diff changeset
   694
claus
parents:
diff changeset
   695
add:aSpec
claus
parents:
diff changeset
   696
    self readSpec:aSpec
claus
parents:
diff changeset
   697
!
claus
parents:
diff changeset
   698
claus
parents:
diff changeset
   699
readSpec:aSpec
claus
parents:
diff changeset
   700
    |what|
claus
parents:
diff changeset
   701
claus
parents:
diff changeset
   702
    what := aSpec first.
claus
parents:
diff changeset
   703
    ^ self perform:('x' , what , ':') asSymbol with:aSpec
claus
parents:
diff changeset
   704
!
claus
parents:
diff changeset
   705
claus
parents:
diff changeset
   706
doSpec:aSpec for:aView frame:frame 
claus
parents:
diff changeset
   707
    |state selector args argsToRead|
claus
parents:
diff changeset
   708
claus
parents:
diff changeset
   709
    argsToRead := 0.
claus
parents:
diff changeset
   710
    args := #().
claus
parents:
diff changeset
   711
    aSpec from:2 to:(aSpec size) do:[:element |
claus
parents:
diff changeset
   712
	argsToRead > 1 ifTrue:[
claus
parents:
diff changeset
   713
	    self halt.
claus
parents:
diff changeset
   714
	] ifFalse:[
claus
parents:
diff changeset
   715
	    argsToRead == 1 ifTrue:[
claus
parents:
diff changeset
   716
		args := element.
claus
parents:
diff changeset
   717
		argsToRead := argsToRead - 1
claus
parents:
diff changeset
   718
	    ] ifFalse:[
claus
parents:
diff changeset
   719
		selector := element.
claus
parents:
diff changeset
   720
		argsToRead := selector numArgs.
claus
parents:
diff changeset
   721
	    ].
claus
parents:
diff changeset
   722
	].
claus
parents:
diff changeset
   723
	argsToRead == 0 ifTrue:[
claus
parents:
diff changeset
   724
	    self doSingleSpec:selector args:args for:aView frame:frame
claus
parents:
diff changeset
   725
	]
claus
parents:
diff changeset
   726
    ]
claus
parents:
diff changeset
   727
!
claus
parents:
diff changeset
   728
claus
parents:
diff changeset
   729
readSpec:aSpec view:aView frame:frameView
claus
parents:
diff changeset
   730
    |what|
claus
parents:
diff changeset
   731
claus
parents:
diff changeset
   732
    what := aSpec first.
claus
parents:
diff changeset
   733
    self perform:('x' , what , ':view:') asSymbol with:aSpec with:aView
claus
parents:
diff changeset
   734
!
claus
parents:
diff changeset
   735
claus
parents:
diff changeset
   736
doSingleSpec:selector args:args for:aView frame:frame
claus
parents:
diff changeset
   737
    Verbose ifTrue:[
claus
parents:
diff changeset
   738
	'doSingle (' print. aView print. ' -> ' print. selector print.
claus
parents:
diff changeset
   739
	' ' print. args printString printNL.
claus
parents:
diff changeset
   740
    ].
claus
parents:
diff changeset
   741
claus
parents:
diff changeset
   742
    self perform:('y' , selector asString asUppercaseFirst , 'view:frame:') asSymbol 
claus
parents:
diff changeset
   743
	    with:args
claus
parents:
diff changeset
   744
	    with:aView
claus
parents:
diff changeset
   745
	    with:frame.
claus
parents:
diff changeset
   746
claus
parents:
diff changeset
   747
! !
claus
parents:
diff changeset
   748
claus
parents:
diff changeset
   749
!UIBuilder methodsFor:'private special kludges'!
claus
parents:
diff changeset
   750
claus
parents:
diff changeset
   751
fixFontFor:aComponent
claus
parents:
diff changeset
   752
    "since ST-80 seems to use a smaller default font,
claus
parents:
diff changeset
   753
     and component sizes are often given in pixels in winSpecs,
75
claus
parents: 69
diff changeset
   754
     make the font smaller for less ugly looking elements."
66
claus
parents:
diff changeset
   755
claus
parents:
diff changeset
   756
"/   aComponent font:(aComponent font size:8)
claus
parents:
diff changeset
   757
!
claus
parents:
diff changeset
   758
claus
parents:
diff changeset
   759
fixExtentFor:aPoint
claus
parents:
diff changeset
   760
    ^ aPoint "/ (aPoint * (1 @ 1.5)) truncated
claus
parents:
diff changeset
   761
! !
claus
parents:
diff changeset
   762
claus
parents:
diff changeset
   763
UIBuilder  initialize!