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