'From Squeak3.3alpha of 15 February 2002 [latest update: #4760] on 22 February 2002 at 10:52:33 am'!
"Change Set:		WanderingLetters
Date:			1 February 2001
Author:			Ted Kaehler

This is wandering letters using the old non-Players (and non-multi-instance Players).  Just make a new Morphic Project and file it in.  
	Toggle wandering by clicking the top button.  Responds to Stop and Go buttons so it does not have to be running all the time.
	Toggle method if getting back to their right places with the lower button.
    Change WanderingLetters>>stepTime to make the speed be right."!

PasteUpMorph subclass: #WanderingLetters
	instanceVariableNames: 'letterActors wild leftMargin rightMargin switch current jumpSwitch hotIndex '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Models'!

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 8/20/97 10:15'!
beLeader: letterMorph in: str at: ind
	"Make me a leader by installing variables leed and chars in my workings."

	| chars |
	letterMorph setProperty: #leed toValue: true.
	chars _ str findDelimiters: ' -	()' startingAt: ind.
	letterMorph setProperty: #chars toValue: chars - ind.	"Count me but not space"
	letterMorph setProperty: #wordWidth toValue: -1.		"Compute it later in overEnd"
! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 8/21/97 12:47'!
bounce
	"change velocity if hit a wall"

	| box v |
	(current owner == nil or: [current owner isHandMorph]) ifTrue: [^ self].
	box _ current owner bounds.
	v _ current valueOfProperty: #velocity.
	(current left < box left) ifTrue: [
		current setProperty: #velocity toValue: (v x abs @ v y)].
	(current right > box right) ifTrue: [
		current setProperty: #velocity toValue: (v x abs negated @ v y)].
	(current top < box top) ifTrue: [
		current setProperty: #velocity toValue: (v x @ v y abs)].
	(current bottom > box bottom) ifTrue: [
		current setProperty: #velocity toValue: (v x @ v y abs negated)].! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/22/2002 10:07'!
goButton
	"Find the World's go button"

	World submorphsDo: [:mm | 
		mm knownName = 'script controls' ifTrue: [
			^ mm submorphNamed: 'Go Button']].
	^ nil! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 8/21/97 15:42'!
letterActors: array
	letterActors _ array! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/3/2001 18:51'!
lettersOnTicks: aLetter
	"Tell the letter what to do this cycle."

	| v isNewLine |
	v _ 19.
	current _ aLetter.	"guy we are working on"
	wild ifFalse:
			[isNewLine _ (current valueOfProperty: #leed) ~~ nil and: [self overEnd].
			self place: current after: (current valueOfProperty: #target) newLine: isNewLine]
		ifTrue: [(current valueOfProperty: #velocity) x = 0 
			ifTrue: [current setProperty: #velocity toValue:
					(v atRandom - (v//2)) @ (v atRandom - (v//2))]
			ifFalse: [current position: current position + (current valueOfProperty: #velocity).
				self bounce]]
! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/22/2002 10:50'!
lettersSetup
	"Install all letterActors on the playfield.  Assume leftMargin, rightMargin, and switch morphs are already there."

	| playfield v leader str new formCanvas font letList |
	playfield _ leftMargin owner.
	playfield privateSubmorphs copy do: [:each | 
		each class == ImageMorph ifTrue: [each delete]].	"get rid of old"
	letterActors do: [:each | each delete]. 	"Make sure"
	wild ifFalse: [self toggle].
	font _ ((TextStyle default fontAt: 3) emphasized: 0).	"nil"
	v _ 19.	"make it odd"
	leader _ true.
	str _ 'Have you ever thought what a letter must go through in order to do word-wrap?'.
"	str _ 'Have you ever thought what a letter must go through in order to do word-wrap?'."
	letList _ Array new: str size.
	str doWithIndex: [:letter :ind |  
		new _ ImageMorph new.
		"set my image and bounds here"
		new image: (ColorForm extent: 
			(font widthOfString: (String with: letter)) @ (font height)).
		new form colors: (Array with: Color transparent with: Color black).
		formCanvas _ FormCanvas on: new form.	"remember to change when undo"
		formCanvas text: (String with: letter) bounds: new bounds 
			font: font color: Color black.

		"new rotationStyle: #none."
		new setProperty: #velocity toValue: (v atRandom - (v//2)) @ (v atRandom - (v//2)).
		new setProperty: #letter toValue: letter.
		letList at: ind put: new.
		playfield addMorph: new.
		new position: leftMargin topLeft.
		"alias of guy I follow"
		ind > 1 ifTrue: ["have a guy in front of me"
			new setProperty: #target toValue: (letList at: ind-1)].
		leader ifTrue: [self beLeader: new in: str at: ind.
			leader _ false].
		(' -	()' includes: letter) ifTrue: [leader _ true].
		].
	letterActors _ letList.
! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/3/2001 18:35'!
march: aLetter to: goal
	"Proceed toward the goal, a little at a time.  Set velocity and/or position."
	| dd x y |

	hotIndex ifNotNil: [^ aLetter position: goal].	"snap or hop"

	dd _ goal - aLetter topLeft.	"wander"
	dd abs < (7@7 "5 for old") ifTrue: ["close" ^ aLetter position: goal].
	
	x _ (dd x < 0 ifTrue: [-7] ifFalse: [dd x = 0 ifTrue: [0] ifFalse: [7]]).
	y _ (dd y < 0 ifTrue: [-7] ifFalse: [dd y = 0 ifTrue: [0] ifFalse: [7]]).
	aLetter position: aLetter position + (x@y).! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/3/2001 18:40'!
oneLetterJump
	| hotGuy isNewLine |
	"make one letter (hotIndex) jump directly to his final place.  Just like real text placement"

	hotGuy _ current _ letterActors at: hotIndex.
	isNewLine _ (current valueOfProperty: #leed) ~~ nil and: [self overEnd].
	self place: hotGuy after: (hotGuy valueOfProperty: #target) newLine: isNewLine.
	hotIndex _ hotIndex == letterActors size
		ifTrue: [1]
		ifFalse: [hotIndex+1].! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 8/21/97 12:58'!
overEnd
	"I am a leader (first letter of a word).  Would my word be hanging over the right margin?"

	| width myInd rt target |
	(target _ current valueOfProperty: #target) == nil ifTrue: [^ false].
		"First character in paragraph"
	width _ current valueOfProperty: #wordWidth.
	width < 0 ifTrue: ["recompute"
		width _ 0.
		myInd _ letterActors indexOf: current.
		myInd = 0 ifTrue: [current delete.  ^ false].	"debugging"
		1 to: (current valueOfProperty: #chars) do: [:ind |
			width _ width + (letterActors at: myInd+ind-1) width].
		current setProperty: #wordWidth toValue: width].

	rt _ rightMargin left.
	^ target right + width > rt! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/3/2001 18:53'!
place: aLetter after: prevLetter newLine: isNewLine
	| place |
	"Position this letter.  Put its left edge where the previous letter's right edge is.  Move down to the next line if isNewLine is true.  Add some leading for condensed or expanded text."

	prevLetter 
		ifNil: [place _ leftMargin topRight]
		ifNotNil: [isNewLine 
					ifFalse: [place _ 0 "horiz spacing" @ 0 "slant" + prevLetter topRight]
					ifTrue: [place _ leftMargin right @ (prevLetter bottom + 1 "leading")]].
	self march: aLetter to: place.	"go there"! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/22/2002 10:02'!
setUp
	"Make the morphs     WanderingLetters new setUp     "

	letterActors _ #().
	wild _ false.
	World addMorph: self.
	self goButton ifNil: [
		World addMorphFront: ScriptingSystem scriptControlButtons].
	self position: 100@100; extent: 300@300.
	leftMargin ifNil: [leftMargin _ RectangleMorph new].  
	leftMargin extent: 3@150.
	leftMargin position: 120@120; borderColor: Color lightGray.
	self addMorph: leftMargin.
	rightMargin ifNil: [rightMargin _ RectangleMorph new].  
	rightMargin extent: 3@150.
	rightMargin position: 380@120; borderColor: Color lightGray.
	self addMorph: rightMargin.
	switch ifNil: [switch _ EllipseMorph new].
	switch position: self topLeft - (80@0).
	switch on: #mouseUp send: #toggle to: self.
	self world addMorph: switch.
	jumpSwitch ifNil: [jumpSwitch _ EllipseMorph new].
	jumpSwitch position: self topLeft - (80@-100).
	jumpSwitch on: #mouseUp send: #toggleJumping to: self.
	self world addMorph: jumpSwitch.
	self lettersSetup.
	self addMorphBack: leftMargin.	"behind the letters" 
	self addMorphBack: rightMargin.
	self world presenter startRunningScripts.! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/22/2002 10:02'!
step
	| go |
	"run each letter"

	super step.
	(go _ self goButton) ifNotNil: [
		go isOn ifTrue: [(hotIndex == nil) | wild
			ifTrue: [letterActors reverseDo: [:let | self lettersOnTicks: let]]
			ifFalse: [hotIndex < 0 
				ifTrue: [hotIndex _ 1.
					letterActors do: [:let | self oneLetterJump].
					hotIndex _ -1]
				ifFalse: [self oneLetterJump]]]].! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/1/2001 14:39'!
stepTime
	"Adjust this to make the speed right.  Answer the desired time between steps in milliseconds."

	^ 10! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/3/2001 03:23'!
toggle
	"flip between free wandering letterActors and a paragraph"

wild == true ifTrue: [switch color: Color green. wild _ false]
		ifFalse: [switch color: Color red. wild _ true].
hotIndex ifNotNil: [hotIndex _ hotIndex min: 1].! !

!WanderingLetters methodsFor: 'as yet unclassified' stamp: 'tk 2/3/2001 03:37'!
toggleJumping
	| str sm |
	"Make the letters go straight to their final place, like normal layout.  wander there -> hop there -> snap there"

	jumpSwitch removeAllMorphs. 
	hotIndex 
		ifNil: ["was wandering"  jumpSwitch color: Color orange.  hotIndex _ 1.
				str _ 'hop']
		ifNotNil: [hotIndex < 0 
			ifTrue: ["was snapping" jumpSwitch color: Color green lighter lighter.  hotIndex _ nil.
				str _ 'wander']
			ifFalse: ["was hopping" jumpSwitch color: Color gray.  hotIndex _ -1.
				str _ 'snap']].
	sm _ StringMorph contents: str.
	sm align: sm center with: jumpSwitch center.
	jumpSwitch addMorph: sm! !

"Postscript:
Start those letters a-wandering."

WanderingLetters new setUp.!