[enh] backdrops

Stephan B. Wessels stephan.wessels at sdrc.com
Wed Nov 10 15:21:16 UTC 1999


--------------BD3E3FA6E523F71600849D13
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit


This change set adds a BackdropManager to Squeak.  I've tested it with V2.7a and
it's pretty cool.  Here's what it provides:

    For either MVC or Morphic the appearance menu has been modified for setting
the background color.  You can now choose between a solid color (uses standard
Squeak code) or you can choose a vertical gradient fill between any two colors.
Looks pretty neat.

    FileList was changed so that jpeg, gif, bmp etc. images which are placed
into the background can be either tiled (like Squeak does now by default),
scaled to fit the entire desktop or centered within the current desktop.

    A last provision that the BackdropManager provides is to cache pictures
which can be called up by name programmatically and loaded into the desktop
background as either tiled, scaled or centered.  However, I don't recommend this
approach unless you prefer to operate without disk access.

Have fun.  Comments and feedback are encouraged.

  - Steve


--------------BD3E3FA6E523F71600849D13
Content-Type: text/plain; charset=us-ascii;
 name="backdrops.10Nov1011am.cs"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline;
 filename="backdrops.10Nov1011am.cs"


'From Squeak2.7alpha of 10 November 1999 [latest update: #1592] on 10 November 1999 at 10:11:00 am'!
Object subclass: #BackdropManager
	instanceVariableNames: ''
	classVariableNames: 'Backdrops Mode Tile '
	poolDictionaries: ''
	category: 'SBW-Tools-Misc'!

!BackdropManager commentStamp: '<historical>' prior: 0!
Supports loading sclaed and tiled images as the desktop in either MVC or Morphic.

Use the FileList to select an image for loading and then select scaled or tiled loading from the menu.

A provision is also made to cahce forms into a class variable.  An assumption that a folder called <backdrops> holds the images you want cached.  See class methods.  Obviously this technique will eat up memory.!

!BackdropManager class reorganize!
('initialize-release' initializeBackdrops)
('objects from disk' backdropNameForFileName: backdropsFolder backdropsFolderExists folderName fullBackdropNameFor: isValidBackdropSuffix: loadBackdropFromFileNamed: loadBackdrops)
('gui' loadBackdropFormCentered: loadBackdropFormStretched: loadBackdropFormTiled: loadBackdropFormUsingCurrentMode: loadBackdropNamed: loadYGradientBackgroundStartColor:endColor: userPicksGradientBackdrop)
('accessing' addBackdrop:named: backdropExists: backdropNamed: backdrops backdrops:)
('position modes' isCenter isStretch isTile mode mode: setCenter setStretch setTile)
('as yet unclassified' test test2)
!


!BackdropManager class methodsFor: 'initialize-release' stamp: 'sbw 11/7/1999 11:38'!
initializeBackdrops
	"BackdropManager initializeBackdrops"

	self backdrops: Dictionary new! !

!BackdropManager class methodsFor: 'objects from disk' stamp: 'sbw 11/7/1999 10:11'!
backdropNameForFileName: aString
	"Answers the name of the backdrop.  Use the file name preceding the extension."

	^FileDirectory baseNameFor: aString! !

!BackdropManager class methodsFor: 'objects from disk' stamp: 'sbw 11/7/1999 10:05'!
backdropsFolder

	^FileDirectory default directoryNamed: self folderName! !

!BackdropManager class methodsFor: 'objects from disk' stamp: 'sbw 11/7/1999 09:57'!
backdropsFolderExists
	"Answers if there is a backdrops folder at the default location."

	^FileDirectory default directoryExists: self folderName! !

!BackdropManager class methodsFor: 'objects from disk' stamp: 'sbw 11/7/1999 09:52'!
folderName

	^'backdrops'! !

!BackdropManager class methodsFor: 'objects from disk' stamp: 'sbw 11/7/1999 10:18'!
fullBackdropNameFor: aFileName

	^self backdropsFolder fullNameFor: aFileName! !

