UIBuilder.st
author claus
Tue, 06 Jun 1995 06:10:38 +0200
changeset 80 e029e7deed8b
parent 75 a53337dc3e19
child 86 38cc61653cb2
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 
claus
parents:
diff changeset
     4
	 instanceVariableNames:''
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
claus
parents:
diff changeset
    31
!UIBuilder methodsFor:'operation'!
claus
parents:
diff changeset
    32
claus
parents:
diff changeset
    33
buildFromSpec:aSpec
claus
parents:
diff changeset
    34
    self readSpec:aSpec.
claus
parents:
diff changeset
    35
    ^ topView
claus
parents:
diff changeset
    36
! !
claus
parents:
diff changeset
    37
claus
parents:
diff changeset
    38
!UIBuilder methodsFor:'private spec component parsing'!
claus
parents:
diff changeset
    39
claus
parents:
diff changeset
    40
xLabelSpec:aSpec view:aView
claus
parents:
diff changeset
    41
    |l|
claus
parents:
diff changeset
    42
claus
parents:
diff changeset
    43
    l := Label in:aView.
claus
parents:
diff changeset
    44
    self fixFontFor:l.
claus
parents:
diff changeset
    45
    self doSpec:aSpec for:l 
claus
parents:
diff changeset
    46
claus
parents:
diff changeset
    47
!
claus
parents:
diff changeset
    48
claus
parents:
diff changeset
    49
xFullSpec:aSpec
claus
parents:
diff changeset
    50
    topView := StandardSystemView new.
claus
parents:
diff changeset
    51
    topView controller:(ApplicationController new).
claus
parents:
diff changeset
    52
    topView application:application.
claus
parents:
diff changeset
    53
claus
parents:
diff changeset
    54
    self doSpec:aSpec for:topView.
claus
parents:
diff changeset
    55
    ^ topView
claus
parents:
diff changeset
    56
!
claus
parents:
diff changeset
    57
claus
parents:
diff changeset
    58
xSpecCollection:aSpec view:aView
claus
parents:
diff changeset
    59
    self doSpec:aSpec for:aView
claus
parents:
diff changeset
    60
claus
parents:
diff changeset
    61
!
claus
parents:
diff changeset
    62
claus
parents:
diff changeset
    63
xWindowSpec:aSpec view:aView
claus
parents:
diff changeset
    64
    self doSpec:aSpec for:aView
claus
parents:
diff changeset
    65
claus
parents:
diff changeset
    66
!
claus
parents:
diff changeset
    67
claus
parents:
diff changeset
    68
xInputFieldSpec:aSpec view:aView
claus
parents:
diff changeset
    69
    |l|
claus
parents:
diff changeset
    70
claus
parents:
diff changeset
    71
    l := EditField in:aView.
claus
parents:
diff changeset
    72
    self fixFontFor:l.
claus
parents:
diff changeset
    73
    l aspect:#value; change:#value:.
claus
parents:
diff changeset
    74
    self doSpec:aSpec for:l 
claus
parents:
diff changeset
    75
!
claus
parents:
diff changeset
    76
claus
parents:
diff changeset
    77
xActionButtonSpec:aSpec view:aView
claus
parents:
diff changeset
    78
    |b|
claus
parents:
diff changeset
    79
claus
parents:
diff changeset
    80
    b := Button in:aView.
claus
parents:
diff changeset
    81
    self fixFontFor:b.
claus
parents:
diff changeset
    82
    self doSpec:aSpec for:b 
claus
parents:
diff changeset
    83
!
claus
parents:
diff changeset
    84
claus
parents:
diff changeset
    85
xSequenceViewSpec:aSpec view:aView
claus
parents:
diff changeset
    86
    |f s|
claus
parents:
diff changeset
    87
claus
parents:
diff changeset
    88
    f := ScrollableView for:SelectionInListView in:aView.
claus
parents:
diff changeset
    89
    s := f scrolledView.
claus
parents:
diff changeset
    90
    self doSpec:aSpec for:s frame:f.
claus
parents:
diff changeset
    91
!
claus
parents:
diff changeset
    92
claus
parents:
diff changeset
    93
xScrollerSpec:aSpec view:aView
claus
parents:
diff changeset
    94
    |s idx orientation|
claus
parents:
diff changeset
    95
claus
parents:
diff changeset
    96
    idx := aSpec indexOf:#orientation:.
claus
parents:
diff changeset
    97
    idx == 0 ifTrue:[
claus
parents:
diff changeset
    98
	orientation := #vertical
claus
parents:
diff changeset
    99
    ] ifFalse:[
claus
parents:
diff changeset
   100
	orientation := aSpec at:(idx + 1)
claus
parents:
diff changeset
   101
    ].
claus
parents:
diff changeset
   102
    orientation == #horizontal ifTrue:[
claus
parents:
diff changeset
   103
	s := HorizontalScroller in:aView
