Object subclass: #Board
	instanceVariableNames: 'lastQueen isFirst '
	classVariableNames: ''
	poolDictionaries: ''
	category: '8-Queens'!

!Board methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 21:36'!
initialize
	lastQueen _ QueenTerminator new.
	(1 to: 8)
		do: [:i | lastQueen _ Queen new setColumn: i neighbor: lastQueen].
	isFirst _ true
	! !

!Board methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 15:07'!
solve
	Transcript clear.
	lastQueen firstSolution
		ifTrue: [Transcript show:
				lastQueen result printString; cr.
			[lastQueen nextSolution]
				whileTrue: [Transcript show:
							lastQueen result printString; cr].
				Transcript show: 'End of Solution.'; cr]
			ifFalse: [Transcript show:
						'No Solution.'; cr]! !

!Board methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 21:38'!
solveNext
	isFirst
		ifTrue: [lastQueen firstSolution
				ifTrue: [Transcript show: lastQueen result printString; cr].
				isFirst _ false]
		ifFalse: [lastQueen nextSolution
				ifTrue: [Transcript show: lastQueen result printString; cr]].
		^ lastQueen result! !


Object subclass: #Queen
	instanceVariableNames: 'row column neighbor '
	classVariableNames: ''
	poolDictionaries: ''
	category: '8-Queens'!

!Queen methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 14:55'!
advance
	row = 8
		ifTrue: [neighbor nextSolution
				 ifFalse: [^ false].
				row _ 0].
		row _ row + 1.
		^ true! !

!Queen methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 14:51'!
canAttack: testRow x: testColumn
	| columnDifference |
	columnDifference _ testColumn - column.
	((row = testRow
		or: [row + columnDifference = testRow])
		or: [row - columnDifference = testRow])
	 ifTrue: [^ true].
	 ^ neighbor canAttack: testRow x: testColumn
! !

!Queen methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 15:21'!
firstSolution
	neighbor firstSolution.
	row _ 1.
	^ self moveToNextNonAttackedRow! !

!Queen methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 14:57'!
moveToNextNonAttackedRow
	[neighbor canAttack: row x: column]
	whileTrue: [self advance
					ifFalse: [^ false]].
	^ true! !

!Queen methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 15:22'!
nextSolution
	^ self advance
		and: [self moveToNextNonAttackedRow]! !

!Queen methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 15:23'!
result
	^neighbor result addLast: row; yourself! !

!Queen methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 14:48'!
setColumn: aColumn neighbor: aQueen
	column _ aColumn.
	neighbor _ aQueen! !


BorderedMorph subclass: #QueenMorph
	instanceVariableNames: 'squareList queenList board count '
	classVariableNames: ''
	poolDictionaries: ''
	category: '8-Queens'!

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 20:46'!
AddToQueenList: col
	^ queenList add: (QueenPieceMorph initialize: false) afterIndex: col! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 21:44'!
Board
	^ board! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 20:41'!
QueenList
	^ queenList! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 19:00'!
SquareList
	^ squareList! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 18:44'!
Squares
	^ squares! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 21:49'!
