ProgressIndicator.st
author claus
Tue, 12 Sep 1995 12:50:48 +0200
changeset 74 637a256d52c8
parent 62 378b60ba1200
child 86 4d7dbb5f1719
permissions -rw-r--r--
.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
62
claus
parents: 50
diff changeset
     1
"
claus
parents: 50
diff changeset
     2
 COPYRIGHT (c) 1995 by Claus Gittinger
claus
parents: 50
diff changeset
     3
	      All Rights Reserved
claus
parents: 50
diff changeset
     4
claus
parents: 50
diff changeset
     5
 This software is furnished under a license and may be used
claus
parents: 50
diff changeset
     6
 only in accordance with the terms of that license and with the
claus
parents: 50
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
claus
parents: 50
diff changeset
     8
 be provided or otherwise made available to, or used by, any
claus
parents: 50
diff changeset
     9
 other person.  No title to or ownership of the software is
claus
parents: 50
diff changeset
    10
 hereby transferred.
claus
parents: 50
diff changeset
    11
"
50
claus
parents:
diff changeset
    12
claus
parents:
diff changeset
    13
View subclass:#ProgressIndicator
62
claus
parents: 50
diff changeset
    14
	 instanceVariableNames:'percentage showPercentage fgColor
claus
parents: 50
diff changeset
    15
				connectedTop connectedLabel'
50
claus
parents:
diff changeset
    16
	 classVariableNames:''
claus
parents:
diff changeset
    17
	 poolDictionaries:''
claus
parents:
diff changeset
    18
	 category:'Views-Misc'
claus
parents:
diff changeset
    19
!
claus
parents:
diff changeset
    20
claus
parents:
diff changeset
    21
!ProgressIndicator class methodsFor:'documentation'!
claus
parents:
diff changeset
    22
62
claus
parents: 50
diff changeset
    23
copyright
claus
parents: 50
diff changeset
    24
"
claus
parents: 50
diff changeset
    25
 COPYRIGHT (c) 1995 by Claus Gittinger
claus
parents: 50
diff changeset
    26
	      All Rights Reserved
claus
parents: 50
diff changeset
    27
claus
parents: 50
diff changeset
    28
 This software is furnished under a license and may be used
claus
parents: 50
diff changeset
    29
 only in accordance with the terms of that license and with the
claus
parents: 50
diff changeset
    30
 inclusion of the above copyright notice.   This software may not
claus
parents: 50
diff changeset
    31
 be provided or otherwise made available to, or used by, any
claus
parents: 50
diff changeset
    32
 other person.  No title to or ownership of the software is
claus
parents: 50
diff changeset
    33
 hereby transferred.
claus
parents: 50
diff changeset
    34
"
claus
parents: 50
diff changeset
    35
!
claus
parents: 50
diff changeset
    36
50
claus
parents:
diff changeset
    37
version
claus
parents:
diff changeset
    38
"
74
claus
parents: 62
diff changeset
    39
$Header: /cvs/stx/stx/libwidg2/ProgressIndicator.st,v 1.3 1995-09-12 10:50:48 claus Exp $
50
claus
parents:
diff changeset
    40
"
claus
parents:
diff changeset
    41
!
claus
parents:
diff changeset
    42
claus
parents:
diff changeset
    43
documentation
claus
parents:
diff changeset
    44
"
claus
parents:
diff changeset
    45
    a view showing a rectangle filled according the percentage value.
claus
parents:
diff changeset
    46
    Can be used as a progress indicator a la MSwindows.
claus
parents:
diff changeset
    47
"
claus
parents:
diff changeset
    48
!
claus
parents:
diff changeset
    49
claus
parents:
diff changeset
    50
examples
claus
parents:
diff changeset
    51
"
62
claus
parents: 50
diff changeset
    52
    basic (internal) interface
claus
parents: 50
diff changeset
    53
    (if progress indicator is to be used in a complex box ...):
50
claus
parents:
diff changeset
    54
claus
parents:
diff changeset
    55
      |top p h|
claus
parents:
diff changeset
    56
62
claus
parents: 50
diff changeset
    57
      top := ModalBox new.
50
claus
parents:
diff changeset
    58
      top extent:300@100.
claus
parents:
diff changeset
    59
      top label:'Progress'.
claus
parents:
diff changeset
    60
      p := ProgressIndicator in:top.