claus
parents:
diff changeset
   104
    ] ifFalse:[
claus
parents:
diff changeset
   105
	s := Scroller in:aView
claus
parents:
diff changeset
   106
    ].
claus
parents:
diff changeset
   107
    self doSpec:aSpec for:s 
claus
parents:
diff changeset
   108
!
claus
parents:
diff changeset
   109
claus
parents:
diff changeset
   110
xProgressIndicatorSpec:aSpec view:aView
claus
parents:
diff changeset
   111
    |s|
claus
parents:
diff changeset
   112
claus
parents:
diff changeset
   113
    s := ProgressIndicator in:aView.
claus
parents:
diff changeset
   114
    self doSpec:aSpec for:s 
claus
parents:
diff changeset
   115
!
claus
parents:
diff changeset
   116
claus
parents:
diff changeset
   117
xSliderSpec:aSpec view:aView
claus
parents:
diff changeset
   118
    |s idx orientation|
claus
parents:
diff changeset
   119
claus
parents:
diff changeset
   120
    idx := aSpec indexOf:#orientation:.
claus
parents:
diff changeset
   121
    idx == 0 ifTrue:[
claus
parents:
diff changeset
   122
	orientation := #vertical
claus
parents:
diff changeset
   123
    ] ifFalse:[
claus
parents:
diff changeset
   124
	orientation := aSpec at:(idx + 1)
claus
parents:
diff changeset
   125
    ].
claus
parents:
diff changeset
   126
    orientation == #horizontal ifTrue:[
claus
parents:
diff changeset
   127
	s := HorizontalSlider in:aView
claus
parents:
diff changeset
   128
    ] ifFalse:[
claus
parents:
diff changeset
   129
	s := Slider in:aView
claus
parents:
diff changeset
   130
    ].
claus
parents:
diff changeset
   131
    self doSpec:aSpec for:s 
claus
parents:
diff changeset
   132
!
claus
parents:
diff changeset
   133
claus
parents:
diff changeset
   134
xCompositeSpecCollection:aSpec view:aView
claus
parents:
diff changeset
   135
    |v|
claus
parents:
diff changeset
   136
claus
parents:
diff changeset
   137
"/ 'compositeSpecCollection ignoed' printNL.
claus
parents:
diff changeset
   138
"/ ^ self.
claus
parents:
diff changeset
   139
    v := View in:aView.
claus
parents:
diff changeset
   140
    self doSpec:aSpec for:v 
claus
parents:
diff changeset
   141
claus
parents:
diff changeset
   142
!
claus
parents:
diff changeset
   143
claus
parents:
diff changeset
   144
xArbitraryComponentSpec:aSpec view:aView
claus
parents:
diff changeset
   145
    |v|
claus
parents:
diff changeset
   146
claus
parents:
diff changeset
   147
"/    v := View in:aView.
claus
parents:
diff changeset
   148
    v := Label label:'ArbitraryView' in:aView.
claus
parents:
diff changeset
   149
    v level:-1.
claus
parents:
diff changeset
   150
    self doSpec:aSpec for:v 
claus
parents:
diff changeset
   151
!
claus
parents:
diff changeset
   152
claus
parents:
diff changeset
   153
xCheckBoxSpec:aSpec view:aView
claus
parents:
diff changeset
   154
    |b|
claus
parents:
diff changeset
   155
claus
parents:
diff changeset
   156
    b := CheckBox in:aView.
claus
parents:
diff changeset
   157
    self fixFontFor:b.
claus
parents:
diff changeset
   158
    self doSpec:aSpec for:b 
claus
parents:
diff changeset
   159
claus
parents:
diff changeset
   160
!
claus
parents:
diff changeset
   161
claus
parents:
diff changeset
   162
xTableViewSpec:aSpec view:aView
claus
parents:
diff changeset
   163
    |l|
claus
parents:
diff changeset
   164
claus
parents:
diff changeset
   165
    'tableView ignored' printNL.
claus
parents:
diff changeset
   166
    l := Label label:'TableView' in:aView.
claus
parents:
diff changeset
   167
    l level:-1.
claus
parents:
diff changeset
   168
    self doSpec:aSpec for:l 
claus
parents:
diff changeset
   169
!
claus
parents:
diff changeset
   170
claus
parents:
diff changeset
   171
xGroupBoxSpec:aSpec view:aView
claus
parents:
diff changeset
   172
    |l|
claus
parents:
diff changeset
   173
claus
parents:
diff changeset
   174
    l := FramedBox in:aView.
claus
parents:
diff changeset
   175
    self doSpec:aSpec for:l 
claus
parents:
diff changeset
   176
!
claus
parents:
diff changeset
   177
claus
parents:
diff changeset
   178
xDividerSpec:aSpec view:aView
claus
parents:
diff changeset
   179
    |l|
claus
parents:
diff changeset
   180
