Smalltalk から Scratchのブロックを組み立てる

build.st

| master numbersTable numbersPosition commonParts toShowParts toHideParts |
"assume there are sprites named 'master' and 'separator', then run inside ScratchStageMorph"

(self sprites
 reject: [:x| {'master' asUTF8. 'separator' asUTF8} includes:  x objName]) do: [:x | x delete].

master _ self sprites detect: [:x| x objName = 'master'].

numbersTable := #(

#(
#(0 0 1 0 0) 
#(1 0 0 0 1) 
#(0 0 0 0 0) 
#(1 0 0 0 1) 
#(0 0 0 0 0) 
#(1 0 0 0 1) 
#(0 0 1 0 0)
) 

#(
#(0 0 1 0 0) 
#(0 0 0 0 0) 
#(1 0 1 0 0) 
#(0 0 0 0 0) 
#(0 0 1 0 0) 
#(0 0 0 0 0) 
#(1 0 1 0 1)
) 

#(
#(0 0 1 0 0) 
#(1 0 0 0 1) 
#(0 0 0 0 0) 
#(0 0 1 0 0) 
#(1 0 0 0 0) 
#(0 0 0 0 0) 
#(1 0 1 0 1)
) 

#(
#(0 0 1 0 0) 
#(1 0 0 0 1) 
#(0 0 0 0 0) 
#(0 0 0 1 0) 
#(0 0 0 0 0) 
#(1 0 0 0 1) 
#(0 0 1 0 0)
) 

#(
#(0 0 1 0 0) 
#(0 0 0 0 0) 
#(0 1 0 0 0) 
#(0 0 0 0 0) 
#(1 0 1 0 1) 
#(0 0 0 0 0) 
#(0 0 1 0 0)
) 

#(
#(1 0 1 0 1) 
#(0 0 0 0 0) 
#(1 0 1 0 0) 
#(0 0 0 0 1) 
#(0 0 0 0 0) 
#(1 0 0 0 1) 
#(0 0 1 0 0)
) 

#(
#(0 0 1 0 0) 
#(1 0 0 0 0) 
#(0 0 1 0 0) 
#(1 0 0 0 1) 
#(0 0 0 0 0) 
#(1 0 0 0 1) 
#(0 0 1 0 0)
) 

#(
#(1 0 1 0 1) 
#(0 0 0 0 0) 
#(0 0 0 0 1) 
#(0 0 0 0 0) 
#(0 0 1 0 0) 
#(0 0 0 0 0) 
#(0 0 1 0 0)
) 

#(
#(0 0 1 0 0) 
#(1 0 0 0 1) 
#(0 0 0 0 0) 
#(1 0 1 0 1) 
#(0 0 0 0 0) 
#(1 0 0 0 1) 
#(0 0 1 0 0)
) 

#(
#(0 0 1 0 0) 
#(1 0 0 0 1) 
#(0 0 0 0 0) 
#(1 0 0 0 1) 
#(0 0 1 0 0) 
#(0 0 0 0 1) 
#(0 0 1 0 0)
)
).

numbersPosition := numbersTable collect:[ :num||buf|
  buf := OrderedCollection new.
  1 to: 7 do: [:y|
    1 to: 5 do: [:x|
	  ((num at: y) at: x) = 1 ifTrue:[
		  buf add: x @ y.
		].
	 ]
  ].
  buf.
].

commonParts _ [:sprite :prefix :number ||block1 block2|
  block1 _ (sprite blockFromSpec:#('when I receive %e' E -) 
		color: (sprite class blockColorFor: 'control'))
		eventName: prefix,'-', number asString.
  block2 _ (sprite blockFromSpec:#('glide %n secs to x:%n y:%n' t glideSecs:toX:y:elapsed:from: 0.1 50 50)
    color: (sprite class blockColorFor: 'motion')).
  block2
   defaultArgs: #(0.1 0 0);
   replaceArgMorph: (block2 argMorphs at: 2) 
  	by: (sprite blockFromSpec: #('mouse x' r mouseX) color: (sprite class blockColorFor: 'sensing'));
   replaceArgMorph: (block2 argMorphs at: 3) 
  	by: (sprite blockFromSpec: #('mouse y' r mouseY) color: (sprite class blockColorFor: 'sensing')).

  { block1. block2}
].

toShowParts _ [:sprite :prefix :number :base :point||newPoint|
  newPoint _ point * 8.
  (commonParts value: sprite value: prefix value: number),
  {
    sprite blockFromSpec:#('show' - show) color: (sprite class blockColorFor: 'looks').
    (sprite blockFromSpec:#('glide %n secs to x:%n y:%n' t glideSecs:toX:y:elapsed:from: 0.1 150 50)
		color: (sprite class blockColorFor: 'motion'))
		defaultArgs: {0.25. base x + newPoint x. base y - newPoint y}
  }
].

toHideParts _ [:sprite :prefix :number|
  (commonParts value: sprite value: prefix value: number),
  {
    sprite blockFromSpec:#('hide' - hide) color: (sprite class blockColorFor: 'looks')
  }
].

{
  {'hour-2'. (-21 * 8)@0}. {'hour-1'. (-15 * 8)@0}.
  {'min-2'. (-6 * 8)@0}. {'min-1'. (0 * 8)@0}.
  {'sec-2'. (9 * 8)@0}. {'sec-1'. (15 * 8)@0}
}  do: [:xs|| prefix base|
  prefix _ (xs at: 1).
  base _ xs at: 2.
  1 to: 9 do: [:i||sprite|
    sprite _ master fullCopy.
    self addMorphFront: sprite.
    self sprites addLast: sprite.

    0 to: 9 do: [:number||point|
      point _ (numbersPosition at: (number + 1)) at: i ifAbsent: [nil].
      (point ifNil: [ toHideParts value: sprite value: prefix value: number]
                     ifNotNil: [ toShowParts valueWithArguments: {sprite. prefix. number. base. point} ])
        inject: sprite blocksBin into: [:acc :x| acc addMorph: x. x]
    ]  
  ]
]