'From Squeak3.1alpha of 4 February 2001 [latest update: #3681] on 21 February 2001 at 9:38:09 pm'! "Change Set: UnivTiles11-tk Date: 21 February 2001 Author: Ted Kaehler (Republished 16 Mar because it was left out of the 3.1 update stream.) Adds a delete button to the popUp controls for each line of a script that is in universalTiles. Adds a color patch any SyntaxMorph that would evalutate to a color. You must select the tiles to see the patch. Click on the patch and choose a color -- the method tiles are rewritten to reflect the new color. Not done: Add the color patch when the tiles are created, rather than when they are selected. Color patch is not deselected when tiles are. Color patch does not look quite right."! !ColorPickerMorph methodsFor: 'menu' stamp: 'tk 2/21/2001 17:54'! pickUpColorFor: aMorph "Show the eyedropper cursor, and modally track the mouse through a mouse-down and mouse-up cycle" | aHand localPt | aHand _ aMorph ifNil: [self activeHand] ifNotNil: [aMorph activeHand]. aHand ifNil: [aHand _ self currentHand]. self addToWorld: aHand world near: (aMorph ifNil: [aHand world]) fullBounds. self owner ifNil: [^ self]. aHand showTemporaryCursor: (ScriptingSystem formAtKey: #Eyedropper) hotSpotOffset: 6 negated @ 4 negated. "<<<< the form was changed a bit??" self updateContinuously: false. [Sensor anyButtonPressed] whileFalse: [self trackColorUnderMouse]. self deleteAllBalloons. localPt _ Sensor cursorPoint - self topLeft. self inhibitDragging ifFalse: [ (DragBox containsPoint: localPt) ifTrue: ["Click or drag the drag-dot means to anchor as a modeless picker" ^ self anchorAndRunModeless: aHand]. ]. (clickedTranslucency _ TransparentBox containsPoint: localPt) ifTrue: [selectedColor _ originalColor]. self updateContinuously: true. [Sensor anyButtonPressed] whileTrue: [self updateTargetColorWith: self indicateColorUnderMouse]. aHand newMouseFocus: nil; showTemporaryCursor: nil; flushEvents. self delete. ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 2/21/2001 21:11'! colorChangedForSubmorph: colorPatch | sel newSel cc ms phrase completeMsg | "reporting a color change" (self nodeClassIs: MessageNode) ifFalse: [^ nil]. (sel _ self selector) ifNil: [^ nil]. (Color colorNames includes: sel) | (sel == #r:g:b:) ifFalse: [^ nil]. "a standard color name" "replace self with new tiles from the color" (newSel _ (cc _ colorPatch color) name) ifNil: [ms _ MessageSend receiver: Color selector: #r:g:b: arguments: (Array with: cc red with: cc green with: cc blue). phrase _ ms asTilesIn: Color] ifNotNil: [ms _ MessageSend receiver: Color selector: newSel arguments: #(). phrase _ ms asTilesIn: Color]. self deletePopup. completeMsg _ self isNoun ifTrue: [self] ifFalse: [owner]. completeMsg owner replaceSubmorph: completeMsg by: phrase. "rec setSelection: {rec. nil. rec}." phrase acceptIfInScriptor.! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 2/21/2001 21:04'! colorPatch "Return a color patch button that lets the user choose a color and modifies the code" | cc patch sel completeMsg | (self nodeClassIs: MessageNode) ifFalse: [^ nil]. (sel _ self selector) ifNil: [^ nil]. (Color colorNames includes: sel) | (sel == #r:g:b:) ifFalse: [^ nil]. "a standard color name" completeMsg _ self isNoun ifTrue: [self] ifFalse: [owner]. (cc _ completeMsg try) class == Color ifFalse: [^ nil]. patch _ ColorTileMorph new colorSwatchColor: cc. "sends colorChangedForSubmorph: to the messageNode" patch color: self color. patch submorphs last delete. ^ patch! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 2/21/2001 16:37'! deleteLine | temp | temp _ owner. self deletePopup. self delete. temp setSelection: nil. temp acceptIfInScriptor.! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 2/21/2001 13:09'! dismisser "Return the icon to delete this line of tiles. I am an entire line in a block." | handle handleSpec colorToUse iconName form | (owner isSyntaxMorph and: [owner nodeClassIs: BlockNode]) ifFalse: [^ nil]. handleSpec _ Preferences haloSpecifications fourth. "dismiss" handle _ EllipseMorph newBounds: (Rectangle center: 10@10 extent: 16 asPoint) color: (colorToUse _ Color colorFrom: handleSpec color). iconName _ handleSpec iconSymbol. form _ ScriptingSystem formAtKey: iconName. "#'Halo-Dismiss'" handle addMorphCentered: (ImageMorph new image: form; color: colorToUse makeForegroundColor; lock). handle on: #mouseDown send: #deleteLine to: self. ^ handle! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 2/21/2001 18:22'! offerPopUp "Put up a halo to allow user to change Literals (Integer, true), Selector (beep: sound, +,-,*,//,\\, r:g:b:, setX: incX: decX: for any X,), Variable (Color), not AssignmentNode (_ inc dec), Extend arrows on each literal, variable, and message, (block that is by itself). Retract arrows on each literal or variable, or message or block that is an argument. Any literal can be changed by Shift-clicking and typing." | panel any upDown retract extend colorPatch edge outside dismiss rr | (self hasProperty: #myPopup) ifTrue: [^ self]. "already has one" ((outside _ self rootTile owner) isKindOf: AlignmentMorph) ifTrue: [^ self]. "can't put panel in right place" any _ false. (upDown _ self upDownArrows) ifNotNil: [any _ true]. (retract _ self retractArrow) ifNotNil: [any _ true]. (extend _ self extendArrow) ifNotNil: [any _ true]. (dismiss _ self dismisser) ifNotNil: [any _ true]. submorphs last class == ColorTileMorph ifFalse: [ (colorPatch _ self colorPatch) ifNotNil: [any _ true]]. any ifFalse: [^ self]. "Transcript cr; print: parseNode class; space; print: (self hasProperty: #myPopup); endEntry." panel _ RectangleMorph new color: Color transparent; borderWidth: 0. upDown ifNotNil: [ panel addMorphBack: upDown first. upDown first align: upDown first topLeft with: panel topLeft. panel addMorphBack: upDown second. upDown second align: upDown second topLeft with: upDown first bottomLeft]. rr _ self right. colorPatch ifNotNil: [ rr _ rr + colorPatch submorphs first width + 1. self addMorphBack: colorPatch. "always in tile" "colorPatch align: colorPatch topLeft with: panel topLeft + (1@1)"]. retract ifNotNil: [ edge _ panel submorphs size = 0 ifTrue: [panel left] ifFalse: [panel submorphs last right]. panel addMorphBack: retract. retract align: retract topLeft with: (edge+2) @ (panel top + 3)]. extend ifNotNil: [ edge _ panel submorphs size = 0 ifTrue: [panel left] ifFalse: [panel submorphs last right]. panel addMorphBack: extend. extend align: extend topLeft with: (edge+2) @ (panel top + 3)]. dismiss ifNotNil: [ edge _ panel submorphs size = 0 ifTrue: [panel left] ifFalse: [panel submorphs last right]. panel addMorphBack: dismiss. dismiss align: dismiss topLeft with: (edge+2) @ (panel top + 1)]. panel align: panel topLeft with: rr @ self top. panel extent: panel submorphs last bottomRight - panel topLeft. self setProperty: #myPopup toValue: panel. outside addMorphFront: panel. ! ! !SyntaxMorph methodsFor: 'pop ups' stamp: 'tk 2/21/2001 13:26'! retract "replace this message with its receiver. I am the message node." | rec cascade | self isCascadePart ifTrue: ["This is a piece of a cascaded message -- just delete it" self deletePopup. cascade _ owner. self delete. cascade setSelection: {cascade. nil. cascade}. ^ cascade acceptIfInScriptor]. rec _ submorphs detect: [:ss | ss isSyntaxMorph and: [ss parseNode ~~ nil]]. self deletePopup. owner replaceSubmorph: self by: rec. rec setSelection: {rec. nil. rec}. rec acceptIfInScriptor.! ! !TileMorph methodsFor: 'misc' stamp: 'tk 2/21/2001 20:07'! colorChangedForSubmorph: aSubmorph "Invoked when the user selects a new color on a colorTile or a color-seer-tile; need to recompile the script." self acceptNewLiteral owner ifNil: [^ self]. owner isTileLike ifFalse: [owner colorChangedForSubmorph: aSubmorph].! ! SyntaxMorph removeSelector: #chooseColor!