claus
parents:
diff changeset
   181
    l := View in:aView.
claus
parents:
diff changeset
   182
    self doSpec:aSpec for:l 
claus
parents:
diff changeset
   183
! !
claus
parents:
diff changeset
   184
claus
parents:
diff changeset
   185
!UIBuilder methodsFor:'private spec attribute parsing'!
claus
parents:
diff changeset
   186
claus
parents:
diff changeset
   187
yMultipleSelections:args view:aView
claus
parents:
diff changeset
   188
    aView multipleSelectOk:args
claus
parents:
diff changeset
   189
!
claus
parents:
diff changeset
   190
claus
parents:
diff changeset
   191
yBounds:args view:aView frame:frameView
claus
parents:
diff changeset
   192
    |value r|
claus
parents:
diff changeset
   193
claus
parents:
diff changeset
   194
    value := self getArg:args.
claus
parents:
diff changeset
   195
    (value at:1) == #rectangle ifTrue:[
claus
parents:
diff changeset
   196
	r := value at:2.
claus
parents:
diff changeset
   197
	aView origin:r origin corner:r corner.
claus
parents:
diff changeset
   198
	^ self
claus
parents:
diff changeset
   199
    ].
claus
parents:
diff changeset
   200
    self halt:'unimplemented'.
claus
parents:
diff changeset
   201
!
claus
parents:
diff changeset
   202
claus
parents:
diff changeset
   203
yCollection:args view:aView frame:frameView
claus
parents:
diff changeset
   204
    args do:[:aSpec |
claus
parents:
diff changeset
   205
	self readSpec:aSpec view:aView frame:frameView.
claus
parents:
diff changeset
   206
    ].
claus
parents:
diff changeset
   207
!
claus
parents:
diff changeset
   208
claus
parents:
diff changeset
   209
yComponent:args view:aView frame:frameView
claus
parents:
diff changeset
   210
    |v|
claus
parents:
diff changeset
   211
claus
parents:
diff changeset
   212
    args isSymbol ifTrue:[
claus
parents:
diff changeset
   213
	v := application perform:args.
claus
parents:
diff changeset
   214
	aView addSubView:v
claus
parents:
diff changeset
   215
    ] ifFalse:[
claus
parents:
diff changeset
   216
	v := View origin:0.0@0.0 corner:1.0@1.0 in:aView.
claus
parents:
diff changeset
   217
	self readSpec:args view:v frame:frameView.
claus
parents:
diff changeset
   218
    ]
claus
parents:
diff changeset
   219
!
claus
parents:
diff changeset
   220
claus
parents:
diff changeset
   221
yColors:args view:aView frame:frameView
claus
parents:
diff changeset
   222
    |value|
claus
parents:
diff changeset
   223
claus
parents:
diff changeset
   224
    value := self getArg:args.
claus
parents:
diff changeset
   225
    self halt:'unimplemented'.
claus
parents:
diff changeset
   226
!
claus
parents:
diff changeset
   227
claus
parents:
diff changeset
   228
yCompositeSpec:args view:aView frame:frameView
claus
parents:
diff changeset
   229
    |value r|
claus
parents:
diff changeset
   230
claus
parents:
diff changeset
   231
    self doSpec:args for:aView.
claus
parents:
diff changeset
   232
"
claus
parents:
diff changeset
   233
    value := self getArg:args.
claus
parents:
diff changeset
   234
    (value at:1) == #rectangle ifTrue:[
claus
parents:
diff changeset
   235
	r := value at:2.
claus
parents:
diff changeset
   236
	aView origin:r origin corner:r corner.
claus
parents:
diff changeset
   237
	^ self
claus
parents:
diff changeset
   238
    ].
claus
parents:
diff changeset
   239
claus
parents:
diff changeset
   240
self halt.
claus
parents:
diff changeset
   241
"
claus
parents:
diff changeset
   242
!
claus
parents:
diff changeset
   243
claus
parents:
diff changeset
   244
yDefaultable:args view:aView frame:frameView
claus
parents:
diff changeset
   245
    'defaultable ignored' printNL
claus
parents:
diff changeset
   246
!
claus
parents:
diff changeset
   247
claus
parents:
diff changeset
   248
yLabel:args view:aView frame:frameView
claus
parents:
diff changeset
   249
    aView label:args.
claus
parents:
diff changeset
   250
claus
parents:
diff changeset
   251
!
claus
parents:
diff changeset
   252
claus
parents:
diff changeset
   253
yLayout:args view:aView frame:frameView
claus
parents:
diff changeset
   254
    |value r org corn orgInset cornInset what|
claus
parents:
diff changeset
   255
claus
parents:
diff changeset
   256
    value := self getArg:args.
claus
parents:
diff changeset
   257
claus
parents:
diff changeset
   258
    what := value at:1.
claus
parents:
diff changeset
   259
    what == #point ifTrue:[
