Scratch

'From MIT Squeak 0.9.4 (June 1, 2003) [No updates present.] on 5 November 2011 at 9:11:00 am'!
ChoiceArgMorph subclass: #AnyArgMorph
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Scratch-Blocks'!
ArgMorph subclass: #MultiArgMorph
    instanceVariableNames: 'args addMorph removeMorph template '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Scratch-Blocks'!
ExpressionArgMorph subclass: #SourceArgMorph
    instanceVariableNames: 'resizeMorph resizePoint '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Scratch-Blocks'!

!AnyArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 16:16'!
acceptsDroppedReporters

    ^ true! !

!AnyArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 16:16'!
acceptsTypeOf: aBlock

    ^ true! !

!AnyArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 16:19'!
checkbox

    | toggleButton |
    toggleButton _ ToggleButton
        onForm: (ScratchFrameMorph skinAt: #watcherButtonPressed)
        offForm: (ScratchFrameMorph skinAt: #watcherButton).

    toggleButton borderWidth: 0.
    ^ toggleButton! !

!AnyArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 16:21'!
choice: aSymbol

    aSymbol = choice ifTrue: [^ self].

    labelMorph delete.

    choice := aSymbol.
    aSymbol = #string ifTrue: [labelMorph := ExpressionArgMorph new stringExpression: ''].
    aSymbol = #number ifTrue: [labelMorph := ExpressionArgMorph new numExpression: 10].
    aSymbol = #boolean ifTrue: [labelMorph := self checkbox].
    aSymbol = #color ifTrue: [labelMorph := ColorArgMorph new].
    aSymbol = #sprite ifTrue: [labelMorph := SpriteArgMorph new].
    aSymbol = #list ifTrue: [labelMorph := MultiArgMorph new template: AnyArgMorph new].
    aSymbol = #editor ifTrue: [labelMorph := SourceArgMorph new].

    self addMorph: labelMorph.

    self fixArgLayout.! !

!AnyArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 16:22'!
evaluate

    choice = #boolean ifTrue: [^ labelMorph isOn].
    ^ labelMorph evaluate! !

!AnyArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 16:14'!
fixArgLayout

    owner ifNotNil: [self color: (owner color mixed: 0.75 with: (Color gray: 0.45))].
    labelMorph position: self position + borderWidth + (3 @ 1).
    self extent: (labelMorph extent + (16@3) + borderWidth).

    menuIconMorph position: (self right - borderWidth - 10)@(self top + borderWidth + 4).! !

!AnyArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 16:10'!
initialize

    super initialize.
    options := #(string number boolean color sprite list editor).
    self choice: #string! !


!BlockMorph methodsFor: 'dropping/grabbing' stamp: 'nfd 11/1/2011 15:33'!
aboutToBeGrabbedBy: aHandMorph
    "If I'm being used as an argument, replace myself with an appropriate argument morph. Copied from WatcherMorph."

    | m |
    (owner isKindOf: CommandBlockMorph) | (owner isKindOf: WhenHatBlockMorph) | (owner isKindOf: MultiArgMorph) ifTrue: [
        "if I was being used as argument, replace myself with a generic argument morph"
        m _ owner argMorphToReplace: self.
        m ifNotNil: [owner replaceArgMorph: self by: m]].
! !

!BlockMorph methodsFor: 'dropping/grabbing' stamp: 'nfd 11/1/2011 15:48'!
handleReporterDrop
    "This block, a reporter, has just been dropped. Try to embed it in a command block."

    | scriptsMorph argM argOwner |
    (self isReporter and: [owner isKindOf: ScratchScriptsMorph]) ifFalse: [^ self].
    scriptsMorph _ owner.

    argM _ owner topArgMorphAt: self bounds exclude: self.
    (argM notNil and: [(argM respondsTo: #acceptsTypeOf:) not or: [argM acceptsTypeOf: self]]) ifFalse: [^ self].

    (argM isKindOf: BlockMorph)
        ifTrue: [
            argOwner _ argM owner.
            argOwner replaceArgMorph: argM by: self.
            scriptsMorph addMorph: argM.
            argM position: (argOwner left+90)@(argM top - 20)]
        ifFalse: [
            argM owner replaceArgMorph: argM by: self].
! !


!CommandBlockMorph methodsFor: 'menus' stamp: 'nfd 11/1/2011 15:13'!
tabToNextField: evt
    "Move the keyboard focus to the next submorph that responds to keyboard events."

    | fields current |
    fields _ OrderedCollection new.
    argMorphs do: [:m |
        (m isKindOf: ExpressionArgMorph) ifTrue: [fields add: m].
        ((m isKindOf: MultiArgMorph) and: [m template isKindOf: ExpressionArgMorph]) ifTrue: [
            fields addAll: m args]].

    current _ (1 to: fields size) detect: [:i | (fields at: i) labelMorph == evt hand keyboardFocus] ifNone: [fields size].
    evt hand newKeyboardFocus: (fields at: (current \\ fields size) + 1) labelMorph.
! !

!CommandBlockMorph methodsFor: 'private' stamp: 'nfd 11/1/2011 16:04'!
uncoloredArgMorphFor: specString
    "Answer an argument morph for the given argument specification string."

    | code |
    code _ specString at: 2.
    $a = code ifTrue: [^ AttributeArgMorph new choice: 'volume'].
    $b = code ifTrue: [^ BooleanArgMorph new].
    $c = code ifTrue: [^ ColorArgMorph new showPalette: true].
    $C = code ifTrue: [^ ColorArgMorph new showPalette: false].  "don't use palette; pick from screen"
    $d = code ifTrue: [^ ExpressionArgMorphWithMenu new numExpression: '0'; menuSelector: #directionMenu].
    $D = code ifTrue: [^ ExpressionArgMorphWithMenu new numExpression: '48'; menuSelector: #midiDrumMenu].
    $e = code ifTrue: [^ EventTitleMorph new].
    $f = code ifTrue: [^ ChoiceArgMorph new getOptionsSelector: #mathFunctionNames; choice: 'sqrt'].
    $g = code ifTrue: [^ ChoiceArgMorph new getOptionsSelector: #graphicEffectNames; choice: 'color'].
    $H = code ifTrue: [^ ChoiceArgMorph new getOptionsSelector: #hookupSensorNames].
    $h = code ifTrue: [^ ChoiceArgMorph new getOptionsSelector: #hookupBooleanSensorNames].
    $I = code ifTrue: [^ ExpressionArgMorphWithMenu new numExpression: '1'; menuSelector: #midiInstrumentMenu].
    $i = code ifTrue: [^ ExpressionArgMorphWithMenu new numExpression: '1'; menuSelector: #listIndexMenu].
    $k = code ifTrue: [^ ChoiceArgMorph new getOptionsSelector: #keyNames; choice: 'space'].
    $L = code ifTrue: [^ ChoiceArgMorph new getOptionsSelector: #listVarMenu].
    $l = code ifTrue: [^ ChoiceOrExpressionArgMorph new getOptionsSelector: #costumeNames; choice: 'costume1'].
    $m = code ifTrue: [^ SpriteArgMorph new].
    $M = code ifTrue: [^ ChoiceArgMorph new getOptionsSelector: #motorNames].
    $n = code ifTrue: [^ ExpressionArgMorph new numExpression: '10'].
    $N = code ifTrue: [^ ExpressionArgMorphWithMenu new numExpression: '60'; menuSelector: #noteSelector].
    $s = code ifTrue: [^ ExpressionArgMorph new stringExpression: ''].
    $S = code ifTrue: [^ ChoiceOrExpressionArgMorph new getOptionsSelector: #soundNames; choice: 'pop'].
    $T = code ifTrue: [^ SourceArgMorph new].
    $t = code ifTrue: [^ MultiArgMorph new template: (ExpressionArgMorph new stringExpression: '')].
    $Q = code ifTrue: [^ MultiArgMorph new template: AnyArgMorph new].
    $v = code ifTrue: [^ ChoiceArgMorph new getOptionsSelector: #varNamesMenu; choice: ''].
    $W = code ifTrue: [^ ChoiceArgMorph new getOptionsSelector: #motorDirection].
    $x = code ifTrue: [^ ChoiceOrExpressionArgMorph new getOptionsSelector: #sceneNames; choice: ''].
    $y = code ifTrue: [^ ExpressionArgMorphWithMenu new numExpression: '1'; menuSelector: #listIndexForDeleteMenu].

    ^ ExpressionArgMorph new numExpression: '10'
! !


!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 22:35'!
addArg

    | arg |
    arg := template fullCopy.
    self addMorph: arg.
    args add: arg.
    self fixArgLayout! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 22:01'!
addArg: arg

    args add: arg.
    self addMorph: arg.! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 15:46'!
adder

    ^ addMorph! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 15:34'!
argMorphToReplace: aBlock

    ^ template fullCopy! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 23:06'!
args

    ^ args! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 21:18'!
clearArgs

    args do: [:a |
        a delete].
    args := OrderedCollection new.! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 22:48'!
evaluate

    ^ args collect: [:a | a evaluate]! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 16:38'!
fixArgLayout

    | argsp x h |
    
    owner ifNotNil: [self color: owner color].
    args size = 0
        ifTrue: [
            removeMorph delete.
            argsp := {addMorph}]
        ifFalse: [
            self addMorph: removeMorph.
            argsp := args, {removeMorph. addMorph}].
    h := argsp inject: 0 into: [:a :b | a max: b height].
    x := 0.
    argsp do: [:a |
        (a respondsTo: #fixArgLayout) ifTrue: [a fixArgLayout].
        (a respondsTo: #fixBlockLayout) ifTrue: [a fixBlockLayout].
        a position: x@(h - a height // 2) + self position.
        x := x + a width + ((a isKindOf: ImageMorph) ifTrue: [0] ifFalse: [3])].

    self extent: x @ h.
! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 22:21'!
fullCopyX

    | c |
    c := MultiArgMorph new template: template; clearArgs.
    args do: [:a | c addArg].
    c fixArgLayout.
    ^ c! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 21:30'!
handlesMouseDown: evt

    ^ true! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 21:26'!
initialize

    | arrow |
    super initialize.
    args := OrderedCollection new.
    arrow := ScratchFrameMorph skinAt: #arrowClosedComment.
    addMorph := ImageMorph new form: arrow.
    removeMorph := ImageMorph new form: (arrow flipBy: #horizontal centerAt: arrow center).
    self color: Color transparent;
        borderWidth: 0;
        addMorph: addMorph;
        addMorph: removeMorph.! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 21:32'!
mouseDown: evt

    (addMorph bounds containsPoint: evt cursorPoint)
        ifTrue: [self addArg]
        ifFalse: [
            (removeMorph bounds containsPoint: evt cursorPoint) & (args size > 0)
                ifTrue: [self removeArg]].! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 15:42'!
removeArg

    | a scriptsMorph |
    (a := args removeLast) delete.
    (a isKindOf: BlockMorph) ifTrue: [
        (scriptsMorph := self ownerThatIsA: ScratchScriptsMorph) ifNotNil: [
            scriptsMorph addMorph: a.
            a position: (a owner left+90)@(a top - 20)]].
    self fixArgLayout.! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 11/1/2011 15:49'!
replaceArgMorph: arg by: b

    arg == addMorph
        ifTrue: [self addArg: b]
        ifFalse: [
            self replaceSubmorph: arg by: b.
            args at: (args indexOf: arg) put: b].
    self fixArgLayout.! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 21:12'!
template

    ^ template! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 22:35'!
template: t

    self clearArgs.
    template := t.
    self addArg.! !

!MultiArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 23:12'!
updateReferencesUsing: aDictionary

    super updateReferencesUsing: aDictionary.
    args := args collect: [:a | aDictionary at: a ifAbsent: [a]].! !


!ScratchScriptsMorph methodsFor: 'stepping' stamp: 'nfd 11/1/2011 15:48'!
step
    "Give feedback about possible drop targets."

    | feedbackColor h b targetArg targetAssoc targetP targetBlock |

    feedbackMorph
        ifNil: [feedbackMorph _ BorderedMorph new borderWidth: 3]  "create feedback morph if necessary"
        ifNotNil: [feedbackMorph delete].  "remove old feedback"
    feedbackColor _ Color white.
    feedbackMorph useSquareCorners.

    h _ World activeHand.
    h toolType = 'CutTool' ifTrue: [^ self showDeleteFeedback].

    (self bounds containsPoint: h position) ifFalse: [^ self].
    h submorphCount = 1 ifFalse: [^ self].
    b _ h firstSubmorph.
    (b isKindOf: ScratchCommentMorph) ifTrue: [^ self showCommentDropFeedback].
    (b isKindOf: BlockMorph) ifFalse: [^ self].

"attempt at auto-scrolling (has some issues, commented out for now):

    ((self owner bounds containsPoint: h position) and:
        [(h position x - self owner left) < 50 or: [
            (self owner right - h position x) < 50 or: [
                (self owner bottom - h position y) < 50 or: [
                    (h position y - self owner top) < 50]]]])
        ifTrue:[self owner scrollMorphIntoView: h firstSubmorph].
xxxxxxxx"

    b isReporter ifTrue: [ "reporter block"
        (targetArg _ self topArgMorphAt: b bounds exclude: nil) ifNil: [^ self].
        ((targetArg respondsTo: #acceptsTypeOf:) not or: [targetArg acceptsTypeOf: b]) ifFalse: [^ self].
        feedbackMorph
            bounds: (targetArg bounds expandBy: 5);
            color: (feedbackColor alpha: 0.4);
            borderColor: feedbackColor;
            useRoundedCorners.
        ^ self addMorphFront: feedbackMorph].

    "non-reporter (i.e. command block or hat block)"
    targetAssoc _ b closestAttachTargetIn: self.
    targetAssoc ifNil: [
        (b bottomBlock isKindOf: CBlockMorph) ifFalse: [
            targetAssoc _ b bottomBlock closestAttachTargetIn: self.
            targetAssoc ifNotNil:[
                (targetAssoc value owner isKindOf: BlockMorph) ifTrue:[
                    targetAssoc _ nil]]]].
    targetAssoc ifNil: [^ self].

    targetP _ targetAssoc key.
    targetBlock _ targetAssoc value.
    feedbackMorph borderColor: feedbackColor; color: feedbackColor.

    "subtract the attachment point x from the width so that the feedback in CBlock won't stick out"
    ScratchTranslator isRTL
        ifTrue: [feedbackMorph extent: (targetP x - targetBlock left)@5.
            self addMorphFront: (feedbackMorph position: targetP - (feedbackMorph width@0))]
        ifFalse: [feedbackMorph extent: (targetBlock right - targetP x)@5.
            self addMorphFront: (feedbackMorph position: targetP)].
! !

!ScratchScriptsMorph methodsFor: 'stepping' stamp: 'nfd 11/1/2011 15:46'!
topArgMorphAt: aRectangle exclude: aMorph
    "Give feedback about possible drop targets."

    | stack argM |
    "find the top block or stack under the given point, excluding the given morph"
    stack _ submorphs
        detect: [:m | (m ~~ aMorph) and: [(m isKindOf: BlockMorph) and: [m fullBounds intersects: aRectangle]]]
        ifNone: [^ nil].

    stack allMorphsDo: [:b |
        ((b isKindOf: CommandBlockMorph) and:
         [(b isKindOf: HatBlockMorph) not]) ifTrue: [
            1 to: b argumentCount do: [:i |
                argM _ b argumentAt: i.
                (argM isKindOf: MultiArgMorph) ifTrue: [
                    argM args do: [:a |
                        ((a bounds intersects: aRectangle) and:
                         [a acceptsDroppedReporters])
                            ifTrue: [^ a]].
                    "append to multiarg if dropped on the add-arrow"
                    (argM adder bounds intersects: aRectangle) ifTrue: [^ argM adder]].
                    
                ((argM bounds intersects: aRectangle) and:
                 [argM acceptsDroppedReporters])
                    ifTrue: [^ argM]]].
        (b isKindOf: WhenHatBlockMorph) ifTrue: [
            argM _ b argMorph.
            ((argM bounds intersects: aRectangle) and:
             [argM acceptsDroppedReporters])
                ifTrue: [^ argM]]].
    ^ nil
! !


!ScriptableScratchMorph methodsFor: 'other ops' stamp: 'nfd 11/1/2011 16:31'!
call: block withArgs: args

    (block respondsTo: #value) ifFalse: [^ ''].
    ^ block value: args! !

!ScriptableScratchMorph methodsFor: 'other ops' stamp: 'nfd 11/1/2011 16:42'!
sqArgs: plist source: source

    | parms |
    parms := plist inject: '' into: [:a :b | a, ' ', b].
    ^ [:args |
        | astr |
        astr := WriteStream on: (String new: 120).
        astr nextPut: $|;
            nextPutAll: parms;
            nextPut: $|.
        plist doWithIndex: [:param :i |
            astr nextPutAll: param;
                nextPutAll: ' := ';
                nextPutAll: (args at: i) storeString;
                nextPut: $.].
        astr nextPutAll: '^ [';
            nextPutAll: source;
            nextPut: $];
            nextPutAll: ' value'.
        Compiler evaluate: astr contents for: self logged: false]! !


!ScriptableScratchMorph class methodsFor: 'block specs' stamp: 'nfd 11/1/2011 16:04'!
blockSpecs
    "Answer a collection of block specifications for the blocks that are common to all objects. Block specificatons (Arrays) are interspersed with category names (Strings). A block specification is an Array of the form: (<block spec string> <block type> <selector> [optional initial argument values]).

    Explanation of flags:
        -    no flags
        b    boolean reporter
        c    c-shaped block containing a sequence of commands (always special form)
        r    reporter
        s    special form command with its own evaluation rule
        t    timed command, like wait or glide
        E    message event hat
        K    key event hat
        M    mouse-click event hat
        S    start event hat
        W    when <condition> hat (obsolete)"

    | blocks |
    blocks _ #(
        'control'
            ('when %m clicked'                S    -)
            ('when %k key pressed'            K    -)
            ('when %m clicked'                M    -)
            -
            ('wait %n secs'                    t    wait:elapsed:from: 1)
            -
            ('forever'                        c    doForever)
            ('repeat %n'                        c    doRepeat 10)
            -
            ('broadcast %e'                    -    broadcast:)
            ('broadcast %e and wait'            s    doBroadcastAndWait)
            ('when I receive %e'            E    -)
            -
            ('forever if %b'                    c    doForeverIf)
            ('if %b'                            c    doIf)
            ('if %b'                            c    doIfElse)
            ('wait until %b'                    s    doWaitUntil)
            ('repeat until %b'                c    doUntil)
            -
            ('stop script'                    s    doReturn)
            ('stop all'                        -    stopAll)
        'operators'
            ('%n + %n'                        r    + - -)
            ('%n - %n'                        r    - - -)
            ('%n * %n'                        r    * - -)
            ('%n / %n'                        r    / - -)
            -
            ('pick random %n to %n'        r    randomFrom:to: 1 10)
            -
            ('%s < %s'                        b    < '' '')
            ('%s = %s'                        b    = '' '')
            ('%s > %s'                        b    > '' '')
            -
            ('%b and %b'                    b    &)
            ('%b or %b'                        b    |)
            ('not %b'                        b    not)
            -
            ('join %s %s'                    r    concatenate:with: 'hello ' 'world')
            ('letter %n of %s'                r    letter:of: 1 'world')
            ('length of %s'                    r    stringLength: 'world')
            -
            ('%n mod %n'                    r    \\ - -)
            ('round %n'                        r    rounded -)
            -
            ('%f of %n'                        r    computeFunction:of: 'sqrt' 10)
            -
            ('%t -> %T'                        r    sqArgs:source:)
            ('run %s with %Q'                -    call:withArgs:)
            ('call %s with %Q'                r    call:withArgs:)
        'sound'
            ('play sound %S'                -    playSound:)
            ('play sound %S until done'        s    doPlaySoundAndWait)
            ('stop all sounds'                -    stopAllSounds)
            -
            ('play drum %D for %n beats'    t     drum:duration:elapsed:from: 48 0.2)
            ('rest for %n beats'                t     rest:elapsed:from: 0.2)
            -
            ('play note %N for %n beats'    t    noteOn:duration:elapsed:from: 60 0.5)
            ('set instrument to %I'            -     midiInstrument: 1)
            -
            ('change volume by %n'        -     changeVolumeBy: -10)
            ('set volume to %n%'            -     setVolumeTo: 100)
            ('volume'                        r     volume)
            -
            ('change tempo by %n'            -     changeTempoBy: 20)
            ('set tempo to %n bpm'            -     setTempoTo: 60)
            ('tempo'                            r     tempo)
        'motor'
            ('motor on for %n secs'            t    motorOnFor:elapsed:from: 1)
            ('motor on'                        -    allMotorsOn)
            ('motor off'                        -    allMotorsOff)
            ('motor power %n'                -    startMotorPower: 100)
            ('motor direction %W'            -    setMotorDirection: 'this way')
        'variables'
            ('show variable %v'                -    showVariable:)
            ('hide variable %v'                -    hideVariable:)
        'list'
            ('add %s to %L'                    -    append:toList: 'thing')
            -
            ('delete %y of %L'                -    deleteLine:ofList: 1)
            ('insert %s at %i of %L'            -    insert:at:ofList: 'thing' 1)
            ('replace item %i of %L with %s'        -    setLine:ofList:to: 1 'list' 'thing')
            -
            ('item %i of %L'                    r    getLine:ofList: 1)
            ('length of %L'                    r    lineCountOfList:)
            ('%L contains %s'                b    list:contains: 'list' 'thing')
    ).

    ^ blocks, self obsoleteBlockSpecs
! !


!SourceArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 21:10'!
evaluate

    ^ labelMorph contents! !

!SourceArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 22:47'!
fixArgLayout

    super fixArgLayout.

    self extent: self width + 6 @ self height.
    resizeMorph ifNotNil: [resizeMorph position: self right - 6 @ self top; extent: 6@self height].! !

!SourceArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 22:43'!
handlesMouseDown: evt

    ^ true! !

!SourceArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 22:46'!
initialize

    super initialize.
    labelMorph delete.
    labelMorph := MultilineStringMorph new
        growWithText: true;
        font: (ScratchFrameMorph getFont: #Arg);
        color: Color transparent;
        borderWidth: 0.
    resizeMorph := Morph new color: ((Color gray: 0) alpha: 0.3).
    self addMorph: labelMorph.
    self addMorph: resizeMorph.
    self stringExpression: ''.! !

!SourceArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 22:42'!
mouseDown: evt

    resizePoint := evt cursorPoint! !

!SourceArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 22:43'!
mouseMove: evt

    labelMorph width: evt cursorPoint x - resizePoint x + labelMorph width.
    resizePoint := evt cursorPoint.
    self fixArgLayout.! !

!SourceArgMorph methodsFor: 'as yet unclassified' stamp: 'nfd 10/31/2011 21:01'!
stringExpression: aString

    isNumber _ false.
    labelMorph contents: aString.
    self fixArgLayout.
! !


!StringFieldMorph methodsFor: 'event handling' stamp: 'nfd 11/1/2011 15:14'!
keyStroke: evt

    | ch m |
    ch _ evt unicodeChar.
    ch = 0 ifTrue: [ch _ evt keyValue].

    evt buttons = 64 ifTrue: [ch _ ch \\ 32].  "command (alt) key pressed; map to a control key"
    (ch = 3) & (evt buttons = 0) ifTrue: [ch _ 13].  "map enter key to cr"

    ch = 9 ifTrue: [  "tab"
        (m _ self ownerThatIsA: DialogBoxMorph) ifNotNil: [m tabToNextField: evt].
        (m _ self ownerThatIsA: CommandBlockMorph) ifNotNil: [m tabToNextField: evt].
        ^ self].

    (ch = 10) | (ch = 13) ifTrue: [  "cr, lf, or enter key"
        (m _ self ownerThatIsA: DialogBoxMorph) ifNotNil: [^ m enterKeyPressed: evt].
        (m _ self ownerThatIsA: ScratchPrompterMorph) ifNotNil: [^ m enterKeyPressed].
        evt hand newKeyboardFocus: nil.
        ^ self].

    ch = 27 ifTrue: [  "escape key"
        (m _ self ownerThatIsA: DialogBoxMorph) ifNotNil: [m escapeKeyPressed: evt].
        ^ self].

    ch = 8 ifTrue: [^ self backspace].
    ch = 127 ifTrue: [^ self deleteSelection].

    (evt buttons = 64) | (evt buttons = 16) ifTrue: [    "ctrl (or alt) is pressed"
        ch = 1 ifTrue: [self selectAll].        "ctrl-a"
        ch = 3 ifTrue: [self copySelection].     "ctrl-c"
        ch = 22 ifTrue: [self paste].            "ctrl-v"
        ch = 24 ifTrue: [self cutSelection].    "ctrl-x"
        ch = 26 ifTrue: [self undo]].            "ctrl-z"

    evt buttons = 8 ifTrue: [ "shift is pressed"
        ch = 28 ifTrue: [self moveCursorLeftAndSelect].      "shift-left"
        ch = 29 ifTrue: [self moveCursorRightAndSelect].    "shift-right"
        ch = 1 ifTrue: [self moveCursorHomeAndSelect].    "home"
        ch = 4 ifTrue: [self moveCursorEndAndSelect]].    "end"

    evt buttons = 0 ifTrue: [
        ch = 1 ifTrue: [self moveCursorHome].    "home"
        ch = 4 ifTrue: [self moveCursorEnd].        "end"
        ch = 28 ifTrue: [self moveCursorLeft].    "left"
        ch = 29 ifTrue: [self moveCursorRight].    "right"
        blinkState _ true].

    ch >= 32 ifTrue: [self insertCharacter: ch].
! !

MultiArgMorph removeSelector: #copy!
MultiArgMorph removeSelector: #deepCopy!
MultiArgMorph removeSelector: #fixLayout!
MultiArgMorph removeSelector: #fullCopy!
MultiArgMorph removeSelector: #tabToNextField:!
MultiArgMorph removeSelector: #tabToNextFieldX:!