claus
parents:
diff changeset
    61
      p origin:(0.0@0.5) corner:(1.0@0.5).
claus
parents:
diff changeset
    62
      p level:-1.
62
claus
parents: 50
diff changeset
    63
      h := p preferredExtent y.
50
claus
parents:
diff changeset
    64
      p topInset:(h // 2) negated; 
claus
parents:
diff changeset
    65
	bottomInset:(h // 2) negated;
claus
parents:
diff changeset
    66
	leftInset:5;
claus
parents:
diff changeset
    67
	rightInset:5.
claus
parents:
diff changeset
    68
claus
parents:
diff changeset
    69
      [
claus
parents:
diff changeset
    70
	  1 to:100 do:[:val |
claus
parents:
diff changeset
    71
	      (Delay forSeconds:0.05) wait.
claus
parents:
diff changeset
    72
	      p percentage:val 
62
claus
parents: 50
diff changeset
    73
	  ].
claus
parents: 50
diff changeset
    74
	  top hide.
claus
parents: 50
diff changeset
    75
      ] fork.
claus
parents: 50
diff changeset
    76
      top open.
50
claus
parents:
diff changeset
    77
claus
parents:
diff changeset
    78
claus
parents:
diff changeset
    79
    changing colors, turning percentage display off:
claus
parents:
diff changeset
    80
claus
parents:
diff changeset
    81
      |top p h|
claus
parents:
diff changeset
    82
claus
parents:
diff changeset
    83
      top := StandardSystemView new.
claus
parents:
diff changeset
    84
      top extent:300@100.
claus
parents:
diff changeset
    85
      top label:'Progress'.
claus
parents:
diff changeset
    86
      p := ProgressIndicator in:top.
claus
parents:
diff changeset
    87
      p origin:(0.0@0.5) corner:(1.0@0.5).
claus
parents:
diff changeset
    88
      p level:-1.
claus
parents:
diff changeset
    89
      p showPercentage:false.
claus
parents:
diff changeset
    90
      p foregroundColor:(Color red).
claus
parents:
diff changeset
    91
      h := 10.
claus
parents:
diff changeset
    92
      p topInset:(h // 2) negated; 
claus
parents:
diff changeset
    93
	bottomInset:(h // 2) negated;
claus
parents:
diff changeset
    94
	leftInset:5;
claus
parents:
diff changeset
    95
	rightInset:5.
claus
parents:
diff changeset
    96
      top open.
claus
parents:
diff changeset
    97
      [
claus
parents:
diff changeset
    98
	  1 to:100 do:[:val |
claus
parents:
diff changeset
    99
	      (Delay forSeconds:0.05) wait.
claus
parents:
diff changeset
   100
	      p percentage:val 
claus
parents:
diff changeset
   101
	  ]
claus
parents:
diff changeset
   102
      ] fork
claus
parents:
diff changeset
   103
claus
parents:
diff changeset
   104
    with border (2D look):
claus
parents:
diff changeset
   105
claus
parents:
diff changeset
   106
      |top p h|
claus
parents:
diff changeset
   107
claus
parents:
diff changeset
   108
      top := StandardSystemView new.
claus
parents:
diff changeset
   109
      top extent:300@100.
claus
parents:
diff changeset
   110
      top label:'Progress'.
claus
parents:
diff changeset
   111
      p := ProgressIndicator in:top.
claus
parents:
diff changeset
   112
      p origin:(0.0@0.5) corner:(1.0@0.5).
claus
parents:
diff changeset
   113
      p borderWidth:1.
62
claus
parents: 50
diff changeset
   114
      h := p preferredExtent y.
50
claus
parents:
diff changeset
   115
      p topInset:(h // 2) negated; 
claus
parents:
diff changeset
   116
	bottomInset:(h // 2) negated;
claus
parents:
diff changeset
   117
	leftInset:5;
claus
parents:
diff changeset
   118
	rightInset:5.
claus
parents:
diff changeset
   119
      top open.
claus
parents:
diff changeset
   120
      [
claus
parents:
diff changeset
   121
	  1 to:100 do:[:val |
claus
parents:
diff changeset
   122
	      (Delay forSeconds:0.05) wait.
claus
parents:
diff changeset
   123
	      p percentage:val 
claus
parents:
diff changeset
   124
	  ]
claus
parents:
diff changeset
   125
      ] fork
claus
parents:
diff changeset
   126
claus
parents:
diff changeset
   127
claus
parents:
diff changeset
   128
    getting progress from a model:
claus
parents:
diff changeset
   129
claus
parents:
diff changeset
   130
      |model top p h|
claus
parents:
diff changeset
   131
claus
parents:
diff changeset
   132
      model := 0 asValue.
claus
parents:
diff changeset
   133
claus
parents:
diff changeset
   134
      top := StandardSystemView new.
claus
parents:
diff changeset
   135
      top extent:300@100.
claus
parents:
diff changeset
   136
      top label:'Progress'.
claus
parents:
diff changeset
   137
      p := ProgressIndicator in:top.
claus
parents:
diff changeset
   138
      p model:model.
claus
parents:
diff changeset
   139
      p origin:(0.0@0.5) corner:(1.0@0.5).
claus
parents:
diff changeset
   140
      p level:-1.
62
claus
parents: 50
diff changeset
   141
      h := p preferredExtent y.
50
claus
parents:
diff changeset
   142
      p topInset:(h // 2) negated; 
claus
parents:
diff changeset
   143
	bottomInset:(h // 2) negated;
claus
parents:
diff changeset
   144
	leftInset:5;
claus
parents:
diff changeset
   145
	rightInset:5.
claus
parents:
diff changeset
   146
      top open.
claus
parents:
diff changeset
   147
claus
parents:
diff changeset
   148
      [
claus
parents:
diff changeset
   149
	  1 to:100 do:[:val |
claus
parents:
diff changeset
   150
	      (Delay forSeconds:0.05) wait.
claus
parents:
diff changeset
   151
	      model value:val 
claus
parents:
diff changeset
   152
	  ]
claus
parents:
diff changeset
   153
      ] fork
claus
parents:
diff changeset
   154
62
claus
parents: 50
diff changeset
   155
50
claus
parents:
diff changeset
   156
    concrete example:
claus
parents:
diff changeset
   157
      search all files in the source directory for a string
claus
parents:
diff changeset
   158
      using grep. Show progress while doing so.
claus
parents:
diff changeset
   159
claus
parents:
diff changeset
   160
      |top p h names done|
claus
parents:
diff changeset
   161
claus
parents:
diff changeset
   162
      top := StandardSystemView new.
claus
parents:
diff changeset
   163
      top extent:300@100.
claus
parents:
diff changeset
   164
      top label:'Searching ...'.
claus
parents:
diff changeset
   165
      p := ProgressIndicator in:top.
claus
parents:
diff changeset
   166
      p origin:(0.0@0.5) corner:(1.0@0.5).
claus
parents:
diff changeset
   167
      p level:-1.
62
claus
parents: 50
diff changeset
   168
      h := p preferredExtent y.
50
claus
parents:
diff changeset
   169
      p topInset:(h // 2) negated; 
claus
parents:
diff changeset
   170
	bottomInset:(h // 2) negated;
claus
parents:
diff changeset
   171
	leftInset:5;
claus
parents:
diff changeset
   172
	rightInset:5.
claus
parents:
diff changeset
   173
      top openWithPriority:(Processor activePriority + 1).
claus
parents:
diff changeset
   174
claus
parents:
diff changeset
   175
      names := 'source' asFilename directoryContents.
claus
parents:
diff changeset
   176
      done := 0.
claus
parents:
diff changeset
   177
      names do:[:aName |
claus
parents:
diff changeset
   178
	|stream line|
claus
parents:
diff changeset
   179
claus
parents:
diff changeset
   180
	p percentage:(done / names size * 100).
claus
parents:
diff changeset
   181
	stream := ('source/' , aName) asFilename readStream.
claus
parents:
diff changeset
   182
	[stream atEnd] whileFalse:[
claus
parents:
diff changeset
   183
	    line := stream nextLine.
claus
parents:
diff changeset
   184
	    (line findString:'subclass:') ~~ 0 ifTrue:[
claus
parents:
diff changeset
   185
		Transcript showCr:line
claus
parents:
diff changeset
   186
	    ].
claus
parents:
diff changeset
   187
	].
claus
parents:
diff changeset
   188
	stream close.
claus
parents:
diff changeset
   189
	done := done + 1
claus
parents:
diff changeset
   190
      ].
claus
parents:
diff changeset
   191
claus
parents:
diff changeset
   192
      top destroy
62
claus
parents: 50
diff changeset
   193
claus
parents: 50
diff changeset
   194
claus
parents: 50
diff changeset
   195
   using the convenient inBox-interface
claus
parents: 50
diff changeset
   196
claus
parents: 50
diff changeset
   197
   (this creates a box and an activity label and evaluates a block
claus
parents: 50
diff changeset
   198
    to indicate ...)
claus
parents: 50
diff changeset
   199
claus
parents: 50
diff changeset
   200
    basic interface demonstration:
claus
parents: 50
diff changeset
   201
claus
parents: 50
diff changeset
   202
      |p|
claus
parents: 50
diff changeset
   203
claus
parents: 50
diff changeset
   204
      p := ProgressIndicator 
claus
parents: 50
diff changeset
   205
		inBoxWithLabel:'doing something  ...'
claus
parents: 50
diff changeset
   206
		abortable:true.
claus
parents: 50
diff changeset
   207
      p showProgressOf:
claus
parents: 50
diff changeset
   208
	    [:progressValue :currentAction |
claus
parents: 50
diff changeset
   209
claus
parents: 50
diff changeset
   210
	      1 to:100 do:[:val |
claus
parents: 50
diff changeset
   211
		  (Delay forSeconds:0.05) wait.
claus
parents: 50
diff changeset
   212
		  val == 25 ifTrue:[
claus
parents: 50
diff changeset
   213
		      currentAction value:'still going ...'
claus
parents: 50
diff changeset
   214
		  ].
claus
parents: 50
diff changeset
   215
		  val == 50 ifTrue:[
claus
parents: 50
diff changeset
   216
		      currentAction value:'halfway through ...'
claus
parents: 50
diff changeset
   217
		  ].
claus
parents: 50
diff changeset
   218
		  val == 75 ifTrue:[
claus
parents: 50
diff changeset
   219
		      currentAction value:'almost finished ...'
claus
parents: 50
diff changeset
   220
		  ].
claus
parents: 50
diff changeset
   221
		  progressValue value:val 
claus
parents: 50
diff changeset
   222
	      ]
claus
parents: 50
diff changeset
   223
	    ]
claus
parents: 50
diff changeset
   224
claus
parents: 50
diff changeset
   225
claus
parents: 50
diff changeset
   226
    above search example using this convenient interface:
claus
parents: 50
diff changeset
   227
claus
parents: 50
diff changeset
   228
      |p|
claus
parents: 50
diff changeset
   229
claus
parents: 50
diff changeset
   230
      p := ProgressIndicator inBoxWithLabel:'searching files ...'.
claus
parents: 50
diff changeset
   231
      p showProgressOf:
claus
parents: 50
diff changeset
   232
	    [:progressValue :currentAction |
claus
parents: 50
diff changeset
   233
		|names nDone|
claus
parents: 50
diff changeset
   234
claus
parents: 50
diff changeset
   235
		names := 'source' asFilename directoryContents.
claus
parents: 50
diff changeset
   236
		nDone := 0.
claus
parents: 50
diff changeset
   237
		names do:[:aName |
claus
parents: 50
diff changeset
   238
		  |stream line|
claus
parents: 50
diff changeset
   239
claus
parents: 50
diff changeset
   240
		  progressValue value:(nDone / names size * 100).
claus
parents: 50
diff changeset
   241
		  currentAction value:'searching ' , 'source/' , aName , ' ...'.
claus
parents: 50
diff changeset
   242
claus
parents: 50
diff changeset
   243
		  stream := ('source/' , aName) asFilename readStream.
claus
parents: 50
diff changeset
   244
		  [stream atEnd] whileFalse:[
claus
parents: 50
diff changeset
   245
		      line := stream nextLine.
claus
parents: 50
diff changeset
   246
		      (line findString:'subclass:') ~~ 0 ifTrue:[
claus
parents: 50
diff changeset
   247
			  Transcript showCr:line
claus
parents: 50
diff changeset
   248
		      ].
claus
parents: 50
diff changeset
   249
		  ].
claus
parents: 50
diff changeset
   250
		  stream close.
claus
parents: 50
diff changeset
   251
		  nDone := nDone + 1
claus
parents: 50
diff changeset
   252
		].
claus
parents: 50
diff changeset
   253
	    ].
claus
parents: 50
diff changeset
   254
claus
parents: 50
diff changeset
   255
claus
parents: 50
diff changeset
   256
    a nice example: copying files a la windows ...
claus
parents: 50
diff changeset
   257
claus
parents: 50
diff changeset
   258
      |p|
claus
parents: 50
diff changeset
   259
claus
parents: 50
diff changeset
   260
      (ProgressIndicator 
claus
parents: 50
diff changeset
   261
		inBoxWithLabel:'copy files to /dev/null ...'
claus
parents: 50
diff changeset
   262
		abortable:true)
claus
parents: 50
diff changeset
   263
	 showProgressOf:
claus
parents: 50
diff changeset
   264
	    [:progressValue :currentAction |
claus
parents: 50
diff changeset
   265
		|files nFiles nDone|
claus
parents: 50
diff changeset
   266
claus
parents: 50
diff changeset
   267
		files := '.' asFilename directoryContents.
claus
parents: 50
diff changeset
   268
		nFiles := files size.
claus
parents: 50
diff changeset
   269
		nDone := 0.
claus
parents: 50
diff changeset
   270
		files do:[:aFileName |
claus
parents: 50
diff changeset
   271
		    |percent|
claus
parents: 50
diff changeset
   272
claus
parents: 50
diff changeset
   273
		    nDone := nDone + 1.
claus
parents: 50
diff changeset
   274
		    percent := nDone / nFiles * 100.
claus
parents: 50
diff changeset
   275
		    progressValue value:percent. 
claus
parents: 50
diff changeset
   276
		    aFileName asFilename isDirectory ifTrue:[
claus
parents: 50
diff changeset
   277
			Transcript showCr:('skipping ' , aFileName , ' ...'). 
claus
parents: 50
diff changeset
   278
			currentAction value:('skipping ' , aFileName , ' ...'). 
claus
parents: 50
diff changeset
   279
		    ] ifFalse:[
claus
parents: 50
diff changeset
   280
			Transcript showCr:('copying ' , aFileName , ' ...').
claus
parents: 50
diff changeset
   281
			currentAction value:('copying ' , aFileName , ' ...').
claus
parents: 50
diff changeset
   282
			Object errorSignal handle:[:ex |
claus
parents: 50
diff changeset
   283
			    self warn:'an error occurred while copying ' , aFileName.
claus
parents: 50
diff changeset
   284
			    ex return
claus
parents: 50
diff changeset
   285
			] do:[
claus
parents: 50
diff changeset
   286
			    aFileName asFilename copyTo:'/dev/null'.
claus
parents: 50
diff changeset
   287
			]
claus
parents: 50
diff changeset
   288
		    ].
claus
parents: 50
diff changeset
   289
		].
claus
parents: 50
diff changeset
   290
	    ].
50
claus
parents:
diff changeset
   291
"
claus
parents:
diff changeset
   292
! !
claus
parents:
diff changeset
   293
claus
parents:
diff changeset
   294
!ProgressIndicator methodsFor:'drawing'!
claus
parents:
diff changeset
   295
claus
parents:
diff changeset
   296
redraw
claus
parents:
diff changeset
   297
    |s rx sx sy sw m w h|
claus
parents:
diff changeset
   298
claus
parents:
diff changeset
   299
    m := margin + 1.
claus
parents:
diff changeset
   300
    w := width - (m*2).
claus
parents:
diff changeset
   301
    h := height - (m*2).
claus
parents:
diff changeset
   302
claus
parents:
diff changeset
   303
    s := percentage printString , ' %'.
claus
parents:
diff changeset
   304
    sw := font widthOf:s.
claus
parents:
diff changeset
   305
    sx := (width - sw) // 2.
claus
parents:
diff changeset
   306
    sy := height // 2 + font descent + 2.
claus
parents:
diff changeset
   307
claus
parents:
diff changeset
   308
    rx := (w * percentage / 100) rounded.
claus
parents:
diff changeset
   309
claus
parents:
diff changeset
   310
    self paint:Color white.
claus
parents:
diff changeset
   311
    self fillRectangleX:m y:m width:w height:h.
claus
parents:
diff changeset
   312
claus
parents:
diff changeset
   313
    showPercentage ifTrue:[
claus
parents:
diff changeset
   314
	rx <= (sx+sw) ifTrue:[
claus
parents:
diff changeset
   315
	    self paint:Color black.
claus
parents:
diff changeset
   316
	    self displayString:s x:sx y:sy.
claus
parents:
diff changeset
   317
	]
claus
parents:
diff changeset
   318
    ].
claus
parents:
diff changeset
   319
claus
parents:
diff changeset
   320
    self paint:fgColor.
claus
parents:
diff changeset
   321
    self fillRectangleX:m y:m width:rx height:h.
claus
parents:
diff changeset
   322
claus
parents:
diff changeset
   323
    showPercentage ifTrue:[
claus
parents:
diff changeset
   324
	rx >= sx ifTrue:[
claus
parents:
diff changeset
   325
	    self clipRect:(m@m corner:rx+1 @ h).
claus
parents:
diff changeset
   326
	    self paint:Color white.
claus
parents:
diff changeset
   327
	    self displayString:s x:sx y:sy.
claus
parents:
diff changeset
   328
	    self clipRect:nil
claus
parents:
diff changeset
   329
	]
claus
parents:
diff changeset
   330
    ]
claus
parents:
diff changeset
   331
! !
claus
parents:
diff changeset
   332
62
claus
parents: 50
diff changeset
   333
!ProgressIndicator class methodsFor:'instance creation'!
claus
parents: 50
diff changeset
   334
claus
parents: 50
diff changeset
   335
inBox
claus
parents: 50
diff changeset
   336
    ^ self inBoxWithLabel:'executing ...' abortable:false 
claus
parents: 50
diff changeset
   337
!
claus
parents: 50
diff changeset
   338
claus
parents: 50
diff changeset
   339
inBoxWithLabel:aLabel
claus
parents: 50
diff changeset
   340
    "create a topView containing an instance of myself,
claus
parents: 50
diff changeset
   341
     for later use with #showProgressOf:"
claus
parents: 50
diff changeset
   342
claus
parents: 50
diff changeset
   343
    ^ self inBoxWithLabel:aLabel abortable:false 
claus
parents: 50
diff changeset
   344
!
claus
parents: 50
diff changeset
   345
claus
parents: 50
diff changeset
   346
inBoxWithLabel:aLabel abortable:abortable
claus
parents: 50
diff changeset
   347
    "create a topView containing an instance of myself,
claus
parents: 50
diff changeset
   348
     for later use with #showProgressOf:"
claus
parents: 50
diff changeset
   349
claus
parents: 50
diff changeset
   350
    |top p l h|
claus
parents: 50
diff changeset
   351
claus
parents: 50
diff changeset
   352
    top := Dialog new.
claus
parents: 50
diff changeset
   353
    top extent:300@100; sizeFixed:true.
claus
parents: 50
diff changeset
   354
    top label:aLabel.
claus
parents: 50
diff changeset
   355
    top cursor:(Cursor wait).
claus
parents: 50
diff changeset
   356
claus
parents: 50
diff changeset
   357
    l := top addTextLabel:''.
claus
parents: 50
diff changeset
   358
    l borderWidth:0.
74
claus
parents: 62
diff changeset
   359
    l adjust:#left.
62
claus
parents: 50
diff changeset
   360
    l cursor:(Cursor wait).
claus
parents: 50
diff changeset
   361
claus
parents: 50
diff changeset
   362
    top addVerticalSpace.
claus
parents: 50
diff changeset
   363
claus
parents: 50
diff changeset
   364
    p := ProgressIndicator new.
claus
parents: 50
diff changeset
   365
    p extent:(1.0 @ p preferredExtent y).
claus
parents: 50
diff changeset
   366
    p level:-1.
claus
parents: 50
diff changeset
   367
    p leftInset:5;
claus
parents: 50
diff changeset
   368
      rightInset:5.
claus
parents: 50
diff changeset
   369
    p cursor:(Cursor wait).
claus
parents: 50
diff changeset
   370
    p connectToTop:top label:l.
claus
parents: 50
diff changeset
   371
claus
parents: 50
diff changeset
   372
    top addComponent:p.
claus
parents: 50
diff changeset
   373
claus
parents: 50
diff changeset
   374
    abortable ifTrue:[
claus
parents: 50
diff changeset
   375
	top addVerticalSpace.
claus
parents: 50
diff changeset
   376
	top addAbortButton
claus
parents: 50
diff changeset
   377
    ].
claus
parents: 50
diff changeset
   378
claus
parents: 50
diff changeset
   379
    ^ p
claus
parents: 50
diff changeset
   380
! !
claus
parents: 50
diff changeset
   381
claus
parents: 50
diff changeset
   382
!ProgressIndicator methodsFor:'showing progress'!
claus
parents: 50
diff changeset
   383
claus
parents: 50
diff changeset
   384
connectToTop:top label:label
claus
parents: 50
diff changeset
   385
    connectedTop := top.
claus
parents: 50
diff changeset
   386
    connectedLabel := label
claus
parents: 50
diff changeset
   387
!
claus
parents: 50
diff changeset
   388
claus
parents: 50
diff changeset
   389
showProgressOf:aBlock
claus
parents: 50
diff changeset
   390
    "show progress, while evaluating aBlock.
claus
parents: 50
diff changeset
   391
     If the receiver has been created with inBox, show the
claus
parents: 50
diff changeset
   392
     box centered on the screen. If not, the view is assumed to
claus
parents: 50
diff changeset
   393
     be contained in another view, and no special startup actions
claus
parents: 50
diff changeset
   394
     are performed.
claus
parents: 50
diff changeset
   395
claus
parents: 50
diff changeset
   396
     The block is passed two arguments, the progressValue,
claus
parents: 50
diff changeset
   397
     which should be set to the percentage from time-to-time
claus
parents: 50
diff changeset
   398
     within the block and an action value, which should be set to
claus
parents: 50
diff changeset
   399
     the currently performed action (a string) from time to time.
claus
parents: 50
diff changeset
   400
     The second valueHolder can be left unchanged.
claus
parents: 50
diff changeset
   401
claus
parents: 50
diff changeset
   402
     Caveat: cannot (currently) suppress close of the box ..."
claus
parents: 50
diff changeset
   403
claus
parents: 50
diff changeset
   404
    |progressValue labelValue p|
claus
parents: 50
diff changeset
   405
claus
parents: 50
diff changeset
   406
    progressValue := 0 asValue.
claus
parents: 50
diff changeset
   407
    labelValue := '' asValue.
claus
parents: 50
diff changeset
   408
claus
parents: 50
diff changeset
   409
    connectedLabel notNil ifTrue:[
claus
parents: 50
diff changeset
   410
	connectedLabel 
claus
parents: 50
diff changeset
   411
	    model:labelValue;
claus
parents: 50
diff changeset
   412
	    aspect:#value;
claus
parents: 50
diff changeset
   413
	    labelMessage:#value.
claus
parents: 50
diff changeset
   414
    ].
claus
parents: 50
diff changeset
   415
claus
parents: 50
diff changeset
   416
    self model:progressValue.
claus
parents: 50
diff changeset
   417
claus
parents: 50
diff changeset
   418
    p := [
claus
parents: 50
diff changeset
   419
	[
claus
parents: 50
diff changeset
   420
	    aBlock value:progressValue value:labelValue
claus
parents: 50
diff changeset
   421
	] valueNowOrOnUnwindDo:[
claus
parents: 50
diff changeset
   422
	    p := nil.
claus
parents: 50
diff changeset
   423
	    connectedTop notNil ifTrue:[
claus
parents: 50
diff changeset
   424
		connectedTop hide
claus
parents: 50
diff changeset
   425
	    ]
claus
parents: 50
diff changeset
   426
	]
claus
parents: 50
diff changeset
   427
    ] fork.
claus
parents: 50
diff changeset
   428
claus
parents: 50
diff changeset
   429
    connectedTop notNil ifTrue:[
claus
parents: 50
diff changeset
   430
	Processor activeProcess 
claus
parents: 50
diff changeset
   431
	    withPriority:(Processor activePriority + 1)
claus
parents: 50
diff changeset
   432
	    do:[
claus
parents: 50
diff changeset
   433
		self topView show.
claus
parents: 50
diff changeset
   434
	    ].
claus
parents: 50
diff changeset
   435
	p notNil ifTrue:[p terminate].
claus
parents: 50
diff changeset
   436
    ] ifFalse:[
claus
parents: 50
diff changeset
   437
	self halt:'not yet implemented'.
claus
parents: 50
diff changeset
   438
    ]
claus
parents: 50
diff changeset
   439
claus
parents: 50
diff changeset
   440
claus
parents: 50
diff changeset
   441
    "
claus
parents: 50
diff changeset
   442
      |p|
claus
parents: 50
diff changeset
   443
claus
parents: 50
diff changeset
   444
      p := ProgressIndicator inBox.
claus
parents: 50
diff changeset
   445
      p showProgressOf:
claus
parents: 50
diff changeset
   446
	    [:progressValue :currentAction |
claus
parents: 50
diff changeset
   447
		1 to:100 do:[:percent |
claus
parents: 50
diff changeset
   448
		    (Delay forSeconds:0.05) wait.
claus
parents: 50
diff changeset
   449
		    progressValue value:percent 
claus
parents: 50
diff changeset
   450
		].
claus
parents: 50
diff changeset
   451
	    ].
claus
parents: 50
diff changeset
   452
claus
parents: 50
diff changeset
   453
      'it can be reused ...'.  
claus
parents: 50
diff changeset
   454
      p showProgressOf:
claus
parents: 50
diff changeset
   455
	    [:progressValue :currentAction |
claus
parents: 50
diff changeset
   456
		1 to:100 by:5 do:[:percent |
claus
parents: 50
diff changeset
   457
		    (Delay forSeconds:0.05) wait.
claus
parents: 50
diff changeset
   458
		    progressValue value:percent 
claus
parents: 50
diff changeset
   459
		].
claus
parents: 50
diff changeset
   460
	    ].
claus
parents: 50
diff changeset
   461
claus
parents: 50
diff changeset
   462
    "
claus
parents: 50
diff changeset
   463
! !
claus
parents: 50
diff changeset
   464
50
claus
parents:
diff changeset
   465
!ProgressIndicator methodsFor:'initialization'!
claus
parents:
diff changeset
   466
claus
parents:
diff changeset
   467
initialize
claus
parents:
diff changeset
   468
    super initialize.
62
claus
parents: 50
diff changeset
   469
    viewBackground := styleSheet colorAt:'progressIndicatorViewBackground' default:Color white.
claus
parents: 50
diff changeset
   470
    fgColor := styleSheet colorAt:'progressIndicatorForegroundColor' default:Color blue.
50
claus
parents:
diff changeset
   471
    percentage := 0.
claus
parents:
diff changeset
   472
    showPercentage := true.
claus
parents:
diff changeset
   473
! !
claus
parents:
diff changeset
   474
claus
parents:
diff changeset
   475
!ProgressIndicator methodsFor:'accessing'!
claus
parents:
diff changeset
   476
claus
parents:
diff changeset
   477
percentage:aNumber
claus
parents:
diff changeset
   478
    |newPercentage|
claus
parents:
diff changeset
   479
claus
parents:
diff changeset
   480
    newPercentage := ((aNumber max:0) min:100) rounded.
claus
parents:
diff changeset
   481
    newPercentage ~~ percentage ifTrue:[
claus
parents:
diff changeset
   482
	percentage := newPercentage.
claus
parents:
diff changeset
   483
	shown ifTrue:[self redraw].
claus
parents:
diff changeset
   484
    ]
claus
parents:
diff changeset
   485
!
claus
parents:
diff changeset
   486
claus
parents:
diff changeset
   487
showPercentage:aBoolean
claus
parents:
diff changeset
   488
    showPercentage := aBoolean
claus
parents:
diff changeset
   489
!
claus
parents:
diff changeset
   490
claus
parents:
diff changeset
   491
foregroundColor:aColor 
claus
parents:
diff changeset
   492
    fgColor := aColor
claus
parents:
diff changeset
   493
! !
claus
parents:
diff changeset
   494
claus
parents:
diff changeset
   495
!ProgressIndicator methodsFor:'queries'!
claus
parents:
diff changeset
   496
62
claus
parents: 50
diff changeset
   497
preferredExtent
50
claus
parents:
diff changeset
   498
    ^ 100 @ (font height + font descent + ((margin + 1) * 2))
claus
parents:
diff changeset
   499
! !
claus
parents:
diff changeset
   500
claus
parents:
diff changeset
   501
!ProgressIndicator methodsFor:'change & update'!
claus
parents:
diff changeset
   502
claus
parents:
diff changeset
   503
update:aspect with:aParameter from:changedObject
claus
parents:
diff changeset
   504
    (aspect == aspectMsg
claus
parents:
diff changeset
   505
    and:[changedObject == model]) ifTrue:[
claus
parents:
diff changeset
   506
	self percentage:(model perform:aspectMsg).
claus
parents:
diff changeset
   507
	^ self
claus
parents:
diff changeset
   508
    ].
claus
parents:
diff changeset
   509
    ^ super update:aspect with:aParameter from:changedObject
claus
parents:
diff changeset
   510
! !