claus
parents:
diff changeset
   260
	Verbose ifTrue:[frameView print. ' ' print. 'origin: ' print. (value at:2) printNL].
claus
parents:
diff changeset
   261
	frameView origin:(value at:2).
claus
parents:
diff changeset
   262
	^ self
claus
parents:
diff changeset
   263
    ].
claus
parents:
diff changeset
   264
    what == #rectangle ifTrue:[
claus
parents:
diff changeset
   265
	r := value at:2.
claus
parents:
diff changeset
   266
	Verbose ifTrue:[
claus
parents:
diff changeset
   267
	    frameView print. ' ' print. 'origin: ' print. r origin print.
claus
parents:
diff changeset
   268
			     ' corner: ' print. r corner printNL.
claus
parents:
diff changeset
   269
	].
claus
parents:
diff changeset
   270
	frameView origin:r origin corner:r corner.
claus
parents:
diff changeset
   271
	^ self
claus
parents:
diff changeset
   272
    ].
claus
parents:
diff changeset
   273
    what == #layoutOrigin ifTrue:[
claus
parents:
diff changeset
   274
	"/ #layoutOrigin relOrg orgInset
claus
parents:
diff changeset
   275
	org := value at:2.       "/ relative origin
claus
parents:
diff changeset
   276
	org := org x asFloat @ org y asFloat.
claus
parents:
diff changeset
   277
	orgInset := self fixExtentFor:(value at:3).
claus
parents:
diff changeset
   278
	Verbose ifTrue:[
claus
parents:
diff changeset
   279
	    frameView print. ' ' print. 'origin: ' print. org printNL
claus
parents:
diff changeset
   280
	].
claus
parents:
diff changeset
   281
	frameView origin:org.
claus
parents:
diff changeset
   282
	frameView 
claus
parents:
diff changeset
   283
	      leftInset:orgInset x;
claus
parents:
diff changeset
   284
	      topInset:orgInset y.
claus
parents:
diff changeset
   285
	^ self
claus
parents:
diff changeset
   286
    ].
claus
parents:
diff changeset
   287
    what == #layoutFrame ifTrue:[
claus
parents:
diff changeset
   288
	"/ #layoutFrame orgInset cornInset relOrg relCorner
claus
parents:
diff changeset
   289
claus
parents:
diff changeset
   290
	org := value at:4.       "/ relative origin
claus
parents:
diff changeset
   291
	orgInset := self fixExtentFor:(value at:2).
claus
parents:
diff changeset
   292
claus
parents:
diff changeset
   293
	org := org x asFloat @ org y asFloat.
claus
parents:
diff changeset
   294
"/        org = (0@0) ifTrue:[
claus
parents:
diff changeset
   295
"/            org := value at:2    "/ absolute origin
claus
parents:
diff changeset
   296
"/        ].
claus
parents:
diff changeset
   297
claus
parents:
diff changeset
   298
	corn := value at:5.      "/ relative corner
claus
parents:
diff changeset
   299
	cornInset := self fixExtentFor:(value at:3).
claus
parents:
diff changeset
   300
	corn := corn x asFloat @ corn y asFloat.
claus
parents:
diff changeset
   301
"/        corn = (0@0) ifTrue:[
claus
parents:
diff changeset
   302
"/            corn := value at:3   "/ absolute corner
claus
parents:
diff changeset
   303
"/        ].
claus
parents:
diff changeset
   304
	Verbose ifTrue:[
claus
parents:
diff changeset
   305
	    frameView print. ' ' print. 'origin: ' print. org print.
claus
parents:
diff changeset
   306
			     ' corner: ' print. corn printNL.
claus
parents:
diff changeset
   307
	].
claus
parents:
diff changeset
   308
	frameView origin:org corner:corn.
claus
parents:
diff changeset
   309
	frameView leftInset:orgInset x;
claus
parents:
diff changeset
   310
	      topInset:orgInset y;
claus
parents:
diff changeset
   311
	      rightInset:cornInset x negated;
claus
parents:
diff changeset
   312
	      bottomInset:cornInset y negated.
claus
parents:
diff changeset
   313
	frameView sizeFixed:true.
claus
parents:
diff changeset
   314
	^ self
claus
parents:
diff changeset
   315
    ].
claus
parents:
diff changeset
   316
    what == #alignmentOrigin ifTrue:[
claus
parents:
diff changeset
   317
	org := value at:3.       "/ relative origin
claus
parents:
diff changeset
   318
	org = (0@0) ifTrue:[
claus
parents:
diff changeset
   319
	    org := value at:2    "/ absolute origin
claus
parents:
diff changeset
   320
	].
claus
parents:
diff changeset
   321
	Verbose ifTrue:[frameView print. ' ' print. 'origin: ' print. org printNL].
claus
parents:
diff changeset
   322
	frameView origin:org.
claus
parents:
diff changeset
   323
	^ self
claus
parents:
diff changeset
   324
    ].
