pieter@prls.UUCP (Pieter van der Meulen) (12/09/89)
" Several times it has been noted that there are too litle postings with sources in this newsgroup, but it is changing for the better: I have had several positive responses from people about the 3D switches, but (unfortunately) it did not spawn new postings on other 3D enhancements. So, I decided to create a more complete set of 3D changes and they are listed below, Pieter. ------------------------------cut here------------------------------------- " 'Yes, these are SYSTEM CHANGES, no scruples this time. If you do not like to change system classes (understandable), do NOT file this in. If you did file this in, open a LARGE new Browser to get a good impression. The changes include: - Switches in 3D (similar to the previous posting) - Titles in 3D - Scrollbars in 3D - View borders in 3D (if border is thick enough) Note: - (sub-)view borders will not display in 3D unless they are thick enough (>5). Only a few system windows will have 3D borders (see first method below). If you want other system windows to have 3D borders, you have to search for the senders of <borderWidth:>, and YOU may make the changes. - try thick sub-view borders for the Browser: modify all methods in the protocol <BrowserView|subview creation> so that <borderWidth: 1> will be <borderWidth: 6>. - you do not need to give SwitchViews thick borders, because the <clearInside> already takes care of that. - you could also modify PopUpMenus (use Quadrangle3D instead of Quadrangle), but that would be (too) much system hacking, so YOU may try that yourself. - the 3D effects would be a lot nicer if we had true gray-scales.... - see the <Quadrangle3D|display3Drect:on:clipRect:> method-comments if your display is in inverse video. - your <old> windows may look a little funny, because they were created with plain Quadrangles. - the changes are for Smalltalk-80 V2.3, but it will probably also work for other versions. I do not claim this is the most elegant solution, and any improvements are welcome. Have fun, Pieter S. van der Meulen. DISCLAIMER: I take no responsibility whatsoever for the condition of this software. Unrestricted use is hereby granted as long as this header remains intact.'! !StandardSystemView class methodsFor: 'instance creation'! model: aModel label: labelText minimumSize: minimumSize "Create windows with a thick border for 3D effects. This one will only take care of 3D for some system windows" | view | view _ self new. view model: aModel. view label: labelText. view minimumSize: minimumSize. view borderWidth: 6. ^view! ! !SwitchView methodsFor: 'displaying'! clearInside "Create a view with depth effects. Written by Pieter S. van der Meulen." | aRect aBitBlt | aRect _ self insetDisplayBox copy. aBitBlt _ BitBlt destForm: Display sourceForm: nil halftoneForm: nil combinationRule: Form over destOrigin: aRect origin sourceOrigin: Display boundingBox origin extent: aRect extent clipRect: Display boundingBox. (label isNil ifTrue: [6] ifFalse: [((aRect height - label height min: (aRect width - label width)) // 2 - 1) min: 10]) timesRepeat: [aBitBlt destRect: aRect; mask: Form darkGray; copyBits. aRect corner: aRect corner - (1@1). aBitBlt destRect: aRect; mask: Form lightGray; copyBits. aRect origin: aRect origin + (1@1)]. aBitBlt destRect: aRect; mask: self insideColor; copyBits! highlight "Cause the inset display box (the display box excluding the border, see View|insetDisplayBox) of the receiver to complement." highlightForm == nil ifFalse: [^highlightForm displayOn: Display at: self displayBox topLeft clippingBox: self insetDisplayBox rule: Form reverse mask: nil]. emphasisOn ifTrue: [Display reverse: (self insetDisplayBox insetBy: 1)] ifFalse: ["Display reverse: (self insetDisplayBox insetBy: 1)." Display reverse: (self insetDisplayBox insetBy: 2)]! ! !View methodsFor: 'displaying'! displayBorder "Display the receiver's border (using the receiver's borderColor)." self borderWidth = 0 ifTrue: [self insideColor == nil ifFalse: [Display fill: self displayBox mask: self insideColor]] ifFalse: [self borderWidth corner x > 5 ifTrue: [self display3DBorder] ifFalse: [superView isNil ifTrue: [Display border: self displayBox widthRectangle: self borderWidth mask: borderColor] ifFalse: [Display border: self displayBox widthRectangle: self borderWidth mask: borderColor clippingBox: superView insetDisplayBox]]. self insideColor == nil ifFalse: [Display fill: self insetDisplayBox mask: self insideColor]]! display3DBorder "Display the receiver's border in 3D. Assume the border is thick enough (> 6)." | aQ3D | aQ3D _ Quadrangle3D new. aQ3D region: self displayBox; borderWidth: self borderWidth. superView isNil ifTrue: [aQ3D displayOn: Display] ifFalse: [aQ3D displayOn: Display clipRect: superView insetDisplayBox]! ! !StandardSystemView methodsFor: 'displaying'! display3Drect: aRect on: aForm clipRect: clipRect "Display a Label (Rectangle) on aForm with depth effects. Since labels are small, this method is quicker then the similar Quadrangle3D method. Flashing effects are hardly noticable. Written by Pieter S. van der Meulen." | aBitBlt shrinkRect | (aBitBlt _ BitBlt destForm: aForm sourceForm: nil halftoneForm: Form black combinationRule: Form over destOrigin: aRect origin sourceOrigin: aForm boundingBox origin extent: aRect extent clipRect: clipRect) copyBits. shrinkRect _ aRect insetBy: 1@1. (labelText isNil ifTrue: [6] ifFalse: [((shrinkRect height - labelText height min: (shrinkRect width - labelText width)) // 2 - 1) min: 10]) timesRepeat: [aBitBlt destRect: shrinkRect; mask: Form darkGray; copyBits. shrinkRect corner: shrinkRect corner - (1@1). aBitBlt destRect: shrinkRect; mask: Form lightGray; copyBits. shrinkRect origin: shrinkRect origin + (1@1)]. aBitBlt destRect: shrinkRect; mask: Form white; copyBits. ^aForm! clear3dLabel "Clear the label and add depth effects. Written by Pieter S. van der Meulen." ^self display3Drect: self labelDisplayBox on: Display clipRect: self clippingBox! ! !StandardSystemView methodsFor: 'label access'! labelForm "Answer with a form that contains the label text." | form formBox | form _ Form extent: labelFrame extent. self display3Drect: labelFrame on: form clipRect: labelFrame. labelText isNil ifFalse: [formBox _ form boundingBox. labelText displayOn: form at: (formBox center - (labelText boundingBox center - labelText boundingBox topLeft)) clippingBox: formBox]. ^form! ! !StandardSystemView methodsFor: 'icon access'! iconFromLabel "Return an icon that looks like my title tab" | iconForm box | iconForm _ Form extent: labelFrame corner + (0 @ 2). box _ iconForm computeBoundingBox. self display3Drect: box on: iconForm clipRect: box. labelText asParagraph displayOn: iconForm at: (box extent - labelText boundingBox extent) // 2 clippingBox: box. ^Icon new form: iconForm textRect: nil! ! !StandardSystemView methodsFor: 'displaying'! displayLabel self isCollapsed ifTrue: [^self]. self clear3dLabel. labelText isNil ifFalse: [isLabelComplemented _ false. labelText displayOn: Display at: (self labelDisplayBox center - (labelText boundingBox center - labelText boundingBox topLeft)) clippingBox: self clippingBox]! displayView self isCollapsed ifTrue: [^self]. self clear3dLabel. labelText isNil ifFalse: [isLabelComplemented _ false. labelText displayOn: Display at: (self labelDisplayBox center - (labelText boundingBox center - labelText boundingBox topLeft)) clippingBox: self clippingBox]! ! !StandardSystemView methodsFor: 'label access'! label: aString emphasis: anInteger "Set aString to be the receiver's label." aString == nil ifTrue: [labelText _ nil. labelFrame region: (0 @ 0 extent: 0 @ 0)] ifFalse: [labelText _ (Text string: aString emphasis: anInteger) asParagraph. labelFrame region: (0 @ 0 extent: labelText boundingBox extent + (20 @ 16))]. iconText isNil & iconView notNil ifTrue: [iconView text: self label asText].! label: aString "Set aString to be the receiver's label." self label: aString emphasis: 2! ! Quadrangle subclass: #Quadrangle3D instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Graphics-Primitives'! Quadrangle3D comment: 'I am used by scrollbars to create 3D effects. Written by Pieter S. van der Meulen.'! !Quadrangle3D methodsFor: 'displaying'! display3Drect: aRect on: aForm clipRect: clipRect "Change the value of the forward parameter if you want scrollbars to go the other way (inward or outward). May be usefull if you work in inverse video, and want it to stll come outward. Written by Pieter S. van der Meulen." ^self display3Drect: aRect on: aForm clipRect: clipRect forward: true! display3Drect: aRect on: aForm clipRect: clipRect forward: aBoolean "Display a Rectangle on aForm with depth effects. If aBoolean is true, let the quadrangle come outward. Written by Pieter S. van der Meulen." | aBitBlt m1 m2 sox soy scx scy | sox _ aRect origin x. soy _ aRect origin y. scx _ aRect corner x. scy _ aRect corner y. (aBitBlt _ BitBlt destForm: aForm sourceForm: nil halftoneForm: Form black combinationRule: Form over destOrigin: sox@(scy -1) sourceOrigin: aForm boundingBox origin extent: (scx - sox) @ 1 clipRect: clipRect) copyBits. aBitBlt destRect: ((scx - 1)@soy corner: scx@scy); copyBits. scx _ scx -1. scy _ scy -1. aBitBlt destRect: (sox@soy corner: scx @ (soy + 1)); copyBits. aBitBlt destRect: (sox@soy corner: (sox + 1) @ scy); copyBits. sox _ sox +1. soy _ soy +1. aBoolean ifTrue: [m1 _ Form darkGray. m2 _ Form lightGray] ifFalse: [m2 _ Form darkGray. m1 _ Form lightGray]. (borderWidth isNil ifTrue: [(aRect width min: aRect height) // 2 - 2] ifFalse: [borderWidth isInteger ifTrue: [borderWidth] ifFalse: [borderWidth corner x max: borderWidth corner y]]) timesRepeat: [aBitBlt destRect: (sox@(scy -1) corner: scx@scy); mask: m1; copyBits. aBitBlt destRect: ((scx - 1)@soy corner: scx@scy); copyBits. scx _ scx -1. scy _ scy -1. aBitBlt destRect: (sox@soy corner: scx @ (soy + 1)); mask: m2; copyBits. aBitBlt destRect: (sox@soy corner: (sox + 1) @ scy); copyBits. sox _ sox +1. soy _ soy +1]. aBitBlt destRect: (sox@soy corner: scx@scy); mask: (aBoolean ifTrue: [Form white] ifFalse: [Form black]); copyBits. ^aForm! displayOn: aDisplayMedium "Display the border and insideRegion of the receiver." self display3Drect: self region on: aDisplayMedium clipRect: aDisplayMedium boundingBox! displayOn: aDisplayMedium clipRect: clipRect "Display the border and insideRegion of the receiver." self display3Drect: self region on: aDisplayMedium clipRect: clipRect! displayOn: aDisplayMedium transformation: aWindowingTransformation clippingBox: aRectangle "Display the border and region of the reciever so that it is scaled and translated with respect to aWindowingTransformation. The displayed information should be clipped so that only information with the area determined by aRectangle is displayed." self display3Drect: self region on: aDisplayMedium clipRect: ((aWindowingTransformation applyTo: self) intersect: aRectangle)! ! !TextEditor methodsFor: 'marker adjustment'! computeMarkerRegion "Answer the rectangular area in which the gray area of the scroll bar should be displayed." paragraph textSize = 0 ifTrue: [^0@0 extent: 16 @ scrollBar inside height] ifFalse: [^0@0 extent: 16 @ ((((paragraph nextChar - (paragraph lines at: 1)) asFloat / (paragraph textSize max: 1) asFloat * scrollBar inside height asFloat) rounded min: scrollBar inside height) max: 10)]! ! !ParagraphEditor methodsFor: 'marker adjustment'! computeMarkerRegion paragraph compositionRectangle height = 0 ifTrue: [^0@0 extent: 16 @ scrollBar inside height] ifFalse: [^0@0 extent: 16 @ ((paragraph clippingRectangle height asFloat / self scrollRectangleHeight * scrollBar inside height) rounded min: scrollBar inside height)]! ! !ListController methodsFor: 'marker adjustment'! computeMarkerRegion | viewList | viewList _ view list. ^ 0@0 extent: 16@ ((viewList clippingRectangle height asFloat / viewList compositionRectangle height * scrollBar inside height) rounded min: scrollBar inside height)! ! !ScrollController methodsFor: 'marker adjustment'! computeMarkerRegion "Answer the rectangular area in which the gray area of the scroll bar should be displayed." ^0@0 extent: 16 @ ((view window height asFloat / view boundingBox height * scrollBar inside height) rounded min: scrollBar inside height)! ! !ScrollController methodsFor: 'initialize-release'! initialize super initialize. scrollBar _ Quadrangle new. scrollBar insideColor: Form veryLightGray. scrollBar borderWidthLeft: 2 right: 0 top: 2 bottom: 2. marker _ Quadrangle3D new. marker borderWidth: nil "marker insideColor: Form gray"! ! -- --------------------------------------------- P.S. van der Meulen, MS 02 prls!pieter PRLS, Signetics div. of NAPC ----------- 811 E.Arques Avenue, Sunnyvale, CA 94088-3409