addButtons
	| r |
	r _ AlignmentMorph newRow hResizing: #shrinkWrap;
				 vResizing: #shrinkWrap;
				 color: Color transparent.
	r
		addMorphBack: (self buttonName: '  Next Solution  ' action: #nextMove).
	r
		addMorphBack: (self buttonName: '   Quit  ' action: #delete).
	r disableTableLayout: true.
	r align: r bounds topLeft with: self layoutBounds topLeft.
	self addMorphFront: r! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 21:34'!
buttonFillStyle
	| fill |
	fill _ GradientFillStyle ramp: {0.0
					-> (Color
							r: 0.05
							g: 0.5
							b: 1.0). 1.0
					-> (Color
							r: 0.85
							g: 0.95
							b: 1.0)}.
	fill origin: 0 @ 0.
	fill direction: 40 @ 10.
	fill radial: false.
	^ fill! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 21:33'!
buttonName: aString action: aSymbol 
	^ SimpleButtonMorph new target: self;
		 label: aString;
		 actionSelector: aSymbol;
		
		color: (Color gray: 0.8);
		 fillStyle: self buttonFillStyle;
		 borderWidth: 0;
		 borderColor: #raised"old color"! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 19:00'!
drawBoard
	| white black square index |
	white _ Color white.
	black _ Color lightGray.
	index _ 0.
	#(
	     (	' '	'a'	'b'	'c'	'd'	'e'	'f'	'g'	'h'	' ')
		(	'1'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	' ')
		(	'2'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	' ')
		(	'3'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	' ')
		(	'4'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	' ')
		(	'5'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	' ')
		(	'6'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	' ')
		(	'7'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	' ')
		(	'8'	'W'	'B'	'W'	'B'	'W'	'B'	'W'	'B'	' ')
		(	' '	' '	' '	' '	' '	' '	' '	' '	' '	' ')
	) do:[:file|
		file do:[:sq|
		square _ self newSquare.
		squareList add: square.
		square borderWidth: 0.
		(sq = 'W' or:[sq = 'B']) ifTrue:[
			square color: (sq = 'W' ifTrue:[white] ifFalse:[black]).
			square borderColor: Color red.
			square setProperty: #squarePosition toValue: (index _ index + 1).
			square setNameTo: 
				(String with: ($a asInteger + (index - 1 bitAnd: 7)) asCharacter with: ($1 asInteger + (index -1 bitShift: -3)) asCharacter)] 
		ifFalse:["decoration"
			square color: Color transparent.
			sq = ' ' ifFalse:[
				square addMorphCentered: (StringMorph contents: sq asUppercase font: Preferences windowTitleFont emphasis: 1).
			].
		].
		square extent: 40@40.
		self addMorphBack: square.
	]].
! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 21:54'!
drawOnce: row column: col
	| queen destSquare squareNum |
	squareNum _ 10 * row + (col + 1).
	destSquare _ self SquareList at: squareNum.
	queen _ EllipseMorph new.
	queen position: destSquare position.
	queen openInWorld	! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 21:11'!
drawQueen: row column: col 
	| queen destSquare squareNum |
	squareNum _ 10 * row + (col + 1).
	destSquare _ self SquareList at: squareNum.
	queen _ (self QueenList at: col)
				ifNil: [queen _ self AddToQueenList: col].
	Transcript show: queen class;
		 cr.
	queen position: destSquare position.
	queen isInWorld
		ifTrue: [queen show].
		queen openInWorld! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 21:46'!
initialize
	super initialize.
	count _ 1.
	squareList
		ifNil: [squareList _ OrderedCollection new].
	queenList
		ifNil: [queenList _ OrderedCollection new].
	board
		ifNil: [board _ Board new initialize].
	self borderWidth: 5.
	self extent: 410 @ 410.
	self borderColor: #raised.
	self cornerStyle: #rounded.
	self layoutPolicy: TableLayout new.
	self listDirection: #leftToRight;
		 wrapDirection: #bottomToTop.
	self drawBoard.
	self addButtons! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 20:24'!
newSquare
	^ BorderedMorph new! !

!QueenMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 21:54'!
nextMove
	| results |
	results _ board solveNext.
	(1 to: 8)
		do: [:i | self
				drawOnce: (results at: i)
				column: i].
	count _ count + 1! !


BorderedMorph subclass: #QueenPieceMorph
	instanceVariableNames: 'inWorld '
	classVariableNames: ''
	poolDictionaries: ''
	category: '8-Queens'!

!QueenPieceMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 20:29'!
initialize: val
	inWorld _ val.
	super initialize
		! !

!QueenPieceMorph methodsFor: 'as yet unclassified' stamp: 'DM 2/2/2003 20:30'!
isInWorld
	^ inWorld! !


Object subclass: #QueenTerminator
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: '8-Queens'!

!QueenTerminator methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 14:43'!
canAttack: row  x: column
	^ false! !

!QueenTerminator methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 15:07'!
firstSolution 
	^ true! !

!QueenTerminator methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 14:42'!
nextSolution
	^ false! !

!QueenTerminator methodsFor: 'as yet unclassified' stamp: 'DAM 2/2/2003 14:44'!
result
	^ OrderedCollection new! !