claus
parents:
diff changeset
   325
claus
parents:
diff changeset
   326
    self halt:'unimplemented'.
claus
parents:
diff changeset
   327
!
claus
parents:
diff changeset
   328
claus
parents:
diff changeset
   329
yFlags:args view:aView frame:frameView
claus
parents:
diff changeset
   330
    'flags ignored' printNL
claus
parents:
diff changeset
   331
!
claus
parents:
diff changeset
   332
claus
parents:
diff changeset
   333
yIsDefault:args view:aView frame:frameView
claus
parents:
diff changeset
   334
    aView isReturnButton:args
claus
parents:
diff changeset
   335
!
claus
parents:
diff changeset
   336
claus
parents:
diff changeset
   337
yMin:args view:aView frame:frameView
claus
parents:
diff changeset
   338
    |value|
claus
parents:
diff changeset
   339
claus
parents:
diff changeset
   340
    value := self getArg:args.
claus
parents:
diff changeset
   341
    (value at:1) == #point ifTrue:[
claus
parents:
diff changeset
   342
	aView minExtent:(value at:2).
claus
parents:
diff changeset
   343
	^ self
claus
parents:
diff changeset
   344
    ].
claus
parents:
diff changeset
   345
    self halt:'unimplemented'.
claus
parents:
diff changeset
   346
!
claus
parents:
diff changeset
   347
claus
parents:
diff changeset
   348
yModel:args view:aView frame:frameView
claus
parents:
diff changeset
   349
    |model|
claus
parents:
diff changeset
   350
claus
parents:
diff changeset
   351
    (aspects notNil and:[aspects includesKey:args]) ifTrue:[
claus
parents:
diff changeset
   352
	model := aspects at:args
claus
parents:
diff changeset
   353
    ] ifFalse:[
claus
parents:
diff changeset
   354
	model := application perform:args
claus
parents:
diff changeset
   355
    ].
claus
parents:
diff changeset
   356
    aView model:model.
claus
parents:
diff changeset
   357
!
claus
parents:
diff changeset
   358
claus
parents:
diff changeset
   359
yIsOpaque:args view:aView frame:frameView
claus
parents:
diff changeset
   360
    'isOpaque ignored' printNL.
claus
parents:
diff changeset
   361
!
claus
parents:
diff changeset
   362
claus
parents:
diff changeset
   363
yIsReadOnly:args view:aView frame:frameView
claus
parents:
diff changeset
   364
    args ifTrue:[
claus
parents:
diff changeset
   365
	aView readOnly
claus
parents:
diff changeset
   366
    ]
claus
parents:
diff changeset
   367
!
claus
parents:
diff changeset
   368
claus
parents:
diff changeset
   369
yMax:args view:aView frame:frameView
claus
parents:
diff changeset
   370
    |value|
claus
parents:
diff changeset
   371
claus
parents:
diff changeset
   372
    value := self getArg:args.
claus
parents:
diff changeset
   373
    (value at:1) == #point ifTrue:[
claus
parents:
diff changeset
   374
	aView maxExtent:(value at:2).
claus
parents:
diff changeset
   375
	^ self
claus
parents:
diff changeset
   376
    ].
claus
parents:
diff changeset
   377
    self halt:'unimplemented'.
claus
parents:
diff changeset
   378
!
claus
parents:
diff changeset
   379
claus
parents:
diff changeset
   380
yMenu:args view:aView frame:frameView
claus
parents:
diff changeset
   381
    'menu ignored' printNL
claus
parents:
diff changeset
   382
!
claus
parents:
diff changeset
   383
claus
parents:
diff changeset
   384
yName:args view:aView frame:frameView
75
claus
parents: 69
diff changeset
   385
    bindings isNil ifTrue:[
claus
parents: 69
diff changeset
   386
	bindings := IdentityDictionary new.
66
claus
parents:
diff changeset
   387
    ].
75
claus
parents: 69
diff changeset
   388
    bindings at:args put:aView
66
claus
parents:
diff changeset
   389
!
claus
parents:
diff changeset
   390
claus
parents:
diff changeset
   391
yOrientation:args view:aView frame:frameView
claus
parents:
diff changeset
   392
    'orientation ignored' printNL.
claus
parents:
diff changeset
   393
!
claus
parents:
diff changeset
   394
claus
parents:
diff changeset
   395
ySelectionStyle:args view:aView frame:frameView
claus
parents:
diff changeset
   396
    'selectionStyle ignored' printNL.
claus
parents:
diff changeset
   397
claus
parents:
diff changeset
   398
!
claus
parents:
diff changeset
   399
claus
parents:
diff changeset
   400
