'From Cuis 1.0 of 27 August 2009 [latest update: #282] on 3 September 2009 at 7:19:44 pm'!
!classDefinition: #CursorWithAlpha category: #'Graphics-Display Objects'!
Cursor subclass: #CursorWithAlpha
	instanceVariableNames: 'fallback'
	classVariableNames: 'Constants'
	poolDictionaries: ''
	category: 'Graphics-Display Objects'!

!CursorWithAlpha commentStamp: '<historical>' prior: 0!
A 32-bit ARGB Cursor of arbitrary extent (some platforms may limit the size). Compositing assumes alpha is pre-multiplied.!


!Form methodsFor: 'other' stamp: 'bf 8/17/2009 13:08'!
preMultiplyAlpha
	"Pre-multiply each pixel by its alpha, for proper alpha compositing (BitBlt rule 34).
	E.g., half-transparent green 16r7F00FF00 becomes 16r7F007F00"

	depth = 32 ifFalse: [^self].
	1 to: bits size do: [:i |
		| v a r g b |
		v := bits at: i.
		a := v bitShift: -24.
		r := ((v bitShift: -16) bitAnd: 255) * a // 255.
		g := ((v bitShift: -8) bitAnd: 255) * a // 255.
		b := (v bitAnd: 255) * a // 255.
		bits at: i put: (a bitShift: 24) + (r bitShift: 16) + (g bitShift: 8) + b].! !


!Cursor methodsFor: 'testing' stamp: 'jmv 9/3/2009 19:08'!
is: aSymbol
	^ aSymbol = #Cursor or: [ super is: aSymbol ]! !

!Cursor methodsFor: 'converting' stamp: 'jmv 9/3/2009 18:59'!
asBigCursor
	"Big cursors are 32 bits deep (ARGB premultiplied)"
	(width = 16 and: [ height = 16 ])
		ifTrue:[ ^self enlargedBy: 2 ].
	^self! !

!Cursor methodsFor: 'converting' stamp: 'bf 5/10/2007 18:22'!
enlargedBy: scale
	"Big cursors are 32 bits deep (ARGB premultiplied)"
	| big |
	scale = 1 ifTrue: [^self].
	big := CursorWithAlpha extent: self extent * scale depth: 32.
	(self asCursorForm magnifyBy: scale) displayOn: big.
	big offset: (self offset - 0.5 * scale min: 0@0 max: big extent negated) asIntegerPoint.
	big fallback: self.
	^big! !


!Cursor class methodsFor: 'current cursor' stamp: 'jmv 9/3/2009 19:12'!
currentCursor: aCursor 
	"Make the instance of cursor, aCursor, be the current cursor. Display it. 
	Create an error if the argument is not a Cursor."

	(aCursor isKindOf: self)
		ifTrue: [
			CurrentCursor _ aCursor.
			Preferences biggerCursors
				ifTrue: [
					[ ^aCursor asBigCursor beCursor] 
						on: Error do: [ "fall through "]].
			aCursor beCursor]
		ifFalse: [ self error: 'The new cursor must be an instance of class Cursor' ]! !

!Cursor class methodsFor: 'constants' stamp: 'jmv 9/3/2009 19:12'!
normal
	"Answer the instance of me that is the shape of an arrow slanted left."

	^ Preferences biggerCursors
		ifTrue: [ CursorWithAlpha biggerNormal ]
		ifFalse: [ NormalCursor ]! !


!CursorWithAlpha methodsFor: 'accessing' stamp: 'bf 3/30/2007 18:57'!
fallback
	^fallback ifNil: [NormalCursor]! !

!CursorWithAlpha methodsFor: 'accessing' stamp: 'bf 3/30/2007 18:58'!
fallback: aCursor
	fallback := aCursor! !

!CursorWithAlpha methodsFor: 'converting' stamp: 'bf 4/10/2007 18:16'!
asCursorForm

	^ self as: StaticForm! !

!CursorWithAlpha methodsFor: 'primitives' stamp: 'jmv 9/3/2009 18:42'!
beCursor
	<primitive: 101>
	self fallback beCursor! !


