Object subclass: #GreedRule instanceVariableNames: 'howManyDice minimumPlayers winnerScore initialBankruptScore ' classVariableNames: '' poolDictionaries: '' category: 'Greed-Control'! GreedRule comment: 'Copyright(C) 1998 Masashi Umezawa GreedRule represents a rule of GreedGame. To change the rule, you can give parameters or subclass it. Instance Variables: howManyDice the number of dice that will be rolled in each player''s first turn initialBankruptScore the bunkrupt limit score in the first turn minimumPlayers the minimum number of the players for GreedGame winnerScore the minimum limit score winners should be selected by. '! !GreedRule methodsFor: 'initialize-release'! initialize "Copyright(C) 1998 Masashi Umezawa" howManyDice := 5. minimumPlayers := 2. initialBankruptScore := 200. winnerScore := 3000! ! !GreedRule methodsFor: 'actions'! calculateScoreOf: diceCollection "Copyright(C) 1998 Masashi Umezawa" | score | score := 0. 1 to: 6 do: [:n | score := score + (self calculateEachScoreOf: (diceCollection select: [:each | each number = n]) with: n)]. ^score! checkBunkruptOf: aGreedPlayer with: score "Copyright(C) 1998 Masashi Umezawa" ^aGreedPlayer isInFirstTurn ifTrue: [score < self initialBankruptScore] ifFalse: [score = 0]! checkWinnersFrom: aGreedPlayers "Copyright(C) 1998 Masashi Umezawa" ^(aGreedPlayers detect: [:each | each totalScore > self winnerScore] ifNone: []) isNil not! selectWinnersFrom: aGreedPlayers "Copyright(C) 1998 Masashi Umezawa" | winners | winners := aGreedPlayers select: [:each | each totalScore > self winnerScore]. ^SortedCollection withAll: winners sortBlock: [:a :b | a totalScore > b totalScore]! ! !GreedRule methodsFor: 'private'! calculateEachScoreOf: selectedDiceCollection with: number "Copyright(C) 1998 Masashi Umezawa" | score sz | score := 0. sz := selectedDiceCollection size. sz <= 2 ifTrue: ["singles only" score := self calculateEachSingleScoreOf: selectedDiceCollection with: number score: score delta: sz]. sz >= 3 ifTrue: ["triples and singles" score := number = 1 ifTrue: [1000] ifFalse: [100 * number]. self disposeDiceOf: selectedDiceCollection from: 1 to: 3. sz >= 4 ifTrue: [| delta | delta := sz - 3. score := self calculateEachSingleScoreOf: selectedDiceCollection with: number score: score delta: delta. sz >= 5 ifTrue: [selectedDiceCollection do: [:each | each isDisposed: false]]]]. ^score! calculateEachSingleScoreOf: selectedDiceCollection with: number score: score delta: delta "Copyright(C) 1998 Masashi Umezawa" | tmpScore | tmpScore := score. (number = 1 or: [number = 5]) ifTrue: [| points | number = 1 ifTrue: [points := 100]. number = 5 ifTrue: [points := 50]. tmpScore := tmpScore + (points * delta). self disposeDiceOf: selectedDiceCollection from: 1 to: delta]. ^tmpScore! disposeDiceOf: diceColelction from: fromIndex to: toIndex "Copyright(C) 1998 Masashi Umezawa" fromIndex to: toIndex do: [:n | (diceColelction at: n) isDisposed: true]! ! !GreedRule methodsFor: 'accessing'! howManyDice "Copyright(C) 1998 Masashi Umezawa" ^howManyDice! howManyDice: anInteger "Copyright(C) 1998 Masashi Umezawa" howManyDice := anInteger! initialBankruptScore "Copyright(C) 1998 Masashi Umezawa" ^initialBankruptScore! initialBankruptScore: anInteger "Copyright(C) 1998 Masashi Umezawa" initialBankruptScore := anInteger! minimumPlayers "Copyright(C) 1998 Masashi Umezawa" ^minimumPlayers! minimumPlayers: anInteger "Copyright(C) 1998 Masashi Umezawa" minimumPlayers := anInteger! winnerScore "Copyright(C) 1998 Masashi Umezawa" ^winnerScore! winnerScore: anInteger "Copyright(C) 1998 Masashi Umezawa" winnerScore := anInteger! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! GreedRule class instanceVariableNames: ''! !GreedRule class methodsFor: 'instance creation'! new "Copyright(C) 1998 Masashi Umezawa" ^super new initialize! ! !GreedRule class methodsFor: 'testing'! test1 "Copyright(C) 1998 Masashi Umezawa" "self test1" | pot rule sc ord | ord := OrderedCollection new. 6 timesRepeat: [ord add: (GreedDie maxValue: 6)]. pot := GreedDiePot fromDiceCollection: ord. rule := GreedRule new. Transcript cr; show: '###'. [pot diceCollection isEmpty] whileFalse: [pot shake. Transcript cr; show: 'ふる'. Transcript cr; show: pot displayString. sc := rule calculateScoreOf: pot shakenDice. Transcript cr; show: 'スコア'. Transcript cr; show: sc displayString]! ! Object subclass: #GameProcess instanceVariableNames: 'gameField ' classVariableNames: '' poolDictionaries: '' category: 'Greed-Control'! GameProcess comment: 'Copyright(C) 1998 Masashi Umezawa GameProcess represents a game process. It takes three steps (Prepare, Proced, and End). When entering each step, event will be fired. Instance Variables: gameField the field on which the game will be played '! !GameProcess methodsFor: 'initialize-release'! initialize "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #initialized with: self! ! !GameProcess methodsFor: 'actions'! doProcess "Copyright(C) 1998 Masashi Umezawa" "default: do nothing"! end "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #ended with: self. self release! prepare "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #prepared with: self! proceed "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #enterProceed with: self. [self isProceedable] whileTrue: [self triggerEvent: #preProcess with: self. self doProcess. self triggerEvent: #postProcess with: self]. self triggerEvent: #exitProceed with: self! start "Copyright(C) 1998 Masashi Umezawa" self prepare. self proceed. self end! ! !GameProcess methodsFor: 'testing'! isProceedable "Copyright(C) 1998 Masashi Umezawa" ^false! ! !GameProcess methodsFor: 'accessing'! gameField "Copyright(C) 1998 Masashi Umezawa" ^gameField! gameField: aGameField "Copyright(C) 1998 Masashi Umezawa" gameField := aGameField! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! GameProcess class instanceVariableNames: ''! !GameProcess class methodsFor: 'instance creation'! new "Copyright(C) 1998 Masashi Umezawa" ^super new initialize! on: aGameField "Copyright(C) 1998 Masashi Umezawa" ^self new gameField: aGameField! ! !GameProcess class methodsFor: 'private-events'! constructEventsTriggered "Copyright(C) 1998 Masashi Umezawa" ^#(#initialized #prepared #enterProceed #preProcess #postProcess #exitProceed #ended)! ! GameProcess subclass: #GreedTurn instanceVariableNames: 'player iterateNumber score ' classVariableNames: '' poolDictionaries: '' category: 'Greed-Control'! GreedTurn comment: 'Copyright(C) 1998 Masashi Umezawa GreedTurn represents a turn in which a player plays. The player can continue to play in that turn unless s/he become bunkrupt. Instance Variables: iterateNumber how many times player continue to play player the GreedGame player score the score in this turn '! !GreedTurn methodsFor: 'initialize-release'! initialize "Copyright(C) 1998 Masashi Umezawa" super initialize. score := 0. iterateNumber := 1! ! !GreedTurn methodsFor: 'actions'! addScore: anInteger "Copyright(C) 1998 Masashi Umezawa" self score: self score + anInteger! doProcess "Copyright(C) 1998 Masashi Umezawa" self player play. self iterateNumber: self iterateNumber + 1! end "Copyright(C) 1998 Masashi Umezawa" super end. self player caluculateTotalScore! isProceedable "Copyright(C) 1998 Masashi Umezawa" ^self player isPlayable! prepare "Copyright(C) 1998 Masashi Umezawa" super prepare. self player dicePot: self gameField provideResetDicePot! relatePlayer: aPlayer "Copyright(C) 1998 Masashi Umezawa" self player: aPlayer. aPlayer turn: self! ! !GreedTurn methodsFor: 'accessing'! iterateNumber "Copyright(C) 1998 Masashi Umezawa" ^iterateNumber! iterateNumber: anInteger "Copyright(C) 1998 Masashi Umezawa" ^iterateNumber := anInteger! player "Copyright(C) 1998 Masashi Umezawa" ^player! player: aGreedPlayer "Copyright(C) 1998 Masashi Umezawa" player := aGreedPlayer! score "Copyright(C) 1998 Masashi Umezawa" ^score! score: anInteger "Copyright(C) 1998 Masashi Umezawa" score := anInteger! ! GameProcess subclass: #GreedPlay instanceVariableNames: 'rounds ' classVariableNames: '' poolDictionaries: '' category: 'Greed-Control'! GreedPlay comment: 'Copyright(C) 1998 Masashi Umezawa GreedPlay represents a whole play of GreedGame. Instance Variables: rounds the collection of rounds '! !GreedPlay methodsFor: 'initialize-release'! initialize "Copyright(C) 1998 Masashi Umezawa" super initialize. rounds := OrderedCollection new! ! !GreedPlay methodsFor: 'actions'! doProcess "Copyright(C) 1998 Masashi Umezawa" | rnd | rnd := self defaultRound. self rounds add: rnd. rnd roundNumber: self rounds size. rnd start! isProceedable "Copyright(C) 1998 Masashi Umezawa" ^self gameField isWinnerResolved not! ! !GreedPlay methodsFor: 'factory'! defaultRound "Copyright(C) 1998 Masashi Umezawa" ^self gameField defaultRound! ! !GreedPlay methodsFor: 'accessing'! rounds "Copyright(C) 1998 Masashi Umezawa" ^rounds! rounds: aCollectionOfGreedRound "Copyright(C) 1998 Masashi Umezawa" rounds := aCollectionOfGreedRound! ! GameProcess subclass: #GreedRound instanceVariableNames: 'isAllTurnsEnded turns roundNumber ' classVariableNames: '' poolDictionaries: '' category: 'Greed-Control'! GreedRound comment: 'Copyright(C) 1998 Masashi Umezawa GreedRound represents one round of GreedGame. Instance Variables: isAllTurnsEnded indicates that all turns ware processed roundNumber round''s incremental number turns the collection of turns '! !GreedRound methodsFor: 'initialize-release'! initialize "Copyright(C) 1998 Masashi Umezawa" super initialize. turns := OrderedCollection new. roundNumber := 0. isAllTurnsEnded := false! ! !GreedRound methodsFor: 'actions'! doProcess "Copyright(C) 1998 Masashi Umezawa" self turns do: [:each | each start]. self isAllTurnsEnded: true! end "Copyright(C) 1998 Masashi Umezawa" super end. self gameField players do: [:each | each reset]! isProceedable "Copyright(C) 1998 Masashi Umezawa" ^self isAllTurnsEnded not! prepare "Copyright(C) 1998 Masashi Umezawa" super prepare. self gameField players do: [:each | | turn | turn := self defaultTurn. turn relatePlayer: each. self turns add: turn]! ! !GreedRound methodsFor: 'factory'! defaultTurn "Copyright(C) 1998 Masashi Umezawa" ^self gameField defaultTurn! ! !GreedRound methodsFor: 'accessing'! isAllTurnsEnded "Copyright(C) 1998 Masashi Umezawa" ^isAllTurnsEnded! isAllTurnsEnded: aBoolean "Copyright(C) 1998 Masashi Umezawa" isAllTurnsEnded := aBoolean! roundNumber "Copyright(C) 1998 Masashi Umezawa" ^roundNumber! roundNumber: anInteger "Copyright(C) 1998 Masashi Umezawa" roundNumber := anInteger! turns "Copyright(C) 1998 Masashi Umezawa" ^turns! turns: aCollectionOfGreedTurn "Copyright(C) 1998 Masashi Umezawa" turns := aCollectionOfGreedTurn! ! Object subclass: #GreedTable instanceVariableNames: 'rule play players dicePot diceCollection isWinnerResolved ' classVariableNames: '' poolDictionaries: '' category: 'Greed-Control'! GreedTable comment: 'Copyright(C) 1998 Masashi Umezawa GreedTable is a table on which GreedGame will be played. It accepts the players entry. It also rules the whole play. Instance Variables: diceCollection < Collection of: GreedDie> a collection of dice dicePot a dicePot the table has isWinnerResolved indicates that there are already winners in the play play the play to be started players the players playing GeedGame rule a rule book reference '! !GreedTable methodsFor: 'initialize-release'! initialize "Copyright(C) 1998 Masashi Umezawa" rule := nil. "lazy initialization" diceCollection := nil. dicePot := nil. players := OrderedCollection new. self reset! reset "Copyright(C) 1998 Masashi Umezawa" isWinnerResolved := false! ! !GreedTable methodsFor: 'actions'! addPlayer: aGreedPlayer "Copyright(C) 1998 Masashi Umezawa" aGreedPlayer gameField: self. self players add: aGreedPlayer! calculateScoreOf: shakenDiceCollection "Copyright(C) 1998 Masashi Umezawa" ^self rule calculateScoreOf: shakenDiceCollection! checkBunkruptOf: aGreedPlayer with: score "Copyright(C) 1998 Masashi Umezawa" ^self rule checkBunkruptOf: aGreedPlayer with: score! provideResetDicePot "Copyright(C) 1998 Masashi Umezawa" self diceCollection do: [:each | each isDisposed: false]. self dicePot setDiceCollection: self diceCollection. ^self dicePot! resetPlayers "Copyright(C) 1998 Masashi Umezawa" self players do: [:each | self unregisterPlayerEvents: each]. self players: OrderedCollection new! start "Copyright(C) 1998 Masashi Umezawa" self players size >= self rule minimumPlayers ifTrue: [self play: self defaultPlay. self play start] ifFalse: [self triggerEvent: #cannotPlay]! ! !GreedTable methodsFor: 'configuring events'! configurePlayerEvents: aGreedPlayer "Copyright(C) 1998 Masashi Umezawa" aGreedPlayer when: #checkContinueToPlay send: #checkContinueToPlay: to: self. aGreedPlayer when: #bankrupt send: #bankrupt: to: self! configurePlayEvents: aGreedPlay "Copyright(C) 1998 Masashi Umezawa" aGreedPlay when: #enterProceed send: #playStarting: to: self. aGreedPlay when: #ended send: #playEnding: to: self! configureRoundEvents: aGreedRound "Copyright(C) 1998 Masashi Umezawa" aGreedRound when: #enterProceed send: #newRoundStarting: to: self. aGreedRound when: #ended send: #checkWinners: to: self! configureTurnEvents: aGreedTurn "Copyright(C) 1998 Masashi Umezawa" aGreedTurn when: #enterProceed send: #newTurnStarting: to: self. aGreedTurn when: #preProcess send: #preTurnProcessing: to: self. aGreedTurn when: #postProcess send: #postTurnProcessing: to: self. aGreedTurn when: #exitProceed send: #newTurnEnding: to: self! unregisterPlayerEvents: aGreedPlayer "Copyright(C) 1998 Masashi Umezawa" aGreedPlayer removeActionsWithReceiver: self forEvent: #checkContinueToPlay. aGreedPlayer removeActionsWithReceiver: self forEvent: #bankrupt! ! !GreedTable methodsFor: 'handling events'! bankrupt: aGreedPlayer "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #bankrupt with: aGreedPlayer! checkContinueToPlay: aGreedPlayer "Copyright(C) 1998 Masashi Umezawa" aGreedPlayer isInFirstTurn ifTrue: [self triggerEvent: #checkFirstPlay with: aGreedPlayer] ifFalse: [self triggerEvent: #checkContinueToPlay with: aGreedPlayer]! checkWinners: aGreedRound "Copyright(C) 1998 Masashi Umezawa" self isWinnerResolved: (self rule checkWinnersFrom: self players). self triggerEvent: #checkWinners with: aGreedRound! newRoundStarting: aRound "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #newRoundStarting with: aRound! newTurnEnding: aTurn "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #newTurnEnding with: aTurn! newTurnStarting: aTurn "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #newTurnStarting with: aTurn! playEnding: aGreedPlay "Copyright(C) 1998 Masashi Umezawa" | winners | winners := self rule selectWinnersFrom: self players. self triggerEvent: #playEndingWith with: winners. self players do: [:each | each resetAll. self unregisterPlayerEvents: each]. self reset! playStarting: aGreedPlay "Copyright(C) 1998 Masashi Umezawa" self players do: [:each | self configurePlayerEvents: each]. self triggerEvent: #playStarting! postTurnProcessing: aGreedTurn "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #postTurnProcessing with: aGreedTurn! preTurnProcessing: aGreedTurn "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #preTurnProcessing with: aGreedTurn! turnContinuing: aGreedTurn "Copyright(C) 1998 Masashi Umezawa" self triggerEvent: #preTurnProcessing with: aGreedTurn! ! !GreedTable methodsFor: 'accessing'! diceCollection "Copyright(C) 1998 Masashi Umezawa" ^diceCollection isNil ifTrue: [diceCollection := self defaultDiceCollection] ifFalse: [diceCollection]! diceCollection: aCollectionOfDie "Copyright(C) 1998 Masashi Umezawa" diceCollection := aCollectionOfDie! dicePot "Copyright(C) 1998 Masashi Umezawa" ^dicePot isNil ifTrue: [dicePot := self defaultDicePot] ifFalse: [dicePot]! dicePot: aGreedDicePot "Copyright(C) 1998 Masashi Umezawa" dicePot := aGreedDicePot! isWinnerResolved "Copyright(C) 1998 Masashi Umezawa" ^isWinnerResolved! isWinnerResolved: aBoolean "Copyright(C) 1998 Masashi Umezawa" isWinnerResolved := aBoolean! play "Copyright(C) 1998 Masashi Umezawa" ^play! play: aGreedPlay "Copyright(C) 1998 Masashi Umezawa" play := aGreedPlay! players "Copyright(C) 1998 Masashi Umezawa" ^players! players: aCollectionOfGreedPlayer "Copyright(C) 1998 Masashi Umezawa" players := aCollectionOfGreedPlayer! rule "Copyright(C) 1998 Masashi Umezawa" ^rule isNil ifTrue: [rule := self defaultRule] ifFalse: [rule]! rule: aGreedRule "Copyright(C) 1998 Masashi Umezawa" rule := aGreedRule! ! !GreedTable methodsFor: 'factory'! defaultDice "Copyright(C) 1998 Masashi Umezawa" ^GreedDie new! defaultDiceCollection "Copyright(C) 1998 Masashi Umezawa" | col | col := OrderedCollection new. 1 to: self rule howManyDice do: [:n | | d | d := self defaultDice. col add: d]. ^col! defaultDicePot "Copyright(C) 1998 Masashi Umezawa" ^GreedDiePot fromDiceCollection: self diceCollection! defaultPlay "Copyright(C) 1998 Masashi Umezawa" | pl | pl := GreedPlay on: self. self configurePlayEvents: pl. ^pl! defaultRound "Copyright(C) 1998 Masashi Umezawa" | rnd | rnd := GreedRound on: self. self configureRoundEvents: rnd. ^rnd! defaultRule "Copyright(C) 1998 Masashi Umezawa" ^GreedRule new! defaultTurn "Copyright(C) 1998 Masashi Umezawa" | tn | tn := GreedTurn on: self. self configureTurnEvents: tn. ^tn! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! GreedTable class instanceVariableNames: ''! !GreedTable class methodsFor: 'instance creation'! new "Copyright(C) 1998 Masashi Umezawa" ^super new initialize! ! !GreedTable class methodsFor: 'private-events'! constructEventsTriggered "Copyright(C) 1998 Masashi Umezawa" ^#(#cannotPlay #playStarting #playEndingWith #newRoundStarting #newTurnStarting #preTurnProcessing #postTurnProcessing #newTurnEnding #checkWinners #checkFirstPlay #checkContinueToPlay #bankrupt)! !