yTabable:args view:aView frame:frameView
claus
parents:
diff changeset
   401
    args == true ifTrue:[
claus
parents:
diff changeset
   402
	focusSequence isNil ifTrue:[
claus
parents:
diff changeset
   403
	    focusSequence := OrderedCollection new.
claus
parents:
diff changeset
   404
	].
claus
parents:
diff changeset
   405
	focusSequence add:aView.
claus
parents:
diff changeset
   406
	'tabable element added' printNL.
claus
parents:
diff changeset
   407
    ]
claus
parents:
diff changeset
   408
!
claus
parents:
diff changeset
   409
claus
parents:
diff changeset
   410
yStart:args view:aView frame:frameView
claus
parents:
diff changeset
   411
    'start ignored' printNL.
claus
parents:
diff changeset
   412
claus
parents:
diff changeset
   413
!
claus
parents:
diff changeset
   414
claus
parents:
diff changeset
   415
yStep:args view:aView frame:frameView
claus
parents:
diff changeset
   416
    'step ignored' printNL.
claus
parents:
diff changeset
   417
claus
parents:
diff changeset
   418
!
claus
parents:
diff changeset
   419
claus
parents:
diff changeset
   420
yWindow:args view:aView frame:frameView
claus
parents:
diff changeset
   421
    self readSpec:args view:aView frame:frameView.
claus
parents:
diff changeset
   422
!
claus
parents:
diff changeset
   423
claus
parents:
diff changeset
   424
yStop:args view:aView frame:frameView
claus
parents:
diff changeset
   425
    'stop ignored' printNL.
claus
parents:
diff changeset
   426
claus
parents:
diff changeset
   427
!
claus
parents:
diff changeset
   428
claus
parents:
diff changeset
   429
yStyle:args view:aView frame:frameView
claus
parents:
diff changeset
   430
    'name ignored' printNL.
claus
parents:
diff changeset
   431
claus
parents:
diff changeset
   432
!
claus
parents:
diff changeset
   433
claus
parents:
diff changeset
   434
yType:args view:aView frame:frameView
claus
parents:
diff changeset
   435
    'type ignored' printNL.
claus
parents:
diff changeset
   436
! !
claus
parents:
diff changeset
   437
claus
parents:
diff changeset
   438
!UIBuilder methodsFor:'private arg parsing'!
claus
parents:
diff changeset
   439
claus
parents:
diff changeset
   440
getArg:spec
claus
parents:
diff changeset
   441
    "take something like #(Point 50 100) and return the value"
claus
parents:
diff changeset
   442
claus
parents:
diff changeset
   443
    |what|
claus
parents:
diff changeset
   444
claus
parents:
diff changeset
   445
    what := spec at:1.
claus
parents:
diff changeset
   446
    ^ self perform:('get' , what , ':') asSymbol with:spec
claus
parents:
diff changeset
   447
!
claus
parents:
diff changeset
   448
claus
parents:
diff changeset
   449
getPoint:spec
claus
parents:
diff changeset
   450
    "called for #(Point x y)"
claus
parents:
diff changeset
   451
claus
parents:
diff changeset
   452
    ^ Array with:#point 
claus
parents:
diff changeset
   453
	    with:((spec at:2) @ (spec at:3))
claus
parents:
diff changeset
   454
!
claus
parents:
diff changeset
   455
claus
parents:
diff changeset
   456
getLayoutFrame:spec
claus
parents:
diff changeset
   457
    "called for #(LayoutFrame absOrgX relOrgX absOrgY relOrgY absCornX relCornX absCornY relCornY)"
claus
parents:
diff changeset
   458
    "             1           2       3       4        5      6        7        8        9"
claus
parents:
diff changeset
   459
    ^ Array with:#layoutFrame
claus
parents:
diff changeset
   460
	    with:((spec at:2) @ (spec at:4))     "/ org inset
claus
parents:
diff changeset
   461
	    with:((spec at:6) @ (spec at:8))     "/ corner inset
claus
parents:
diff changeset
   462
	    with:((spec at:3) @ (spec at:5))     "/ rel org
claus
parents:
diff changeset
   463
	    with:((spec at:7) @ (spec at:9))     "/ rel corn 
claus
parents:
diff changeset
   464
claus
parents:
diff changeset
   465
!
claus
parents:
diff changeset
   466
claus
parents:
diff changeset
   467
getRectangle:spec
claus
parents:
diff changeset
   468
    "called for #(Rectangle x y)"
claus
parents:
diff changeset
   469
claus
parents:
diff changeset
   470
    ^ Array with:#rectangle
claus
parents:
diff changeset
   471
	    with:(((spec at:2) @ (spec at:3)) corner:((spec at:4) @ (spec at:5)))
claus
parents:
diff changeset
   472
!
claus
parents:
diff changeset
   473
claus
parents:
diff changeset
   474
getLayoutOrigin:spec
claus
parents:
diff changeset
   475
    "called for #(LayoutOrigin xInset relX yInset relY)"
claus
parents:
diff changeset
   476
claus
parents:
diff changeset
   477
    ^ Array with:#layoutOrigin
