マスク＆落書きで遊ぶ

| lineWidth srcFc srcRect fc fd pts lastPt nextPt minX minY maxX maxY mskRect mskFc dstRect dstFc distance sk |
"線の太さ"
lineWidth _ 10.
fd _ FormCanvas on: Display.
fc _ FormCanvas extent: Display extent.
fc fillColor: Color white.
pts _ OrderedCollection new.
"画像を読み込み表示する"
srcFc _ HTTPSocket
httpJpeg: 'http://www.languagegame.org:8080/zoo/uploads/popo.jpeg'.
srcRect _ Rectangle originFromUser: srcFc extent.
Sensor waitNoButton.
srcFc displayAt: srcRect origin.
"マスク画像を描く"
[Sensor yellowButtonPressed] whileFalse: [
	lastPt _ Sensor cursorPoint.
	pts add: lastPt.
	[Sensor redButtonPressed] whileTrue:[
		nextPt _ Sensor cursorPoint.
		nextPt = lastPt ifFalse:[
			fd line: lastPt to: nextPt width: lineWidth color: (Color red).
			fc line: (lastPt) to: (nextPt) width: lineWidth color: Color red.
			pts add: nextPt.
			lastPt _ nextPt]]].
"マスクの大きさのフォームを作ってマスク画像を転送"
minX _ pts inject: (pts at: 1) x into: [:m :p | m min: p x] .
minY _ pts inject: (pts at: 1) y into: [:m :p | m min: p y] .
maxX _ pts inject: 0 into: [:m :p | m max: p x] .
maxY _ pts inject: 0 into: [:m :p | m max: p y] .
mskRect _ ((minX@minY) corner: (maxX@maxY)) expandBy: lineWidth // 2.
mskFc _ FormCanvas extent: mskRect width @ mskRect height.
mskFc _ fc form copy: mskRect.
"転送先のフォームを作る"
dstRect _ srcRect intersect: mskRect.
dstFc _ FormCanvas extent: mskRect extent.
distance _ dstRect origin - srcRect origin.
dstFc _ srcFc form copy: (distance corner: dstRect extent + distance).
"BitBltでマスク処理"
(BitBlt current toForm: dstFc form) 
	copyForm: mskFc form
	to: (mskRect origin - dstRect origin)
	rule: Form and
	colorMap: (Bitmap with: 16rFFFFFFFF with: 0 ).
"スケッチモーフにする"
"Display restore."
sk _ SketchMorph withForm: dstFc form.
sk openInHand.