'From Squeak5.1 of 10 July 2016 [latest update: #16102] on 26 August 2020 at 4:54:37 pm'! Form subclass: #DisplayScreen instanceVariableNames: 'clippingBox extraRegions' classVariableNames: 'CurrentScaleFactor DeferringUpdates DisplayChangeSignature DisplayIsFullScreen ScreenSave' poolDictionaries: '' category: 'Graphics-Display Objects'! !DisplayObject methodsFor: 'displaying-scaling' stamp: 'topa 6/23/2017 14:30'! aboutToBeScaled " Rescale from previous scaling " ! ! !Number methodsFor: '*Graphics-converting' stamp: 'topa 6/21/2017 16:06'! displayScaled ^ Display scaleFactor = 1.0 ifTrue: [self] ifFalse: [self * Display scaleFactor]! ! !Number methodsFor: '*Graphics-converting' stamp: 'topa 6/21/2017 16:42'! displayUnscaled ^ Display scaleFactor = 1.0 ifTrue: [self] ifFalse: [self / Display scaleFactor]! ! !Integer methodsFor: '*Graphics-converting' stamp: 'topa 6/21/2017 16:06'! displayScaled ^ super displayScaled rounded! ! !Integer methodsFor: '*Graphics-converting' stamp: 'topa 6/21/2017 16:41'! displayUnscaled ^ super displayUnscaled rounded! ! !Point methodsFor: 'transforming' stamp: 'topa 6/21/2017 16:07'! displayScaled ^ self isZero ifTrue: [self] ifFalse: [(x displayScaled) @ (y displayScaled)]! ! !Rectangle methodsFor: '*Graphics-converting' stamp: 'topa 6/23/2017 14:45'! displayScaled ^ Display scaleFactor = 1.0 ifTrue: [self] ifFalse: [Rectangle origin: origin displayScaled corner: corner displayScaled]! ! !DisplayObject methodsFor: 'displaying-scaling' stamp: 'topa 6/23/2017 14:31'! justScaled " Scale to new factor after having been unscaled. " ! ! !Form methodsFor: 'scaling, rotation' stamp: 'topa 6/21/2017 16:06'! displayScaled ^ Display scaleFactor = 1.0 ifTrue: [self] ifFalse: [self magnifyBy: Display scaleFactor]! ! !Form methodsFor: 'scaling, rotation' stamp: 'topa 7/11/2016 23:56'! screenScaled ^ Display scaleFactor = 1.0 ifTrue: [self] ifFalse: [self magnifyBy: Display scaleFactor]! ! !DisplayScreen methodsFor: 'other' stamp: 'topa 6/22/2017 13:55'! restore | scaleFactorChanged | scaleFactorChanged := Display scaleFactor = DisplayScreen actualScreenScaleFactor. scaleFactorChanged ifTrue: [Project current ifNotNil: [:p| p displayAboutToBeScaled]]. DisplayScreen startUp. scaleFactorChanged ifTrue: [Project current ifNotNil: [:p| p displayJustScaled]]. Project current ifNotNil: [:p| p displaySizeChanged].! ! !DisplayScreen methodsFor: 'private' stamp: 'topa 6/22/2017 13:57'! scaleFactor ^ CurrentScaleFactor ifNil: [1.0]! ! !DisplayScreen methodsFor: 'private' stamp: 'topa 7/11/2016 21:17'! setScaleFactor: aFactor CurrentScaleFactor := aFactor.! ! !DisplayScreen class methodsFor: 'display box access' stamp: 'topa 6/22/2017 13:54'! checkForNewScreenScaleFactor "Check whether the screen scale factor has changed and if so take appropriate actions" Display scaleFactor = DisplayScreen actualScreenScaleFactor ifFalse: [Display restore]. ! ! !DisplayScreen class methodsFor: 'display box access' stamp: 'topa 6/22/2017 13:50'! checkForNewScreenSize "Check whether the screen size has changed and if so take appropriate actions" "we have to *first* check for a changed scale factor" self checkForNewScreenScaleFactor. Display extent = DisplayScreen actualScreenSize ifFalse: [Display restore].! ! !DisplayScreen class methodsFor: 'snapshots' stamp: 'topa 7/12/2016 09:29'! actualScreenScaleFactor ^ 1.0! ! !DisplayScreen class methodsFor: 'snapshots' stamp: 'topa 7/11/2016 21:17'! startUp "DisplayScreen startUp" Display setExtent: self actualScreenSize depth: Display nativeDepth. Display setScaleFactor: self actualScreenScaleFactor. Display beDisplay! ! !Morph methodsFor: '*Graphics-Display Scaling' stamp: 'topa 8/26/2020 16:43'! aboutToBeScaled " Rescale from previous scaling " self submorphsDo: [:morph | morph wantsToBeScaled ifTrue: [morph aboutToBeScaled]]. self basicAboutToBeScaled.! ! !Morph methodsFor: '*Graphics-Display Scaling' stamp: 'topa 6/21/2017 19:27'! basicAboutToBeScaled self removeProperty: #dropShadow. "must be redone eventually" self privateBounds: self bounds displayUnscaled.! ! !Morph methodsFor: '*Graphics-Display Scaling' stamp: 'topa 6/21/2017 19:27'! basicJustScaled self privateBounds: self bounds displayScaled. ! ! !Morph methodsFor: '*Graphics-Display Scaling' stamp: 'topa 8/26/2020 16:44'! justScaled " Scale to new factor after having been unscaled." self basicJustScaled. self submorphsDo: [:morph | morph wantsToBeScaled ifTrue: [morph justScaled]].! ! !Morph methodsFor: '*Graphics-Display Scaling' stamp: 'topa 6/16/2017 12:04'! wantsToBeScaled ^ self valueOfProperty: #wantsToBeScaled ifAbsent: [true]! ! !Morph methodsFor: '*Graphics-Display Scaling' stamp: 'topa 6/16/2017 12:08'! wantsToBeScaled: aBoolean ^ self setProperty: #wantsToBeScaled toValue: aBoolean! ! !Morph methodsFor: 'drawing' stamp: 'topa 6/21/2017 16:40'! drawDropShadowOn: aCanvas "Rectangular shadow with support for rounded corners." | shadowBounds offset radius | offset := self shadowOffset displayScaled. radius := self cornerRadius displayScaled. shadowBounds := offset isRectangle ifTrue: [self bounds outsetBy: offset] ifFalse: [self bounds translateBy: (offset negated max: 0@0)]. "Only redraw the shadow if the shadow area is affected." ((aCanvas clipRect intersects: shadowBounds) and: [((self bounds insetBy: (self wantsRoundedCorners ifFalse: [0] ifTrue: [radius])) containsRect: aCanvas clipRect) not]) ifTrue: [ (self hasProperty: #dropShadow) ifFalse: [self updateDropShadowCache]. aCanvas translucentImage: (self valueOfProperty: #dropShadow) at: shadowBounds topLeft].! ! !Morph methodsFor: 'drawing' stamp: 'topa 6/21/2017 16:41'! drawRolloverBorderOn: aCanvas | colorToUse offsetToUse myShadow newForm f | colorToUse := self valueOfProperty: #rolloverColor ifAbsent: [Color blue alpha: 0.5]. offsetToUse := self valueOfProperty: #rolloverWidth ifAbsent: [(10 @ 10) displayScaled]. self hasRolloverBorder: false. myShadow := self shadowForm. self hasRolloverBorder: true. myShadow offset: 0 @ 0. f := ColorForm extent: myShadow extent depth: 1. myShadow displayOn: f. f colors: {Color transparent. colorToUse}. newForm := Form extent: offsetToUse * 2 + myShadow extent depth: 32. (WarpBlt toForm: newForm) sourceForm: f; cellSize: 1; combinationRule: 3; copyQuad: f boundingBox innerCorners toRect: newForm boundingBox. self flag: #roundedCorners. "mt: Check for #wantsRoundedCorners and call appropriate things in canvas." aCanvas translateBy: offsetToUse negated during: [:shadowCanvas | shadowCanvas shadowColor: colorToUse. shadowCanvas paintImage: newForm at: self position]! ! !Morph methodsFor: 'drawing' stamp: 'topa 6/21/2017 16:07'! expandFullBoundsForDropShadow: aRectangle "Return an expanded rectangle for an eventual drop shadow" | delta box | delta := self shadowOffset displayScaled. delta isRectangle ifTrue: [^ aRectangle outsetBy: delta]. box := aRectangle. box := delta x >= 0 ifTrue:[box right: aRectangle right + delta x] ifFalse:[box left: aRectangle left + delta x]. box := delta y >= 0 ifTrue:[box bottom: aRectangle bottom + delta y] ifFalse:[box top: aRectangle top + delta y]. ^box! ! !Morph methodsFor: 'drawing' stamp: 'topa 6/21/2017 16:35'! updateDropShadowCache | shadowBounds offset form canvas drawBlock localBounds mask maskCanvas shadowOffset cornerRadius borderWidth | (shadowOffset := self shadowOffset displayScaled) isRectangle ifTrue: [ shadowBounds := 0@0 corner: (self bounds outsetBy: shadowOffset) extent. offset := 0@0. localBounds := shadowOffset topLeft extent: self extent] ifFalse: [ shadowBounds := 0@0 corner: self extent + shadowOffset abs. offset := shadowOffset max: 0@0. localBounds := (shadowOffset negated max: 0@0) extent: self extent]. cornerRadius := self cornerRadius displayScaled. borderWidth := self borderWidth displayScaled. form := Form extent: shadowBounds extent depth: Display depth. canvas := form getCanvas. drawBlock := self useSoftDropShadow ifFalse: [ [:c | self wantsRoundedCorners ifTrue: [c fillRoundRect: localBounds radius: cornerRadius fillStyle: self shadowColor] ifFalse: [c fillRectangle: localBounds fillStyle: self shadowColor]]] ifTrue: [ [:c | | radius | radius := self wantsRoundedCorners ifTrue: [cornerRadius max: 20] ifFalse: [20]. 0 to: 9 do: [:i | c fillRoundRect: (shadowBounds insetBy: i displayScaled) radius: radius - i displayScaled fillStyle: (self shadowColor alpha: self shadowColor alpha * (i+1))]]]. canvas translateBy: offset during: [ :shadowCanvas | drawBlock value: shadowCanvas]. "Support transparent morph colors without having the shadow to shine through.." mask := Form extent: shadowBounds extent depth: Display depth. maskCanvas := mask getCanvas. self wantsRoundedCorners ifTrue: [maskCanvas fillRoundRect: (localBounds insetBy: borderWidth) radius: cornerRadius fillStyle: Color black] ifFalse: [maskCanvas fillRectangle: (localBounds insetBy: borderWidth) fillStyle: Color black]. mask displayOn: form at: 0@0 rule: Form erase. self setProperty: #dropShadow toValue: form.! ! !Morph methodsFor: 'initialization' stamp: 'topa 6/21/2017 16:40'! basicInitialize "Do basic generic initialization of the instance variables: Set up the receiver, created by a #basicNew and now ready to be initialized, by placing initial values in the instance variables as appropriate" owner := nil. submorphs := Array empty. bounds := self defaultBounds displayScaled. color := self defaultColor! ! !Morph methodsFor: 'initialization' stamp: 'topa 6/21/2017 16:41'! initialize "initialize the state of the receiver" owner := nil. submorphs := Array empty. bounds := self defaultBounds displayScaled. color := self defaultColor! ! !MenuItemMorph methodsFor: 'accessing' stamp: 'dgd 9/13/2004 19:00'! icon: aForm "change the the receiver's icon" icon := aForm. self height: self minHeight. self width: self minWidth! ! !PBBooleanPreferenceView methodsFor: 'user interface' stamp: 'topa 7/12/2016 00:16'! enabledButton | aButton aLabel | aButton := UpdatingThreePhaseButtonMorph checkBox target: self preference; actionSelector: #togglePreferenceValue; getSelector: #preferenceValue; yourself. aLabel := (StringMorph contents: 'enabled' translated font: (StrikeFont familyName: TextStyle defaultFont familyName pointSize: TextStyle defaultFont pointSize - 1)). ^self horizontalPanel addMorphBack: aButton; addMorphBack: aLabel; yourself.! ! !PBBooleanPreferenceView methodsFor: 'user interface' stamp: 'topa 7/12/2016 00:17'! localToProjectButton | aButton aLabel | aButton := UpdatingThreePhaseButtonMorph checkBox target: self preference; actionSelector: #toggleProjectLocalness; getSelector: #localToProject; yourself. aLabel := (StringMorph contents: 'local' translated font: (StrikeFont familyName: TextStyle defaultFont familyName pointSize: TextStyle defaultFont pointSize - 1)). ^self horizontalPanel addMorphBack: aButton; addMorphBack: aLabel; yourself.! ! !PasteUpMorph methodsFor: '*Graphics-Display Scaling' stamp: 'topa 6/21/2017 16:46'! basicAboutToBeScaled self isWorldMorph ifFalse: [super basicAboutToBeScaled].! ! !PasteUpMorph methodsFor: '*Graphics-Display Scaling' stamp: 'topa 6/21/2017 16:47'! basicJustScaled self isWorldMorph ifFalse: [super basicJustScaled].! ! !PluggableCheckBoxMorph methodsFor: 'installing' stamp: 'topa 7/12/2016 00:17'! installButton | aButton aLabel | aButton := UpdatingThreePhaseButtonMorph checkBox target: self model; actionSelector: self actionSelector; getSelector: self valueSelector; yourself. aLabel := (StringMorph contents: self label translated font: (StrikeFont familyName: TextStyle defaultFont familyName pointSize: TextStyle defaultFont pointSize - 1)). self addMorph: (self horizontalPanel addMorphBack: aButton; addMorphBack: aLabel; yourself).! ! !PluggableDropDownListMorph methodsFor: 'drawing' stamp: 'topa 7/12/2016 00:18'! installDropDownList | aButton aLabel | aButton := PluggableButtonMorph on: self model getState: nil action: nil. aLabel := (StringMorph contents: self model currentRemoteVatId translated font: (StrikeFont familyName: TextStyle defaultFont familyName pointSize: TextStyle defaultFont pointSize - 1)). self addMorph: (self horizontalPanel addMorphBack: aLabel; addMorphBack: aButton; yourself).! ! !Point methodsFor: 'transforming' stamp: 'topa 6/21/2017 16:42'! displayUnscaled ^ self isZero ifTrue: [self] ifFalse: [(x displayUnscaled) @ (y displayUnscaled)]! ! !Project methodsFor: 'displaying' stamp: 'topa 6/16/2017 09:29'! displayAboutToBeScaled "Rescale from previous scaling is about to be happening. "! ! !Project methodsFor: 'displaying' stamp: 'topa 6/22/2017 13:39'! displayJustScaled "The display's scale factor has just changed " ! ! !MorphicProject methodsFor: 'display' stamp: 'topa 6/21/2017 10:32'! displayAboutToBeScaled super displayAboutToBeScaled. world wantsToBeScaled ifTrue: [world aboutToBeScaled].! ! !MorphicProject methodsFor: 'display' stamp: 'topa 6/21/2017 10:32'! displayJustScaled world wantsToBeScaled ifTrue: [world justScaled]. super displayJustScaled.! ! !RealEstateAgent class methodsFor: 'framing' stamp: 'topa 6/21/2017 14:29'! initialFrameFor: aView initialExtent: initialExtent world: aWorld | scaledExtent | scaledExtent := initialExtent. ^ Preferences reverseWindowStagger ifTrue: [self strictlyStaggeredInitialFrameFor: aView initialExtent: scaledExtent world: aWorld] ifFalse: [self normalInitialFrameFor: aView initialExtent: scaledExtent world: aWorld]! ! !Rectangle methodsFor: '*Graphics-converting' stamp: 'topa 6/23/2017 14:45'! displayUnscaled ^ Display scaleFactor = 1.0 ifTrue: [self] ifFalse: [Rectangle origin: origin displayUnscaled corner: corner displayUnscaled]! ! !StrikeFont methodsFor: 'accessing' stamp: 'topa 6/21/2017 16:44'! pointSize ^ pointSize displayUnscaled! ! !SystemWindow methodsFor: 'initialization' stamp: 'topa 6/21/2017 14:29'! applyModelExtent self extent: model initialExtent ! ! !SystemWindow methodsFor: 'open/close' stamp: 'topa 6/21/2017 16:42'! openInWorld: aWorld extent: extent "This msg and its callees result in the window being activeOnlyOnTop" ^ (self anyOpenWindowLikeMeIn: aWorld) ifEmpty: [ | scaledExtent | scaledExtent := extent displayScaled. self position: (RealEstateAgent initialFrameFor: self initialExtent: scaledExtent world: aWorld) topLeft ; extent: scaledExtent. self openAsIsIn: aWorld ] ifNotEmptyDo: [ : windows | windows anyOne expand ; beKeyWindow ; postAcceptBrowseFor: self ].! ! !TTCFont methodsFor: 'accessing' stamp: 'topa 6/21/2017 16:44'! pointSize ^ pointSize displayUnscaled ! ! !Thumbnail methodsFor: 'initialization' stamp: 'sw 6/13/2001 19:38'! setStandardDefaultMetrics "Provide the current choices for min.max width/height for thumbnails" self maxWidth: 60 minHeight: 24! ! !ToolIcons class methodsFor: 'accessing' stamp: 'mt 3/5/2015 10:25'! iconNamed: aSymbol ^self icons at: aSymbol ifAbsentPut: [self perform: aSymbol]! !