claus
parents:
diff changeset
   478
	    with:((spec at:3) @ (spec at:5))     "/ rels
claus
parents:
diff changeset
   479
	    with:((spec at:2) @ (spec at:4))     "/ insets
claus
parents:
diff changeset
   480
!
claus
parents:
diff changeset
   481
claus
parents:
diff changeset
   482
getCompositeSpec:spec
claus
parents:
diff changeset
   483
    "called for #(CompositeSpec layout: #(orgx orgy cornx corny)"
claus
parents:
diff changeset
   484
claus
parents:
diff changeset
   485
    |layout|
claus
parents:
diff changeset
   486
claus
parents:
diff changeset
   487
    (spec at:2) == #layout: ifTrue:[
claus
parents:
diff changeset
   488
	layout := spec at:3.
claus
parents:
diff changeset
   489
	(layout at:1) == #Rectangle ifTrue:[
claus
parents:
diff changeset
   490
	    ^ Rectangle
claus
parents:
diff changeset
   491
		    origin:(layout at:2) @ (layout at:3)
claus
parents:
diff changeset
   492
		    corner:(layout at:4) @ (layout at:5)
claus
parents:
diff changeset
   493
	].
claus
parents:
diff changeset
   494
    ].
claus
parents:
diff changeset
   495
    self halt:'unimplemented'.
claus
parents:
diff changeset
   496
!
claus
parents:
diff changeset
   497
claus
parents:
diff changeset
   498
getAlignmentOrigin:spec
claus
parents:
diff changeset
   499
    "called for #(AlignmentOrigin ?x ?relX ?x ?y ?relY ?y)"
claus
parents:
diff changeset
   500
claus
parents:
diff changeset
   501
    ^ Array with:#alignmentOrigin
claus
parents:
diff changeset
   502
	    with:((spec at:2) @ (spec at:5))     "/ ?
claus
parents:
diff changeset
   503
	    with:((spec at:3) @ (spec at:6))     "/ rels ?
claus
parents:
diff changeset
   504
	    with:((spec at:4) @ (spec at:7))     "/ insets ?
claus
parents:
diff changeset
   505
claus
parents:
diff changeset
   506
claus
parents:
diff changeset
   507
!
claus
parents:
diff changeset
   508
claus
parents:
diff changeset
   509
getLookPreferences:spec
claus
parents:
diff changeset
   510
    "called for #(LookPreferences setForegroundColor: (...) setBackgroundColor: (...) ...)"
claus
parents:
diff changeset
   511
claus
parents:
diff changeset
   512
    |coll|
claus
parents:
diff changeset
   513
claus
parents:
diff changeset
   514
    coll := OrderedCollection new.
claus
parents:
diff changeset
   515
    2 to:spec size by:2 do:[:index |
claus
parents:
diff changeset
   516
	coll add: 
claus
parents:
diff changeset
   517
	    (Array with:(spec at:index)
claus
parents:
diff changeset
   518
		  with:(self getArg:(spec at:index+1)))
claus
parents:
diff changeset
   519
    ].
claus
parents:
diff changeset
   520
    ^ coll.
claus
parents:
diff changeset
   521
!
claus
parents:
diff changeset
   522
claus
parents:
diff changeset
   523
getColorValue:spec
claus
parents:
diff changeset
   524
    "called for #(ColorValue #sym)
claus
parents:
diff changeset
   525
	     or #(ColorValue red green blue)"
claus
parents:
diff changeset
   526
claus
parents:
diff changeset
   527
    |clr arg|
claus
parents:
diff changeset
   528
claus
parents:
diff changeset
   529
    (arg := spec at:2) isSymbol ifTrue:[
claus
parents:
diff changeset
   530
	(Color respondsTo:arg) ifTrue:[
claus
parents:
diff changeset
   531
	    ^ Color perform:arg
claus
parents:
diff changeset
   532
	].
claus
parents:
diff changeset
   533
	^ Color name:arg asString ifIllegal:[Color black]
claus
parents:
diff changeset
   534
    ].
claus
parents:
diff changeset
   535
    arg isInteger ifTrue:[
claus
parents:
diff changeset
   536
	^ ColorValue scaledRed:arg
claus
parents:
diff changeset
   537
		     scaledGreen:(spec at:3)
claus
parents:
diff changeset
   538
		     scaledBlue:(spec at:4)
claus
parents:
diff changeset
   539
    ].
claus
parents:
diff changeset
   540
    ^ ColorValue red:arg
claus
parents:
diff changeset
   541
		 green:(spec at:3)
claus
parents:
diff changeset
   542
		 blue:(spec at:4)
claus
parents:
diff changeset
   543
claus
parents:
diff changeset
   544
claus
parents:
diff changeset
   545
! !
claus
parents:
diff changeset
   546
claus
parents:
diff changeset
   547
!UIBuilder methodsFor:'private spec parsing'!
claus
parents:
diff changeset
   548