!CursorWithAlpha class methodsFor: 'constants' stamp: 'bf 8/17/2009 12:55'!
biggerNormal
	"self biggerNormal show"
	"(Base64MimeConverter mimeEncode: ((FileStream readOnlyFileNamed: 'EtoysCursor.png') binary)) upToEnd"

	^self constants at: #biggerNormal ifAbsentPut: [
		| form cursor |
		form := (PNGReadWriter on: (Base64MimeConverter mimeDecodeToBytes:
			'iVBORw0KGgoAAAANSUhEUgAAABsAAAArCAYAAACJrvP4AAAACXBIWXMAAAsTAAALEwEAmpwY
			AAAEF0lEQVRYCb2XS0hcVxjHj2/G8ZWMQQbSGO2iRhERwRALBmJNoOOqwUXtYtxOTQJxI8SN
			CyXJqggVEghusrAuBB8IddUWF64CvnCj+AJrsYKio6JJOPn/j+dc5s6MztyZMR/857v3PL7f
			/c4595w7QmiTUvrN9ZV7wGhfB3jOunpgOoYtPQQm19fXn6DsulY2PJUSi4ARvLm5+SuiE5hS
			mAsBXSYzv99vLuXExMRL1H2jlRKoDYbAMhS4uLj4PJUwN4K5TTqEhQPHxsZeayCzTCrDqLC0
			tLQryTAqjNmFA1OR4YWwaMBk5/BSWDRgMhnGhEUDJpphXDACqdDXIpEMHcHCF43TDB3Bks0w
			IVj4kMabYcKwcGA8c+gIlp2drRaKGc5wYKwMHcFycnIiYOHACzLkhi9SAgsHRsnQOSzaMBJk
			FPoejo6OvkJ5iZY67R1lZoJe5kOBKysrzxzBCgoKrCcnpKysTO7v75sjMKafmZl5gX6uNPww
			M4EeQXrsEAJDJc7Ozngr8vPzRVVVldjZ2RGrq6uqrLi4WPT394u2tjZxeHj4P8C7qiLkJzMz
			8zNvc3NzT+jR/yl9xDBmZWWpTAoLC2V9fb3c29uTXV1dtuwaGxtVRgcHBzuI0QY91vLBUw+0
			voOnXPyyijBEUWWVlZViampKFBUVCcyDKC8vt9pitYnp6WlmfqO7u/uOVRHjIiKzjIwM2dDQ
			oDIKnZCWlhZbdoFAQFUvLCz8Bcb3WrfgqWItFR/XKrEIWG1trQWam5v7Z3Bw8C2jjoyMyNLS
			UgvIYeYQ05A5h5HA+GE1NTVWgPn5+b/RubWiosJ/enoaZNDq6moLhjrZ19fHYjk7O/sO9/eg
			G1oZ8JTNbJmZJ9Wgn9GyleJQMWhPT48NhnllsTw+Pv4X7WLCuI1YX8TsuLy8/CfKmrXuwt9t
			b2//iXX4LJder9cCut1uOT4+zio5PDz8G9pWaqm4uLaZDaZBXLY2GO4bdnd3PzAowDZYc3Mz
			i+X29vY82l0K4ypR/2JOTk7e49qsIuMLUEbdXFpaes6gk5OT0uPxWECeBGtra6ySvb29v6Bt
			ve7DfjZTsKOjo99RyvkzEOMtGOpuBoPBbQblQsK9Ejfnzs5OFsuNjY0JlF8IQ11clodWeVgo
			bxh0YGDABmOmNGxzh2j3EPJqRV2VqLvUFKyjo+NHBuWqxb4nS0pKVFZmGFG+gihJw8wTerHx
			/kEgXng6y7a2thYxnAHAHkHfavEcoxyZBcOh+AOHixS+7HwnfT4f/6nynSQoaZh5MjWcTU1N
			94aGhtrr6up8qLgPcVFQd7SuwVPmIdN5njk1wmi31a8QHu3VuYVrLhDaf+dOHGgvE4Gp3RsB
			cnUQMx+f9P1H7c9PXyHUIcoy01HXX637AibwgHAnFRPGAAAAAElFTkSuQmCC' 
				readStream) readStream) nextImage.
	cursor := CursorWithAlpha extent: form extent depth: 32.
	form displayOn: cursor.
	cursor offset: -2@-1.
	cursor preMultiplyAlpha.
	cursor]! !

!CursorWithAlpha class methodsFor: 'constants' stamp: 'bf 3/30/2007 18:47'!
constants
	^Constants ifNil: [Constants := Dictionary new]! !

!CursorWithAlpha class methodsFor: 'constants' stamp: 'bf 8/17/2009 12:56'!
resetConstants
	Constants := nil.
! !