!BackdropManager class methodsFor: 'objects from disk' stamp: 'sbw 11/7/1999 11:01'!
isValidBackdropSuffix: aString
	"Answers if the suffix given is a valid extension name for a backdrop file."

	| suffix |
	suffix _ aString asLowercase.
	^(suffix = 'bmp') | (suffix = 'gif') | (suffix = 'jpg') | (suffix = 'form')! !

!BackdropManager class methodsFor: 'objects from disk' stamp: 'sbw 11/7/1999 10:59'!
loadBackdropFromFileNamed: aName
	"private.  Load backdrop in the file specified from the default folder."

	| backdropName fullName form suffix |
	self backdropsFolderExists ifFalse: [^nil].
	suffix _ FileDirectory extensionFor: aName.
	(self isValidBackdropSuffix: suffix) ifTrue: [
		backdropName _ self backdropNameForFileName: aName.
		(self backdropExists: backdropName) ifFalse: [
			fullName _ self fullBackdropNameFor: aName.
			form _ Form fromFileNamed: fullName.
			self addBackdrop: form named: backdropName]
		]
! !

!BackdropManager class methodsFor: 'objects from disk' stamp: 'sbw 11/7/1999 10:54'!
loadBackdrops
	"Loads the backdrops from the default folder."
	"BackdropManager loadBackdrops"

	| names loadCount |
	self backdropsFolderExists ifFalse: [^nil].
	names _ self backdropsFolder fileNames.
	names isEmpty ifTrue: [^nil].
	loadCount _ 0.
	'Loading backdrops...' displayProgressAt: Sensor cursorPoint from: loadCount to: names size during: [:progressBar |
		names do: [:each |
			progressBar value: loadCount.
			loadCount _ loadCount + 1.
			self loadBackdropFromFileNamed: each
			]
		]! !

!BackdropManager class methodsFor: 'gui' stamp: 'sbw 11/9/1999 22:06'!
loadBackdropFormCentered: aForm

	self setCenter.
	self loadBackdropFormUsingCurrentMode: aForm! !

!BackdropManager class methodsFor: 'gui' stamp: 'sbw 11/9/1999 22:05'!
loadBackdropFormStretched: aForm

	self setStretch.
	self loadBackdropFormUsingCurrentMode: aForm! !

!BackdropManager class methodsFor: 'gui' stamp: 'sbw 11/9/1999 22:06'!
loadBackdropFormTiled: aForm

	self setTile.
	self loadBackdropFormUsingCurrentMode: aForm! !