claus
parents:
diff changeset
   549
doSpec:aSpec for:aView
claus
parents:
diff changeset
   550
    ^ self doSpec:aSpec for:aView frame:aView
claus
parents:
diff changeset
   551
!
claus
parents:
diff changeset
   552
claus
parents:
diff changeset
   553
add:aSpec
claus
parents:
diff changeset
   554
    self readSpec:aSpec
claus
parents:
diff changeset
   555
!
claus
parents:
diff changeset
   556
claus
parents:
diff changeset
   557
readSpec:aSpec
claus
parents:
diff changeset
   558
    |what|
claus
parents:
diff changeset
   559
claus
parents:
diff changeset
   560
    what := aSpec first.
claus
parents:
diff changeset
   561
    ^ self perform:('x' , what , ':') asSymbol with:aSpec
claus
parents:
diff changeset
   562
!
claus
parents:
diff changeset
   563
claus
parents:
diff changeset
   564
doSpec:aSpec for:aView frame:frame 
claus
parents:
diff changeset
   565
    |state selector args argsToRead|
claus
parents:
diff changeset
   566
claus
parents:
diff changeset
   567
    argsToRead := 0.
claus
parents:
diff changeset
   568
    args := #().
claus
parents:
diff changeset
   569
    aSpec from:2 to:(aSpec size) do:[:element |
claus
parents:
diff changeset
   570
	argsToRead > 1 ifTrue:[
claus
parents:
diff changeset
   571
	    self halt.
claus
parents:
diff changeset
   572
	] ifFalse:[
claus
parents:
diff changeset
   573
	    argsToRead == 1 ifTrue:[
claus
parents:
diff changeset
   574
		args := element.
claus
parents:
diff changeset
   575
		argsToRead := argsToRead - 1
claus
parents:
diff changeset
   576
	    ] ifFalse:[
claus
parents:
diff changeset
   577
		selector := element.
claus
parents:
diff changeset
   578
		argsToRead := selector numArgs.
claus
parents:
diff changeset
   579
	    ].
claus
parents:
diff changeset
   580
	].
claus
parents:
diff changeset
   581
	argsToRead == 0 ifTrue:[
claus
parents:
diff changeset
   582
	    self doSingleSpec:selector args:args for:aView frame:frame
claus
parents:
diff changeset
   583
	]
claus
parents:
diff changeset
   584
    ]
claus
parents:
diff changeset
   585
!
claus
parents:
diff changeset
   586
claus
parents:
diff changeset
   587
readSpec:aSpec view:aView frame:frameView
claus
parents:
diff changeset
   588
    |what|
claus
parents:
diff changeset
   589
claus
parents:
diff changeset
   590
    what := aSpec first.
claus
parents:
diff changeset
   591
    self perform:('x' , what , ':view:') asSymbol with:aSpec with:aView
claus
parents:
diff changeset
   592
!
claus
parents:
diff changeset
   593
claus
parents:
diff changeset
   594
doSingleSpec:selector args:args for:aView frame:frame
claus
parents:
diff changeset
   595
    Verbose ifTrue:[
claus
parents:
diff changeset
   596
	'doSingle (' print. aView print. ' -> ' print. selector print.
claus
parents:
diff changeset
   597
	' ' print. args printString printNL.
claus
parents:
diff changeset
   598
    ].
claus
parents:
diff changeset
   599
claus
parents:
diff changeset
   600
    self perform:('y' , selector asString asUppercaseFirst , 'view:frame:') asSymbol 
claus
parents:
diff changeset
   601
	    with:args
claus
parents:
diff changeset
   602
	    with:aView
claus
parents:
diff changeset
   603
	    with:frame.
claus
parents:
diff changeset
   604
claus
parents:
diff changeset
   605
! !
claus
parents:
diff changeset
   606
claus
parents:
diff changeset
   607
!UIBuilder methodsFor:'private special kludges'!
claus
parents:
diff changeset
   608
claus
parents:
diff changeset
   609
fixFontFor:aComponent
claus
parents:
diff changeset
   610
    "since ST-80 seems to use a smaller default font,
claus
parents:
diff changeset
   611
     and component sizes are often given in pixels in winSpecs,
75
claus
parents: 69
diff changeset
   612
     make the font smaller for less ugly looking elements."
66
claus
parents:
diff changeset
   613
claus
parents:
diff changeset
   614
"/   aComponent font:(aComponent font size:8)
claus
parents:
diff changeset
   615
!
claus
parents:
diff changeset
   616
claus
parents:
diff changeset
   617
fixExtentFor:aPoint
claus
parents:
diff changeset
   618
    ^ aPoint "/ (aPoint * (1 @ 1.5)) truncated
claus
parents:
diff changeset
   619
! !
claus
parents:
diff changeset
   620
claus
parents:
diff changeset
   621
UIBuilder  initialize!