!HandMorph methodsFor: 'cursor' stamp: 'jmv 9/3/2009 19:10'!
showTemporaryCursor: cursorOrNil hotSpotOffset: hotSpotOffset 
	"Set the temporary cursor to the given Form.
	If the argument is nil, revert to the normal hardware cursor."

	self changed.
	temporaryCursorOffset 
		ifNotNil: [ bounds := bounds translateBy: temporaryCursorOffset negated ].
	cursorOrNil isNil 
		ifTrue: [temporaryCursor := temporaryCursorOffset := nil]
		ifFalse: [
			temporaryCursor := (Preferences biggerCursors and: [ cursorOrNil is: #Cursor ])
					ifTrue: [ cursorOrNil asBigCursor asCursorForm ]
					ifFalse: [ cursorOrNil asCursorForm ].
			temporaryCursorOffset := temporaryCursor offset - hotSpotOffset ].
	bounds := self cursorBounds.
	self
		userInitials: userInitials andPicture: self userPicture;
		layoutChanged;
		changed! !


!Preferences class methodsFor: 'standard queries'!
biggerCursors
	^ self
		valueOfFlag: #biggerCursors
		ifAbsent: [false]! !

!Preferences class methodsFor: 'bigger and smaller GUI' stamp: 'jmv 9/3/2009 19:17'!
bigFonts
	"Sets not only fonts but other GUI elements
	to fit high resolution or large screens
	Preferences bigFonts
	"
	
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'DejaVu' 11)
		(setListFontTo: 'DejaVu' 11)
		(setMenuFontTo: 'DejaVu' 12)
		(setWindowTitleFontTo: 'DejaVu' 14)
		(setBalloonHelpFontTo: 'DejaVu' 9)
		(setCodeFontTo: 'DejaVu' 11)
		(setButtonFontTo: 'DejaVu' 11)).
	Preferences enable: #biggerCursors! !

!Preferences class methodsFor: 'bigger and smaller GUI' stamp: 'jmv 9/3/2009 19:17'!
hugeFonts
	"Sets not only fonts but other GUI elements
	to fit very high resolution or very large screens
	Preferences hugeFonts
	"
	
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'DejaVu' 17)
		(setListFontTo: 'DejaVu' 17)
		(setMenuFontTo: 'DejaVu' 17)
		(setWindowTitleFontTo: 'DejaVu' 22)
		(setBalloonHelpFontTo: 'DejaVu' 14)
		(setCodeFontTo: 'DejaVu' 17)
		(setButtonFontTo: 'DejaVu' 17)).
	Preferences enable: #biggerCursors! !

!Preferences class methodsFor: 'bigger and smaller GUI' stamp: 'jmv 9/3/2009 19:17'!
smallFonts
	"Sets not only fonts but other GUI elements
	to fit low resolution or small screens
	Preferences smallFonts
	"
	
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'DejaVu' 8)
		(setListFontTo: 'DejaVu' 7)
		(setMenuFontTo: 'DejaVu' 7)
		(setWindowTitleFontTo: 'DejaVu' 9)
		(setBalloonHelpFontTo: 'DejaVu' 7)
		(setCodeFontTo: 'DejaVu' 7)
		(setButtonFontTo: 'DejaVu' 7)).
	Preferences disable: #biggerCursors! !

!Preferences class methodsFor: 'bigger and smaller GUI' stamp: 'jmv 9/3/2009 19:17'!
standardFonts
	"Sets not only fonts but other GUI elements
	to fit regular resolution and size screens
	Preferences standardFonts
	"
	
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'DejaVu' 9)
		(setListFontTo: 'DejaVu' 9)
		(setMenuFontTo: 'DejaVu' 10)
		(setWindowTitleFontTo: 'DejaVu' 12)
		(setBalloonHelpFontTo: 'DejaVu' 8)
		(setCodeFontTo: 'DejaVu' 9)
		(setButtonFontTo: 'DejaVu' 9)).
	Preferences disable: #biggerCursors! !

!Preferences class methodsFor: 'bigger and smaller GUI' stamp: 'jmv 9/3/2009 19:17'!
tinyFonts
	"Sets not only fonts but other GUI elements
	to fit very low resolution or very small screens
	Preferences tinyFonts
	"
	
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'DejaVu' 7)
		(setListFontTo: 'DejaVu' 5)
		(setMenuFontTo: 'DejaVu' 5)
		(setWindowTitleFontTo: 'DejaVu' 7)
		(setBalloonHelpFontTo: 'DejaVu' 5)
		(setCodeFontTo: 'DejaVu' 5)
		(setButtonFontTo: 'DejaVu' 5)).
	Preferences disable: #biggerCursors! !

!Preferences class methodsFor: 'bigger and smaller GUI' stamp: 'jmv 9/3/2009 19:17'!
veryBigFonts
	"Sets not only fonts but other GUI elements
	to fit very high resolution or very large screens
	Preferences veryBigFonts
	"
	
	Preferences setDefaultFonts: #(
		(setSystemFontTo: 'DejaVu' 14)
		(setListFontTo: 'DejaVu' 14)
		(setMenuFontTo: 'DejaVu' 14)
		(setWindowTitleFontTo: 'DejaVu' 17)
		(setBalloonHelpFontTo: 'DejaVu' 11)
		(setCodeFontTo: 'DejaVu' 14)
		(setButtonFontTo: 'DejaVu' 14)).
	Preferences enable: #biggerCursors! !

Preferences class removeSelector: #scrollBarsNarrow!
