'From Squeak3.1alpha of 28 February 2001 [latest update: #4240] on 8 August 2001 at 3:53:01 pm'! Smalltalk renameClassNamed: #ShadowDrawingCanvas as: #ColorMappingCanvas! Canvas subclass: #ColorMappingCanvas instanceVariableNames: 'myCanvas ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Support'! ColorMappingCanvas subclass: #AlphaBlendingCanvas instanceVariableNames: 'alpha ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Support'! ColorMappingCanvas subclass: #ShadowDrawingCanvas instanceVariableNames: 'shadowColor ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Support'! !Canvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:21'! image: aForm at: aPoint sourceRect: sourceRect rule: rule alpha: sourceAlpha "Privately used for blending forms w/ constant alpha. Fall back to simpler case by defaul." ^self image: aForm at: aPoint sourceRect: sourceRect rule: rule! ! !Canvas methodsFor: 'converting' stamp: 'ar 8/8/2001 14:22'! asAlphaBlendingCanvas: alpha ^(AlphaBlendingCanvas on: self) alpha: alpha! ! !Canvas methodsFor: 'converting' stamp: 'ar 8/8/2001 14:14'! asShadowDrawingCanvas: aColor ^(ShadowDrawingCanvas on: self) shadowColor: aColor! ! !ColorMappingCanvas methodsFor: 'initialization' stamp: 'ar 8/8/2001 14:14'! on: aCanvas myCanvas _ aCanvas.! ! !ColorMappingCanvas methodsFor: 'testing' stamp: 'ar 8/8/2001 14:16'! isShadowDrawing ^myCanvas isShadowDrawing! ! !ColorMappingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:15'! image: aForm at: aPoint sourceRect: sourceRect rule: rule "Draw the given form. For the 'paint' combination rule use stenciling otherwise simply fill the source rectangle." ^myCanvas image: aForm at: aPoint sourceRect: sourceRect rule: rule.! ! !ColorMappingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:15'! mapColor: aColor ^aColor! ! !AlphaBlendingCanvas methodsFor: 'initialization' stamp: 'ar 8/8/2001 14:18'! on: aCanvas myCanvas _ aCanvas. alpha _ 1.0.! ! !AlphaBlendingCanvas methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:24'! alpha ^alpha! ! !AlphaBlendingCanvas methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:24'! alpha: newAlpha alpha _ newAlpha.! ! !AlphaBlendingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:24'! image: aForm at: aPoint sourceRect: sourceRect rule: rule "Draw the given form. For the 'paint' combination rule use stenciling otherwise simply fill the source rectangle." rule = Form paint ifTrue:[ ^myCanvas image: aForm at: aPoint sourceRect: sourceRect rule: 31 alpha: alpha. ]. rule = Form over ifTrue:[ ^myCanvas image: aForm at: aPoint sourceRect: sourceRect rule: 30 alpha: alpha. ].! ! !AlphaBlendingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:23'! mapColor: aColor aColor isColor ifFalse:[^aColor]. "Should not happen but who knows..." aColor isTransparent ifTrue:[^aColor]. aColor isOpaque ifTrue:[^aColor alpha: alpha]. ^aColor alpha: (aColor alpha * alpha)! ! !FormCanvas methodsFor: 'drawing-images' stamp: 'ar 8/8/2001 14:21'! image: aForm at: aPoint sourceRect: sourceRect rule: rule alpha: sourceAlpha "Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule." port colorMap: (aForm colormapIfNeededFor: form); fillColor: nil. port image: aForm at: aPoint + origin sourceRect: sourceRect rule: rule alpha: sourceAlpha.! ! !GrafPort methodsFor: 'drawing support' stamp: 'ar 8/8/2001 14:26'! image: aForm at: aPoint sourceRect: sourceRect rule: rule alpha: sourceAlpha "Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule." sourceForm _ aForm. combinationRule _ rule. self sourceRect: sourceRect. self destOrigin: aPoint. self copyBitsTranslucent: (alpha _ (sourceAlpha * 255) truncated min: 255 max: 0).! ! !Morph methodsFor: 'halos and balloon help' stamp: 'ar 8/8/2001 14:48'! addMagicHaloFor: aHand | halo prospectiveHaloClass | prospectiveHaloClass _ Smalltalk at: self haloClass ifAbsent: [HaloMorph]. halo _ prospectiveHaloClass new bounds: self worldBoundsForHalo. halo popUpMagicallyFor: self hand: aHand.! ! !Morph methodsFor: 'halos and balloon help' stamp: 'ar 8/8/2001 15:40'! haloDelayTime "Return the number of milliseconds before a halo should be put up on the receiver. The halo will only be put up if the receiver responds to #wantsHalo by returning true." ^800! ! !Morph methodsFor: 'events-processing' stamp: 'ar 8/8/2001 15:29'! handleMouseEnter: anEvent "System level event handling." (anEvent isDraggingEvent) ifTrue:[ (self handlesMouseOverDragging: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnterDragging: anEvent]. ^self]. self wantsHalo "If receiver wants halo and balloon, trigger balloon after halo" ifTrue:[anEvent hand triggerHaloFor: self after: self haloDelayTime] ifFalse:[self wantsBalloon ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]]. (self handlesMouseOver: anEvent) ifTrue:[ anEvent wasHandled: true. self mouseEnter: anEvent. ].! ! !HaloMorph methodsFor: 'initialization' stamp: 'ar 8/8/2001 15:40'! delete | label | target ifNotNil:[target hasHalo: false]. (label _ self findA: NameStringInHalo) ifNotNil: [label hasFocus ifTrue: [label lostFocusWithoutAccepting]]. self isMagicHalo: false. Preferences haloTransitions ifTrue:[ self stopStepping; startStepping. self startSteppingSelector: #fadeOutFinally. ] ifFalse:[ super delete. ].! ! !HaloMorph methodsFor: 'initialization' stamp: 'ar 8/8/2001 14:34'! initialize super initialize. self color: (Color r: 0.6 g: 0.8 b: 1.0). growingOrRotating _ false. simpleMode _ Preferences simpleHalosInForce.! ! !HaloMorph methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:35'! isMagicHalo ^self valueOfProperty: #isMagicHalo ifAbsent:[false].! ! !HaloMorph methodsFor: 'accessing' stamp: 'ar 8/8/2001 15:37'! isMagicHalo: aBool self setProperty: #isMagicHalo toValue: aBool. aBool ifFalse:[ "Reset everything" self stopStepping. "get rid of all" self startStepping. "only those of interest" ].! ! !HaloMorph methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:28'! magicAlpha ^self valueOfProperty: #magicAlpha ifAbsent:[1.0]! ! !HaloMorph methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:42'! magicAlpha: alpha self setProperty: #magicAlpha toValue: alpha. self changed.! ! !HaloMorph methodsFor: 'drawing' stamp: 'ar 8/8/2001 15:13'! drawSubmorphsOn: aCanvas | alpha | ((alpha _ self magicAlpha) = 1.0) ifTrue:[^super drawSubmorphsOn: aCanvas]. ^super drawSubmorphsOn: (aCanvas asAlphaBlendingCanvas: alpha)! ! !HaloMorph methodsFor: 'events' stamp: 'ar 8/8/2001 15:11'! popUpFor: aMorph event: evt "This message is sent by morphs that explicitly request the halo on a button click. Note: anEvent is in aMorphs coordinate frame." | hand anEvent | self flag: #workAround. "We should really have some event/hand here..." evt isNil ifTrue:[ hand _ aMorph world activeHand. hand ifNil:[hand _ aMorph world primaryHand]. anEvent _ hand lastEvent transformedBy: (aMorph transformedFrom: nil)] ifFalse:[hand _ evt hand. anEvent _ evt]. self target: aMorph. hand halo: self. hand world addMorphFront: self. positionOffset _ anEvent position - (aMorph point: aMorph position in: owner). self startStepping. Preferences haloTransitions ifTrue:[ self magicAlpha: 0.0. self startSteppingSelector: #fadeInInitially. ].! ! !HaloMorph methodsFor: 'events' stamp: 'ar 8/8/2001 15:50'! popUpMagicallyFor: aMorph hand: aHand "Programatically pop up a halo for a given hand." Preferences magicHalos ifTrue:[ self isMagicHalo: true. self magicAlpha: 0.2]. self target: aMorph. aHand halo: self. aHand world addMorphFront: self. Preferences haloTransitions ifTrue:[ self magicAlpha: 0.0. self startSteppingSelector: #fadeInInitially. ]. positionOffset _ aHand position - (aMorph point: aMorph position in: owner). self startStepping.! ! !HaloMorph methodsFor: 'stepping' stamp: 'ar 8/8/2001 14:56'! fadeIn self magicAlpha >= 1.0 ifTrue:[self stopSteppingSelector: #fadeIn]. self magicAlpha: ((self magicAlpha + 0.1) min: 1.0) ! ! !HaloMorph methodsFor: 'stepping' stamp: 'ar 8/8/2001 15:44'! fadeInInitially | max | max _ self isMagicHalo ifTrue:[0.3] ifFalse:[1.0]. self magicAlpha >= max ifTrue:[self stopSteppingSelector: #fadeInInitially]. self magicAlpha: ((self magicAlpha + (max * 0.1)) min: max) ! ! !HaloMorph methodsFor: 'stepping' stamp: 'ar 8/8/2001 14:57'! fadeOut self magicAlpha <= 0.3 ifTrue:[self stopSteppingSelector: #fadeOut]. self magicAlpha: ((self magicAlpha - 0.1) max: 0.3) ! ! !HaloMorph methodsFor: 'stepping' stamp: 'ar 8/8/2001 15:46'! fadeOutFinally self magicAlpha <= 0.05 ifTrue:[^super delete]. self magicAlpha <= 0.3 ifTrue:[ ^self magicAlpha: (self magicAlpha - 0.03 max: 0.0)]. self magicAlpha: ((self magicAlpha * 0.5) max: 0.0) ! ! !HaloMorph methodsFor: 'stepping' stamp: 'ar 8/8/2001 15:38'! handleEntered self isMagicHalo ifFalse:[^self]. self stopStepping; startStepping. self startSteppingSelector: #fadeIn. ! ! !HaloMorph methodsFor: 'stepping' stamp: 'ar 8/8/2001 15:38'! handleLeft self isMagicHalo ifFalse:[^self]. self stopStepping; startStepping. self startSteppingSelector: #fadeOut.! ! !HaloMorph methodsFor: 'private' stamp: 'ar 8/8/2001 14:45'! addHandle: handleSpec on: eventName send: selector to: recipient "Add a handle within the halo box as per the haloSpec, and set it up to respond to the given event by sending the given selector to the given recipient. Return the handle." | handle aPoint iconName colorToUse | aPoint _ self positionIn: haloBox horizontalPlacement: handleSpec horizontalPlacement verticalPlacement: handleSpec verticalPlacement. handle _ EllipseMorph newBounds: (Rectangle center: aPoint extent: HandleSize asPoint) color: (colorToUse _ Color colorFrom: handleSpec color). self addMorph: handle. (iconName _ handleSpec iconSymbol) ifNotNil: [ | form | form _ ScriptingSystem formAtKey: iconName. form ifNotNil: [handle addMorphCentered: (ImageMorph new image: form; color: colorToUse makeForegroundColor; lock)]]. handle on: #mouseUp send: #endInteraction to: self. handle on: eventName send: selector to: recipient. self isMagicHalo ifTrue:[ handle on: #mouseEnter send: #handleEntered to: self. handle on: #mouseLeave send: #handleLeft to: self]. handle setBalloonText: (target balloonHelpTextForHandle: handle). ^ handle ! ! !HaloMorph methodsFor: 'private' stamp: 'ar 8/8/2001 15:33'! endInteraction "Clean up after a user interaction with the a halo control" | m | self isMagicHalo: false. "no longer" self magicAlpha: 1.0. (target isInWorld not or: [owner == nil]) ifTrue: [^ self]. [target isFlexMorph and: [target hasNoScaleOrRotation]] whileTrue: [m _ target firstSubmorph. target removeFlexShell. target _ m]. self isInWorld ifTrue: ["make sure handles show in front, even if flex shell added" self comeToFront. self addHandles]. (self valueOfProperty: #commandInProgress) doIfNotNil: [:cmd | self rememberCommand: cmd. self removeProperty: #commandInProgress] ! ! !HandMorph methodsFor: 'halo handling' stamp: 'ar 8/8/2001 14:49'! removePendingHaloFor: aMorph "Get rid of pending balloon help or halo actions." self removeAlarm: #spawnMagicHaloFor:.! ! !HandMorph methodsFor: 'halo handling' stamp: 'ar 8/8/2001 14:50'! spawnMagicHaloFor: aMorph (self halo notNil and:[self halo target == aMorph]) ifTrue:[^self]. aMorph addMagicHaloFor: self.! ! !HandMorph methodsFor: 'halo handling' stamp: 'ar 8/8/2001 14:51'! triggerHaloFor: aMorph after: timeOut "Trigger automatic halo after the given time out for some morph" self addAlarm: #spawnMagicHaloFor: with: aMorph after: timeOut! ! !ShadowDrawingCanvas methodsFor: 'initialize' stamp: 'ar 8/8/2001 14:14'! on: aCanvas myCanvas _ aCanvas. shadowColor _ Color black.! ! !ShadowDrawingCanvas methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:16'! isShadowDrawing ^true! ! !ShadowDrawingCanvas methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:14'! shadowColor ^shadowColor! ! !ShadowDrawingCanvas methodsFor: 'accessing' stamp: 'ar 8/8/2001 14:14'! shadowColor: aColor shadowColor _ aColor! ! !ShadowDrawingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:13'! image: aForm at: aPoint sourceRect: sourceRect rule: rule "Draw the given form. For the 'paint' combination rule use stenciling otherwise simply fill the source rectangle." rule = Form paint ifTrue:[ ^myCanvas stencil: aForm at: aPoint sourceRect: sourceRect color: shadowColor ] ifFalse:[ ^myCanvas fillRectangle: (sourceRect translateBy: aPoint) color: shadowColor ].! ! !ShadowDrawingCanvas methodsFor: 'private' stamp: 'ar 8/8/2001 14:14'! mapColor: aColor aColor isColor ifFalse:[^aColor]. "Should not happen but who knows..." ^aColor isTransparent ifTrue:[aColor] ifFalse:[shadowColor]! ! HandMorph removeSelector: #spawnHaloFor:! HaloMorph removeSelector: #popUpFor:hand:! Morph removeSelector: #addHaloFor:! ColorMappingCanvas removeSelector: #shadowColor! ColorMappingCanvas removeSelector: #shadowColor:! Canvas subclass: #ColorMappingCanvas instanceVariableNames: 'myCanvas ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Support'! "Postscript: Initialize a few preferences" Preferences addPreference: #haloTransitions category: 'halos' default: false balloonHelp:'When true, make halo transitions use fade-in and fade-out effects'. Preferences addPreference: #magicHalos category: 'halos' default: false balloonHelp:'When true, use "magic" halos for mouse over transitions'.!