Scroller.st
changeset 117 53cbfeaa9c9a
parent 106 4d26538ad451
child 119 59758ff5b841
equal deleted inserted replaced
116:be0971c081e2 117:53cbfeaa9c9a
    17 		moveDirection thumbFrame thumbLevel scrolling pressOffset
    17 		moveDirection thumbFrame thumbLevel scrolling pressOffset
    18 		synchronousOperation shadowForm lightForm inset thumbShadowColor
    18 		synchronousOperation shadowForm lightForm inset thumbShadowColor
    19 		thumbLightColor thumbEdgeStyle thumbHalfShadowColor
    19 		thumbLightColor thumbEdgeStyle thumbHalfShadowColor
    20 		thumbHalfLightColor thumbFrameSizeDifference tallyLevel
    20 		thumbHalfLightColor thumbFrameSizeDifference tallyLevel
    21 		tallyMarks fixThumbHeight frameBeforeMove ghostColor
    21 		tallyMarks fixThumbHeight frameBeforeMove ghostColor
    22 		ghostFrameColor ghostLevel'
    22 		ghostFrameColor ghostLevel rangeStart rangeEnd rangeStep'
    23 	 classVariableNames:'HandleShadowForm HandleLightForm DefaultViewBackground
    23 	 classVariableNames:'HandleShadowForm HandleLightForm DefaultViewBackground
    24 		DefaultShadowColor DefaultLightColor DefaultThumbColor
    24 		DefaultShadowColor DefaultLightColor DefaultThumbColor
    25 		DefaultThumbShadowColor DefaultThumbLightColor
    25 		DefaultThumbShadowColor DefaultThumbLightColor
    26 		DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
    26 		DefaultThumbHalfShadowColor DefaultThumbHalfLightColor
    27 		DefaultHalfShadowColor DefaultHalfLightColor DefaultTallyMarks
    27 		DefaultHalfShadowColor DefaultHalfLightColor DefaultTallyMarks
    35 
    35 
    36 Scroller comment:'
    36 Scroller comment:'
    37 COPYRIGHT (c) 1989 by Claus Gittinger
    37 COPYRIGHT (c) 1989 by Claus Gittinger
    38 	      All Rights Reserved
    38 	      All Rights Reserved
    39 
    39 
    40 $Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.18 1995-03-18 15:25:44 claus Exp $
    40 $Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.19 1995-04-30 13:40:03 claus Exp $
    41 '!
    41 '!
    42 
    42 
    43 !Scroller class methodsFor:'documentation'!
    43 !Scroller class methodsFor:'documentation'!
    44 
    44 
    45 copyright
    45 copyright
    56 "
    56 "
    57 !
    57 !
    58 
    58 
    59 version
    59 version
    60 "
    60 "
    61 $Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.18 1995-03-18 15:25:44 claus Exp $
    61 $Header: /cvs/stx/stx/libwidg/Scroller.st,v 1.19 1995-04-30 13:40:03 claus Exp $
    62 "
    62 "
    63 !
    63 !
    64 
    64 
    65 documentation
    65 documentation
    66 "
    66 "
    67     this class implements the scroller for scrollbars.
    67     this class implements the scroller for scrollbars.
    68     it can also be used by itself for scrollbars without step-buttons.
    68     it can also be used by itself for scrollbars without step-buttons.
    69     When moved, either a predefined action is performed (scrollAction),
    69     When moved, either a predefined action is performed (scrollAction),
    70     or a model is informed via the changeSymbol.
    70     or a model is informed via the changeSymbol (which is #value: by default).
    71 
    71 
    72     Beside the obvious 3D rectangle, a scroller may draw a know-form
    72     Beside the obvious 3D rectangle, a scroller may draw a know-form
    73     (as in NeXT) or little tally marks (as on SGI) in itself.
    73     (as in NeXT) or little tally marks (as on SGI) in itself.
    74     These are controlled by the shadowForm, lightForm, tallyLevel and tallyMarks
    74     These are controlled by the shadowForm, lightForm, tallyLevel and tallyMarks
    75     instance variables.
    75     instance variables.
   107     tallyLevel                  <Integer>       if not zero, specifies if tally-marks should
   107     tallyLevel                  <Integer>       if not zero, specifies if tally-marks should
   108 						go into or out of the display (actually only <0/>0 is checked)
   108 						go into or out of the display (actually only <0/>0 is checked)
   109 						I dont know of a better word for these ...
   109 						I dont know of a better word for these ...
   110     tallyMarks                  <Integer>       number of tally marks
   110     tallyMarks                  <Integer>       number of tally marks
   111     fixThumbHeight              <Boolean>       perform 'wrong' height computation a la mswindows
   111     fixThumbHeight              <Boolean>       perform 'wrong' height computation a la mswindows
   112 
   112     rangeStart                  <Number>        the range of the scroller
       
   113     rangeEnd                                    (defaults to 0..100)
       
   114     rangeStep
   113 
   115 
   114   style settings:
   116   style settings:
   115 
   117 
   116     scrollerLevel               <Integer>       the level of the scroller w.r.t. its enclosing view
   118     scrollerLevel               <Integer>       the level of the scroller w.r.t. its enclosing view
   117     scrollerBorderWidth         <Integer>       the borderWidth (ignored for 3D styles)
   119     scrollerBorderWidth         <Integer>       the borderWidth (ignored for 3D styles)
   137     scrollerTallyLevel.         <Integer>       the 3D level of any tally marks
   139     scrollerTallyLevel.         <Integer>       the 3D level of any tally marks
   138 
   140 
   139     notice: for mswindows style, we force a WRONG thumb-frame
   141     notice: for mswindows style, we force a WRONG thumb-frame
   140     computation, to make the thumb have constant size; 
   142     computation, to make the thumb have constant size; 
   141     if you dont like that (I do not :-), set scrollerThumbFixHeight to false (in the StyleSheet).
   143     if you dont like that (I do not :-), set scrollerThumbFixHeight to false (in the StyleSheet).
       
   144 "
       
   145 !
       
   146 
       
   147 examples
       
   148 "
       
   149     a scroller with action block (ST/X style):
       
   150 
       
   151 	|top s|
       
   152 
       
   153 	top := StandardSystemView new extent:200@200.
       
   154 	s := Scroller in:top.
       
   155 	s origin:(0.0@0.0) corner:(20@1.0).
       
   156 	s thumbHeight:10.  'percent'.     
       
   157 	s scrollAction:[:percent | Transcript show:'moved to: '; showCr:percent asFloat].
       
   158 	top open
       
   159 
       
   160 
       
   161     using a model (ST-80 style):
       
   162 
       
   163 	|top s m|
       
   164 
       
   165 	m := 0 asValue.
       
   166 	m inspect. 'look at value'.
       
   167 	top := StandardSystemView new extent:200@200.
       
   168 	s := Scroller in:top.
       
   169 	s origin:(0.0@0.0) corner:(20@1.0).
       
   170 	s thumbHeight:10.  'percent'.     
       
   171 	s model:m.
       
   172 	top open
       
   173 
       
   174     using a different changeSelector:
       
   175 
       
   176 	|top s1 s2 m|
       
   177 
       
   178 	m := Plug new.
       
   179 	m respondTo:#value1: with:[:v | Transcript show:'scroller 1 moved to: '; showCr:v].
       
   180 	m respondTo:#value2: with:[:v | Transcript show:'scroller 2 moved to: '; showCr:v].
       
   181 
       
   182 	top := StandardSystemView new extent:200@200.
       
   183 	s1 := Scroller in:top.
       
   184 	s1 origin:(0.0@0.0) corner:(20@1.0).
       
   185 	s1 thumbHeight:10.  'percent'.     
       
   186 	s1 model:m; change:#value1:.
       
   187 
       
   188 	s2 := Scroller in:top.
       
   189 	s2 origin:(30@0.0) corner:(50@1.0).
       
   190 	s2 thumbHeight:10.  'percent'.     
       
   191 	s2 model:m; change:#value2:.
       
   192 	top open
   142 "
   193 "
   143 ! !
   194 ! !
   144 
   195 
   145 !Scroller class methodsFor:'defaults'!
   196 !Scroller class methodsFor:'defaults'!
   146 
   197 
   396     self displayForm:lightForm x:x y:y.
   447     self displayForm:lightForm x:x y:y.
   397 ! !
   448 ! !
   398 
   449 
   399 !Scroller methodsFor:'accessing'!
   450 !Scroller methodsFor:'accessing'!
   400 
   451 
   401 thumbOrigin:newOrigin
   452 thumbOrigin:aNumber 
   402     "set the thumbs origin (in percent)"
   453     "set the thumbs origin (in percent by default)"
   403 
   454 
   404     |realNewOrigin oldFrame oldTop oldBot thumbTop thumbBot
   455     |newOrigin realNewOrigin oldFrame oldTop oldBot thumbTop thumbBot
   405      tH "{ Class: SmallInteger }"
   456      tH "{ Class: SmallInteger }"
   406      tW delta left|
   457      tW delta left|
       
   458 
       
   459     newOrigin := aNumber / (rangeEnd - rangeStart / 100) - rangeStart.
   407 
   460 
   408     ((newOrigin + thumbHeight) > 100) ifTrue:[
   461     ((newOrigin + thumbHeight) > 100) ifTrue:[
   409 	realNewOrigin := 100 - thumbHeight
   462 	realNewOrigin := 100 - thumbHeight
   410     ] ifFalse: [
   463     ] ifFalse: [
   411 	realNewOrigin := newOrigin
   464 	realNewOrigin := newOrigin
   421 	thumbOrigin := realNewOrigin.
   474 	thumbOrigin := realNewOrigin.
   422 
   475 
   423 	shown ifTrue:[
   476 	shown ifTrue:[
   424 	    oldFrame := thumbFrame.
   477 	    oldFrame := thumbFrame.
   425 	    self computeThumbFrame.
   478 	    self computeThumbFrame.
   426 	    (thumbHeight = 100) ifTrue:[^ self].
   479 	    (thumbHeight = 100) ifTrue:[
       
   480 		"/ full: don't draw
       
   481 		^ self
       
   482 	    ].
   427 
   483 
   428 	    (thumbFrame ~~ oldFrame) ifTrue:[
   484 	    (thumbFrame ~~ oldFrame) ifTrue:[
   429 		oldFrame isNil ifTrue:[
   485 		oldFrame isNil ifTrue:[
   430 		    self drawThumb.
   486 		    self drawThumb.
   431 		    ^ self
   487 		    ^ self
   480 	    thumbFrame := nil
   536 	    thumbFrame := nil
   481 	]
   537 	]
   482     ]
   538     ]
   483 !
   539 !
   484 
   540 
   485 thumbHeight:newHeight
   541 thumbHeight:aNumber 
   486     "set the thumbs height (in percent)"
   542     "set the thumbs height (in percent by default)"
   487 
   543 
   488     |realNewHeight oldFrame|
   544     |newHeight realNewHeight oldFrame|
       
   545 
       
   546     newHeight := aNumber / (rangeEnd - rangeStart / 100).
   489 
   547 
   490     (newHeight > 100) ifTrue:[
   548     (newHeight > 100) ifTrue:[
   491 	realNewHeight := 100
   549 	realNewHeight := 100
   492     ] ifFalse:[
   550     ] ifFalse:[
   493 	realNewHeight := newHeight
   551 	realNewHeight := newHeight
   568 	    self thumbOrigin:percentOrigin thumbHeight:percentSize
   626 	    self thumbOrigin:percentOrigin thumbHeight:percentSize
   569 	]
   627 	]
   570     ]
   628     ]
   571 !
   629 !
   572 
   630 
   573 thumbOrigin:newOrigin thumbHeight:newHeight
   631 thumbOrigin:originNumber thumbHeight:heightNumber
   574     "set both thumbs height and origin (in percent)"
   632     "set both thumbs height and origin (in percent by default)"
   575 
   633 
   576     |realNewOrigin realNewHeight old new changed|
   634     |newHeight newOrigin realNewOrigin realNewHeight old new changed|
       
   635 
       
   636     newOrigin := originNumber / (rangeEnd - rangeStart / 100) - rangeStart.
       
   637     newHeight := heightNumber / (rangeEnd - rangeStart / 100).
   577 
   638 
   578     (newHeight > 100) ifTrue:[
   639     (newHeight > 100) ifTrue:[
   579 	realNewHeight := 100
   640 	realNewHeight := 100
   580     ] ifFalse:[
   641     ] ifFalse:[
   581 	realNewHeight := newHeight
   642 	realNewHeight := newHeight
   642 	percent := contentsPosition * 100.0 / total
   703 	percent := contentsPosition * 100.0 / total
   643     ].
   704     ].
   644     self thumbOrigin:percent
   705     self thumbOrigin:percent
   645 !
   706 !
   646 
   707 
       
   708 setThumbHeightFor:aView
       
   709     "get contents and size info from aView and adjust thumb height"
       
   710 
       
   711     |percent total viewsSize|
       
   712 
       
   713     (moveDirection == #y) ifTrue:[
       
   714 	total := aView heightOfContents.
       
   715 	aView transformation notNil ifTrue:[
       
   716 	    total := aView transformation applyScaleY:total.
       
   717 	].
       
   718     ] ifFalse:[
       
   719 	total := aView widthOfContents.
       
   720 	aView transformation notNil ifTrue:[
       
   721 	    total := aView transformation applyScaleX:total.
       
   722 	].
       
   723     ].
       
   724     (total = 0) ifTrue:[
       
   725 	percent := 100
       
   726     ] ifFalse:[
       
   727 	viewsSize := (moveDirection == #y) ifTrue:[aView innerHeight]
       
   728 					   ifFalse:[aView innerWidth].
       
   729 	percent := viewsSize * 100.0 / total
       
   730     ].
       
   731     self thumbHeight:percent
       
   732 !
       
   733 
   647 is3D
   734 is3D
   648     StyleSheet name = #mswindows ifTrue:[^ true].
   735     StyleSheet name = #mswindows ifTrue:[^ true].
   649     ^ super is3D
   736     ^ super is3D
       
   737 !
       
   738 
       
   739 action:aBlock
       
   740     "for protocol compatibility; same as scrollAction:"
       
   741 
       
   742     self scrollAction:aBlock
   650 !
   743 !
   651 
   744 
   652 scrollAction:aBlock
   745 scrollAction:aBlock
   653     "set the scroll action, aBlock which is evaluated when scrolled"
   746     "set the scroll action, aBlock which is evaluated when scrolled"
   654 
   747 
   686 !
   779 !
   687 
   780 
   688 thumbOrigin
   781 thumbOrigin
   689     "answer the thumbs origin (in percent)"
   782     "answer the thumbs origin (in percent)"
   690 
   783 
   691     ^ thumbOrigin
   784     ^ thumbOrigin * (rangeEnd - rangeStart) / 100 + rangeStart
   692 !
   785 !
   693 
   786 
   694 thumbHeight
   787 thumbHeight
   695     "answer the thumbs height (in percent)"
   788     "answer the thumbs height (in percent)"
   696 
   789 
   697     ^ thumbHeight
   790     ^ thumbHeight * (rangeEnd - rangeStart) / 100
   698 !
       
   699 
       
   700 setThumbHeightFor:aView
       
   701     "get contents and size info from aView and adjust thumb height"
       
   702 
       
   703     |percent total viewsSize|
       
   704 
       
   705     (moveDirection == #y) ifTrue:[
       
   706 	total := aView heightOfContents.
       
   707 	aView transformation notNil ifTrue:[
       
   708 	    total := aView transformation applyScaleY:total.
       
   709 	].
       
   710     ] ifFalse:[
       
   711 	total := aView widthOfContents.
       
   712 	aView transformation notNil ifTrue:[
       
   713 	    total := aView transformation applyScaleX:total.
       
   714 	].
       
   715     ].
       
   716     (total = 0) ifTrue:[
       
   717 	percent := 100
       
   718     ] ifFalse:[
       
   719 	viewsSize := (moveDirection == #y) ifTrue:[aView innerHeight]
       
   720 					   ifFalse:[aView innerWidth].
       
   721 	percent := viewsSize * 100.0 / total
       
   722     ].
       
   723     self thumbHeight:percent
       
   724 !
   791 !
   725 
   792 
   726 thumbColor:aColor
   793 thumbColor:aColor
   727     "change the color of the thumb"
   794     "change the color of the thumb"
   728 
   795 
   895 
   962 
   896     thumbOrigin := 0.
   963     thumbOrigin := 0.
   897     thumbHeight := 100.
   964     thumbHeight := 100.
   898     thumbFrameSizeDifference := 0.
   965     thumbFrameSizeDifference := 0.
   899 
   966 
       
   967     rangeStart := 0.
       
   968     rangeEnd := 100.
       
   969     rangeStep := nil.   "/ meaning: arbitrary precision
   900 "/    inset := 1.
   970 "/    inset := 1.
   901 
   971 
   902 "/    self computeThumbFrame
   972 "/    self computeThumbFrame
   903 !
   973 !
   904 
   974 
  1201     scrolling := true
  1271     scrolling := true
  1202 !
  1272 !
  1203 
  1273 
  1204 buttonMultiPress:button x:x y:y
  1274 buttonMultiPress:button x:x y:y
  1205     ^ self buttonPress:button x:x y:y
  1275     ^ self buttonPress:button x:x y:y
       
  1276 !
       
  1277 
       
  1278 update:something with:aParameter from:changedObject
       
  1279     "handle update from a model (if any)"
       
  1280 
       
  1281     (changedObject == model 
       
  1282     "and:[something == aspectSymbol]") ifTrue:[
       
  1283 	self thumbOrigin:(model value).
       
  1284 	^ self
       
  1285     ].
       
  1286     super update:something with:aParameter from:changedObject
  1206 ! !
  1287 ! !
  1207 
  1288 
  1208 !Scroller methodsFor:'forwarding changed origin'!
  1289 !Scroller methodsFor:'forwarding changed origin'!
  1209 
  1290 
  1210 tellOthers
  1291 tellOthers
       
  1292     |org|
       
  1293 
       
  1294     org := self thumbOrigin.
  1211     "
  1295     "
  1212      the ST/X way of notifying scrolls
  1296      the ST/X way of notifying scrolls
  1213     "
  1297     "
  1214     scrollAction notNil ifTrue:[
  1298     scrollAction notNil ifTrue:[
  1215 	scrollAction value:thumbOrigin
  1299 	scrollAction value:org 
  1216     ].
  1300     ].
  1217     "
  1301     "
  1218      the ST-80 way of notifying scrolls
  1302      the ST-80 way of notifying scrolls
  1219     "
  1303     "
  1220     self sendChangeMessageWith:thumbOrigin.
  1304     self sendChangeMessageWith:org.
  1221     self changed:#scrollerPosition.
  1305     self changed:#scrollerPosition.
  1222 ! !
  1306 ! !
  1223 
  1307 
  1224 !Scroller methodsFor:'forced scroll'!
  1308 !Scroller methodsFor:'forced scroll'!
  1225 
  1309 
  1234     "page down/right"
  1318     "page down/right"
  1235 
  1319 
  1236     self thumbOrigin:(thumbOrigin + thumbHeight).
  1320     self thumbOrigin:(thumbOrigin + thumbHeight).
  1237     self tellOthers
  1321     self tellOthers
  1238 ! !
  1322 ! !
  1239