Scroller.st
changeset 105 3d064ba4a0cc
parent 103 87da77f6c88d
child 106 4d26538ad451
equal deleted inserted replaced
104:ca75c90df7a9 105:3d064ba4a0cc
     8  be provided or otherwise made available to, or used by, any
     8  be provided or otherwise made available to, or used by, any
     9  other person.  No title to or ownership of the software is
     9  other person.  No title to or ownership of the software is
    10  hereby transferred.
    10  hereby transferred.
    11 "
    11 "
    12 
    12 
       
    13 'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:18:14 am'!
       
    14 
    13 View subclass:#Scroller
    15 View subclass:#Scroller
    14        instanceVariableNames:'thumbOrigin thumbHeight thumbColor thumbFrameColor
    16 	 instanceVariableNames:'thumbOrigin thumbHeight thumbColor thumbFrameColor scrollAction
    15 			      scrollAction moveDirection
    17 		moveDirection thumbFrame thumbLevel scrolling pressOffset
    16 			      thumbFrame thumbLevel
    18 		synchronousOperation shadowForm lightForm inset thumbShadowColor
    17 			      scrolling pressOffset
    19 		thumbLightColor thumbEdgeStyle thumbHalfShadowColor
    18 			      synchronousOperation
    20 		thumbHalfLightColor thumbFrameSizeDifference tallyLevel
    19 			      shadowForm lightForm inset
    21 		tallyMarks fixThumbHeight frameBeforeMove ghostColor
    20 			      thumbShadowColor thumbLightColor
    22 		ghostFrameColor ghostLevel'
    21 			      thumbEdgeStyle
    23 	 classVariableNames:'HandleShadowForm HandleLightForm DefaultViewBackground
    22 			      thumbHalfShadowColor thumbHalfLightColor
    24 		DefaultShadowColor DefaultLightColor DefaultThumbColor
    23 			      thumbFrameSizeDifference
    25 		DefaultThumbShadowColor DefaultThumbLightColor
    24 			      tallyLevel tallyMarks
    26 		DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
    25 			      fixThumbHeight frameBeforeMove 
    27 		DefaultHalfShadowColor DefaultHalfLightColor DefaultTallyMarks
    26 			      ghostColor ghostFrameColor ghostLevel'
    28 		DefaultTallyLevel DefaultLevel DefaultBorderWidth
    27        classVariableNames:   'HandleShadowForm HandleLightForm
    29 		DefaultThumbLevel DefaultInset DefaultThumbFrameColor
    28 			      DefaultViewBackground
    30 		DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
    29 			      DefaultShadowColor DefaultLightColor DefaultThumbColor 
    31 		DefaultFixThumbHeight DefaultEdgeStyle'
    30 			      DefaultThumbShadowColor DefaultThumbLightColor
    32 	 poolDictionaries:''
    31 			      DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
    33 	 category:'Views-Interactors'
    32 			      DefaultHalfShadowColor DefaultHalfLightColor
       
    33 			      DefaultTallyMarks DefaultTallyLevel
       
    34 			      DefaultLevel DefaultBorderWidth DefaultThumbLevel 
       
    35 			      DefaultInset DefaultThumbFrameColor 
       
    36 			      DefaultGhostColor DefaultGhostFrameColor DefaultGhostLevel
       
    37 			      DefaultFixThumbHeight DefaultEdgeStyle'
       
    38        poolDictionaries:''
       
    39        category:'Views-Interactors'
       
    40 !
    34 !
    41 
    35 
    42 Scroller comment:'
    36 Scroller comment:'
    43 COPYRIGHT (c) 1989 by Claus Gittinger
    37 COPYRIGHT (c) 1989 by Claus Gittinger
    44 	      All Rights Reserved
    38 	      All Rights Reserved
    45 
    39 
    46 $Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.16 1995-03-09 03:29:16 claus Exp $
    40 $Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.17 1995-03-18 05:16:01 claus Exp $
    47 '!
    41 '!
    48 
    42 
    49 !Scroller class methodsFor:'documentation'!
    43 !Scroller class methodsFor:'documentation'!
    50 
    44 
    51 copyright
    45 copyright
    62 "
    56 "
    63 !
    57 !
    64 
    58 
    65 version
    59 version
    66 "
    60 "
    67 $Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.16 1995-03-09 03:29:16 claus Exp $
    61 $Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.17 1995-03-18 05:16:01 claus Exp $
    68 "
    62 "
    69 !
    63 !
    70 
    64 
    71 documentation
    65 documentation
    72 "
    66 "
   228 	HandleLightForm := f
   222 	HandleLightForm := f
   229     ].
   223     ].
   230     ^ f
   224     ^ f
   231 ! !
   225 ! !
   232 
   226 
   233 !Scroller methodsFor:'initialization'!
   227 !Scroller methodsFor:'drawing'!
   234 
   228 
   235 initialize
   229 drawThumb
   236     "initialize - setup instvars from defaults"
   230     "draw the thumb"
   237 
   231 
   238     super initialize.
   232     |handleX handleY l t 
   239     self computeInitialExtent.
   233      w "{ Class: SmallInteger }"
   240     moveDirection := #y.
   234      h "{ Class: SmallInteger }"
   241 
   235      x "{ Class: SmallInteger }"
   242     scrolling := false.
   236      y "{ Class: SmallInteger }"
   243     synchronousOperation := true.
   237      mm xL xR yT yB color1 color2|
   244 
   238 
   245     thumbOrigin := 0.
   239     (thumbHeight >= 100) ifTrue:[^ self].
   246     thumbHeight := 100.
   240     moveDirection == #y ifTrue:[
   247     thumbFrameSizeDifference := 0.
   241 	thumbFrame height >= height ifTrue:[^ self].
   248 
   242     ] ifFalse:[
   249 "/    inset := 1.
   243 	thumbFrame width >= width ifTrue:[^ self].
   250 
   244     ].
   251 "/    self computeThumbFrame
   245 
   252 !
   246     l := thumbFrame left.
   253 
   247     t := thumbFrame top.
   254 computeInitialExtent
   248     w := thumbFrame width.
   255     ^ self
   249     h := thumbFrame height.
   256 !
   250     self paint:thumbColor.
   257 
   251     self fillRectangleX:l y:t width:w-1 height:h.
   258 initStyle
   252 
   259     "initialize style dep. stuff"
   253     thumbLevel == 0 ifTrue:[
   260 
   254 	thumbFrameColor notNil ifTrue:[
   261     super initStyle.
   255 	    self paint:thumbFrameColor.
   262 
   256 	    self displayRectangle:thumbFrame.
   263     DefaultViewBackground notNil ifTrue:[
   257 	].
   264 	viewBackground := DefaultViewBackground on:device.
   258 	^ self
   265     ].
   259     ].
   266     DefaultShadowColor notNil ifTrue:[
   260 
   267 	shadowColor := DefaultShadowColor on:device.
   261     "what a kludge - must be a parameter to drawEdge..."
   268     ].
   262     self drawEdgesForX:l y:t width:w height:h level:thumbLevel
   269     DefaultLightColor notNil ifTrue:[
   263 		shadow:thumbShadowColor light:thumbLightColor
   270 	lightColor := DefaultLightColor on:device.
   264 		halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor
   271     ].
   265 		style:thumbEdgeStyle.
   272 
   266 
   273     tallyMarks := DefaultTallyMarks.
   267     thumbFrameColor notNil ifTrue:[
   274     tallyLevel := DefaultTallyLevel.
   268 	self paint:thumbFrameColor.
   275     DefaultLevel ~~ level ifTrue:[
   269 	moveDirection == #y ifTrue:[
   276 	self level:DefaultLevel.
   270 	    self displayRectangleX:l y:t width:w"-1" height:h.
   277     ].
   271 	] ifFalse:[
   278     DefaultBorderWidth ~~ borderWidth ifTrue:[
   272 	    self displayRectangleX:l y:t width:w height:h"-1".
   279 	self borderWidth:DefaultBorderWidth.
   273 	]
   280     ].
   274     ].
   281     thumbLevel := DefaultThumbLevel.
   275 
   282     inset := DefaultInset.
   276     (tallyLevel == 0 or:[tallyMarks == 0]) ifTrue:[
   283     fixThumbHeight := DefaultFixThumbHeight.
   277 	shadowForm notNil ifTrue:[
   284     thumbEdgeStyle := DefaultEdgeStyle.
   278 	    handleX := l + ((w - 8) // 2).
   285 
   279 	    handleY := t + ((h - 8) // 2).
   286     DefaultGhostColor notNil ifTrue:[
   280 	    self drawHandleFormAtX:handleX y:handleY
   287 	ghostColor := DefaultGhostColor on:device.
   281 	].
   288     ].
   282 	^ self
   289     DefaultGhostFrameColor notNil ifTrue:[
   283     ].
   290 	ghostFrameColor := DefaultGhostFrameColor on:device.
   284 
   291     ].
   285     "iris style - draw tallys"
   292     ghostLevel := DefaultGhostLevel.
   286 
   293 
   287     tallyLevel > 0 ifTrue:[
   294     DefaultThumbFrameColor notNil ifTrue:[
   288 	color1 := thumbLightColor.
   295 	thumbFrameColor := DefaultThumbFrameColor on:device.
   289 	color2 := thumbShadowColor.
   296     ].
   290     ] ifFalse:[
   297     DefaultThumbShadowColor notNil ifTrue:[
   291 	color1 := thumbShadowColor.
   298 	thumbShadowColor := DefaultThumbShadowColor
   292 	color2 := thumbLightColor.
   299     ] ifFalse:[
   293     ].
   300 	thumbShadowColor := shadowColor.
   294 
   301     ].
   295     "draw tally marks"
   302     DefaultThumbLightColor notNil ifTrue:[
   296 
   303 	thumbLightColor := DefaultThumbLightColor
   297     (moveDirection == #y) ifTrue:[
   304     ] ifFalse:[
   298 	self paint:color1.
   305 	thumbLightColor := lightColor.
   299 	y := t + (h // 2) - 1.
   306     ].
   300 	xL := l + thumbLevel - 1.
   307 
   301 	xR := l + w - thumbLevel "+ 1".
   308     thumbEdgeStyle notNil ifTrue:[
   302 	self displayLineFromX:xL y:y toX:xR y:y.
   309 	DefaultThumbHalfShadowColor notNil ifTrue:[
   303 	y := y + 1.
   310 	    thumbHalfShadowColor := DefaultThumbHalfShadowColor
   304 	self paint:color2.
   311 	].
   305 	self displayLineFromX:xL y:y toX:xR y:y.
   312 	DefaultThumbHalfLightColor notNil ifTrue:[
   306 
   313 	    thumbHalfLightColor := DefaultThumbHalfLightColor
   307 	tallyMarks > 1 ifTrue:[
   314 	].
   308 	    "dont draw other marks if there is not enough space"
   315     ].
   309 
   316 
   310 	    mm := device verticalPixelPerMillimeter rounded.
   317     device hasGreyscales ifFalse:[
   311 	    h > (mm * (tallyMarks * 2)) ifTrue:[
   318 	thumbEdgeStyle notNil ifTrue:[
   312 		y := y - 1 - mm.
   319 	    thumbHalfShadowColor := Color darkGrey.
   313 		self paint:color1.
   320 	    thumbHalfLightColor := White
   314 		self displayLineFromX:xL y:y toX:xR y:y.
   321 	].
   315 		y := y + 1.
   322 
   316 		self paint:color2.
   323 	thumbShadowColor := Black.
   317 		self displayLineFromX:xL y:y toX:xR y:y.
   324 "/        thumbLightColor := White.
   318 
   325 
   319 		y := y - 1 + mm + mm.
   326 	StyleSheet name = #motif ifTrue:[
   320 		self paint:color1.
   327 	    DefaultThumbColor isNil ifTrue:[
   321 		self displayLineFromX:xL y:y toX:xR y:y.
   328 		thumbColor := White .
   322 		y := y + 1.
   329 	    ].
   323 		self paint:color2.
   330 	]
   324 		self displayLineFromX:xL y:y toX:xR y:y
   331     ].
   325 	    ]
   332 
   326 	]
   333     DefaultThumbColor notNil ifTrue:[
   327     ] ifFalse:[
   334 	thumbColor := DefaultThumbColor on:device
   328 	x := l + (w // 2) - 1.
   335     ] ifFalse:[
   329 	yT := t + thumbLevel - 1.
   336 	thumbColor := White.
   330 	yB := t + h - thumbLevel "+ 1".
   337 	StyleSheet name ~= #normal ifTrue:[
   331 	self paint:color1.
   338 	    device hasGreyscales ifFalse:[
   332 	self displayLineFromX:x y:yT toX:x y:yB.
   339 		thumbColor := Color grey
   333 	self paint:color2.
   340 	    ].
   334 	x := x + 1.
   341 	].
   335 	self displayLineFromX:x y:yT toX:x y:yB.
   342     ].
   336 
   343 
   337 	tallyMarks > 1 ifTrue:[
   344     thumbColor := thumbColor on:device.
   338 	    "dont draw other marks if there is not enough space"
   345     thumbShadowColor notNil ifTrue:[
   339 
   346 	thumbShadowColor := thumbShadowColor on:device.
   340 	    mm := device horizontalPixelPerMillimeter rounded.
   347     ].
   341 	    w > (mm * (tallyMarks * 2)) ifTrue:[
   348     thumbLightColor notNil ifTrue:[
   342 		x := x - 1 - mm.
   349 	thumbLightColor := thumbLightColor on:device.
   343 		self paint:color1.
   350     ].
   344 		self displayLineFromX:x y:yT toX:x y:yB.
   351     thumbHalfShadowColor notNil ifTrue:[
   345 		x := x + 1.
   352 	thumbHalfShadowColor := thumbHalfShadowColor on:device.
   346 		self paint:color2.
   353     ].
   347 		self displayLineFromX:x y:yT toX:x y:yB.
   354     thumbHalfLightColor notNil ifTrue:[
   348 
   355 	thumbHalfLightColor := thumbHalfLightColor on:device.
   349 		x := x - 1 + mm + mm.
   356     ].
   350 		self paint:color1.
   357     thumbEdgeStyle notNil ifTrue:[
   351 		self displayLineFromX:x y:yT toX:x y:yB.
   358 	thumbHalfShadowColor isNil ifTrue:[
   352 		x := x + 1.
   359 	    thumbHalfShadowColor := thumbShadowColor lightened on:device
   353 		self paint:color2.
   360 	]
   354 		self displayLineFromX:x y:yT toX:x y:yB
   361     ].
   355 	    ]
   362 
   356 	]
   363     StyleSheet name = #next ifTrue:[
   357     ]
   364 	shadowForm := self class handleShadowFormOn:device.
   358 !
   365 	lightForm := self class handleLightFormOn:device
   359 
   366     ] ifFalse:[
   360 drawThumbBackgroundInX:x y:y width:w height:h
   367 	shadowForm := lightForm := nil
   361     "draw part of the thumbs background; defined as a separate
   368     ].
   362      method, to allow drawing of arbitrary patterns under thumb 
   369 
   363      (see ColorSlider)."
   370     drawableId notNil ifTrue:[
   364 
   371 	self computeThumbFrame
   365     shown ifTrue:[
   372     ]
   366 	self clearRectangleX:x y:y width:w height:h.
   373 !
   367 	frameBeforeMove notNil ifTrue:[
   374 
   368 	    self clippedTo:(Rectangle left:x top:y width:w height:h) do:[
   375 initCursor
   369 		|gX gY gW gH|
   376     "set the cursor - a hand"
   370 
   377 
   371 		gX := frameBeforeMove left.
   378     cursor := Cursor hand
   372 		gY := frameBeforeMove top.
       
   373 		gW := frameBeforeMove width.
       
   374 		gH := frameBeforeMove height.
       
   375                 
       
   376 		self fillRectangle:frameBeforeMove with:ghostColor.
       
   377 		(ghostLevel ~~ 0) ifTrue:[
       
   378 		    self drawEdgesForX:gX y:gY width:gW height:gH level:ghostLevel
       
   379 		].
       
   380 		ghostFrameColor notNil ifTrue:[
       
   381 		    self paint:ghostFrameColor.
       
   382 		    self displayRectangleX:gX y:gY width:gW height:gH
       
   383 		]
       
   384 	    ]
       
   385 	]
       
   386     ]
       
   387 !
       
   388 
       
   389 drawHandleFormAtX:x y:y
       
   390     thumbShadowColor := thumbShadowColor on:device.
       
   391     thumbLightColor := thumbLightColor on:device.
       
   392 
       
   393     self paint:thumbShadowColor.
       
   394     self displayForm:shadowForm x:x y:y.
       
   395     self paint:thumbLightColor.
       
   396     self displayForm:lightForm x:x y:y.
   379 ! !
   397 ! !
   380 
   398 
   381 !Scroller methodsFor:'accessing'!
   399 !Scroller methodsFor:'accessing'!
   382 
       
   383 is3D
       
   384     StyleSheet name = #mswindows ifTrue:[^ true].
       
   385     ^ super is3D
       
   386 !
       
   387 
       
   388 asynchronousOperation
       
   389     "set scroll-mode to be asynchronous - scroll action is performed after
       
   390      scrolling, when mouse-button is finally released"
       
   391      
       
   392     synchronousOperation := false
       
   393 !
       
   394 
       
   395 synchronousOperation
       
   396     "set scroll-mode to be synchronous - scroll action is performed for 
       
   397      every movement of thumb"
       
   398      
       
   399     synchronousOperation := true
       
   400 !
       
   401 
       
   402 scrollAction:aBlock
       
   403     "set the scroll action, aBlock which is evaluated when scrolled"
       
   404 
       
   405     scrollAction := aBlock
       
   406 !
       
   407 
       
   408 scrollAction
       
   409     "answer the scroll action block"
       
   410 
       
   411     ^ scrollAction
       
   412 !
       
   413 
       
   414 scrollDownAction:aBlock
       
   415     "ignored -
       
   416      but implemented, so that scroller can be used in place of a scrollbar"
       
   417 !
       
   418 
       
   419 scrollUpAction:aBlock
       
   420     "ignored -
       
   421      but implemented, so that scroller can be used in place of a scrollbar"
       
   422 !
       
   423 
       
   424 thumbOrigin
       
   425     "answer the thumbs origin (in percent)"
       
   426 
       
   427     ^ thumbOrigin
       
   428 !
       
   429 
   400 
   430 thumbOrigin:newOrigin
   401 thumbOrigin:newOrigin
   431     "set the thumbs origin (in percent)"
   402     "set the thumbs origin (in percent)"
   432 
   403 
   433     |realNewOrigin oldFrame oldTop oldBot thumbTop thumbBot
   404     |realNewOrigin oldFrame oldTop oldBot thumbTop thumbBot
   509 	    thumbFrame := nil
   480 	    thumbFrame := nil
   510 	]
   481 	]
   511     ]
   482     ]
   512 !
   483 !
   513 
   484 
   514 thumbHeight
       
   515     "answer the thumbs height (in percent)"
       
   516 
       
   517     ^ thumbHeight
       
   518 !
       
   519 
       
   520 thumbHeight:newHeight
   485 thumbHeight:newHeight
   521     "set the thumbs height (in percent)"
   486     "set the thumbs height (in percent)"
   522 
   487 
   523     |realNewHeight oldFrame|
   488     |realNewHeight oldFrame|
   524 
   489 
   545 	    thumbFrame := nil
   510 	    thumbFrame := nil
   546 	]
   511 	]
   547     ]
   512     ]
   548 !
   513 !
   549 
   514 
       
   515 setThumbFor:aView
       
   516     "get contents and size info from aView and adjust thumb"
       
   517 
       
   518     |percentSize percentOrigin contentsSize contentsPosition viewsSize|
       
   519 
       
   520     "
       
   521      get the content's size
       
   522     "
       
   523     aView isNil ifTrue:[
       
   524 	contentsSize := 0
       
   525     ] ifFalse:[
       
   526 	moveDirection == #y ifTrue:[
       
   527 	    contentsSize := aView heightOfContents.
       
   528 	    aView transformation notNil ifTrue:[
       
   529 		contentsSize := aView transformation applyScaleY:contentsSize.
       
   530 	    ].
       
   531 	] ifFalse:[
       
   532 	    contentsSize := aView widthOfContents.
       
   533 	    aView transformation notNil ifTrue:[
       
   534 		contentsSize := aView transformation applyScaleX:contentsSize.
       
   535 	    ].
       
   536 	]
       
   537     ].
       
   538 
       
   539     (contentsSize = 0) ifTrue:[
       
   540 	percentSize := 100.
       
   541 	percentOrigin := 100
       
   542     ] ifFalse:[
       
   543 	(moveDirection == #y) ifTrue:[
       
   544 	    viewsSize := aView innerHeight.
       
   545 	    contentsPosition := aView yOriginOfContents.
       
   546 	] ifFalse:[
       
   547 	    viewsSize := aView innerWidth.
       
   548 	    contentsPosition := aView xOriginOfContents
       
   549 	].
       
   550 
       
   551 	percentSize := viewsSize * 100.0 / contentsSize.
       
   552 	percentOrigin := contentsPosition * 100.0 / contentsSize.
       
   553 	percentOrigin + percentSize > 100.0 ifTrue:[
       
   554 	    "actually showing stuff below contents of view"
       
   555 "
       
   556 	    contentsSize := contentsPosition + aView innerHeight.
       
   557 	    percentSize := viewsSize * 100.0 / contentsSize.
       
   558 	    percentOrigin := contentsPosition * 100.0 / contentsSize
       
   559 "
       
   560 	]
       
   561     ].
       
   562     (percentSize = thumbHeight) ifTrue:[
       
   563 	self thumbOrigin:percentOrigin
       
   564     ] ifFalse:[
       
   565 	(percentOrigin = thumbOrigin) ifTrue:[
       
   566 	    self thumbHeight:percentSize
       
   567 	] ifFalse:[
       
   568 	    self thumbOrigin:percentOrigin thumbHeight:percentSize
       
   569 	]
       
   570     ]
       
   571 !
       
   572 
   550 thumbOrigin:newOrigin thumbHeight:newHeight
   573 thumbOrigin:newOrigin thumbHeight:newHeight
   551     "set both thumbs height and origin (in percent)"
   574     "set both thumbs height and origin (in percent)"
   552 
   575 
   553     |realNewOrigin realNewHeight old new changed|
   576     |realNewOrigin realNewHeight old new changed|
   554 
   577 
   593 	    ]
   616 	    ]
   594 	]
   617 	]
   595     ]
   618     ]
   596 !
   619 !
   597 
   620 
   598 setThumbFor:aView
   621 setThumbOriginFor:aView
   599     "get contents and size info from aView and adjust thumb"
   622     "get contents and size info from aView and adjust thumb origin"
   600 
   623 
   601     |percentSize percentOrigin contentsSize contentsPosition viewsSize|
   624     |percent total contentsPosition|
   602 
       
   603     "
       
   604      get the content's size
       
   605     "
       
   606     aView isNil ifTrue:[
       
   607 	contentsSize := 0
       
   608     ] ifFalse:[
       
   609 	moveDirection == #y ifTrue:[
       
   610 	    contentsSize := aView heightOfContents.
       
   611 	    aView transformation notNil ifTrue:[
       
   612 		contentsSize := aView transformation applyScaleY:contentsSize.
       
   613 	    ].
       
   614 	] ifFalse:[
       
   615 	    contentsSize := aView widthOfContents.
       
   616 	    aView transformation notNil ifTrue:[
       
   617 		contentsSize := aView transformation applyScaleX:contentsSize.
       
   618 	    ].
       
   619 	]
       
   620     ].
       
   621 
       
   622     (contentsSize = 0) ifTrue:[
       
   623 	percentSize := 100.
       
   624 	percentOrigin := 100
       
   625     ] ifFalse:[
       
   626 	(moveDirection == #y) ifTrue:[
       
   627 	    viewsSize := aView innerHeight.
       
   628 	    contentsPosition := aView yOriginOfContents.
       
   629 	] ifFalse:[
       
   630 	    viewsSize := aView innerWidth.
       
   631 	    contentsPosition := aView xOriginOfContents
       
   632 	].
       
   633 
       
   634 	percentSize := viewsSize * 100.0 / contentsSize.
       
   635 	percentOrigin := contentsPosition * 100.0 / contentsSize.
       
   636 	percentOrigin + percentSize > 100.0 ifTrue:[
       
   637 	    "actually showing stuff below contents of view"
       
   638 "
       
   639 	    contentsSize := contentsPosition + aView innerHeight.
       
   640 	    percentSize := viewsSize * 100.0 / contentsSize.
       
   641 	    percentOrigin := contentsPosition * 100.0 / contentsSize
       
   642 "
       
   643 	]
       
   644     ].
       
   645     (percentSize = thumbHeight) ifTrue:[
       
   646 	self thumbOrigin:percentOrigin
       
   647     ] ifFalse:[
       
   648 	(percentOrigin = thumbOrigin) ifTrue:[
       
   649 	    self thumbHeight:percentSize
       
   650 	] ifFalse:[
       
   651 	    self thumbOrigin:percentOrigin thumbHeight:percentSize
       
   652 	]
       
   653     ]
       
   654 !
       
   655 
       
   656 setThumbHeightFor:aView
       
   657     "get contents and size info from aView and adjust thumb height"
       
   658 
       
   659     |percent total viewsSize|
       
   660 
   625 
   661     (moveDirection == #y) ifTrue:[
   626     (moveDirection == #y) ifTrue:[
   662 	total := aView heightOfContents.
   627 	total := aView heightOfContents.
   663 	aView transformation notNil ifTrue:[
   628 	aView transformation notNil ifTrue:[
   664 	    total := aView transformation applyScaleY:total.
   629 	    total := aView transformation applyScaleY:total.
   670 	].
   635 	].
   671     ].
   636     ].
   672     (total = 0) ifTrue:[
   637     (total = 0) ifTrue:[
   673 	percent := 100
   638 	percent := 100
   674     ] ifFalse:[
   639     ] ifFalse:[
   675 	viewsSize := (moveDirection == #y) ifTrue:[aView innerHeight]
   640 	contentsPosition := (moveDirection == #y) ifTrue:[aView yOriginOfContents]
   676 					   ifFalse:[aView innerWidth].
   641 						  ifFalse:[aView xOriginOfContents].
   677 	percent := viewsSize * 100.0 / total
   642 	percent := contentsPosition * 100.0 / total
   678     ].
   643     ].
   679     self thumbHeight:percent
   644     self thumbOrigin:percent
   680 !
   645 !
   681 
   646 
   682 setThumbOriginFor:aView
   647 is3D
   683     "get contents and size info from aView and adjust thumb origin"
   648     StyleSheet name = #mswindows ifTrue:[^ true].
   684 
   649     ^ super is3D
   685     |percent total contentsPosition|
   650 !
       
   651 
       
   652 scrollAction:aBlock
       
   653     "set the scroll action, aBlock which is evaluated when scrolled"
       
   654 
       
   655     scrollAction := aBlock
       
   656 !
       
   657 
       
   658 asynchronousOperation
       
   659     "set scroll-mode to be asynchronous - scroll action is performed after
       
   660      scrolling, when mouse-button is finally released"
       
   661      
       
   662     synchronousOperation := false
       
   663 !
       
   664 
       
   665 synchronousOperation
       
   666     "set scroll-mode to be synchronous - scroll action is performed for 
       
   667      every movement of thumb"
       
   668      
       
   669     synchronousOperation := true
       
   670 !
       
   671 
       
   672 scrollAction
       
   673     "answer the scroll action block"
       
   674 
       
   675     ^ scrollAction
       
   676 !
       
   677 
       
   678 scrollDownAction:aBlock
       
   679     "ignored -
       
   680      but implemented, so that scroller can be used in place of a scrollbar"
       
   681 !
       
   682 
       
   683 scrollUpAction:aBlock
       
   684     "ignored -
       
   685      but implemented, so that scroller can be used in place of a scrollbar"
       
   686 !
       
   687 
       
   688 thumbOrigin
       
   689     "answer the thumbs origin (in percent)"
       
   690 
       
   691     ^ thumbOrigin
       
   692 !
       
   693 
       
   694 thumbHeight
       
   695     "answer the thumbs height (in percent)"
       
   696 
       
   697     ^ thumbHeight
       
   698 !
       
   699 
       
   700 setThumbHeightFor:aView
       
   701     "get contents and size info from aView and adjust thumb height"
       
   702 
       
   703     |percent total viewsSize|
   686 
   704 
   687     (moveDirection == #y) ifTrue:[
   705     (moveDirection == #y) ifTrue:[
   688 	total := aView heightOfContents.
   706 	total := aView heightOfContents.
   689 	aView transformation notNil ifTrue:[
   707 	aView transformation notNil ifTrue:[
   690 	    total := aView transformation applyScaleY:total.
   708 	    total := aView transformation applyScaleY:total.
   696 	].
   714 	].
   697     ].
   715     ].
   698     (total = 0) ifTrue:[
   716     (total = 0) ifTrue:[
   699 	percent := 100
   717 	percent := 100
   700     ] ifFalse:[
   718     ] ifFalse:[
   701 	contentsPosition := (moveDirection == #y) ifTrue:[aView yOriginOfContents]
   719 	viewsSize := (moveDirection == #y) ifTrue:[aView innerHeight]
   702 						  ifFalse:[aView xOriginOfContents].
   720 					   ifFalse:[aView innerWidth].
   703 	percent := contentsPosition * 100.0 / total
   721 	percent := viewsSize * 100.0 / total
   704     ].
   722     ].
   705     self thumbOrigin:percent
   723     self thumbHeight:percent
   706 !
   724 !
   707 
   725 
   708 thumbColor:aColor
   726 thumbColor:aColor
   709     "change the color of the thumb"
   727     "change the color of the thumb"
   710 
   728 
   734     thumbFrame isNil ifTrue:[ self computeThumbFrame].
   752     thumbFrame isNil ifTrue:[ self computeThumbFrame].
   735     ^ thumbFrame
   753     ^ thumbFrame
   736 ! !
   754 ! !
   737 
   755 
   738 !Scroller methodsFor:'private'!
   756 !Scroller methodsFor:'private'!
   739 
       
   740 absFromPercent:percent
       
   741     "given a percentage, compute number of pixels"
       
   742 
       
   743     |fullSize|
       
   744 
       
   745     (moveDirection == #y) ifTrue:[
       
   746 	fullSize := height
       
   747     ] ifFalse:[
       
   748 	fullSize := width
       
   749     ].
       
   750 "/    ^ ((percent * (fullSize - (margin * 2))) / 100) rounded
       
   751 "/ 20-apr-94
       
   752     ^ ((percent * (fullSize - thumbFrameSizeDifference- (margin * 2))) / 100) rounded
       
   753 !
       
   754 
       
   755 percentFromAbs:absValue
       
   756     "given a number of pixels, compute percentage"
       
   757 
       
   758     |fullSize val|
       
   759 
       
   760     (moveDirection == #y) ifTrue:[
       
   761 	fullSize := height
       
   762     ] ifFalse:[
       
   763 	fullSize := width
       
   764     ].
       
   765 
       
   766     val := absValue / (fullSize - thumbFrameSizeDifference - (margin * 2)) * 100.
       
   767     val < 0 ifTrue:[^ 0].
       
   768     val > 100 ifTrue:[^ 100].
       
   769     ^ val
       
   770 !
       
   771 
   757 
   772 computeThumbFrame
   758 computeThumbFrame
   773     "compute the thumbs frame (a rectangle) whenever thumb is moved, 
   759     "compute the thumbs frame (a rectangle) whenever thumb is moved, 
   774      changed height or the scrollers size has changed.
   760      changed height or the scrollers size has changed.
   775      We take care, that the thumb will not become too small (i.e.
   761      We take care, that the thumb will not become too small (i.e.
   859 	    ]
   845 	    ]
   860 	  ]
   846 	  ]
   861 	]
   847 	]
   862     ].
   848     ].
   863     thumbFrame := Rectangle left:nx top:ny width:nw height:nh
   849     thumbFrame := Rectangle left:nx top:ny width:nw height:nh
       
   850 !
       
   851 
       
   852 absFromPercent:percent
       
   853     "given a percentage, compute number of pixels"
       
   854 
       
   855     |fullSize|
       
   856 
       
   857     (moveDirection == #y) ifTrue:[
       
   858 	fullSize := height
       
   859     ] ifFalse:[
       
   860 	fullSize := width
       
   861     ].
       
   862 "/    ^ ((percent * (fullSize - (margin * 2))) / 100) rounded
       
   863 "/ 20-apr-94
       
   864     ^ ((percent * (fullSize - thumbFrameSizeDifference- (margin * 2))) / 100) rounded
       
   865 !
       
   866 
       
   867 percentFromAbs:absValue
       
   868     "given a number of pixels, compute percentage"
       
   869 
       
   870     |fullSize val|
       
   871 
       
   872     (moveDirection == #y) ifTrue:[
       
   873 	fullSize := height
       
   874     ] ifFalse:[
       
   875 	fullSize := width
       
   876     ].
       
   877 
       
   878     val := absValue / (fullSize - thumbFrameSizeDifference - (margin * 2)) * 100.
       
   879     val < 0 ifTrue:[^ 0].
       
   880     val > 100 ifTrue:[^ 100].
       
   881     ^ val
   864 ! !
   882 ! !
   865 
   883 
   866 !Scroller methodsFor:'drawing'!
   884 !Scroller methodsFor:'initialization'!
   867 
   885 
   868 drawHandleFormAtX:x y:y
   886 initialize
   869     thumbShadowColor := thumbShadowColor on:device.
   887     "initialize - setup instvars from defaults"
   870     thumbLightColor := thumbLightColor on:device.
   888 
   871 
   889     super initialize.
   872     self paint:thumbShadowColor.
   890     self computeInitialExtent.
   873     self displayForm:shadowForm x:x y:y.
   891     moveDirection := #y.
   874     self paint:thumbLightColor.
   892 
   875     self displayForm:lightForm x:x y:y.
   893     scrolling := false.
   876 !
   894     synchronousOperation := true.
   877 
   895 
   878 drawThumbBackgroundInX:x y:y width:w height:h
   896     thumbOrigin := 0.
   879     "draw part of the thumbs background; defined as a separate
   897     thumbHeight := 100.
   880      method, to allow drawing of arbitrary patterns under thumb 
   898     thumbFrameSizeDifference := 0.
   881      (see ColorSlider)."
   899 
   882 
   900 "/    inset := 1.
   883     shown ifTrue:[
   901 
   884 	self clearRectangleX:x y:y width:w height:h.
   902 "/    self computeThumbFrame
   885 	frameBeforeMove notNil ifTrue:[
   903 !
   886 	    self clippedTo:(Rectangle left:x top:y width:w height:h) do:[
   904 
   887 		|gX gY gW gH|
   905 initStyle
   888 
   906     "initialize style dep. stuff"
   889 		gX := frameBeforeMove left.
   907 
   890 		gY := frameBeforeMove top.
   908     super initStyle.
   891 		gW := frameBeforeMove width.
   909 
   892 		gH := frameBeforeMove height.
   910     DefaultViewBackground notNil ifTrue:[
   893                 
   911 	viewBackground := DefaultViewBackground on:device.
   894 		self fillRectangle:frameBeforeMove with:ghostColor.
   912     ].
   895 		(ghostLevel ~~ 0) ifTrue:[
   913     DefaultShadowColor notNil ifTrue:[
   896 		    self drawEdgesForX:gX y:gY width:gW height:gH level:ghostLevel
   914 	shadowColor := DefaultShadowColor on:device.
   897 		].
   915     ].
   898 		ghostFrameColor notNil ifTrue:[
   916     DefaultLightColor notNil ifTrue:[
   899 		    self paint:ghostFrameColor.
   917 	lightColor := DefaultLightColor on:device.
   900 		    self displayRectangleX:gX y:gY width:gW height:gH
   918     ].
   901 		]
   919 
   902 	    ]
   920     tallyMarks := DefaultTallyMarks.
   903 	]
   921     tallyLevel := DefaultTallyLevel.
   904     ]
   922     DefaultLevel ~~ level ifTrue:[
   905 !
   923 	self level:DefaultLevel.
   906 
   924     ].
   907 drawThumb
   925     DefaultBorderWidth ~~ borderWidth ifTrue:[
   908     "draw the thumb"
   926 	self borderWidth:DefaultBorderWidth.
   909 
   927     ].
   910     |handleX handleY l t 
   928     thumbLevel := DefaultThumbLevel.
   911      w "{ Class: SmallInteger }"
   929     inset := DefaultInset.
   912      h "{ Class: SmallInteger }"
   930     fixThumbHeight := DefaultFixThumbHeight.
   913      x "{ Class: SmallInteger }"
   931     thumbEdgeStyle := DefaultEdgeStyle.
   914      y "{ Class: SmallInteger }"
   932 
   915      mm xL xR yT yB color1 color2|
   933     DefaultGhostColor notNil ifTrue:[
   916 
   934 	ghostColor := DefaultGhostColor on:device.
   917     (thumbHeight >= 100) ifTrue:[^ self].
   935     ].
   918     moveDirection == #y ifTrue:[
   936     DefaultGhostFrameColor notNil ifTrue:[
   919 	thumbFrame height >= height ifTrue:[^ self].
   937 	ghostFrameColor := DefaultGhostFrameColor on:device.
   920     ] ifFalse:[
   938     ].
   921 	thumbFrame width >= width ifTrue:[^ self].
   939     ghostLevel := DefaultGhostLevel.
   922     ].
   940 
   923 
   941     DefaultThumbFrameColor notNil ifTrue:[
   924     l := thumbFrame left.
   942 	thumbFrameColor := DefaultThumbFrameColor on:device.
   925     t := thumbFrame top.
   943     ].
   926     w := thumbFrame width.
   944     DefaultThumbShadowColor notNil ifTrue:[
   927     h := thumbFrame height.
   945 	thumbShadowColor := DefaultThumbShadowColor
   928     self paint:thumbColor.
   946     ] ifFalse:[
   929     self fillRectangleX:l y:t width:w-1 height:h.
   947 	thumbShadowColor := shadowColor.
   930 
   948     ].
   931     thumbLevel == 0 ifTrue:[
   949     DefaultThumbLightColor notNil ifTrue:[
   932 	thumbFrameColor notNil ifTrue:[
   950 	thumbLightColor := DefaultThumbLightColor
   933 	    self paint:thumbFrameColor.
   951     ] ifFalse:[
   934 	    self displayRectangle:thumbFrame.
   952 	thumbLightColor := lightColor.
   935 	].
   953     ].
   936 	^ self
   954 
   937     ].
   955     thumbEdgeStyle notNil ifTrue:[
   938 
   956 	DefaultThumbHalfShadowColor notNil ifTrue:[
   939     "what a kludge - must be a parameter to drawEdge..."
   957 	    thumbHalfShadowColor := DefaultThumbHalfShadowColor
   940     self drawEdgesForX:l y:t width:w height:h level:thumbLevel
   958 	].
   941 		shadow:thumbShadowColor light:thumbLightColor
   959 	DefaultThumbHalfLightColor notNil ifTrue:[
   942 		halfShadow:thumbHalfShadowColor halfLight:thumbHalfLightColor
   960 	    thumbHalfLightColor := DefaultThumbHalfLightColor
   943 		style:thumbEdgeStyle.
   961 	].
   944 
   962     ].
   945     thumbFrameColor notNil ifTrue:[
   963 
   946 	self paint:thumbFrameColor.
   964     device hasGreyscales ifFalse:[
   947 	moveDirection == #y ifTrue:[
   965 	thumbEdgeStyle notNil ifTrue:[
   948 	    self displayRectangleX:l y:t width:w"-1" height:h.
   966 	    thumbHalfShadowColor := Color darkGrey.
   949 	] ifFalse:[
   967 	    thumbHalfLightColor := White
   950 	    self displayRectangleX:l y:t width:w height:h"-1".
   968 	].
   951 	]
   969 
   952     ].
   970 	thumbShadowColor := Black.
   953 
   971 "/        thumbLightColor := White.
   954     (tallyLevel == 0 or:[tallyMarks == 0]) ifTrue:[
   972 
   955 	shadowForm notNil ifTrue:[
   973 	StyleSheet name = #motif ifTrue:[
   956 	    handleX := l + ((w - 8) // 2).
   974 	    DefaultThumbColor isNil ifTrue:[
   957 	    handleY := t + ((h - 8) // 2).
   975 		thumbColor := White .
   958 	    self drawHandleFormAtX:handleX y:handleY
   976 	    ].
   959 	].
   977 	]
   960 	^ self
   978     ].
   961     ].
   979 
   962 
   980     DefaultThumbColor notNil ifTrue:[
   963     "iris style - draw tallys"
   981 	thumbColor := DefaultThumbColor on:device
   964 
   982     ] ifFalse:[
   965     tallyLevel > 0 ifTrue:[
   983 	thumbColor := White.
   966 	color1 := thumbLightColor.
   984 	StyleSheet name ~= #normal ifTrue:[
   967 	color2 := thumbShadowColor.
   985 	    device hasGreyscales ifFalse:[
   968     ] ifFalse:[
   986 		thumbColor := Color grey
   969 	color1 := thumbShadowColor.
   987 	    ].
   970 	color2 := thumbLightColor.
   988 	].
   971     ].
   989     ].
   972 
   990 
   973     "draw tally marks"
   991     thumbColor := thumbColor on:device.
   974 
   992     thumbShadowColor notNil ifTrue:[
   975     (moveDirection == #y) ifTrue:[
   993 	thumbShadowColor := thumbShadowColor on:device.
   976 	self paint:color1.
   994     ].
   977 	y := t + (h // 2) - 1.
   995     thumbLightColor notNil ifTrue:[
   978 	xL := l + thumbLevel - 1.
   996 	thumbLightColor := thumbLightColor on:device.
   979 	xR := l + w - thumbLevel "+ 1".
   997     ].
   980 	self displayLineFromX:xL y:y toX:xR y:y.
   998     thumbHalfShadowColor notNil ifTrue:[
   981 	y := y + 1.
   999 	thumbHalfShadowColor := thumbHalfShadowColor on:device.
   982 	self paint:color2.
  1000     ].
   983 	self displayLineFromX:xL y:y toX:xR y:y.
  1001     thumbHalfLightColor notNil ifTrue:[
   984 
  1002 	thumbHalfLightColor := thumbHalfLightColor on:device.
   985 	tallyMarks > 1 ifTrue:[
  1003     ].
   986 	    "dont draw other marks if there is not enough space"
  1004     thumbEdgeStyle notNil ifTrue:[
   987 
  1005 	thumbHalfShadowColor isNil ifTrue:[
   988 	    mm := device verticalPixelPerMillimeter rounded.
  1006 	    thumbHalfShadowColor := thumbShadowColor lightened on:device
   989 	    h > (mm * (tallyMarks * 2)) ifTrue:[
  1007 	]
   990 		y := y - 1 - mm.
  1008     ].
   991 		self paint:color1.
  1009 
   992 		self displayLineFromX:xL y:y toX:xR y:y.
  1010     StyleSheet name = #next ifTrue:[
   993 		y := y + 1.
  1011 	shadowForm := self class handleShadowFormOn:device.
   994 		self paint:color2.
  1012 	lightForm := self class handleLightFormOn:device
   995 		self displayLineFromX:xL y:y toX:xR y:y.
  1013     ] ifFalse:[
   996 
  1014 	shadowForm := lightForm := nil
   997 		y := y - 1 + mm + mm.
  1015     ].
   998 		self paint:color1.
  1016 
   999 		self displayLineFromX:xL y:y toX:xR y:y.
  1017     drawableId notNil ifTrue:[
  1000 		y := y + 1.
  1018 	self computeThumbFrame
  1001 		self paint:color2.
  1019     ]
  1002 		self displayLineFromX:xL y:y toX:xR y:y
  1020 !
  1003 	    ]
  1021 
  1004 	]
  1022 computeInitialExtent
  1005     ] ifFalse:[
  1023     ^ self
  1006 	x := l + (w // 2) - 1.
  1024 !
  1007 	yT := t + thumbLevel - 1.
  1025 
  1008 	yB := t + h - thumbLevel "+ 1".
  1026 initCursor
  1009 	self paint:color1.
  1027     "set the cursor - a hand"
  1010 	self displayLineFromX:x y:yT toX:x y:yB.
  1028 
  1011 	self paint:color2.
  1029     cursor := Cursor hand
  1012 	x := x + 1.
       
  1013 	self displayLineFromX:x y:yT toX:x y:yB.
       
  1014 
       
  1015 	tallyMarks > 1 ifTrue:[
       
  1016 	    "dont draw other marks if there is not enough space"
       
  1017 
       
  1018 	    mm := device horizontalPixelPerMillimeter rounded.
       
  1019 	    w > (mm * (tallyMarks * 2)) ifTrue:[
       
  1020 		x := x - 1 - mm.
       
  1021 		self paint:color1.
       
  1022 		self displayLineFromX:x y:yT toX:x y:yB.
       
  1023 		x := x + 1.
       
  1024 		self paint:color2.
       
  1025 		self displayLineFromX:x y:yT toX:x y:yB.
       
  1026 
       
  1027 		x := x - 1 + mm + mm.
       
  1028 		self paint:color1.
       
  1029 		self displayLineFromX:x y:yT toX:x y:yB.
       
  1030 		x := x + 1.
       
  1031 		self paint:color2.
       
  1032 		self displayLineFromX:x y:yT toX:x y:yB
       
  1033 	    ]
       
  1034 	]
       
  1035     ]
       
  1036 ! !
       
  1037 
       
  1038 !Scroller methodsFor:'forced scroll'!
       
  1039 
       
  1040 pageUp
       
  1041     "page up/left"
       
  1042 
       
  1043     self thumbOrigin:(thumbOrigin - thumbHeight).
       
  1044     self tellOthers
       
  1045 !
       
  1046 
       
  1047 pageDown
       
  1048     "page down/right"
       
  1049 
       
  1050     self thumbOrigin:(thumbOrigin + thumbHeight).
       
  1051     self tellOthers
       
  1052 ! !
       
  1053 
       
  1054 !Scroller methodsFor:'forwarding changed origin'!
       
  1055 
       
  1056 tellOthers
       
  1057     "
       
  1058      the ST/X way of notifying scrolls
       
  1059     "
       
  1060     scrollAction notNil ifTrue:[
       
  1061 	scrollAction value:thumbOrigin
       
  1062     ].
       
  1063     "
       
  1064      the ST-80 way of notifying scrolls
       
  1065     "
       
  1066     self sendChangeMessageWith:thumbOrigin.
       
  1067     self changed:#scrollerPosition.
       
  1068 ! !
  1030 ! !
  1069 
  1031 
  1070 !Scroller methodsFor:'event handling'!
  1032 !Scroller methodsFor:'event handling'!
  1071 
  1033 
  1072 redrawX:x y:y width:w height:h
  1034 redrawX:x y:y width:w height:h
  1078 	].
  1040 	].
  1079 	((y + h) < thumbFrame top) ifTrue:[
  1041 	((y + h) < thumbFrame top) ifTrue:[
  1080 	    ^ self
  1042 	    ^ self
  1081 	].
  1043 	].
  1082 	self drawThumb
  1044 	self drawThumb
  1083     ]
       
  1084 !
       
  1085 
       
  1086 redraw
       
  1087     "redraw"
       
  1088 
       
  1089     shown ifTrue:[
       
  1090 	thumbFrame isNil ifTrue:[self computeThumbFrame].
       
  1091 	self drawThumbBackgroundInX:0 y:0 width:width height:height.
       
  1092 	self drawThumb
       
  1093     ]
       
  1094 !
       
  1095 
       
  1096 sizeChanged:how
       
  1097     "size of scroller changed - recompute thumbs frame and redraw it"
       
  1098 
       
  1099     shown ifTrue:[
       
  1100 	self computeThumbFrame.
       
  1101 	self redraw
       
  1102     ]
       
  1103 !
       
  1104 
       
  1105 buttonPress:button x:x y:y
       
  1106     "button was pressed - if above thumb, page up; if below thumb, page down;
       
  1107      otherwise start scrolling"
       
  1108 
       
  1109     |curr limit1 limit2|
       
  1110 
       
  1111     (moveDirection == #y) ifTrue:[
       
  1112 	curr := y.
       
  1113 	limit1 := thumbFrame top.
       
  1114 	limit2 := thumbFrame bottom
       
  1115     ] ifFalse:[
       
  1116 	curr := x.
       
  1117 	limit1 := thumbFrame left.
       
  1118 	limit2 := thumbFrame right
       
  1119     ].
       
  1120 
       
  1121     (curr < limit1) ifTrue:[
       
  1122 	"page up/left"
       
  1123 	self pageUp
       
  1124     ] ifFalse:[
       
  1125 	(curr > limit2) ifTrue:[
       
  1126 	    "page down/right"
       
  1127 	    self pageDown
       
  1128 	] ifFalse:[
       
  1129 	    pressOffset := curr - limit1.
       
  1130 	    scrolling := true
       
  1131 	]
       
  1132     ]
       
  1133 !
       
  1134 
       
  1135 buttonMultiPress:button x:x y:y
       
  1136     ^ self buttonPress:button x:x y:y
       
  1137 !
       
  1138 
       
  1139 buttonShiftPress:button x:x y:y
       
  1140     "mouse-click with shift - jump to position"
       
  1141 
       
  1142     |pos curr limit org|
       
  1143 
       
  1144     (moveDirection == #y) ifTrue:[
       
  1145 	curr := y.
       
  1146 	limit := height.
       
  1147 	org := thumbFrame top
       
  1148     ] ifFalse:[
       
  1149 	curr := x.
       
  1150 	limit := width.
       
  1151 	org := thumbFrame left
       
  1152     ].
       
  1153 
       
  1154     (curr < 0) ifTrue:[                        "check against limits"
       
  1155 	pos := 0
       
  1156     ] ifFalse:[
       
  1157 	(curr > limit) ifTrue:[
       
  1158 	    pos := limit
       
  1159 	] ifFalse:[
       
  1160 	    pos := curr
       
  1161 	]
       
  1162     ].
       
  1163 
       
  1164     self thumbOrigin:(self percentFromAbs:pos).
       
  1165     self tellOthers.
       
  1166 
       
  1167     pressOffset := curr - org.
       
  1168     scrolling := true
       
  1169 !
       
  1170 
       
  1171 buttonMotion:button x:x y:y
       
  1172     "mouse-button was moved while pressed;
       
  1173      redraw thumb at its new position and, if scroll-mode is asynchronous, 
       
  1174      the scroll action is performed"
       
  1175 
       
  1176     |pos curr limit|
       
  1177 
       
  1178     scrolling ifFalse: [^ self].              "should not happen"
       
  1179 
       
  1180     frameBeforeMove isNil ifTrue:[
       
  1181 	ghostColor notNil ifTrue:[
       
  1182 	    frameBeforeMove := thumbFrame insetBy:1@1
       
  1183 	]
       
  1184     ].
       
  1185 
       
  1186     (moveDirection == #y) ifTrue:[
       
  1187 	curr := y.
       
  1188 	limit := height
       
  1189     ] ifFalse:[
       
  1190 	curr := x.
       
  1191 	limit := width
       
  1192     ].
       
  1193 
       
  1194     (curr < 0) ifTrue:[                        "check against limits"
       
  1195 	pos := 0
       
  1196     ] ifFalse:[
       
  1197 	(curr > limit) ifTrue:[
       
  1198 	    pos := limit
       
  1199 	] ifFalse:[
       
  1200 	    pos := curr
       
  1201 	]
       
  1202     ].
       
  1203 
       
  1204     self thumbOrigin:(self percentFromAbs:(pos - pressOffset)).
       
  1205 
       
  1206     synchronousOperation ifTrue: [
       
  1207 	self tellOthers.
       
  1208     ]
  1045     ]
  1209 !
  1046 !
  1210 
  1047 
  1211 buttonRelease:button x:x y:y
  1048 buttonRelease:button x:x y:y
  1212     "mouse-button was released - if scroll-mode is asynchronous, the scroll
  1049     "mouse-button was released - if scroll-mode is asynchronous, the scroll
  1230 	scrolling := false.
  1067 	scrolling := false.
  1231 	synchronousOperation ifFalse: [
  1068 	synchronousOperation ifFalse: [
  1232 	    self tellOthers.
  1069 	    self tellOthers.
  1233 	]
  1070 	]
  1234     ]
  1071     ]
       
  1072 !
       
  1073 
       
  1074 buttonPress:button x:x y:y
       
  1075     "button was pressed - if above thumb, page up; if below thumb, page down;
       
  1076      otherwise start scrolling"
       
  1077 
       
  1078     |curr limit1 limit2|
       
  1079 
       
  1080     (moveDirection == #y) ifTrue:[
       
  1081 	curr := y.
       
  1082 	limit1 := thumbFrame top.
       
  1083 	limit2 := thumbFrame bottom
       
  1084     ] ifFalse:[
       
  1085 	curr := x.
       
  1086 	limit1 := thumbFrame left.
       
  1087 	limit2 := thumbFrame right
       
  1088     ].
       
  1089 
       
  1090     (curr < limit1) ifTrue:[
       
  1091 	"page up/left"
       
  1092 	self pageUp
       
  1093     ] ifFalse:[
       
  1094 	(curr > limit2) ifTrue:[
       
  1095 	    "page down/right"
       
  1096 	    self pageDown
       
  1097 	] ifFalse:[
       
  1098 	    pressOffset := curr - limit1.
       
  1099 	    scrolling := true
       
  1100 	]
       
  1101     ]
       
  1102 !
       
  1103 
       
  1104 sizeChanged:how
       
  1105     "size of scroller changed - recompute thumbs frame and redraw it"
       
  1106 
       
  1107     shown ifTrue:[
       
  1108 	self computeThumbFrame.
       
  1109 	self redraw
       
  1110     ]
       
  1111 !
       
  1112 
       
  1113 buttonMotion:button x:x y:y
       
  1114     "mouse-button was moved while pressed;
       
  1115      redraw thumb at its new position and, if scroll-mode is asynchronous, 
       
  1116      the scroll action is performed"
       
  1117 
       
  1118     |pos curr limit|
       
  1119 
       
  1120     scrolling ifFalse: [^ self].              "should not happen"
       
  1121 
       
  1122     frameBeforeMove isNil ifTrue:[
       
  1123 	ghostColor notNil ifTrue:[
       
  1124 	    frameBeforeMove := thumbFrame insetBy:1@1
       
  1125 	]
       
  1126     ].
       
  1127 
       
  1128     (moveDirection == #y) ifTrue:[
       
  1129 	curr := y.
       
  1130 	limit := height
       
  1131     ] ifFalse:[
       
  1132 	curr := x.
       
  1133 	limit := width
       
  1134     ].
       
  1135 
       
  1136     (curr < 0) ifTrue:[                        "check against limits"
       
  1137 	pos := 0
       
  1138     ] ifFalse:[
       
  1139 	(curr > limit) ifTrue:[
       
  1140 	    pos := limit
       
  1141 	] ifFalse:[
       
  1142 	    pos := curr
       
  1143 	]
       
  1144     ].
       
  1145 
       
  1146     self thumbOrigin:(self percentFromAbs:(pos - pressOffset)).
       
  1147 
       
  1148     synchronousOperation ifTrue: [
       
  1149 	self tellOthers.
       
  1150     ]
       
  1151 !
       
  1152 
       
  1153 redraw
       
  1154     "redraw"
       
  1155 
       
  1156     shown ifTrue:[
       
  1157 	thumbFrame isNil ifTrue:[self computeThumbFrame].
       
  1158 	self drawThumbBackgroundInX:0 y:0 width:width height:height.
       
  1159 	self drawThumb
       
  1160     ]
       
  1161 !
       
  1162 
       
  1163 buttonShiftPress:button x:x y:y
       
  1164     "mouse-click with shift - jump to position"
       
  1165 
       
  1166     |pos curr limit1 limit2 org|
       
  1167 
       
  1168     (moveDirection == #y) ifTrue:[
       
  1169 	curr := y.
       
  1170 	limit1 := height.
       
  1171 	limit2 := thumbFrame top
       
  1172     ] ifFalse:[
       
  1173 	curr := x.
       
  1174 	limit1 := width.
       
  1175 	limit2 := thumbFrame left
       
  1176     ].
       
  1177 
       
  1178     (curr < 0) ifTrue:[                        "check against limits"
       
  1179 	pos := 0
       
  1180     ] ifFalse:[
       
  1181 	(curr > limit1) ifTrue:[
       
  1182 	    pos := limit1
       
  1183 	] ifFalse:[
       
  1184 	    pos := curr
       
  1185 	]
       
  1186     ].
       
  1187 
       
  1188     frameBeforeMove := thumbFrame insetBy:1@1.
       
  1189 
       
  1190     self thumbOrigin:(self percentFromAbs:pos).
       
  1191     self tellOthers.
       
  1192 
       
  1193     (moveDirection == #y) ifTrue:[
       
  1194 	limit2 := thumbFrame top
       
  1195     ] ifFalse:[
       
  1196 	limit2 := thumbFrame left
       
  1197     ].
       
  1198     pressOffset := curr - limit2.
       
  1199     scrolling := true
       
  1200 !
       
  1201 
       
  1202 buttonMultiPress:button x:x y:y
       
  1203     ^ self buttonPress:button x:x y:y
  1235 ! !
  1204 ! !
       
  1205 
       
  1206 !Scroller methodsFor:'forwarding changed origin'!
       
  1207 
       
  1208 tellOthers
       
  1209     "
       
  1210      the ST/X way of notifying scrolls
       
  1211     "
       
  1212     scrollAction notNil ifTrue:[
       
  1213 	scrollAction value:thumbOrigin
       
  1214     ].
       
  1215     "
       
  1216      the ST-80 way of notifying scrolls
       
  1217     "
       
  1218     self sendChangeMessageWith:thumbOrigin.
       
  1219     self changed:#scrollerPosition.
       
  1220 ! !
       
  1221 
       
  1222 !Scroller methodsFor:'forced scroll'!
       
  1223 
       
  1224 pageUp
       
  1225     "page up/left"
       
  1226 
       
  1227     self thumbOrigin:(thumbOrigin - thumbHeight).
       
  1228     self tellOthers
       
  1229 !
       
  1230 
       
  1231 pageDown
       
  1232     "page down/right"
       
  1233 
       
  1234     self thumbOrigin:(thumbOrigin + thumbHeight).
       
  1235     self tellOthers
       
  1236 ! !
       
  1237