ArrowButton.st
changeset 205 6814c0bf8df8
parent 174 d80a6cc3f9b2
child 270 aa6a36e199e7
equal deleted inserted replaced
204:2da6481de6d4 205:6814c0bf8df8
    10  hereby transferred.
    10  hereby transferred.
    11 "
    11 "
    12 
    12 
    13 Button subclass:#ArrowButton
    13 Button subclass:#ArrowButton
    14 	 instanceVariableNames:'arrowStyle'
    14 	 instanceVariableNames:'arrowStyle'
    15 	 classVariableNames:'DownArrowForm UpArrowForm
    15 	 classVariableNames:'DownArrowForm UpArrowForm LeftArrowForm RightArrowForm
    16 			     LeftArrowForm RightArrowForm CachedStyle
    16                 CachedStyle DefaultArrowStyle DefaultBackgroundColor
    17 			     DefaultArrowStyle 
    17                 DefaultForegroundColor DefaultActiveBackgroundColor
    18 			     DefaultBackgroundColor DefaultForegroundColor 
    18                 DefaultActiveForegroundColor DefaultEnteredBackgroundColor
    19 			     DefaultActiveBackgroundColor DefaultActiveForegroundColor
    19                 DefaultEnteredForegroundColor DefaultDisabledForegroundColor
    20 			     DefaultEnteredBackgroundColor DefaultEnteredForegroundColor
    20                 DefaultArrowButtonActiveLevel DefaultArrowButtonPassiveLevel
    21 			     DefaultDisabledForegroundColor   
    21                 DownArrowFormFile UpArrowFormFile LeftArrowFormFile
    22 			     DefaultArrowButtonActiveLevel DefaultArrowButtonPassiveLevel 
    22                 RightArrowFormFile'
    23 			     DownArrowFormFile UpArrowFormFile 
       
    24 			     LeftArrowFormFile RightArrowFormFile'
       
    25 	 poolDictionaries:''
    23 	 poolDictionaries:''
    26 	 category:'Views-Interactors'
    24 	 category:'Views-Interactors'
    27 !
    25 !
    28 
    26 
    29 !ArrowButton class methodsFor:'documentation'!
    27 !ArrowButton class methodsFor:'documentation'!
    40  other person.  No title to or ownership of the software is
    38  other person.  No title to or ownership of the software is
    41  hereby transferred.
    39  hereby transferred.
    42 "
    40 "
    43 !
    41 !
    44 
    42 
    45 version
       
    46     ^ '$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.18 1995-11-11 16:18:56 cg Exp $'
       
    47 !
       
    48 
       
    49 documentation
    43 documentation
    50 "
    44 "
    51     ArrowButtons display an arrow as their label; they are mainly
    45     ArrowButtons display an arrow as their label; they are mainly
    52     used for scrollbars, but can be useful on their own in some applications.
    46     used for scrollbars, but can be useful on their own in some applications.
    53     Beside the contents, their default behavior is to perform their action
    47     Beside the contents, their default behavior is to perform their action
   159 	View defaultStyle:oldStyle.
   153 	View defaultStyle:oldStyle.
   160 	v open
   154 	v open
   161 "
   155 "
   162 ! !
   156 ! !
   163 
   157 
       
   158 !ArrowButton class methodsFor:'instance creation'!
       
   159 
       
   160 downIn:aView
       
   161     ^ (super in:aView) direction:#down
       
   162 !
       
   163 
       
   164 leftIn:aView
       
   165     ^ (super in:aView) direction:#left
       
   166 !
       
   167 
       
   168 rightIn:aView
       
   169     ^ (super in:aView) direction:#right
       
   170 !
       
   171 
       
   172 upIn:aView
       
   173     ^ (super in:aView) direction:#up
       
   174 ! !
       
   175 
   164 !ArrowButton class methodsFor:'defaults'!
   176 !ArrowButton class methodsFor:'defaults'!
   165 
   177 
   166 updateStyleCache
   178 downArrowButtonForm:style on:aDevice
   167     DefaultArrowStyle := StyleSheet at:'arrowButtonStyle' default:StyleSheet name.
   179     "retun the form used for the scrollDown Button"
   168     DefaultArrowStyle := DefaultArrowStyle asSymbol.
   180 
   169 
   181     |form|
   170     DefaultArrowButtonActiveLevel := StyleSheet at:'arrowButtonActiveLevel' default:nil.
   182 
   171     DefaultArrowButtonPassiveLevel := StyleSheet at:'arrowButtonPassiveLevel' default:nil.
   183     "
   172 
   184      use cached form, if device is appropriate
   173     DefaultBackgroundColor := StyleSheet colorAt:'arrowButtonBackgroundColor'.
   185     "
   174     DefaultForegroundColor := StyleSheet colorAt:'arrowButtonForegroundColor'.
   186     CachedStyle ~~ style ifTrue:[
   175     DefaultActiveBackgroundColor := StyleSheet colorAt:'arrowButtonActiveBackgroundColor'.
   187 	UpArrowForm := DownArrowForm := LeftArrowForm := RightArrowForm := nil
   176     DefaultActiveForegroundColor := StyleSheet colorAt:'arrowButtonActiveForegroundColor'.
   188     ].
   177     DefaultEnteredBackgroundColor := StyleSheet colorAt:'arrowButtonEnteredBackgroundColor'.
   189 
   178     DefaultEnteredForegroundColor := StyleSheet colorAt:'arrowButtonEnteredForegroundColor'.
   190     ((aDevice == Display) and:[DownArrowForm notNil]) ifTrue:[
   179     DefaultDisabledForegroundColor := StyleSheet colorAt:'arrowButtonDisabledForegroundColor'.
   191 	^ DownArrowForm
       
   192     ].
   180 
   193 
   181     DownArrowForm := StyleSheet at:'arrowButtonDownForm' default:nil.
   194     DownArrowForm := StyleSheet at:'arrowButtonDownForm' default:nil.
   182     UpArrowForm := StyleSheet at:'arrowButtonUpForm' default:nil.
   195     DownArrowForm notNil ifTrue:[
       
   196 	^ DownArrowForm
       
   197     ].
       
   198 
       
   199     "
       
   200      special treatment for st80 arrows 
       
   201      - they do not really fit into the general (bitmap) scheme ...
       
   202      (i.e. they are computed instead of drawn from a bitmap)
       
   203     "
       
   204     style ~~ #st80 ifTrue:[
       
   205 	DownArrowFormFile notNil ifTrue:[
       
   206 	    form := Form fromFile:DownArrowFormFile resolution:100 on:aDevice.
       
   207 	    form isNil ifTrue:[
       
   208 		'ARRBUTTON: no bitmapFile: ' infoPrint. DownArrowFormFile infoPrintNL.
       
   209 	    ]
       
   210 	]
       
   211     ].
       
   212 
       
   213     "
       
   214      form to use as a fallback, if no bitmap file is present
       
   215      (actually not really needed - just to show something useful, in
       
   216       case of a bad installation)
       
   217     "
       
   218     form isNil ifTrue:[
       
   219 	style == #st80 ifTrue:[
       
   220 	    form := Form width:9 height:9 depth:1 on:Display.
       
   221 	    form clear.
       
   222 	    form lineWidth:2.
       
   223 	    form capStyle:#round.
       
   224 	    form paint:(Color colorId:1).
       
   225 	    form displayLineFromX:0 y:2 toX:4 y:6.
       
   226 	    form displayLineFromX:4 y:6 toX:8 y:2 
       
   227 	] ifFalse:[
       
   228 	    form  := Form width:16 height:16 
       
   229 			  fromArray:#[2r00000000 2r00000000
       
   230 				      2r00001111 2r11110000
       
   231 				      2r00001000 2r00010000
       
   232 				      2r00001000 2r00010000
       
   233 				      2r00001000 2r00010000
       
   234 				      2r00001000 2r00010000
       
   235 				      2r00001000 2r00010000
       
   236 				      2r01111000 2r00011110
       
   237 				      2r01000000 2r00000010
       
   238 				      2r00100000 2r00000100
       
   239 				      2r00010000 2r00001000
       
   240 				      2r00001000 2r00010000
       
   241 				      2r00000100 2r00100000
       
   242 				      2r00000010 2r01000000
       
   243 				      2r00000001 2r10000000
       
   244 				      2r00000000 2r00000000]
       
   245 			 on:aDevice
       
   246 	].
       
   247     ].
       
   248     form := form on:aDevice.
       
   249 
       
   250     "
       
   251      remember form for next use
       
   252     "
       
   253     (aDevice == Display) ifTrue:[
       
   254 	CachedStyle := style.
       
   255 	DownArrowForm := form
       
   256     ].
       
   257 
       
   258     ^ form
       
   259 !
       
   260 
       
   261 leftArrowButtonForm:style on:aDevice
       
   262     "retun the form used for the scrollLeft Button"
       
   263 
       
   264     |form|
       
   265 
       
   266     "
       
   267      use cached form, if device is appropriate
       
   268     "
       
   269     CachedStyle ~~ style ifTrue:[
       
   270 	UpArrowForm := DownArrowForm := LeftArrowForm := RightArrowForm := nil
       
   271     ].
       
   272 
       
   273     ((aDevice == Display) and:[LeftArrowForm notNil]) ifTrue:[
       
   274 	^ LeftArrowForm
       
   275     ].
       
   276 
   183     LeftArrowForm := StyleSheet at:'arrowButtonLeftForm' default:nil.
   277     LeftArrowForm := StyleSheet at:'arrowButtonLeftForm' default:nil.
       
   278     LeftArrowForm notNil ifTrue:[
       
   279 	^ LeftArrowForm
       
   280     ].
       
   281 
       
   282     "
       
   283      special treatment for st80 arrows 
       
   284      - they do not really fit into the general (bitmap) scheme ...
       
   285      (i.e. they are computed instead of drawn from a bitmap)
       
   286     "
       
   287     style ~~ #st80 ifTrue:[
       
   288 	LeftArrowFormFile notNil ifTrue:[
       
   289 	    form := Form fromFile:LeftArrowFormFile resolution:100 on:aDevice.
       
   290 	    form isNil ifTrue:[
       
   291 		'ARRBUTTON: no bitmapFile: ' infoPrint. LeftArrowFormFile infoPrintNL.
       
   292 	    ]
       
   293 	]
       
   294     ].
       
   295 
       
   296     "
       
   297      form to use as a fallback, if no bitmap file is present
       
   298      (actually not really needed - just to show something useful, in
       
   299       case of a bad installation)
       
   300     "
       
   301     form isNil ifTrue:[
       
   302 	style == #st80 ifTrue:[
       
   303 	    form := Form width:9 height:9 depth:1 on:Display.
       
   304 	    form clear.
       
   305 	    form lineWidth:2.
       
   306 	    form capStyle:#round.
       
   307 	    form paint:(Color colorId:1).
       
   308 	    form displayLineFromX:6 y:0 toX:2 y:4.
       
   309 	    form displayLineFromX:2 y:4 toX:6 y:8.
       
   310 	] ifFalse:[
       
   311 	    form := Form width:16 height:16 
       
   312 			 fromArray:#[2r00000000 2r00000000
       
   313 				     2r00000001 2r10000000
       
   314 				     2r00000010 2r10000000
       
   315 				     2r00000100 2r10000000
       
   316 				     2r00001000 2r11111110
       
   317 				     2r00010000 2r00000010
       
   318 				     2r00100000 2r00000010
       
   319 				     2r01000000 2r00000010
       
   320 				     2r01000000 2r00000010
       
   321 				     2r00100000 2r00000010
       
   322 				     2r00010000 2r00000010
       
   323 				     2r00001000 2r11111110
       
   324 				     2r00000100 2r10000000
       
   325 				     2r00000010 2r10000000
       
   326 				     2r00000001 2r10000000
       
   327 				     2r00000000 2r00000000]
       
   328 			 on:aDevice
       
   329 	].
       
   330     ].
       
   331     form := form on:aDevice.
       
   332 
       
   333     "
       
   334      remember form for next use
       
   335     "
       
   336     (aDevice == Display) ifTrue:[
       
   337 	CachedStyle := style.
       
   338 	LeftArrowForm := form
       
   339     ].
       
   340 
       
   341     ^ form
       
   342 !
       
   343 
       
   344 rightArrowButtonForm:style on:aDevice
       
   345     "retun the form used for the scrollRight Button"
       
   346 
       
   347     |form|
       
   348 
       
   349     "
       
   350      use cached form, if device is appropriate
       
   351     "
       
   352     CachedStyle ~~ style ifTrue:[
       
   353 	UpArrowForm := DownArrowForm := LeftArrowForm := RightArrowForm := nil
       
   354     ].
       
   355 
       
   356     ((aDevice == Display) and:[RightArrowForm notNil]) ifTrue:[
       
   357 	^ RightArrowForm
       
   358     ].
       
   359 
   184     RightArrowForm := StyleSheet at:'arrowButtonRightForm' default:nil.
   360     RightArrowForm := StyleSheet at:'arrowButtonRightForm' default:nil.
   185 
   361     RightArrowForm notNil ifTrue:[
   186     UpArrowFormFile := DownArrowFormFile := LeftArrowFormFile := RightArrowFormFile := nil.
   362 	^ RightArrowForm
   187     UpArrowForm isNil ifTrue:[
   363     ].
   188 	UpArrowFormFile := StyleSheet at:'arrowButtonUpFormFile' default:'ScrollUp.xbm'.
   364 
   189     ].
   365     "
   190     DownArrowForm isNil ifTrue:[
   366      special treatment for st80 arrows 
   191 	DownArrowFormFile := StyleSheet at:'arrowButtonDownFormFile' default:'ScrollDn.xbm'.
   367      - they do not really fit into the general (bitmap) scheme ...
   192     ].
   368      (i.e. they are computed instead of drawn from a bitmap)
   193     LeftArrowForm isNil ifTrue:[
   369     "
   194 	LeftArrowFormFile := StyleSheet at:'arrowButtonLeftFormFile' default:'ScrollLt.xbm'.
   370     style ~~ #st80 ifTrue:[
   195     ].
   371 	RightArrowFormFile notNil ifTrue:[
   196     RightArrowForm isNil ifTrue:[
   372 	    form := Form fromFile:RightArrowFormFile resolution:100 on:aDevice.
   197 	RightArrowFormFile := StyleSheet at:'arrowButtonRightFormFile' default:'ScrollRt.xbm'.
   373 	    form isNil ifTrue:[
   198     ].
   374 		'ARRBUTTON: no bitmapFile: ' infoPrint. RightArrowFormFile infoPrintNL.
   199 
   375 	    ]
   200     "
   376 	]
   201      self updateStyleCache
   377     ].
   202     "
   378 
   203 
   379     "
   204     "Modified: 31.8.1995 / 03:01:14 / claus"
   380      form to use as a fallback, if no bitmap file is present
       
   381      (actually not really needed - just to show something useful, in
       
   382       case of a bad installation)
       
   383     "
       
   384     form isNil ifTrue:[
       
   385 	style == #st80 ifTrue:[
       
   386 	    form := Form width:9 height:9 depth:1 on:Display.
       
   387 	    form clear.
       
   388 	    form lineWidth:2.
       
   389 	    form capStyle:#round.
       
   390 	    form paint:(Color colorId:1).
       
   391 	    form displayLineFromX:2 y:0 toX:6 y:4.
       
   392 	    form displayLineFromX:6 y:4 toX:2 y:8 
       
   393 	] ifFalse:[
       
   394 	    form := Form width:16 height:16 
       
   395 			 fromArray:#[2r00000000 2r00000000
       
   396 				     2r00000001 2r10000000
       
   397 				     2r00000001 2r01000000
       
   398 				     2r00000001 2r00100000
       
   399 				     2r01111111 2r00010000
       
   400 				     2r01000000 2r00001000
       
   401 				     2r01000000 2r00000100
       
   402 				     2r01000000 2r00000010
       
   403 				     2r01000000 2r00000010
       
   404 				     2r01000000 2r00000100
       
   405 				     2r01000000 2r00001000
       
   406 				     2r01111111 2r00010000
       
   407 				     2r00000001 2r00100000
       
   408 				     2r00000001 2r01000000
       
   409 				     2r00000001 2r10000000
       
   410 				     2r00000000 2r00000000]
       
   411 			 on:aDevice
       
   412 	].
       
   413     ].
       
   414     form := form on:aDevice.
       
   415 
       
   416     "
       
   417      remember form for next use
       
   418     "
       
   419     (aDevice == Display) ifTrue:[
       
   420 	CachedStyle := style.
       
   421 	RightArrowForm := form
       
   422     ].
       
   423 
       
   424     ^ form
   205 !
   425 !
   206 
   426 
   207 upArrowButtonForm:style on:aDevice
   427 upArrowButtonForm:style on:aDevice
   208     "return the form used for the scrollUp Button"
   428     "return the form used for the scrollUp Button"
   209 
   429 
   286     ].
   506     ].
   287 
   507 
   288     ^ form
   508     ^ form
   289 !
   509 !
   290 
   510 
   291 downArrowButtonForm:style on:aDevice
   511 updateStyleCache
   292     "retun the form used for the scrollDown Button"
   512     DefaultArrowStyle := StyleSheet at:'arrowButtonStyle' default:StyleSheet name.
   293 
   513     DefaultArrowStyle := DefaultArrowStyle asSymbol.
   294     |form|
   514 
   295 
   515     DefaultArrowButtonActiveLevel := StyleSheet at:'arrowButtonActiveLevel' default:nil.
   296     "
   516     DefaultArrowButtonPassiveLevel := StyleSheet at:'arrowButtonPassiveLevel' default:nil.
   297      use cached form, if device is appropriate
   517 
   298     "
   518     DefaultBackgroundColor := StyleSheet colorAt:'arrowButtonBackgroundColor'.
   299     CachedStyle ~~ style ifTrue:[
   519     DefaultForegroundColor := StyleSheet colorAt:'arrowButtonForegroundColor'.
   300 	UpArrowForm := DownArrowForm := LeftArrowForm := RightArrowForm := nil
   520     DefaultActiveBackgroundColor := StyleSheet colorAt:'arrowButtonActiveBackgroundColor'.
   301     ].
   521     DefaultActiveForegroundColor := StyleSheet colorAt:'arrowButtonActiveForegroundColor'.
   302 
   522     DefaultEnteredBackgroundColor := StyleSheet colorAt:'arrowButtonEnteredBackgroundColor'.
   303     ((aDevice == Display) and:[DownArrowForm notNil]) ifTrue:[
   523     DefaultEnteredForegroundColor := StyleSheet colorAt:'arrowButtonEnteredForegroundColor'.
   304 	^ DownArrowForm
   524     DefaultDisabledForegroundColor := StyleSheet colorAt:'arrowButtonDisabledForegroundColor'.
   305     ].
       
   306 
   525 
   307     DownArrowForm := StyleSheet at:'arrowButtonDownForm' default:nil.
   526     DownArrowForm := StyleSheet at:'arrowButtonDownForm' default:nil.
   308     DownArrowForm notNil ifTrue:[
   527     UpArrowForm := StyleSheet at:'arrowButtonUpForm' default:nil.
   309 	^ DownArrowForm
       
   310     ].
       
   311 
       
   312     "
       
   313      special treatment for st80 arrows 
       
   314      - they do not really fit into the general (bitmap) scheme ...
       
   315      (i.e. they are computed instead of drawn from a bitmap)
       
   316     "
       
   317     style ~~ #st80 ifTrue:[
       
   318 	DownArrowFormFile notNil ifTrue:[
       
   319 	    form := Form fromFile:DownArrowFormFile resolution:100 on:aDevice.
       
   320 	    form isNil ifTrue:[
       
   321 		'ARRBUTTON: no bitmapFile: ' infoPrint. DownArrowFormFile infoPrintNL.
       
   322 	    ]
       
   323 	]
       
   324     ].
       
   325 
       
   326     "
       
   327      form to use as a fallback, if no bitmap file is present
       
   328      (actually not really needed - just to show something useful, in
       
   329       case of a bad installation)
       
   330     "
       
   331     form isNil ifTrue:[
       
   332 	style == #st80 ifTrue:[
       
   333 	    form := Form width:9 height:9 depth:1 on:Display.
       
   334 	    form clear.
       
   335 	    form lineWidth:2.
       
   336 	    form capStyle:#round.
       
   337 	    form paint:(Color colorId:1).
       
   338 	    form displayLineFromX:0 y:2 toX:4 y:6.
       
   339 	    form displayLineFromX:4 y:6 toX:8 y:2 
       
   340 	] ifFalse:[
       
   341 	    form  := Form width:16 height:16 
       
   342 			  fromArray:#[2r00000000 2r00000000
       
   343 				      2r00001111 2r11110000
       
   344 				      2r00001000 2r00010000
       
   345 				      2r00001000 2r00010000
       
   346 				      2r00001000 2r00010000
       
   347 				      2r00001000 2r00010000
       
   348 				      2r00001000 2r00010000
       
   349 				      2r01111000 2r00011110
       
   350 				      2r01000000 2r00000010
       
   351 				      2r00100000 2r00000100
       
   352 				      2r00010000 2r00001000
       
   353 				      2r00001000 2r00010000
       
   354 				      2r00000100 2r00100000
       
   355 				      2r00000010 2r01000000
       
   356 				      2r00000001 2r10000000
       
   357 				      2r00000000 2r00000000]
       
   358 			 on:aDevice
       
   359 	].
       
   360     ].
       
   361     form := form on:aDevice.
       
   362 
       
   363     "
       
   364      remember form for next use
       
   365     "
       
   366     (aDevice == Display) ifTrue:[
       
   367 	CachedStyle := style.
       
   368 	DownArrowForm := form
       
   369     ].
       
   370 
       
   371     ^ form
       
   372 !
       
   373 
       
   374 leftArrowButtonForm:style on:aDevice
       
   375     "retun the form used for the scrollLeft Button"
       
   376 
       
   377     |form|
       
   378 
       
   379     "
       
   380      use cached form, if device is appropriate
       
   381     "
       
   382     CachedStyle ~~ style ifTrue:[
       
   383 	UpArrowForm := DownArrowForm := LeftArrowForm := RightArrowForm := nil
       
   384     ].
       
   385 
       
   386     ((aDevice == Display) and:[LeftArrowForm notNil]) ifTrue:[
       
   387 	^ LeftArrowForm
       
   388     ].
       
   389 
       
   390     LeftArrowForm := StyleSheet at:'arrowButtonLeftForm' default:nil.
   528     LeftArrowForm := StyleSheet at:'arrowButtonLeftForm' default:nil.
   391     LeftArrowForm notNil ifTrue:[
       
   392 	^ LeftArrowForm
       
   393     ].
       
   394 
       
   395     "
       
   396      special treatment for st80 arrows 
       
   397      - they do not really fit into the general (bitmap) scheme ...
       
   398      (i.e. they are computed instead of drawn from a bitmap)
       
   399     "
       
   400     style ~~ #st80 ifTrue:[
       
   401 	LeftArrowFormFile notNil ifTrue:[
       
   402 	    form := Form fromFile:LeftArrowFormFile resolution:100 on:aDevice.
       
   403 	    form isNil ifTrue:[
       
   404 		'ARRBUTTON: no bitmapFile: ' infoPrint. LeftArrowFormFile infoPrintNL.
       
   405 	    ]
       
   406 	]
       
   407     ].
       
   408 
       
   409     "
       
   410      form to use as a fallback, if no bitmap file is present
       
   411      (actually not really needed - just to show something useful, in
       
   412       case of a bad installation)
       
   413     "
       
   414     form isNil ifTrue:[
       
   415 	style == #st80 ifTrue:[
       
   416 	    form := Form width:9 height:9 depth:1 on:Display.
       
   417 	    form clear.
       
   418 	    form lineWidth:2.
       
   419 	    form capStyle:#round.
       
   420 	    form paint:(Color colorId:1).
       
   421 	    form displayLineFromX:6 y:0 toX:2 y:4.
       
   422 	    form displayLineFromX:2 y:4 toX:6 y:8.
       
   423 	] ifFalse:[
       
   424 	    form := Form width:16 height:16 
       
   425 			 fromArray:#[2r00000000 2r00000000
       
   426 				     2r00000001 2r10000000
       
   427 				     2r00000010 2r10000000
       
   428 				     2r00000100 2r10000000
       
   429 				     2r00001000 2r11111110
       
   430 				     2r00010000 2r00000010
       
   431 				     2r00100000 2r00000010
       
   432 				     2r01000000 2r00000010
       
   433 				     2r01000000 2r00000010
       
   434 				     2r00100000 2r00000010
       
   435 				     2r00010000 2r00000010
       
   436 				     2r00001000 2r11111110
       
   437 				     2r00000100 2r10000000
       
   438 				     2r00000010 2r10000000
       
   439 				     2r00000001 2r10000000
       
   440 				     2r00000000 2r00000000]
       
   441 			 on:aDevice
       
   442 	].
       
   443     ].
       
   444     form := form on:aDevice.
       
   445 
       
   446     "
       
   447      remember form for next use
       
   448     "
       
   449     (aDevice == Display) ifTrue:[
       
   450 	CachedStyle := style.
       
   451 	LeftArrowForm := form
       
   452     ].
       
   453 
       
   454     ^ form
       
   455 !
       
   456 
       
   457 rightArrowButtonForm:style on:aDevice
       
   458     "retun the form used for the scrollRight Button"
       
   459 
       
   460     |form|
       
   461 
       
   462     "
       
   463      use cached form, if device is appropriate
       
   464     "
       
   465     CachedStyle ~~ style ifTrue:[
       
   466 	UpArrowForm := DownArrowForm := LeftArrowForm := RightArrowForm := nil
       
   467     ].
       
   468 
       
   469     ((aDevice == Display) and:[RightArrowForm notNil]) ifTrue:[
       
   470 	^ RightArrowForm
       
   471     ].
       
   472 
       
   473     RightArrowForm := StyleSheet at:'arrowButtonRightForm' default:nil.
   529     RightArrowForm := StyleSheet at:'arrowButtonRightForm' default:nil.
   474     RightArrowForm notNil ifTrue:[
   530 
   475 	^ RightArrowForm
   531     UpArrowFormFile := DownArrowFormFile := LeftArrowFormFile := RightArrowFormFile := nil.
   476     ].
   532     UpArrowForm isNil ifTrue:[
   477 
   533 	UpArrowFormFile := StyleSheet at:'arrowButtonUpFormFile' default:'ScrollUp.xbm'.
   478     "
   534     ].
   479      special treatment for st80 arrows 
   535     DownArrowForm isNil ifTrue:[
   480      - they do not really fit into the general (bitmap) scheme ...
   536 	DownArrowFormFile := StyleSheet at:'arrowButtonDownFormFile' default:'ScrollDn.xbm'.
   481      (i.e. they are computed instead of drawn from a bitmap)
   537     ].
   482     "
   538     LeftArrowForm isNil ifTrue:[
   483     style ~~ #st80 ifTrue:[
   539 	LeftArrowFormFile := StyleSheet at:'arrowButtonLeftFormFile' default:'ScrollLt.xbm'.
   484 	RightArrowFormFile notNil ifTrue:[
   540     ].
   485 	    form := Form fromFile:RightArrowFormFile resolution:100 on:aDevice.
   541     RightArrowForm isNil ifTrue:[
   486 	    form isNil ifTrue:[
   542 	RightArrowFormFile := StyleSheet at:'arrowButtonRightFormFile' default:'ScrollRt.xbm'.
   487 		'ARRBUTTON: no bitmapFile: ' infoPrint. RightArrowFormFile infoPrintNL.
   543     ].
   488 	    ]
   544 
   489 	]
   545     "
   490     ].
   546      self updateStyleCache
   491 
   547     "
   492     "
   548 
   493      form to use as a fallback, if no bitmap file is present
   549     "Modified: 31.8.1995 / 03:01:14 / claus"
   494      (actually not really needed - just to show something useful, in
       
   495       case of a bad installation)
       
   496     "
       
   497     form isNil ifTrue:[
       
   498 	style == #st80 ifTrue:[
       
   499 	    form := Form width:9 height:9 depth:1 on:Display.
       
   500 	    form clear.
       
   501 	    form lineWidth:2.
       
   502 	    form capStyle:#round.
       
   503 	    form paint:(Color colorId:1).
       
   504 	    form displayLineFromX:2 y:0 toX:6 y:4.
       
   505 	    form displayLineFromX:6 y:4 toX:2 y:8 
       
   506 	] ifFalse:[
       
   507 	    form := Form width:16 height:16 
       
   508 			 fromArray:#[2r00000000 2r00000000
       
   509 				     2r00000001 2r10000000
       
   510 				     2r00000001 2r01000000
       
   511 				     2r00000001 2r00100000
       
   512 				     2r01111111 2r00010000
       
   513 				     2r01000000 2r00001000
       
   514 				     2r01000000 2r00000100
       
   515 				     2r01000000 2r00000010
       
   516 				     2r01000000 2r00000010
       
   517 				     2r01000000 2r00000100
       
   518 				     2r01000000 2r00001000
       
   519 				     2r01111111 2r00010000
       
   520 				     2r00000001 2r00100000
       
   521 				     2r00000001 2r01000000
       
   522 				     2r00000001 2r10000000
       
   523 				     2r00000000 2r00000000]
       
   524 			 on:aDevice
       
   525 	].
       
   526     ].
       
   527     form := form on:aDevice.
       
   528 
       
   529     "
       
   530      remember form for next use
       
   531     "
       
   532     (aDevice == Display) ifTrue:[
       
   533 	CachedStyle := style.
       
   534 	RightArrowForm := form
       
   535     ].
       
   536 
       
   537     ^ form
       
   538 ! !
       
   539 
       
   540 !ArrowButton class methodsFor:'instance creation'!
       
   541 
       
   542 upIn:aView
       
   543     ^ (super in:aView) direction:#up
       
   544 !
       
   545 
       
   546 downIn:aView
       
   547     ^ (super in:aView) direction:#down
       
   548 !
       
   549 
       
   550 leftIn:aView
       
   551     ^ (super in:aView) direction:#left
       
   552 !
       
   553 
       
   554 rightIn:aView
       
   555     ^ (super in:aView) direction:#right
       
   556 ! !
   550 ! !
   557 
   551 
   558 !ArrowButton methodsFor:'accessing'!
   552 !ArrowButton methodsFor:'accessing'!
   559 
   553 
   560 direction:aDirectionSymbol
   554 direction:aDirectionSymbol
   578     ].
   572     ].
   579     self form:form
   573     self form:form
   580 ! !
   574 ! !
   581 
   575 
   582 !ArrowButton methodsFor:'initialization'!
   576 !ArrowButton methodsFor:'initialization'!
   583 
       
   584 initialize
       
   585     super initialize.
       
   586     controller beTriggerOnDown.
       
   587 !
       
   588 
   577 
   589 initStyle
   578 initStyle
   590     super initStyle.
   579     super initStyle.
   591 
   580 
   592     DefaultBackgroundColor notNil ifTrue:[
   581     DefaultBackgroundColor notNil ifTrue:[
   624 "/    arrowStyle == #motif ifTrue:[
   613 "/    arrowStyle == #motif ifTrue:[
   625 "/        onLevel := 0.
   614 "/        onLevel := 0.
   626 "/        offLevel := 0.
   615 "/        offLevel := 0.
   627 "/        self level:0.
   616 "/        self level:0.
   628 "/    ]
   617 "/    ]
       
   618 !
       
   619 
       
   620 initialize
       
   621     super initialize.
       
   622     controller beTriggerOnDown.
   629 ! !
   623 ! !
   630 
   624 
   631 !ArrowButton methodsFor:'redrawing'!
   625 !ArrowButton methodsFor:'redrawing'!
   632 
   626 
   633 drawWith:fg and:bg
   627 drawWith:fg and:bg
   717 	]    
   711 	]    
   718     ]
   712     ]
   719 
   713 
   720     "Modified: 31.8.1995 / 03:03:12 / claus"
   714     "Modified: 31.8.1995 / 03:03:12 / claus"
   721 ! !
   715 ! !
       
   716 
       
   717 !ArrowButton class methodsFor:'documentation'!
       
   718 
       
   719 version
       
   720     ^ '$Header: /cvs/stx/stx/libwidg/ArrowButton.st,v 1.19 1995-11-23 18:19:24 cg Exp $'
       
   721 ! !