[Seaside] Design Question of a very small game

Alexandre Bergel bergel at iam.unibe.ch
Wed Oct 20 22:05:52 CEST 2004


Hi!

I would like to know a bit your opinion about the code I just wrote.
It consist in a very small game: the computer choose randomly a number between 0 and 100, and the user has to guess it. For each answer, the computer says: 'too litle' or 'too big'.

It is composed of 5 classes with a couple of method for each of them.
Do you have a better design for this simple game ?

Best Regards,
Alexandre

-- 
_,.;:~^~:;._,.;:~^~:;._,.;:~^~:;._,.;:~^~:;._,.;:
Alexandre Bergel  http://www.iam.unibe.ch/~bergel
^~:;._,.;:~^~:;._,.;:~^~:;._,.;:~^~:;._,.;:~^~:;.
-------------- next part --------------
'From Squeak3.8alpha of 8 September 2004 [latest update: #5987] on 20 October 2004 at 10:03:12 pm'!
WAComponent subclass: #GetNumberComponent
	instanceVariableNames: 'nbTry message'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SimpleGame'!
WAComponent subclass: #Learner
	instanceVariableNames: 'words germanWord englishWord chosenEntry score'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'WordLearning'!
WAComponent subclass: #Loose
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SimpleGame'!
WAComponent subclass: #SimpleGame
	instanceVariableNames: 'nbTry nbToGuess'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SimpleGame'!
WATask subclass: #SimpleGameTask
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SimpleGame'!
WAComponent subclass: #Victory
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'SimpleGame'!

!GetNumberComponent methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:57'!
message: aString
	message := aString! !

!GetNumberComponent methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:25'!
nbTry: nb
	nbTry := nb! !

!GetNumberComponent methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:49'!
previousNbEntered: nb
	nbEntered := nb
	! !

!GetNumberComponent methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:57'!
renderContentOn: html
	message ifNotNil: [
		html text: message.
		html break].
	html text: 'Try number ', nbTry printString.
	html break.
	html form: [
		html textInputWithCallback: [:w| self answer: w asInteger]]! !


!Learner methodsFor: 'as yet unclassified' stamp: 'ab 10/19/2004 19:15'!
chooseEntry
	chosenEntry := self words at: (self words size atRandom).
	! !

!Learner methodsFor: 'as yet unclassified' stamp: 'ab 10/19/2004 19:24'!
increaseScore
	score := self score + 1! !

!Learner methodsFor: 'as yet unclassified' stamp: 'ab 10/19/2004 19:16'!
initialize
	super initialize.
	self session registerObjectForBacktracking: self! !

!Learner methodsFor: 'as yet unclassified' stamp: 'ab 10/19/2004 19:15'!
readyToGuess
	^ self words size > 0! !

!Learner methodsFor: 'as yet unclassified' stamp: 'ab 10/19/2004 19:23'!
renderContentOn: html
	html heading: 'Improve your Language Skills'.
	html form: [
		html text: 'English: '.
		html textInputWithCallback: [:w| englishWord := w].
		html text: 'German: '.
		html textInputWithCallback: [:w| germanWord := w].
		html submitButtonWithAction:
			[self words add: (Array with: englishWord with: germanWord)]
			  text: 'Add Word'].
		
	html horizontalRule.
	self readyToGuess ifTrue: [
		html heading: 'Your score is: ', self score asString.
		html form: [|i|
			self chooseEntry.
			i :=  chosenEntry.
			html text: (i first).
			html textInputWithCallback: [:w| (w = i second) ifTrue: [self increaseScore]]]]! !

!Learner methodsFor: 'as yet unclassified' stamp: 'ab 10/19/2004 19:26'!
score
	score ifNil: [score := 0].
	^ score! !

!Learner methodsFor: 'as yet unclassified' stamp: 'ab 10/19/2004 19:14'!
words
	words ifNil: [words := OrderedCollection new].
	^ words! !


!Learner class methodsFor: 'as yet unclassified' stamp: 'ab 10/19/2004 19:16'!
initialize
	"self initialize"
	self registerAsApplication: 'word'! !


!Loose methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:33'!
go
	| numberEntered nbTry nbToGuess |
	nbTry := 1.
	nbToGuess := 100 atRandom.
	
	[numberEntered := self call: (GetNumberComponent new nbTry: nbTry).
	(nbTry < 10) and: [numberEntered ~= nbToGuess]] whileTrue.

	(numberEntered = nbToGuess) 
		ifTrue: [self call: (Victory new)].
	
	self call: (Loose new)! !

!Loose methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:32'!
renderContentOn: html
	html text: 'You loose!!'! !


!SimpleGame methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:15'!
initialize
	super initialize.
	nbTry := 0! !

!SimpleGame methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:34'!
renderContentOn: html

	self call: SimpleGameTask new! !


!SimpleGame class methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:02'!
initialize
	"self initialize"
	self registerAsApplication: 'SimpleGame'! !


!SimpleGameTask methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:35'!
foo! !

!SimpleGameTask methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:57'!
go
	|nbTry nbToGuess nbEntered |
	nbTry := 0.
	nbToGuess := 100 atRandom.
	nbEntered := nil.
	[|g|
	g := GetNumberComponent new nbTry: nbTry; yourself.
	nbEntered ifNotNil: [
		g message: ((nbEntered < nbToGuess) ifTrue: ['Too little'] ifFalse: ['Too big'])].
	nbEntered := self call: (g).
	 nbTry := nbTry + 1.
	 (nbEntered ~= nbToGuess) and: [nbTry < 10]] whileTrue.

	(nbEntered = nbToGuess) 
		ifTrue: [self call: (Victory new)]
		ifFalse: [self call: (Loose new)]
	! !


!Victory methodsFor: 'as yet unclassified' stamp: 'ab 10/20/2004 21:32'!
renderContentOn: html
	html text: 'You won!!'! !

SimpleGame initialize!
Learner initialize!


More information about the Seaside mailing list