!BackdropManager class methodsFor: 'gui' stamp: 'sbw 11/9/1999 22:58'!
loadBackdropFormUsingCurrentMode: frm

	| ext dsp scale backdrop h1 h2 w1 w2 destPt |
	ext _ frm extent.
	dsp _ Display extent.
	scale _ dsp / ext.
	backdrop _ frm.  "Assume tile as default."
	self isCenter ifTrue: [
		backdrop _ Form extent: dsp depth: Display depth.
		backdrop fill: backdrop boundingBox rule: Form over fillColor: Preferences desktopColor.
		h1 _ backdrop extent y.
		h2 _ frm extent y.
		w1 _ backdrop extent x.
		w2 _ frm extent x.
		destPt _ ((w1 - w2) // 2)@((h1 - h2) // 2).
		backdrop copy: frm boundingBox from: frm to: destPt rule: Form over].
	self isStretch ifTrue: [backdrop _ frm magnify: frm boundingBox by: scale].
	World
		ifNil: [
			ScheduledControllers screenController view model: (InfiniteForm with: backdrop).
			ScheduledControllers restore]
		ifNotNil: [World color: (InfiniteForm with: backdrop)]! !

!BackdropManager class methodsFor: 'gui' stamp: 'sbw 11/9/1999 22:07'!
loadBackdropNamed: aString

	| frm |
	frm _ self backdropNamed: aString.
	frm isNil ifTrue: [^nil].
	self loadBackdropFormTiled: frm! !

!BackdropManager class methodsFor: 'gui' stamp: 'sbw 11/10/1999 00:00'!
loadYGradientBackgroundStartColor: startColor endColor: endColor

	| frm |
	frm _ Form extent: Display extent depth: Display depth.
	frm fillYStartColor: startColor endColor: endColor.
	self loadBackdropFormTiled: frm! !

!BackdropManager class methodsFor: 'gui' stamp: 'sbw 11/10/1999 10:10'!
userPicksGradientBackdrop

	| startColor endColor |
	PopUpMenu notify: 'choose bottom edge color'.
	endColor _ Color fromUser.
	PopUpMenu notify: 'choose top edge color'.
	startColor _ Color fromUser.
	self loadYGradientBackgroundStartColor: startColor endColor: endColor! !

!BackdropManager class methodsFor: 'accessing' stamp: 'sbw 11/7/1999 10:19'!
addBackdrop: aForm named: aString

	self backdrops at: aString put: aForm! !

!BackdropManager class methodsFor: 'accessing' stamp: 'sbw 11/7/1999 10:13'!
backdropExists: aString

	^self backdrops includesKey: aString! !

!BackdropManager class methodsFor: 'accessing' stamp: 'sbw 11/7/1999 10:20'!
backdropNamed: aString

	^self backdrops at: aString ifAbsent: [nil]! !

!BackdropManager class methodsFor: 'accessing' stamp: 'sbw 11/7/1999 11:31'!
backdrops
	"BackdropManager backdrops"

	Backdrops == nil ifTrue: [self initializeBackdrops].
	^Backdrops! !

!BackdropManager class methodsFor: 'accessing' stamp: 'sbw 11/7/1999 09:50'!
backdrops: aDictionary
	"private"

	Backdrops _ aDictionary! !

!BackdropManager class methodsFor: 'position modes' stamp: 'sbw 11/8/1999 21:46'!
isCenter

	^self mode = #center! !

!BackdropManager class methodsFor: 'position modes' stamp: 'sbw 11/8/1999 21:46'!
isStretch

	^self mode = #stretch! !

!BackdropManager class methodsFor: 'position modes' stamp: 'sbw 11/8/1999 21:46'!
isTile

	^self mode = #tile! !

!BackdropManager class methodsFor: 'position modes' stamp: 'sbw 11/8/1999 21:44'!
mode

	Mode == nil ifTrue: [^#tile].
	^Mode! !

!BackdropManager class methodsFor: 'position modes' stamp: 'sbw 11/8/1999 21:44'!
mode: aSymbol

	Mode _ aSymbol! !

!BackdropManager class methodsFor: 'position modes' stamp: 'sbw 11/8/1999 21:45'!
setCenter

	self mode: #center! !

!BackdropManager class methodsFor: 'position modes' stamp: 'sbw 11/8/1999 21:45'!
setStretch

	self mode: #stretch! !

!BackdropManager class methodsFor: 'position modes' stamp: 'sbw 11/8/1999 21:45'!
setTile

	self mode: #tile! !

!BackdropManager class methodsFor: 'as yet unclassified' stamp: 'sbw 11/9/1999 22:03'!
test
	| frm startColor endColor rDelta gDelta bDelta yRel rVal gVal bVal |
	"BackdropManager test"

	frm _ Form extent: Display extent depth: Display depth.
	startColor _ Color r: 0.6 g: 0.4 b: 0.1.
	endColor _ Color r: 0.6 g: 0.4 b: 0.9.
	rDelta _ endColor red - startColor red.
	gDelta _ endColor green - startColor green.
	bDelta _ endColor blue - startColor blue.
	0 to: frm height do: [:y |
		yRel _ y asFloat / (frm height - 1) asFloat.
		rVal _ 1.0 min: (rDelta * yRel asFloat + startColor red).
		gVal _ 1.0 min: (gDelta * yRel asFloat + startColor green).
		bVal _ 1.0 min: (bDelta * yRel asFloat + startColor blue).
		frm
			fill: (0 at y extent: frm width at 1)
			fillColor: (Color r: rVal g: gVal b: bVal)
		].
	self setTile.
	self loadBackdropFormUsingCurrentMode: frm! !

!BackdropManager class methodsFor: 'as yet unclassified' stamp: 'sbw 11/9/1999 22:04'!
test2
	| frm startColor endColor |
	"BackdropManager test2"

	frm _ Form extent: Display extent depth: Display depth.
	endColor _ Color r: 0.6 g: 0.4 b: 0.4.
	startColor _ Color r: 1.0 g: 1.0 b: 1.0.
	frm fillYStartColor: startColor endColor: endColor.
	self setTile.
	self loadBackdropFormUsingCurrentMode: frm! !


!FileList methodsFor: 'file list menu' stamp: 'sbw 11/9/1999 22:10'!
itemsForFileEnding: suffix
	| labels lines selectors |
	labels _ OrderedCollection new.
	lines _ OrderedCollection new.
	selectors _ OrderedCollection new.
	(suffix = 'bmp') | (suffix = 'gif') | (suffix = 'jpg') | (suffix = 'form') | (suffix = '*') ifTrue:
		[labels addAll: #('open image in a window' 'read image into ImageImports'
						 'open image as background tiled' 'open image as background stretched' 'open image as background centered').
		selectors addAll: #(openImageInWindow importImage openAsBackgroundTiled openAsBackgroundStretched openAsBackgroundCentered)].
	(suffix = 'morph') | (suffix = 'morphs') | (suffix = 'sp') | (suffix = '*') ifTrue:
		[labels add: 'load as morph'.
		selectors add: #openMorphFromFile.
		labels add: 'load as project'.
		selectors add: #openProjectFromFile].
	(suffix = 'bo') | (suffix = '*') ifTrue:[
		labels add: 'load as book'.
		selectors add: #openBookFromFile].
	(suffix = 'mid') | (suffix = '*') ifTrue:
		[labels add: 'play midi file'.
		selectors add: #playMidiFile].
	(suffix = 'movie') | (suffix = '*') ifTrue:
		[labels add: 'open as movie'.
		selectors add: #openAsMovie].
	(suffix = 'st') | (suffix = 'cs') | (suffix = '*') ifTrue:
		[suffix = '*' ifTrue: [lines add: labels size].
		labels addAll: #('fileIn' 'file into new change set' 'browse changes' 'browse code' 'remove line feeds' 'broadcast as update').
		lines add: labels size - 1.
		selectors addAll: #(fileInSelection fileIntoNewChangeSet browseChanges browseFile removeLinefeeds putUpdate)].
	(suffix = 'swf') | (suffix = '*') ifTrue:[
		labels add:'open as Flash'.
		selectors add: #openAsFlash].
	(suffix = 'ttf') | (suffix = '*') ifTrue:[
		labels add: 'open true type font'.
		selectors add: #openAsTTF].
	(suffix = 'gz') | (suffix = '*') ifTrue:[
		labels addAll: #('view decompressed' 'decompress to file').
		selectors addAll: #(viewGZipContents saveGZipContents)].
	(suffix = '3ds') | (suffix = '*') ifTrue:[
		labels add: 'Open 3DS file'.
		selectors add: #open3DSFile].
	(suffix = 'tape') | (suffix = '*') ifTrue:
		[labels add: 'open for playback'.
		selectors add: #openTapeFromFile].
	(suffix = 'wrl') | (suffix = '*') ifTrue:
		[labels add: 'open in Wonderland'.
		selectors add: #openVRMLFile].
	(suffix = '*') ifTrue:
		[labels addAll: #('generate HTML').
		lines add: labels size - 1.
		selectors addAll: #(renderFile)].
	^ Array with: labels with: lines with: selectors! !

!FileList methodsFor: 'file list menu' stamp: 'sbw 11/9/1999 22:08'!
openAsBackgroundCentered

	| frm |
	frm _ Form fromFileNamed: self fullName.
	BackdropManager loadBackdropFormCentered: frm! !

!FileList methodsFor: 'file list menu' stamp: 'sbw 11/9/1999 22:07'!
openAsBackgroundStretched

	| frm |
	frm _ Form fromFileNamed: self fullName.
	BackdropManager loadBackdropFormStretched: frm! !

!FileList methodsFor: 'file list menu' stamp: 'sbw 11/9/1999 22:07'!
openAsBackgroundTiled

	| frm |
	frm _ Form fromFileNamed: self fullName.
	BackdropManager loadBackdropFormTiled: frm! !


!Form methodsFor: 'filling' stamp: 'sbw 11/8/1999 23:13'!
fillYStartColor: startColor endColor: endColor

	| rDelta gDelta bDelta ratio rVal gVal bVal |
	rDelta _ endColor red - startColor red.
	gDelta _ endColor green - startColor green.
	bDelta _ endColor blue - startColor blue.
	0 to: height do: [:y |
		ratio _ y asFloat / (height - 1) asFloat.
		rVal _ 1.0 min: (startColor red + (rDelta * ratio)).
		gVal _ 1.0 min: (startColor green + (gDelta * ratio)).
		bVal _ 1.0 min: (startColor blue + (bDelta * ratio)).
		self
			fill: (0 at y extent: width at 1)
			fillColor: (Color r: rVal g: gVal b: bVal)]! !


!HandMorph methodsFor: 'world menu' stamp: 'sbw 11/9/1999 22:17'!
appearanceMenu
	"Build the appearance menu for the world."
	| menu screenCtrl |
	screenCtrl _ ScreenController new.
	menu _ (MenuMorph entitled: 'appearance...') defaultTarget: self.
	menu addStayUpItem.
	menu add: 'window colors...' target: Preferences action: #windowSpecificationPanel.
	menu balloonTextForLastItem: 'lets you specify colors for standard system windows.'.
	menu add: 'text highlight color...' target: Preferences action: #chooseTextHighlightColor.
	menu balloonTextForLastItem: 'Lets you choose which color should be used for text highlighting in Morphic.'.
	menu add: 'insertion point color...' target: Preferences action: #chooseInsertionPointColor.
	menu balloonTextForLastItem: 'Lets you choose which color to use for the text insertion point in Morphic.'.
	menu addLine.

	menu addUpdating: #menuColorString target: Preferences action: #toggleMenuColorPolicy.
	menu balloonTextForLastItem: 'Governs whether menu colors should be derived from the desktop color.'.
	menu addUpdating: #roundedCornersString target: Preferences action: #toggleRoundedCorners.
	menu balloonTextForLastItem: 'Governs whether morphic windows and menus should have rounded corners.'.

	menu addLine.

	menu add: 'full screen on' target: screenCtrl action: #fullScreenOn.
	menu balloonTextForLastItem: 'puts you in full-screen mode, if not already there.'.
	menu add: 'full screen off' target: screenCtrl action: #fullScreenOff.
	menu balloonTextForLastItem: 'if in full-screen mode, takes you out of it.'.
	menu addLine.

	menu add: 'set display depth...' action: #setDisplayDepth.
	menu balloonTextForLastItem: 'choose how many bits per pixel.'.
	menu add: 'set desktop to solid color...' action: #changeBackgroundColor.
	menu add: 'set desktop to gradient fill...' action: #changeBackgroundGradient.
	menu balloonTextForLastItem: 'choose a uniform color to use as desktop background.'.
	menu add: 'use texture background' target: self world action: #setStandardTexture.
	menu balloonTextForLastItem: 'apply a graph-paper-like texture background to the desktop.'.

	^ menu
! !

!HandMorph methodsFor: 'world menu commands' stamp: 'sbw 11/10/1999 10:10'!
changeBackgroundGradient

	BackdropManager userPicksGradientBackdrop! !


!ScreenController methodsFor: 'menu messages' stamp: 'sbw 11/10/1999 10:10'!
setDesktopGradient

	BackdropManager userPicksGradientBackdrop! !

!ScreenController methodsFor: 'nested menus' stamp: 'sbw 11/9/1999 23:55'!
appearanceMenu 
	"Answer the appearance menu to be put up as a screen submenu"

	^ SelectionMenu labelList:
		#(	'window colors...'
			'full screen on'
			'full screen off'
			'set display depth...'
			'set desktop to solid color...'
			'set desktop to gradient fill...' ) 

		lines: #(1 3)
		selections: #(windowSpecificationPanel
fullScreenOn fullScreenOff setDisplayDepth setDesktopColor setDesktopGradient)
"
ScreenController new appearanceMenu startUp
"! !


BackdropManager class removeSelector: #userPicksGradientBackground!

--------------BD3E3FA6E523F71600849D13--





More information about the Squeak-dev mailing list