Informe del TRABAJO PRACTICO 1

Integrantes del grupo

Nombre

Email

 

Alejandro Valdez

 

 

avaldez(ARROBA)dc.uba.ar

 

Enunciado

 

 

Implementar el Pacman.

 

 


Comentarios preliminares

 

El informe cuenta con las siguientes secciones:

 

-         Diagramas del modelo

-         Diagramas de la vista

-         Cosas que sé que no estan del todo bién

-         Apendice A: Código fuente

-         Apendice B: Como iniciar el juego

-         Apendice C: Artwork (un cierre informal)

 

Algunos gráficos no logré que se vean lo suficientemente bien,  en caso de que no sean legibles se pueden encontrar  un file-out de la jerarquía de Jacaranda con los gráficos originales en el directorio ‘extra\jacaranda’.


 

 

Diagramas de instancia del modelo

 

 

 

 

 

 





 

 

 

 

 

 

 

 

 

 

 

 

 


 

 

 

 

 

 


 Diagramas de instancia del modelo

 

 


Diagramas secuencia del modelo

 

Comienza un juego nuevo:

 


aPacManGame carga el nivel 1:


aLevel obtiene el layout y la fruta correspondiente al nivel 1:

 


aGameTimer envía  un step a aPacManGame:

 

 

 

 

aPacManGame procesa un turno:

 


aPacManGame mueve los actores:

 

 

 

 

 

 


aRuleManager procesa las reglas del juego:

 

 

 

 


aLevel procesa el layout para inicializar aBoard, agrega aWall en aBoard:

 


Se agrega aWall en aBoard:

 

 

 

 


aFruitManager pone aCherry en juego:

 

 

 


aFruitManager elimina las frutas que estan comidas:

 

 


aPillManager elimina las pills comidas:

 


aPowerPillManager elimina las powerPills comidas:

 

 

 

 

 

 


aPillManager inicia el efecto de una powerPill  que fue comida:

 

 

 


aPillManager pone a los ghosts en estado recovering (el efecto de la powerPill esta por terminar):

 


Expiró el efecto de la powerPill activa, aPowerPillManager pone a los ghosts en estado normal:

 


aRuleManager verifica las reglas del juego:

 

 

 

 


aRuleManager detecta que aPacMan esta muerto, resta una vida y reinicia el nivel actual:

 

 

 

 


aRuleManager detecta que aPacMan esta muerto, resta una vida y da por terminado el juego:

 


aRuleManager verifica que el nivel actual esta terminado y pasa al siguiente:

 

 


aMovilActor (en este caso aBliny) se mueve:

 


aChaseHard (una estrategia) elije la dirección hacia donde se moverá un aMovilActor (en este caso aBlinky) que tiene asociado:

 


aChaseHard (una estrategia) calcula la nueva direccion de movimiento:

 


aCollisionManager encuentra las direcciones en las que se puede mover aMovilActor (en este caso aBlinky):

 


aCollisionManager pide permiso a los objetos que estan en colision con aMovilActor (en este caso aBlinky):

 


aCollisionManager notifica los objetos que estan en colision con aMovilActor (en este caso aBlinky) de esta situacion:

 


 

aCherry se mueve, expira su tiempo de vida en el juego:

 


aPacMan es notificado de una colision con aGhost (en este caso aBlinky), aPacMan muere:

 

aGhost (en este caso aBlinky) es notificado de una colision con aPacMan, aBlinky (muy contrariado) se pone en estado eated:

 


aGhost (en este caso aBlinky) se pone en estado eated:

 


aBlinky colisiona con aGhostHome,  se pone en estado leavingHome y abandona su casita:

 


aLeaveHome (una estrategia) termina su trabajo y pone al aMovilActor que tiene asociado (aBlinky)  en estado normal para salir a perseguir al engreido PacMan:

 


Diagrama de clases de la vista

 


 

Diagrama de instancias de la vista


 

 

Diagramas de secuencia de la vista

 

Se crea una vista:


Se inicializan las subvistas:


Se incializa la vista del board:


aBoardView crea las vistas de los actores:

 


Se crea aGhostView:


Luego que el modelo se actualiza, se actualiza la vista:


 

aGhostView se actualiza:

 


Algunas aclaraciones del modelo

 

Qué es un gridPoint?, y el gridSize?

 

Al mirar el pacMan de ejemplo que esta en la pagina de la materia, pude observar que las paredes estaban formadas por cuadrados dispuestos uno al lado de otro, también que el pacMan y los ghosts eran dibujos que no excedían en tamaño al de una pared. De alguna manera ese tamaño servia como una unidad de medida, que era la longitud del lado del cuadrado, llame a esa longitud gridSize.

 

Luego imaginé un board lleno de paredes (todas cuadradas), formando algo así:

 

 

A mi se me hacia mas fácil pensar en la posición de cada cuadrado considerando su centro (algunas personas se les hace mas fácil pensando en su esquina superior izquierda). Los centros de los cuadrados son lo que llame gridPoint (puntos de grilla), representan las posiciones donde inicialmente se colocan las piezas y además son las posiciones  en las que un actor móvil puede girar hacia los lados en caso de que no haya algún objeto que le impida moverse en esa dirección.

 

Manejo de colisiones

 

Cada actor móvil tiene una dirección de movimiento, antes de que pueda avanzar en esa dirección se calcula su nueva posición y considerando esa nueva posición se pregunta a los objetos que están en colisión si el objeto colisionante puede solaparse con ellos. Para que se realice el movimiento a la nueva posición todos los objetos en colisión deben dar su permiso, para esto cada actor del juego sabe contestar a los mensajes #canGhostCollision:on:, #canPacManCollision:on: y #canFruitCollision:on:.

 

Una vez realizado el movimiento del actor a la nueva posición, se notifica a los objetos que están en colisión con él de esta situación, para eso cada actor móvil guarda como colaborador interno el selector que se utilizara en la notificación a los objetos colisionados.

 

Cuando los objetos colisionados reciben la notificación realizan las acciones que correspondan a esa colisión.


 

Cosas que sé que no están del  todo bien

 

Los siguientes son algunas autocríticas el modelo, estas cuestiones las fui dejando para solucionarlas si  disponía de tiempo suficiente antes de la fecha de entrega, cosa que no sucedió:

 

El mecanismo con el que se almacena la especificación de cada nivel  debería realizarse con algún objeto extra, la solución de tener  dos colecciones e indexarlas según el numero de nivel fue para salir del paso. Una mejor solución seria leer los niveles de disco y generar el layout a partir del contenido de archivos con nombres conocidos.

 

La separación de level y levelNumebr es un tanto artificial e incomoda para operar, una mejor idea seria que aLevel conociera su propio numero de nivel e incluso supiera cambiarse (o generar una nueva instancia) con el nivel que sigue en el juego.

 

Cada vez que se actualiza el modelo, toda la vista se actualiza (y redibuja en pantalla) ya que se propaga el mensaje #updateView a todos los subMorphs tengan o no que actualizarse. Una mejor solución seria que cada elemento de la vista reciba un mensaje #updated del objeto que tiene asociado en el modelo solo cuando ese objeto cambia.

 

En general el código tiene mas IF de los que a mi me gustaría, y se que eso denota  falta de polimorfismo. Imagino que con mas tiempo podría mejorar el diseño para disminuir esa cantidad. En particular la vista tiene muchos IF, esto se debe a que cuando un objeto de la vista recibe el mensaje #updateView no tiene suficiente información para saber que aspecto del objeto observado cambio y debe preguntárselo (por ejemplo, ‘esta el fantasma débil?’ o ‘esta el fantasma recuperándose?’) lo cual lleva a que aparezcan IF.

 

Por algún motivo que no recuerdo, hay una sola instancia de CollisionManager y es compartida por todos los actores del juego, además la utilizan las estrategias de movimiento. Algunas relaciones de conocimiento (en especial entre una estrategia y al actor que tiene como colaborador interno) están a los efectos de permitir tener acceso a esa instancia de Collision Manager, que ciertamente es un motivo baste pobre y mas relacionado con la implementación que con el dominio que quería modelar.

 

No me alcanzo el tiempo, pero me doy cuenta que en la vista hay comportamiento repetido en varias clases, seguramente que podría haber realizado alguna abstracción de haber contado con mas tiempo. Por ejemplo los objetos de la vista que representan actores con movimiento, siempre que se actualizan se centran en la posición x@y que ocupan en el modelo.

 

La detección de colisiones se hace solo sobre los objetos que están sobre una misma linea horizontal o vertical, encontré algunas situaciones en las que esto no es del todo adecuado y la colision se detecta un poco despues de que sucedió. El cambio de este mecanismo solo se limitaría a la clase CollisionManager.

 

La vista no admite ser arrastrada a otra posición distinta de la esquina superior izquierda, esto es sencillo de arreglar (alcanza con sumar la posición del owner a cada subMorph de la vista), pero no esta implementado.

 

Los objetos aFruitManager, aPillManager y aPowerPillManager parecen tener comportamiento común entre si, por ejemplo eliminar los objetos que estan comidos y actual en consecuencia. Tendria que revisar un poco mas que conceptos manejan a ver si hay alguna abstracción que falta hacer.


Apéndice A: Código fuente

 

 

Object subclass: #PacManGame
    instanceVariableNames: 'score lives level levelNumber board pacMan ghosts gameTimer fruits ruleManager collisionManager gameOver '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP Core'!

 


!PacManGame methodsFor: 'scoring' stamp: 'Ale 6/23/2004 20:59'!

addScore: aNumber

    self score: (self score + aNumber).! !


!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:45'!

board
    ^ board! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:45'!
board: aBoard
    board := aBoard! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
collisionManager
    ^ collisionManager! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
collisionManager: aCollisionManager
    collisionManager := aCollisionManager! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
fruits
    ^ fruits! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
fruits: aFruitSet
    fruits := aFruitSet! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
gameOver
    ^ gameOver! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
gameOver: aBoolean
    gameOver := aBoolean! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
gameTimer
    ^ gameTimer! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
gameTimer: aGameTimer
    gameTimer := aGameTimer! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
ghosts
    ^ ghosts! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
ghosts: aGhostSet
    ghosts := aGhostSet! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
level
    ^ level! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:47'!
level: aLevel
    level := aLevel
    ! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:46'!
levelNumber
    ^ levelNumber! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:47'!
levelNumber: aNumber
    levelNumber := aNumber! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:47'!
lives
    ^ lives! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:47'!
lives: aNumber
    lives := aNumber! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:47'!
pacMan
    ^ pacMan! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:47'!
pacMan: aPacMan
    pacMan := aPacMan! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:47'!
ruleManager
    ^ ruleManager! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:47'!
ruleManager: aRuleManager
    ruleManager := aRuleManager! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:47'!
score
    ^ score! !

!PacManGame methodsFor: 'accessing' stamp: 'Ale 7/16/2004 16:47'!
score: aNumber
    score := aNumber    ! !


!PacManGame methodsFor: 'initializing' stamp: 'Ale 7/17/2004 13:09'!

buildActors
    "Crear los actores y agregarlos al game."

    self pacMan:
        (PacMan new collisionManager: (self collisionManager)).

    self ghosts
        add: Blinky new;
        add: Pinky new;
        add: Inky new;
        add: Sue new.

    self ghosts
        do: [:each| each
            collisionManager: (self collisionManager);
            pacMan: self pacMan]
! !

!PacManGame methodsFor: 'initializing' stamp: 'Ale 7/17/2004 21:20'!
initialize

    self ghosts: Set new.
    self fruits: Set new.
    self board: Board new.

    self score: 0.
    self lives: 0.
    self levelNumber: 1.
    self gameOver: true.

    self gameTimer: ((GameTimer new) initializeWith: self).
    self collisionManager: (CollisionManager new).
    self ruleManager: (RuleManager new).
    self buildActors.
! !


!PacManGame methodsFor: 'level loading' stamp: 'Ale 7/19/2004 15:23'!

loadLevel: aNumber
    "Cargar un nuevo nivel y reinicializar el juego."
    self level: ((Level new) loadLevel: aNumber).
    self levelNumber: aNumber.
    self level fruit collisionManager: self collisionManager.
    self level initializeBoard: board.
    self level initializeGhosts: self ghosts.
    self ruleManager initializeWith: self.
    self putActors.
    self fruits: Set new.
    self resetActorsState.
    self changed: #resetView.! !

!PacManGame methodsFor: 'level loading' stamp: 'Ale 7/19/2004 16:36'!
newGame
    self lives: 3.
    self score: 0.
    self loadLevel: 1.
    self gameTimer openInWorld.
    self gameOver: false.
! !

!
PacManGame methodsFor: 'level loading' stamp: 'Ale 7/17/2004 12:57'!
putActors
    "Poner al pacMan y los ghosts en las posiciones iniciales del board para
    el nivel actual."
    self ghosts
        do: [:g | board
                put: g
                at: (board positionOf: self level ghostHome)].
    self board
        put: self pacMan
        at: (board positionOf: self level pacManHome)! !

!PacManGame methodsFor: 'level loading' stamp: 'Ale 7/16/2004 18:51'!
removeActors
    "Quita al pacman, los ghosts y la fruit del board. "
    self board remove: (self pacMan).
    self ghosts
        do: [:each | board remove: each].
    self fruits
        do: [:each | board remove: each].
    self fruits: Set new.
! !

!
PacManGame methodsFor: 'level loading' stamp: 'Ale 7/16/2004 16:59'!
resetActorsPosition
    "Quitar los actores de sus posiciones actuales y ponerlos en la de inicio de nivel."
    self removeActors.
    self putActors.! !

!
PacManGame methodsFor: 'level loading' stamp: 'Ale 7/16/2004 18:51'!
resetActorsState
    "Poner a los actores con su estado inicial."
    pacMan resetState.
    self ghosts
        do:[:each | each resetState].! !

!
PacManGame methodsFor: 'level loading' stamp: 'Ale 7/16/2004 17:01'!
resetLevel
    "Reiniciar posiciones y estado de los actores en el board."
    self resetActorsPosition.
    self resetActorsState.
! !


!PacManGame methodsFor: 'pacManMoves' stamp: 'Ale 7/16/2004 17:01'!

pacManDown
    "Se indico que el pacMan vaya hacia abajo."
    self pacMan wantedDirection: (0@1).! !

!
PacManGame methodsFor: 'pacManMoves' stamp: 'Ale 7/16/2004 17:01'!
pacManLeft
    "Se indico que el pacMan vaya hacia la izquierda."
    self pacMan wantedDirection: (-1@0).! !

!
PacManGame methodsFor: 'pacManMoves' stamp: 'Ale 7/16/2004 17:01'!
pacManRight
    "Se indico que el pacMan vaya hacia la derecha."
    self pacMan wantedDirection: (1@0).! !

!
PacManGame methodsFor: 'pacManMoves' stamp: 'Ale 7/16/2004 17:02'!
pacManUp
    "Se indico que el pacMan vaya hacia arriba."
    self pacMan wantedDirection: (0@-1).! !


!PacManGame methodsFor: 'turn processing' stamp: 'Ale 7/16/2004 18:50'!

isLevelClear
    "Informa si todas las pastillas del nivel actual fueron comidas."
    ^ (level pills union: level powerPills) size isZero
! !

!PacManGame methodsFor: 'turn processing' stamp: 'Ale 7/16/2004 17:02'!
isPacManDead
    "Informa si el pacMan esta muerto."
    ^ self pacMan alive not! !

!PacManGame methodsFor: 'turn processing' stamp: 'Ale 7/16/2004 18:51'!
moveActors
    "Mueve todos los actores."
    pacMan moveOn: board.
    ghosts
        do: [:each | each moveOn: board].
    fruits
        do: [:each | each moveOn: board].
! !

!PacManGame methodsFor: 'turn processing' stamp: 'Ale 7/16/2004 17:03'!
processTurn
    "Procesar un turno."
    self moveActors.
    self ruleManager process: self.
    self changed.! !

!PacManGame methodsFor: 'turn processing' stamp: 'Ale 7/16/2004 18:51'!
step
    "Se recibio un step desde el timer del modelo."
    self gameOver
        ifFalse:[ self processTurn ]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PacManGame class
    instanceVariableNames: ''!

 


!PacManGame class methodsFor: 'as yet unclassified' stamp: 'Ale 6/21/2004 10:20'!

new

    ^(super new) initialize.! !

 


StringMorph subclass: #GameTimer
    instanceVariableNames: 'pacManGame stepTime '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP Core'!

 


!GameTimer methodsFor: 'accesing' stamp: 'Ale 7/16/2004 16:42'!

pacManGame
    ^ pacManGame ! !

!GameTimer methodsFor: 'accesing' stamp: 'Ale 7/16/2004 16:42'!
pacManGame: aPacManGame
    pacManGame := aPacManGame! !

!GameTimer methodsFor: 'accesing' stamp: 'Ale 7/16/2004 16:42'!
stepTime
    ^ stepTime! !

!GameTimer methodsFor: 'accesing' stamp: 'Ale 7/16/2004 16:42'!
stepTime: aNumber
    stepTime := aNumber! !


!GameTimer methodsFor: 'actions' stamp: 'Ale 7/16/2004 16:43'!

step
    self pacManGame step.
! !


!GameTimer methodsFor: 'initialize' stamp: 'Ale 7/17/2004 21:23'!

initializeWith: aPacManGame
    self stopStepping.
    self pacManGame: aPacManGame.
    self stepTime: 1.
    self position: 500@0.
    self contents: 'Un Timer'! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:33:12 am'!

Object subclass: #Board
    instanceVariableNames: 'positions objects extent gridSize '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP Core'!

 


!Board methodsFor: 'accesors' stamp: 'Ale 7/16/2004 16:21'!

extent
    ^ extent! !

!Board methodsFor: 'accesors' stamp: 'Ale 7/16/2004 16:21'!
extent: aPoint
    extent := aPoint! !

!Board methodsFor: 'accesors' stamp: 'Ale 7/16/2004 16:22'!
gridSize
    ^ gridSize! !

!Board methodsFor: 'accesors' stamp: 'Ale 7/16/2004 16:23'!
gridSize: aNumber
    ^ gridSize := aNumber! !

!Board methodsFor: 'accesors' stamp: 'Ale 6/23/2004 17:00'!
objects
    ^ objects! !

!
Board methodsFor: 'accesors' stamp: 'Ale 7/16/2004 16:22'!
objects: aDictionary
    objects := aDictionary! !

!Board methodsFor: 'accesors' stamp: 'Ale 6/28/2004 17:27'!
positions
    ^ positions! !

!Board methodsFor: 'accesors' stamp: 'Ale 7/16/2004 16:22'!
positions: aDictionary
    positions := aDictionary! !


!Board methodsFor: 'game concepts' stamp: 'Ale 7/16/2004 16:23'!

isAtGridPoint: anObject
    " Informa si anObject esta ubicado en un gridPoint. "
    ^ self isGridPoint: (self positionOf: anObject).
! !

!Board methodsFor: 'game concepts' stamp: 'Ale 7/16/2004 16:23'!
isGridPoint: aPoint
    " Informa si una coordenada es un gridPoint. "
    | grid |
    grid := self gridSize.
    ^ ((aPoint x) - (grid/2) / grid) isInteger and: [((aPoint y) - (grid/2) / grid) isInteger].
! !


!Board methodsFor: 'initializing' stamp: 'Ale 7/16/2004 16:23'!

initialize
    self positions: Dictionary new.
    self objects: Dictionary new.
    self extent: (0@0).
    self gridSize: 0.! !


!Board methodsFor: 'adding/removing' stamp: 'Ale 7/16/2004 16:36'!

put: anObject at: aPoint
    " Agregar anObject en la posicion aPoint al board."
    positions at: anObject put: aPoint.
    self objects at: aPoint put: ((self objectsAt: aPoint) add: anObject; yourself).

! !

!Board methodsFor: 'adding/removing' stamp: 'Ale 7/11/2004 14:28'!
remove: anObject

    | aPoint |   

    aPoint := self positionOf: anObject.

    (self objects at: aPoint) remove: anObject.
   
    (self objects at: aPoint) isEmpty
        ifTrue: [ self objects removeKey: aPoint ].
   
    positions removeKey: anObject
! !


!Board methodsFor: 'observing' stamp: 'Ale 7/16/2004 16:25'!

includes: anObject
    " Informa si anObejct esta presente en el board."
    ^ positions keys includes: anObject.! !

!Board methodsFor: 'observing' stamp: 'Ale 7/16/2004 16:25'!
objectsAt: aPoint
    " Informa los objetos presentes en el board en la posicion aPoint. "
    (self objects includesKey: aPoint)
        ifTrue: [ ^ objects at: aPoint ]
        ifFalse: [ ^ (Set new) ]! !

!Board methodsFor: 'observing' stamp: 'Ale 7/16/2004 16:41'!
objectsAt: aPoint axis: aDirection distance: aNumber
    "Objetos a distancia aNumner en direccion aDirection desde aPoint."
    | returnSet inspectPoint |
    returnSet := Set new.
    0 to: aNumber do:
        [ :each |
            inspectPoint := aPoint + (aDirection * each).
            returnSet := returnSet union: (self objectsAt: inspectPoint).].

    ^ returnSet
! !

!Board methodsFor: 'observing' stamp: 'Ale 7/16/2004 16:24'!
positionOf: anObject
    " Informa la posicion de anObject en el board."
    ^ positions at: anObject! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Board class
    instanceVariableNames: ''!

 


!Board class methodsFor: 'as yet unclassified' stamp: 'Ale 6/21/2004 09:11'!

new

    ^ (super new) initialize! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:34:02 am'!

Object subclass: #Level
    instanceVariableNames: 'layout fruit turnsToFruit ghostHome pacManHome fruitHome pills walls powerPills ghostOnlyWalls classRepository layoutRepository fruitRepository '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP Core'!

 


!Level methodsFor: 'layout processing' stamp: 'Ale 7/18/2004 20:44'!

addFile: aFile number: aFileNumber to: aBoard
    "Agregar una fila del layout al board."
    1 to: aFile size
        do: [:aColNumber | self
                addPiece: (aFile at: aColNumber)
                at: aColNumber - 1 @ aFileNumber
                to: aBoard]! !

!Level methodsFor: 'layout processing' stamp: 'Ale 7/16/2004 18:00'!
addPiece: aSymbol at: aPoint to: aBoard
    "Agregar un elemento del layout al board."
    | aGridPoint aPiece |
    aPiece := self symbolToInstance: aSymbol.
    aGridPoint := self pointToGrid: aPoint.
    aPiece addToLevel: self.
    aBoard put: aPiece at: aGridPoint.
! !

!Level methodsFor: 'layout processing' stamp: 'Ale 7/16/2004 17:17'!
gridSize
    "Separacion entre puntos de grilla."
    ^18! !

!Level methodsFor: 'layout processing' stamp: 'Ale 7/17/2004 21:28'!
initializeBoard: aBoard
    aBoard initialize.
    1
        to: layout size
        do: [:fileNumber | self
                addFile: (layout at: fileNumber)
                number: fileNumber - 1
                to: aBoard].
    aBoard extent: (layout at: 1) size * self gridSize @ (layout size * self gridSize).
    aBoard gridSize: self gridSize.
! !

!Level methodsFor: 'layout processing' stamp: 'Ale 7/17/2004 11:53'!
initializeGhosts: aGhostSet

    aGhostSet do: [:each | each ghostHome: (self ghostHome)].! !

!Level methodsFor: 'layout processing' stamp: 'Ale 7/16/2004 18:12'!
numberToGrid: aNumber.
    "Convierte un numero a la posicion de grid asociada."
    aNumber = 0
        ifTrue: [^ self gridSize / 2]
        ifFalse: [^ self gridSize * aNumber + (self gridSize / 2)].
! !

!Level methodsFor: 'layout processing' stamp: 'Ale 7/16/2004 18:12'!
pointToGrid: aPoint
    "Convierte una posicion del layout del nivel a una posicion grid del
    board. "
    | xGrid yGrid |
    xGrid := self numberToGrid: aPoint x.
    yGrid := self numberToGrid: aPoint y.
    ^ (xGrid@yGrid)

! !

!Level methodsFor: 'layout processing' stamp: 'Ale 7/16/2004 18:03'!
symbolToInstance: aSymbol
    "Convierte un simbolo del layout a una instancia para poner en el
    board. "
    ^ (self classRepository
        select: [:each | each isMyLayoutId: aSymbol]) anyOne new! !


!Level methodsFor: 'initialize' stamp: 'Ale 7/17/2004 20:10'!

initialize
    self pills: Set new.
    self powerPills: Set new.
    self walls: Set new.
    self ghostOnlyWalls: Set new.
    self initializeClassRepository.
    self initializeLayoutRepository.
    self initializeFruitRepository.! !

!Level methodsFor: 'initialize' stamp: 'Ale 7/18/2004 20:47'!
initializeClassRepository
    "Clases asociadas a los simbolos que pueden aparecer en un layout de un nivel."
    self classRepository: Set new.
    self classRepository add: Wall.
    self classRepository add: Pill.
    self classRepository add: PowerPill.
    self classRepository add: GhostOnlyWall.
    self classRepository add: GhostHome.
    self classRepository add: PacManHome.! !

!Level methodsFor: 'initialize' stamp: 'Ale 7/19/2004 15:44'!
initializeFruitRepository
    "Fruits del juego, una por nivel."

    | aFruitRepository |
    aFruitRepository := OrderedCollection new.
    aFruitRepository addLast: (Cherry new) initialize.
    aFruitRepository addLast: (Apple new) initialize.
    aFruitRepository addLast: (Bannana new) initialize.
    aFruitRepository addLast: (Peach new) initialize.
    fruitRepository := aFruitRepository.! !

!Level methodsFor: 'initialize' stamp: 'Ale 7/19/2004 15:46'!
initializeLayoutRepository
    "Layouts del juego, uno por nivel."

    | aLayoutRepository |
    aLayoutRepository := OrderedCollection new.

    aLayoutRepository addLast: #(
#(w w w w w w w w w w w w w w w)
#(w s p p p p p p p p p p p s w)
#(w p w w w w p w p w w w w p w)
#(w p p p p w p p p w p p p p w)
#(w p w w p w p w p w p w w p w)
#(w p p p p p p p p p p p p p w)
#(w p w p w p w w w p w p w p w)
#(w p w p p p p p p p p p w p w)
#(w p w w p w w d w w p w w p w)
#(w p p p p p w G w p p p p p w)
#(w p w w w p w w w p w w w p w)
#(w s p p p p p P p p p p p s w)
#(w w w w w w w w w w w w w w w)
).

    aLayoutRepository addLast: #(
#(w w w w w w w w w w w w w w w)
#(w p p p p p w w w p p p p p w)
#(w p w p w p p s p p w p w p w)
#(w p p p w w p w p w w p p p w)
#(w p w w w w p w p w w w w p w)
#(w p p p p p p p p p p p p p w)
#(w w w p w w w s w w w p w w w)
#(w p p p p p p p p p p p p p w)
#(w p w w w p w d w p w w w p w)
#(w p p p w p w G w p w p p p w)
#(w p w p w p w w w p w p w p w)
#(w p p p p p p p P p p p p p w)
#(w w w w w w w w w w w w w w w)
).

    aLayoutRepository addLast: #(
#(w w w w w w w w w w w)
#(w p p p p p p p p s w)
#(w p w w p w p w w p w)
#(w p w p p p p p w p w)
#(w p p p w d w p p p w)
#(w p w w w G w w w p w)
#(w p p p w w w p p p w)
#(w p w p p P p p w p w)
#(w p w w p w p w w p w)
#(w s p p p p p p p p w)
#(w w w w w w w w w w w)
).




aLayoutRepository addLast:
#(
#(w w w w w w w w w w w w w w w w w w w)
#(w s p p p p p p p p p p p p p p p s w)
#(w p w w p w p w p w p w p w p w w p w)
#(w p p p p p p p p w p p p p p p p p w)
#(w p w w p w p w w w w w p w p w w p w)
#(w p p p p p p p p p p p p p p p p p w)
#(w p w p w w p p w d w p p w w p w p w)
#(w p w p w w p p w G w p p w w p w p w)
#(w p p p p p p p w w w p p p p p p p w)
#(w p w p w w p p p p p p p w w p w p w)
#(w p w p w w p w w w w w p w w p w p w)
#(w p w p w w p p p p p p p w w p w p w)
#(w p w p p p p w w w w w p p p p w p w)
#(w p p p w w p w w w w w p w w p p p w)
#(w p w p p w p p p P p p p w p p w p w)
#(w p w w p w w w w p w w w w p w w p w)
#(w s p p p p p p p p p p p p p p p s w)
#(w w w w w w w w w w w w w w w w w w w)
).



    layoutRepository := aLayoutRepository.! !

!Level methodsFor: 'initialize' stamp: 'Ale 7/18/2004 10:01'!
loadLevel: aNumber

    self initialize.
    self layout: (layoutRepository at: aNumber).
    self fruit: (fruitRepository at: aNumber).
    self turnsToFruit: 400 atRandom.

! !


!Level methodsFor: 'set wrapers' stamp: 'Ale 7/16/2004 17:14'!

addGhostOnlyWall: aGhostOnlyWall
    self ghostOnlyWalls add: aGhostOnlyWall! !

!Level methodsFor: 'set wrapers' stamp: 'Ale 7/16/2004 17:14'!
addPill: aPill
    self pills add: aPill    ! !

!Level methodsFor: 'set wrapers' stamp: 'Ale 7/16/2004 17:14'!
addPowerPill: aPowerPill
    self powerPills add: aPowerPill    ! !

!Level methodsFor: 'set wrapers' stamp: 'Ale 7/16/2004 17:14'!
addWall: aWall
    self walls add: aWall! !

!Level methodsFor: 'set wrapers' stamp: 'Ale 7/16/2004 17:14'!
removePill: aPill
    self pills remove: aPill    ! !

!Level methodsFor: 'set wrapers' stamp: 'Ale 7/16/2004 17:14'!
removePowerPill: aPowerPill
    self powerPills remove: aPowerPill    ! !


!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:49'!

classRepository
    ^ classRepository! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:50'!
classRepository: aSet
    classRepository := aSet! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:13'!
fruit
    ^ fruit! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:13'!
fruit: aFruit
    fruit := aFruit! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:13'!
fruitHome
    "La fruit tiene la misma posicion inicial que el pacman (asi lo hace la version de
    ejemplo que esta en la pagina de la materia)"
    ^ pacManHome! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/17/2004 10:41'!
fruitHome: aFruitHome
    fruitHome := aFruitHome! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/17/2004 11:54'!
ghostHome
    ^ ghostHome! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/17/2004 11:54'!
ghostHome: aGhostHome
    ghostHome := aGhostHome! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:11'!
ghostOnlyWalls
    ^ ghostOnlyWalls! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:11'!
ghostOnlyWalls: aGhostOnlyWallSet
    ghostOnlyWalls := aGhostOnlyWallSet.! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:11'!
layout
    ^ layout! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:11'!
layout: aSortedCollection
    layout := aSortedCollection.! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:11'!
pacManHome
    ^ pacManHome! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/17/2004 10:42'!
pacManHome: aPacManHome
    pacManHome := aPacManHome! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:10'!
pills
    ^ pills! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:10'!
pills: aPillSet
    pills := aPillSet! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:10'!
powerPills
    ^ powerPills! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:10'!
powerPills: aPowerPillSet
    powerPills := aPowerPillSet! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:10'!
turnsToFruit
    ^ turnsToFruit! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:10'!
turnsToFruit: aNumber
    turnsToFruit := aNumber! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:10'!
walls
    ^ walls! !

!Level methodsFor: 'accesors' stamp: 'Ale 7/16/2004 17:10'!
walls: aWallSet
    walls := aWallSet! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Level class
    instanceVariableNames: ''!


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:35:47 am'!

Object subclass: #RuleManager
    instanceVariableNames: 'powerPillManager pillManager fruitManager '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP Managers'!

 


!RuleManager methodsFor: 'accesing' stamp: 'Ale 7/17/2004 10:11'!

fruitManager
    ^ fruitManager! !

!RuleManager methodsFor: 'accesing' stamp: 'Ale 7/17/2004 10:11'!
fruitManager: aFruitManager
    fruitManager := aFruitManager! !

!RuleManager methodsFor: 'accesing' stamp: 'Ale 7/17/2004 10:11'!
pillManager
    ^ pillManager! !

!RuleManager methodsFor: 'accesing' stamp: 'Ale 7/17/2004 10:11'!
pillManager: aPillManager
    pillManager := aPillManager! !

!RuleManager methodsFor: 'accesing' stamp: 'Ale 7/17/2004 10:11'!
powerPillManager
    ^ powerPillManager! !

!RuleManager methodsFor: 'accesing' stamp: 'Ale 7/17/2004 10:11'!
powerPillManager: aPowerPillManager
    powerPillManager := aPowerPillManager! !


!RuleManager methodsFor: 'processing' stamp: 'Ale 7/17/2004 10:10'!

decrementLives: aGame.
    aGame lives: (aGame lives - 1). ! !

!RuleManager methodsFor: 'processing' stamp: 'Ale 7/17/2004 10:10'!
isOver: aGame
    ^ aGame lives isZero
! !

!RuleManager methodsFor: 'processing' stamp: 'Ale 7/17/2004 10:10'!
loadNextLevel: aGame
    aGame loadLevel: ( aGame levelNumber + 1).! !

!RuleManager methodsFor: 'processing' stamp: 'Ale 7/17/2004 10:10'!
pacManDead: aGame
    "Acciones a tomar cuando el pacMan muere."
    self decrementLives: aGame.
    (self isOver: aGame)
        ifFalse: [aGame resetLevel]
        ifTrue: [aGame gameOver: true].! !


!RuleManager methodsFor: 'processing' stamp: 'Ale 7/17/2004 10:08'!
process: aGame
    self fruitManager process: aGame.
    self powerPillManager process: aGame.
    self pillManager process: aGame.
    self processGameRules: aGame.! !

!RuleManager methodsFor: 'processing' stamp: 'Ale 7/17/2004 10:09'!
processGameRules: aGame
    aGame isPacManDead
        ifTrue: [self pacManDead: aGame].
    aGame isLevelClear
        ifTrue: [self loadNextLevel: aGame].! !


!RuleManager methodsFor: 'initializing' stamp: 'Ale 7/11/2004 16:42'!

initialize

    self fruitManager: (FruitManager new).
    self powerPillManager: (PowerPillManager new).
    self pillManager: (PillManager new).! !

!RuleManager methodsFor: 'initializing' stamp: 'Ale 7/17/2004 10:11'!
initializeWith: aGame
    self fruitManager: (FruitManager new initializeWith: aGame).
    self powerPillManager: (PowerPillManager new initialize).
    self pillManager: (PillManager new).! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:36:56 am'!

Object subclass: #PowerPillManager
    instanceVariableNames: 'duration '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP Managers'!

 


!PowerPillManager methodsFor: 'initializing' stamp: 'Ale 7/17/2004 09:57'!

initialize
    self duration: -1.! !


!PowerPillManager methodsFor: 'accesing' stamp: 'Ale 7/17/2004 09:57'!

duration
    ^ duration! !

!PowerPillManager methodsFor: 'accesing' stamp: 'Ale 7/17/2004 09:57'!
duration: aNumber
    duration := aNumber! !


!PowerPillManager methodsFor: 'filtering ghosts' stamp: 'Ale 7/17/2004 09:57'!

aliveGhosts: aGame
    ^ aGame ghosts select:[:each | each eated not].
! !

!PowerPillManager methodsFor: 'filtering ghosts' stamp: 'Ale 7/17/2004 09:57'!
weakGhosts: aGame
    ^ aGame ghosts select:[:each | each weak].
! !


!PowerPillManager methodsFor: 'process' stamp: 'Ale 7/17/2004 09:57'!

decreaseDuration
    self duration: (self duration) - 1.! !

!PowerPillManager methodsFor: 'process' stamp: 'Ale 7/17/2004 10:06'!
process: aGame
    "Remueve las superPills comidas, revisa si es momento de detener el efecto
    de alguna superPill activada."
    self removeEated: aGame.
    self isActive
        ifTrue: [
            self decreaseDuration.
            self tryRecoverGhosts: aGame.
            self tryStopEffect: aGame. ]
! !

!PowerPillManager methodsFor: 'process' stamp: 'Ale 7/17/2004 09:59'!
recoveringGhosts: aGame
    "Avisar a los ghost que esta por expriar el efecto de la powerPill."
    (self aliveGhosts: aGame) do: [:each | each beRecovering].
! !


!PowerPillManager methodsFor: 'process' stamp: 'Ale 7/17/2004 10:04'!
removeEated: aGame
    "Elimina las superPills comidas, inicia el efecto de la superPill."
    | pillsToRemove |
    pillsToRemove := aGame level powerPills select: [:each | each eated].
    pillsToRemove do: [:each |
                aGame board remove: each.
                aGame level removePowerPill: each.
                aGame addScore: each score.
                self startEffect: each turnsToLive on: aGame ]! !

!PowerPillManager methodsFor: 'process' stamp: 'Ale 7/17/2004 10:01'!
startEffect: turnsNumber on: aGame
    "Iniciar los efectos de la powerPill."
    self duration: turnsNumber.   
    aGame pacMan bePowerUp.
    (self aliveGhosts: aGame) do: [:each | each beWeak]
! !

!PowerPillManager methodsFor: 'process' stamp: 'Ale 7/17/2004 10:01'!
stopEffect: aGame
    "Detener los efectos de la powerPill."
    aGame pacMan beNormal.
    (self aliveGhosts: aGame) do: [:each | each beNormal].

! !

!PowerPillManager methodsFor: 'process' stamp: 'Ale 7/17/2004 09:58'!
tryRecoverGhosts: aGame
    "Si esta por expirar el efecto de la pildora avisar a los ghost que se
    estan por recuperar."
    self isNearExpire ifTrue: [ self recoveringGhosts: aGame ].! !

!PowerPillManager methodsFor: 'process' stamp: 'Ale 7/17/2004 10:05'!
tryStopEffect: aGame
    "Si se termino la duracion de la superPill, detener su efecto."
    self shouldStopEffect ifTrue: [ self stopEffect: aGame ].
! !


!PowerPillManager methodsFor: 'observing' stamp: 'Ale 7/17/2004 09:59'!

isActive
    ^ self duration > 0! !

!PowerPillManager methodsFor: 'observing' stamp: 'Ale 7/17/2004 09:59'!
isNearExpire
    ^ self isActive and: [self duration < 15].! !

!PowerPillManager methodsFor: 'observing' stamp: 'Ale 7/17/2004 09:59'!
shouldStopEffect
    ^ duration = 0.! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:37:35 am'!

Object subclass: #PillManager
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP Managers'!

 


!PillManager methodsFor: 'processing' stamp: 'Ale 7/17/2004 10:05'!

process: aGame
    "Remueve las pills comidas."
    self removeEated: aGame.

! !

!PillManager methodsFor: 'processing' stamp: 'Ale 7/18/2004 20:58'!
removeEated: aGame
    "Elimina las pills comidas."
    | pillsToRemove |
    pillsToRemove := aGame level pills select: [:each | each eated ].
    pillsToRemove do: [ :each |
        aGame board remove: each .
        aGame level removePill:
        each. aGame addScore: each score].
! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:38:34 am'!

Object subclass: #FruitManager
    instanceVariableNames: 'turnsToFruit '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP Managers'!

 


!FruitManager methodsFor: 'initializing' stamp: 'Ale 7/18/2004 20:56'!

initializeWith: aGame
    self turnsToFruit: aGame level turnsToFruit! !


!FruitManager methodsFor: 'accesing' stamp: 'Ale 7/18/2004 20:56'!

turnsToFruit
    ^ turnsToFruit! !

!FruitManager methodsFor: 'accesing' stamp: 'Ale 7/18/2004 20:56'!
turnsToFruit: aNumber
    turnsToFruit := aNumber! !


!FruitManager methodsFor: 'process' stamp: 'Ale 7/17/2004 09:54'!

decreaseTimeToFruit
    self turnsToFruit: (self turnsToFruit - 1).
! !

!FruitManager methodsFor: 'process' stamp: 'Ale 7/17/2004 09:41'!
isFruitOnPlay: aGame
    "Informa si la fruta esta en juego."
    ^ aGame fruits size isZero not! !

!FruitManager methodsFor: 'process' stamp: 'Ale 7/17/2004 09:44'!
process: aGame
    "Pone o quita la fruta del juego. "
    (self isFruitOnPlay: aGame)
        ifTrue: [self removeEated: aGame]
        ifFalse: [self tryPutFruitOn: aGame]
       
! !

!FruitManager methodsFor: 'process' stamp: 'Ale 7/18/2004 20:57'!
removeEated: aGame
    "Elimina las fruits comidas."
    | fruitsToRemove |
    fruitsToRemove := aGame fruits select: [:each | each eated].
    fruitsToRemove do: [:each |
        aGame board remove: each.
        aGame fruits remove: each.
        aGame addScore: (each score)].
! !

 

 

 


!FruitManager methodsFor: 'process' stamp: 'Ale 7/18/2004 20:58'!
tryPutFruitOn: aGame
    "Si es el momento, poner la fruta en juego."
    | aFruit aFruitHomePosition|
    self decreaseTimeToFruit.
    self turnsToFruit isZero
        ifTrue: [aFruit := aGame level fruit.
        aFruitHomePosition := aGame board positionOf: (aGame level fruitHome).
        aGame board put: aFruit at: aFruitHomePosition.
        aGame fruits add: aFruit].
! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:39 am'!

Object subclass: #CollisionManager
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP Managers'!

 


!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:52'!

askCollisionPermission: anActor to: anObjectSet on: aBoard
    " Preguntar a anObjectSet perteneciente a aBoard si puedo colisionar con ellos. "

    | responses return |
    return := true.

    responses := anObjectSet     collect: [ :each |   
        each perform: (anActor collisionAskSelector) with: anActor with: aBoard ].

    responses do: [ :each |
        return := return and: each].

    ^ return! !

!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:52'!
canAdvance: anActor on: aBoard
    "Informa si anActor puede avanzar en su direccion actual."
    | aviableDirections |
    aviableDirections := self permitedDirections: anActor on: aBoard.
    ^ aviableDirections includes: (anActor direction).! !

!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:52'!
collisionDirections
    " Direcciones en las que se verifican colisiones. "

    | return |
    return := Set new.
    return add: (1@0).
    return add: (-1@0).
    return add: (0@1).
    return add: (0@-1).

    ^ return! !

!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:53'!
collisionDistance: anActor
    "Distancia a la que se considera un objeto en colision"
    ^ ((anActor extent x)-1).! !

!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:53'!
collisionObjects: anActor on: aBoard at: aPoint direction: aDirection
    "Objectos en colision con anActor en una direccion."
    ^ aBoard objectsAt: aPoint axis: aDirection distance: (self collisionDistance: anActor).
! !

 


!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:53'!
collisionObjects: anActor on: aBoard direction: aDirection
    " Encontrar los objetos que colisionan en aDireccion. "
    | myPosition |
    myPosition := aBoard positionOf: anActor.
    ^ aBoard objectsAt: myPosition axis: aDirection distance: (self collisionDistance: anActor).! !

!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:54'!
collisionObjets: anActor on: aBoard
    " Encontrar los objetos que estan en colision con anActor. "
    | return |
    return := Set new.
    (self collisionDirections) do: [:each |
        return := return union: (self collisionObjects: anActor on: aBoard direction: each)].
    ^ return

! !

!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:54'!
collisionPermission: anActor on: aBoard at: aPoint direction: aDirection
    " Pedir permiso a los objetos en colision en aDirection estando en aPoint. "
    | collisionObjects collisionPermision |
    collisionObjects := self collisionObjects: anActor on: aBoard at: aPoint direction: aDirection.
    collisionPermision := self askCollisionPermission: anActor to: collisionObjects on:aBoard.
    ^ collisionPermision
! !

!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:54'!
notifyCollision: anObject from: anActor on: aBoard
    "Notificar anObject de que hubo una colision con anActor."
    anObject perform: (anActor collisionSelector) with: anActor with: aBoard.
! !

!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:54'!
notifyCollisions: anActor on: aBoard
    " Informar a los objetos en colision de esta situacion."
    (self collisionObjets: anActor on: aBoard)
        do: [:each | self notifyCollision: each from: anActor on: aBoard].! !

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


!CollisionManager methodsFor: 'colission' stamp: 'Ale 7/18/2004 20:55'!
permitedDirections: anActor on: aBoard
    " Retorna aSet con las direcciones en las que el actor tiene permiso para moverse. "
    | myPosition allDirections return |

    return := Set new.
    myPosition := aBoard positionOf: anActor.
    allDirections := self collisionDirections.

    allDirections do: [ :each ||testPosition anObjectSet|
        testPosition := myPosition + each.
        anObjectSet := self collisionObjects: anActor on: aBoard at: testPosition direction: each.
        (self askCollisionPermission: anActor to: anObjectSet on:aBoard)
            ifTrue: [return add: each].
    ].

    ^ return! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:40:22 am'!

Object subclass: #MoveStrategy
    instanceVariableNames: 'turnsToChoose actor '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Strategies'!

 


!MoveStrategy methodsFor: 'accesors' stamp: 'Ale 7/9/2004 15:57'!

actor

    ^ actor! !

!MoveStrategy methodsFor: 'accesors' stamp: 'Ale 7/9/2004 15:58'!
actor: anObject

    actor := anObject! !

!MoveStrategy methodsFor: 'accesors' stamp: 'Ale 7/9/2004 16:35'!
turnsToChoose

    ^ turnsToChoose! !

!MoveStrategy methodsFor: 'accesors' stamp: 'Ale 7/9/2004 16:35'!
turnsToChoose: aNumber

    turnsToChoose := aNumber! !


!MoveStrategy methodsFor: 'initializing' stamp: 'Ale 7/17/2004 11:32'!

initializeWith: anActor
    "Una estrategia esta asociada a un actor."
    self actor: anActor.   
    self forceTurnsToChoose.! !


!MoveStrategy methodsFor: 'strategy AI' stamp: 'Ale 7/19/2004 00:58'!

aviableDirectionsOn: aBoard
    "Las direcciones disponibles dependen de si el actor esta o no en una
    posicion gridPoint."

    ( aBoard isAtGridPoint: (self actor))
        ifTrue: [^ self gridPointAviableDirectionsOn: aBoard ]
        ifFalse: [^ self nonGridPointAviableDirectionsOn: aBoard ].

! !

!MoveStrategy methodsFor: 'strategy AI' stamp: 'Ale 7/19/2004 00:57'!
calculateDirectionOn: aBoard
    " Seleccionar las direcciones posibles, quedarse con la mejor segun la estrategia."
    | aviableDirections |
    aviableDirections := self aviableDirectionsOn: aBoard.
    ^ self selectBestDirection: aviableDirections on: aBoard.
! !

!MoveStrategy methodsFor: 'strategy AI' stamp: 'Ale 7/19/2004 00:58'!
gridPointAviableDirectionsOn: aBoard
    "Direcciones disponibles cuando el actor esta en un gridPoint."
    self subclassResponsibility.! !

!MoveStrategy methodsFor: 'strategy AI' stamp: 'Ale 7/19/2004 00:58'!
nonGridPointAviableDirectionsOn: aBoard
    "Direcciones disponibles cuando el actor no esta en un gridPoint."
    self subclassResponsibility.! !

!MoveStrategy methodsFor: 'strategy AI' stamp: 'Ale 7/19/2004 00:59'!
selectBestDirection: aviableDirections on: aBoard
    "Seleccionar la mejor direccion entre las aviableDirections."
    self subclassResponsibility.! !


!MoveStrategy methodsFor: 'strategy' stamp: 'Ale 7/17/2004 12:32'!

canAdvanceOn: aBoard
    "Informa si el actor puede avanzar en el board."
    ^ self actor collisionManager canAdvance: (self actor) on: aBoard! !

!MoveStrategy methodsFor: 'strategy' stamp: 'Ale 7/19/2004 00:52'!
chooseDirectionOn: aBoard
    " Si es necesario, seleccionar una nueva direccion de movimiento."
    self decreaseTurnsToChoose.
    (self shouldChooseDirectionOn: aBoard)
        ifTrue:[ self chooseNewDirectionOn: aBoard; resetTurnsToChoose].
! !

!MoveStrategy methodsFor: 'strategy' stamp: 'Ale 7/9/2004 16:33'!
chooseNewDirectionOn: aBoard

    "Calcular una nueva direccion e informar al actor."

    self actor direction: (self calculateDirectionOn: aBoard).
! !

!MoveStrategy methodsFor: 'strategy' stamp: 'Ale 7/9/2004 16:43'!
decreaseTurnStep

    " Cantidad en la que se decrementa el contador de turnos."

    ^ 1

! !

!MoveStrategy methodsFor: 'strategy' stamp: 'Ale 7/9/2004 17:00'!
decreaseTurnsToChoose

    "Decrementar el contador de turnos."

    self turnsToChoose: ((self turnsToChoose) - self decreaseTurnStep).
! !

 

 


!MoveStrategy methodsFor: 'strategy' stamp: 'Ale 7/9/2004 17:28'!
forceTurnsToChoose

    "Inicializar el valor del contador de turnos."

    self turnsToChoose: 1.
! !

!MoveStrategy methodsFor: 'strategy' stamp: 'Ale 7/9/2004 16:57'!
resetTurnsToChoose

    "Inicializar el valor del contador de turnos."

    self subclassResponsibility.
! !

!MoveStrategy methodsFor: 'strategy' stamp: 'Ale 7/17/2004 12:34'!
shouldChooseDirectionOn: aBoard

    "Condicion para seleccionar una nueva direccion."

    ^ self turnsToChoose isZero or: [(self canAdvanceOn: aBoard) not]! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:40:54 am'!

MoveStrategy subclass: #Targeted
    instanceVariableNames: 'target '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Strategies'!

 


!Targeted methodsFor: 'accesors' stamp: 'Ale 7/9/2004 16:04'!

target

    ^ target! !

!Targeted methodsFor: 'accesors' stamp: 'Ale 7/9/2004 16:04'!
target: anObject

    target := anObject! !


!Targeted methodsFor: 'distance' stamp: 'Ale 7/9/2004 19:40'!

farestDirectionToTarget: aDirectionSet on: aBoard

    | myPosition aDistance targetPosition bestDirection |

    myPosition := aBoard positionOf: (self actor).
    targetPosition := aBoard positionOf: (self target).

    aDistance := 0.

    aDirectionSet do:[ :each || testPosition|
        testPosition := myPosition + each.
        (aDistance < (testPosition dist: targetPosition))
            ifTrue: [aDistance := (testPosition dist: targetPosition). bestDirection := each]].

    ^ bestDirection.
! !

!Targeted methodsFor: 'distance' stamp: 'Ale 7/17/2004 19:47'!
nearestDirectionToTarget: aDirectionSet on: aBoard

    | myPosition aDistance targetPosition bestDirection |

    myPosition := aBoard positionOf: (self actor).
    targetPosition := aBoard positionOf: (self target).

    aDistance := (aBoard extent x) squared + (aBoard extent y) squared.

    aDirectionSet do:[ :each || testPosition|
        testPosition := myPosition + each.
        (aDistance > (testPosition dist: targetPosition))
            ifTrue: [aDistance := (testPosition dist: targetPosition). bestDirection := each]].

    ^ bestDirection.
! !


!Targeted methodsFor: 'initializing' stamp: 'Ale 7/17/2004 19:48'!

initializeWith: anActor target: anObject

    super initializeWith: anActor.
    self target: anObject.! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:41:36 am'!

Targeted subclass: #ChaseEasy
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Strategies'!

 


!ChaseEasy methodsFor: 'strategy' stamp: 'Ale 7/20/2004 02:21'!

gridPointAviableDirectionsOn: aBoard
    " pedir las direcciones libres de colision, eliminar la opcion de retroceder "
    | aviableDirections |
    aviableDirections := self actor collisionManager permitedDirections: (self actor) on: aBoard.
    aviableDirections remove: ((self actor direction) * -1) ifAbsent: [].
    ^ aviableDirections! !

!ChaseEasy methodsFor: 'strategy' stamp: 'Ale 7/20/2004 02:21'!
nonGridPointAviableDirectionsOn: aBoard
    " Fuera de un gridPoint solo se puede seguir en la misma direccion. "
    | aviableDirections |
    aviableDirections := Set new.
    aviableDirections add: (self actor direction).
    ^ aviableDirections! !

!ChaseEasy methodsFor: 'strategy' stamp: 'Ale 7/17/2004 12:28'!
resetTurnsToChoose

    self turnsToChoose: self actor smartness.! !

!ChaseEasy methodsFor: 'strategy' stamp: 'Ale 7/17/2004 12:36'!
selectBestDirection: aviableDirections on: aBoard
    "Si es momento de elegir una direccion buscar la mejor, pero sino (no puede avanzar en
    su direccion) entonces elegir una al azar."

    self turnsToChoose isZero
        ifTrue: [^ self nearestDirectionToTarget: aviableDirections on: aBoard]
        ifFalse: [^ aviableDirections atRandom]
! !


!ChaseEasy methodsFor: 'initializing' stamp: 'Ale 7/17/2004 12:28'!

initializeWith: anActor target: anObject

    super initializeWith: anActor.

    self target: anObject.
! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:42:06 am'!

Targeted subclass: #ChaseHard
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Strategies'!

 


!ChaseHard methodsFor: 'strategy' stamp: 'Ale 7/20/2004 02:21'!

gridPointAviableDirectionsOn: aBoard
    " pedir las direcciones libres de colision,, eliminar la opcion de retroceder "
    | aviableDirections |
    aviableDirections := self actor collisionManager permitedDirections: (self actor) on: aBoard.
    aviableDirections remove: ((self actor direction) * -1) ifAbsent: [].
    ^ aviableDirections! !

!ChaseHard methodsFor: 'strategy' stamp: 'Ale 7/20/2004 02:21'!
nonGridPointAviableDirectionsOn: aBoard
    " Fuera de un gridPoint solo se puede seguir en la misma direccion. "
    | aviableDirections |
    aviableDirections := Set new.
    aviableDirections add: (self actor direction).
    ^ aviableDirections! !

!ChaseHard methodsFor: 'strategy' stamp: 'Ale 7/9/2004 17:40'!
resetTurnsToChoose

    self turnsToChoose: self actor smartness.! !

!ChaseHard methodsFor: 'strategy' stamp: 'Ale 7/17/2004 12:37'!
selectBestDirection: aviableDirections on: aBoard
    "Siempre elegir la direccion mas cercana al target."
    ^ self nearestDirectionToTarget: aviableDirections on: aBoard.
! !


!ChaseHard methodsFor: 'initializing' stamp: 'Ale 7/9/2004 17:41'!

initializeWith: anActor target: anObject

    super initializeWith: anActor.

    self target: anObject.
! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:42:46 am'!

Targeted subclass: #Escape
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Strategies'!

 


!Escape methodsFor: 'strategy' stamp: 'Ale 7/20/2004 02:21'!

gridPointAviableDirectionsOn: aBoard
    | aviableDirections |
    aviableDirections := self actor collisionManager permitedDirections: (self actor) on: aBoard.
    aviableDirections remove: ((self actor direction) * -1) ifAbsent: [].
    ^ aviableDirections

    ! !

!Escape methodsFor: 'strategy' stamp: 'Ale 7/20/2004 02:22'!
nonGridPointAviableDirectionsOn: aBoard
    | aviableDirections |
    aviableDirections := Set new. aviableDirections add: (self actor direction).
    ^aviableDirections .


    ! !

!Escape methodsFor: 'strategy' stamp: 'Ale 7/17/2004 11:11'!
resetTurnsToChoose

    self turnsToChoose: self actor smartness.! !

!Escape methodsFor: 'strategy' stamp: 'Ale 7/9/2004 19:17'!
selectBestDirection: aviableDirections on: aBoard

    ^ self farestDirectionToTarget: aviableDirections on: aBoard.
! !


!Escape methodsFor: 'initializing' stamp: 'Ale 7/9/2004 17:49'!

initializeWith: anActor target: anObject

    super initializeWith: anActor.

    self target: anObject.! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:43:30 am'!

Targeted subclass: #GoHome
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Strategies'!

 


!GoHome methodsFor: 'strategy' stamp: 'Ale 7/12/2004 18:48'!

gridPointAviableDirectionsOn: aBoard

    | aviableDirections |
    aviableDirections := self actor collisionManager permitedDirections: (self actor) on: aBoard.
    aviableDirections remove: ((self actor direction) * -1) ifAbsent: [].

    ^ aviableDirections.


! !

!GoHome methodsFor: 'strategy' stamp: 'Ale 7/9/2004 19:21'!
nonGridPointAviableDirectionsOn: aBoard

    | aviableDirections |

    aviableDirections := Set new. aviableDirections add: (self actor direction).
    ^aviableDirections.
! !

!GoHome methodsFor: 'strategy' stamp: 'Ale 7/9/2004 17:54'!
resetTurnsToChoose

    self forceTurnsToChoose.! !

!GoHome methodsFor: 'strategy' stamp: 'Ale 7/9/2004 19:21'!
selectBestDirection: aviableDirections on: aBoard

    ^ self nearestDirectionToTarget: aviableDirections on: aBoard.
! !


!GoHome methodsFor: 'initializing' stamp: 'Ale 7/9/2004 20:43'!

initializeWith: anActor target: anObject

    super initializeWith: anActor target: anObject.

! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:44:25 am'!

MoveStrategy subclass: #GridRandom
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Strategies'!

 


!GridRandom methodsFor: 'strategy' stamp: 'Ale 7/12/2004 19:00'!

gridPointAviableDirectionsOn: aBoard

    | aviableDirections |
    aviableDirections := (self actor collisionManager) permitedDirections: (self actor) on: aBoard.
    aviableDirections remove: ((self actor direction) * -1) ifAbsent: [].

    ^ aviableDirections.

! !

!GridRandom methodsFor: 'strategy' stamp: 'Ale 7/9/2004 21:33'!
nonGridPointAviableDirectionsOn: aBoard

    | aviableDirections |
    aviableDirections := Set new.
    aviableDirections add: (self actor direction).

    ^ aviableDirections


! !

!GridRandom methodsFor: 'strategy' stamp: 'Ale 7/17/2004 19:44'!
resetTurnsToChoose
    self turnsToChoose: 1! !

!GridRandom methodsFor: 'strategy' stamp: 'Ale 7/9/2004 21:34'!
selectBestDirection: aviableDirections on: aBoard

    ^ aviableDirections atRandom.
! !


!GridRandom methodsFor: 'initializing' stamp: 'Ale 7/9/2004 21:33'!

initializeWith: anActor

    super initializeWith: anActor.
! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:44:53 am'!

MoveStrategy subclass: #LeaveHome
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Strategies'!

 


!LeaveHome methodsFor: 'strategy' stamp: 'Ale 7/17/2004 12:40'!

chooseDirectionOn: aBoard

    self decreaseTurnsToChoose.

    (self shouldChooseDirectionOn: aBoard)
        ifTrue:[ self actor beNormal].! !

!LeaveHome methodsFor: 'strategy' stamp: 'Ale 7/9/2004 17:06'!
resetTurnsToChoose

    ^ self turnsToChoose: 20! !


!LeaveHome methodsFor: 'initializing' stamp: 'Ale 7/9/2004 17:35'!

initializeWith: anActor

    super initializeWith: anActor.

    self resetTurnsToChoose.

    anActor direction: (0@-1).
! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:45:24 am'!

MoveStrategy subclass: #UserControlled
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Strategies'!

 


!UserControlled methodsFor: 'strategy' stamp: 'Ale 7/12/2004 18:55'!

gridPointAviableDirectionsOn: aBoard

    ^ (self actor collisionManager) permitedDirections: (self actor) on: aBoard.

! !

!UserControlled methodsFor: 'strategy' stamp: 'Ale 7/9/2004 19:22'!
nonGridPointAviableDirectionsOn: aBoard

    | aviableDirections |
    aviableDirections := Set new.
    aviableDirections add: (self actor direction).
    aviableDirections add: ((self actor direction) *-1).

    ^ aviableDirections


! !

!UserControlled methodsFor: 'strategy' stamp: 'Ale 7/9/2004 17:02'!
resetTurnsToChoose

    ^ self turnsToChoose: 1! !

!UserControlled methodsFor: 'strategy' stamp: 'Ale 7/9/2004 19:23'!
selectBestDirection: aviableDirections on: aBoard

    (aviableDirections includes: self actor wantedDirection)
        ifTrue: [ ^ self actor wantedDirection ]
        ifFalse: [ ^ self actor direction ]
! !


!UserControlled methodsFor: 'initializing' stamp: 'Ale 7/9/2004 16:58'!

initializeWith: anActor

    super initializeWith: anActor.
! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:48:31 am'!

Object subclass: #Actor
    instanceVariableNames: 'extent '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Abstract'!

 


!Actor methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:51'!

defaultExtent
    self subclassResponsibility.! !

!Actor methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:51'!
initialize
    self extent: self defaultExtent.
! !


!Actor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 19:51'!

extent
    ^ extent! !

!Actor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 19:51'!
extent: aPoint
    extent := aPoint! !


!Actor methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:51'!

canFruitCollision: aFruit on: aBoard
    "Informa si aFruit tiene permiso de colisionar con el receptor."
    self subclassResponsibility.! !

!Actor methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:51'!
canGhostCollision: aGhost on: aBoard
    "Informa si aGhost tiene permiso de colisionar con el receptor."
    self subclassResponsibility.! !

!Actor methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:51'!
canPacManCollision: aPacMan on: aBoard
    "Informa si aPacMan tiene permiso de colisionar con el receptor."
    self subclassResponsibility.! !

!Actor methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:51'!
fruitCollision: aFruit on: aBoard
    "Informa al receptor que esta en colision con aFruit."
    self subclassResponsibility.! !

!Actor methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:51'!
ghostCollision: aGhost on: aBoard
    "Informa al receptor que esta en colision con aGhost."
    self subclassResponsibility.! !

!Actor methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:51'!
pacManCollision: aPacMan on: aBoard
    "Informa al receptor que esta en colision con aPacMan."
    self subclassResponsibility.! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Actor class
    instanceVariableNames: ''!

 


!Actor class methodsFor: 'as yet unclassified' stamp: 'Ale 7/18/2004 19:51'!

new

    ^(super new) initialize! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:48:57 am'!

Actor subclass: #MovilActor
    instanceVariableNames: 'direction speed collisionManager collisionSelector collisionAskSelector moveStrategy '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Abstract'!

 


!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!

collisionAskSelector
    ^ collisionAskSelector! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
collisionAskSelector: aSymbol
    collisionAskSelector := aSymbol! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
collisionManager
    ^ collisionManager! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
collisionManager: aCollisionManager
    collisionManager := aCollisionManager.! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
collisionSelector
    ^ collisionSelector! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
collisionSelector: aSymbol
    collisionSelector := aSymbol! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
direction
    ^ direction! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
direction: aPoint
    direction := aPoint! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
moveStrategy
    ^ moveStrategy! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
moveStrategy: aMoveStrategy
    moveStrategy := aMoveStrategy! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
speed
    ^ speed! !

!MovilActor methodsFor: 'accessing' stamp: 'Ale 7/18/2004 20:04'!
speed: aNumber
    speed := aNumber! !


!MovilActor methodsFor: 'moving' stamp: 'Ale 7/18/2004 20:32'!

calculateNewPositionOn: aBoard
    "Calcular la siguiente posicion en aBoard."
    "Se asume que la estrategia del actor siempre le provee una direction en
    la que pueda moverse."
    ^ (aBoard positionOf: self) + self direction.
! !

!MovilActor methodsFor: 'moving' stamp: 'Ale 7/18/2004 20:05'!
moveOn: aBoard
    " Moverse en aBoard. "
    ^ self moveOn: aBoard times: (self speed)
    ! !

!MovilActor methodsFor: 'moving' stamp: 'Ale 7/18/2004 20:11'!
moveOn: aBoard times: aNumber
    " Moverse en aBoard devolviendo la nueva posicion y notificar las colisiones. "
    | newPosition |

    aNumber isZero
        ifTrue: [^ aBoard positionOf: self].

    self moveStrategy
        chooseDirectionOn: aBoard.

    newPosition := self calculateNewPositionOn: aBoard.

    aBoard
        remove: self;
        put: self at: newPosition.

    self collisionManager
        notifyCollisions: self on: aBoard.

    ^ self moveOn: aBoard times: (aNumber - 1)
    ! !


!MovilActor methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:56'!

initialize
    super initialize.
    self speed: 5.
    self direction: (-1@0).
! !


!MovilActor methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:12'!

canFruitCollision: aGhost on: aBoard
    "Los actores moviles de este juego pueden colisionar todos con todos."
    ^ true! !

!MovilActor methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:12'!
canGhostCollision: aGhost on: aBoard
    "Los actores moviles de este juego pueden colisionar todos con todos."
    ^ true! !

!MovilActor methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:12'!
canPacManCollision: aPacMan on: aBoard
    "Los actores moviles de este juego pueden colisionar todos con todos."
    ^ true! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

MovilActor class
    instanceVariableNames: ''!

 


!MovilActor class methodsFor: 'as yet unclassified' stamp: 'Ale 7/9/2004 19:46'!

new

    ^ (super new) initialize! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:49 am'!

Actor subclass: #StaticActor
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Abstract'!

 


!StaticActor methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:35'!

addToLevel: aLevel
    self subclassResponsibility.! !


!StaticActor methodsFor: 'operations' stamp: 'Ale 7/18/2004 19:38'!

isAtCollision: anObject on: aBoard
    "Verifica que la distancia entre centros de anObject con el receptor
    sea menor al extent del receptor."

    ^ ((aBoard positionOf: self) dist: (aBoard positionOf: anObject)) <= (self extent)! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

StaticActor class
    instanceVariableNames: ''!

 


!StaticActor class methodsFor: 'as yet unclassified' stamp: 'Ale 7/10/2004 17:13'!

new

    ^(super new) initialize! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:50:21 am'!

MovilActor subclass: #Ghost
    instanceVariableNames: 'eated pacMan ghostHome weak recovering '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Ghosts'!

 


!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 19:51'!

eated
    ^ eated! !

!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 19:52'!
eated: aBoolean
    eated := aBoolean.
! !

!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 11:50'!
ghostHome
    ^ ghostHome! !

!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 11:50'!
ghostHome: aGhostHome
    ghostHome := aGhostHome! !

!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 19:51'!
pacMan
    ^ pacMan! !

!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 19:51'!
pacMan: aPacMan
    pacMan := aPacMan! !

!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 19:51'!
recovering
    ^ recovering! !

!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 19:51'!
recovering: aBoolean
    recovering := aBoolean! !

!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 19:51'!
speed
    ^ speed! !

!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 19:52'!
speed: aNumber
    speed := aNumber! !

!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 19:52'!
weak
    ^ weak! !


!Ghost methodsFor: 'accessing' stamp: 'Ale 7/17/2004 19:52'!
weak: aBoolean
    weak := aBoolean.
! !


!Ghost methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:57'!

defaultExtent
    ^ (18@18)! !

!Ghost methodsFor: 'initializing' stamp: 'Ale 7/17/2004 11:12'!
initialize
    super initialize.
    self resetState.   
    self collisionSelector: #ghostCollision:on:.
    self collisionAskSelector: #canGhostCollision:on:.
! !

!Ghost methodsFor: 'initializing' stamp: 'Ale 7/18/2004 20:15'!
resetState
    self
        weak: false;
        recovering: false;
        eated:false;
        speed: self normalSpeed;
        leaveHome.! !


!Ghost methodsFor: 'strategy' stamp: 'Ale 7/18/2004 20:16'!

chaseEasy
    "Seleccionar esta estrategia de movimiento."
    self moveStrategy: (ChaseEasy new initializeWith: self target: (self pacMan))! !

!Ghost methodsFor: 'strategy' stamp: 'Ale 7/18/2004 20:16'!
chaseHard
    "Seleccionar esta estrategia de movimiento."
    self moveStrategy: (ChaseHard new initializeWith: self target: (self pacMan))! !

!Ghost methodsFor: 'strategy' stamp: 'Ale 7/18/2004 20:16'!
escape
    "Seleccionar esta estrategia de movimiento."
    self moveStrategy: (Escape new initializeWith: self target: (self pacMan)).! !

!Ghost methodsFor: 'strategy' stamp: 'Ale 7/18/2004 20:16'!
goHome
    "Seleccionar esta estrategia de movimiento."
    self moveStrategy: (GoHome new initializeWith: self target: self ghostHome).! !

!Ghost methodsFor: 'strategy' stamp: 'Ale 7/18/2004 20:16'!
gridRandom
    "Seleccionar esta estrategia de movimiento."
    self moveStrategy: (GridRandom new initializeWith: self)! !


!Ghost methodsFor: 'strategy' stamp: 'Ale 7/18/2004 20:16'!
isGoingHome
    "Informar si esta usando esta estategia de movimiento."
    ^ (self moveStrategy class) = GoHome.! !

!Ghost methodsFor: 'strategy' stamp: 'Ale 7/18/2004 20:17'!
isLeavingHome
    "Informar si esta usando esta estategia de movimiento."
    ^ (self moveStrategy class) = LeaveHome.! !

!Ghost methodsFor: 'strategy' stamp: 'Ale 7/18/2004 20:17'!
leaveHome
    "Seleccionar esta estrategia de movimiento."
    self moveStrategy: (LeaveHome new initializeWith: self)! !


!Ghost methodsFor: 'state changes' stamp: 'Ale 7/18/2004 20:20'!

beEated
    "Poner al ghost como comido."
    self eated: true.
    self weak: false.
    self recovering: false.
    self speed: (self normalSpeed * 1.4) ceiling.
    self goHome.! !

!Ghost methodsFor: 'state changes' stamp: 'Ale 7/18/2004 20:19'!
beLeavingHome
    "Poner al ghost partiendo de su casa."
    self resetState! !

!Ghost methodsFor: 'state changes' stamp: 'Ale 7/18/2004 20:19'!
beNormal
    "Poner al ghost en estado normal."
    self weak: false.
    self recovering: false.
    self speed: self normalSpeed.
    self normalStrategy.
! !

!Ghost methodsFor: 'state changes' stamp: 'Ale 7/18/2004 20:19'!
beRecovering
    "Poner al ghost recuperandose del efecto de la powerPill."
    self recovering: true.! !

!Ghost methodsFor: 'state changes' stamp: 'Ale 7/18/2004 20:19'!
beWeak
    "Poner al ghost debil."
    self weak: true.
    self recovering: false.
    self speed: 3.
    self escape.

! !


!Ghost methodsFor: 'state changes' stamp: 'Ale 7/18/2004 20:18'!
normalSpeed
    "Velocidad default que utiliza el ghost."
    self subclassResponsibility.
! !

!Ghost methodsFor: 'state changes' stamp: 'Ale 7/18/2004 20:18'!
normalStrategy
    "Estrategia default que utiliza el ghost."
    self subclassResponsibility.
! !

!Ghost methodsFor: 'state changes' stamp: 'Ale 7/18/2004 20:18'!
smartness
    "Un numero que indica cuan inteligente es el actor, lo utilizan
    las distintas estrategias. A mayor numero menor inteligencia."
    self subclassResponsibility.
! !


!Ghost methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:21'!

fruitCollision: aFruit on: aBoard
    "No realizar ninguna accion."! !

!Ghost methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:21'!
ghostCollision: aGhost on: aBoard
    "No realizar ninguna accion."! !

!Ghost methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:20'!
pacManCollision: aPacman on: aBoard
    "Al colisionar con aPacMan verificar si estaba debil y cambiar su estado
    en consecuencia."
    self weak
        ifTrue: [self beEated]
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Ghost class
    instanceVariableNames: ''!

 


!Ghost class methodsFor: 'as yet unclassified' stamp: 'Ale 6/23/2004 18:49'!

new

    ^(super new) initialize! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:50:46 am'!

Ghost subclass: #Blinky
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Ghosts'!

 


!Blinky methodsFor: 'state changes' stamp: 'Ale 7/17/2004 11:23'!

normalSpeed
    ^ 5! !

!Blinky methodsFor: 'state changes' stamp: 'Ale 7/17/2004 12:38'!
normalStrategy
    self chaseHard
! !

!Blinky methodsFor: 'state changes' stamp: 'Ale 7/17/2004 11:40'!
smartness
    ^ 1! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:51:15 am'!

Ghost subclass: #Pinky
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Ghosts'!

 


!Pinky methodsFor: 'state changes' stamp: 'Ale 7/17/2004 11:24'!

normalSpeed
    ^ 5! !

!Pinky methodsFor: 'state changes' stamp: 'Ale 7/17/2004 19:23'!
normalStrategy
    self chaseHard
! !

!Pinky methodsFor: 'state changes' stamp: 'Ale 7/17/2004 19:30'!
smartness
    ^ 8! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:51:39 am'!

Ghost subclass: #Inky
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Ghosts'!

 


!Inky methodsFor: 'state changes' stamp: 'Ale 7/17/2004 19:26'!

normalSpeed
    ^ 5! !

!Inky methodsFor: 'state changes' stamp: 'Ale 7/17/2004 19:16'!
normalStrategy
    self chaseEasy! !

!Inky methodsFor: 'state changes' stamp: 'Ale 7/17/2004 19:26'!
smartness
    ^ 4! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 2:52:10 am'!

Ghost subclass: #Sue
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Ghosts'!

 


!Sue methodsFor: 'state changes' stamp: 'Ale 7/17/2004 11:24'!

normalSpeed
    ^ 5! !

!Sue methodsFor: 'state changes' stamp: 'Ale 7/17/2004 11:10'!
normalStrategy
    self gridRandom
! !

!Sue methodsFor: 'state changes' stamp: 'Ale 7/17/2004 19:36'!
smartness
    ^ 1! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:02:30 am'!

MovilActor subclass: #Fruit
    instanceVariableNames: 'score turnsToLive eated '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Fruits'!

 


!Fruit methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:57'!

defaultExtent
    ^ (18@18)! !

!Fruit methodsFor: 'initializing' stamp: 'Ale 7/18/2004 20:29'!
defaultScore
    "El score de la fruit cambia segun la clase de fruit."
    self subclassResponsibility! !

!Fruit methodsFor: 'initializing' stamp: 'Ale 7/18/2004 20:29'!
defaultSpeed
    "La velocidad de la fruit cambia segun la clase de fruit."
    self subclassResponsibility! !

!Fruit methodsFor: 'initializing' stamp: 'Ale 7/18/2004 20:29'!
defaultTurnsToLive
    "El tiempo de vida de la fruit cambia segun la clase de fruit."
    self subclassResponsibility! !

!Fruit methodsFor: 'initializing' stamp: 'Ale 7/17/2004 20:02'!
initialize
    super initialize.
    self collisionSelector: #fruitCollision:on:.
    self collisionAskSelector: #canFruitCollision:on:.
    self resetState.
    self gridRandom.! !

!Fruit methodsFor: 'initializing' stamp: 'Ale 7/17/2004 20:02'!
resetState
    self eated: false.
    self speed: self defaultSpeed.
    self score: self defaultScore.
    self turnsToLive: self defaultTurnsToLive.! !


!Fruit methodsFor: 'accesing' stamp: 'Ale 7/17/2004 09:31'!

eated
    ^ eated! !

!Fruit methodsFor: 'accesing' stamp: 'Ale 7/17/2004 09:31'!
eated: aBoolean
    eated := aBoolean! !

!Fruit methodsFor: 'accesing' stamp: 'Ale 7/17/2004 09:31'!
score
    ^ score! !


!Fruit methodsFor: 'accesing' stamp: 'Ale 7/17/2004 09:31'!
score: aNumber
    score := aNumber! !

!Fruit methodsFor: 'accesing' stamp: 'Ale 7/17/2004 09:31'!
turnsToLive
    ^ turnsToLive! !

!Fruit methodsFor: 'accesing' stamp: 'Ale 7/17/2004 09:31'!
turnsToLive: aNumber
    turnsToLive := aNumber! !


!Fruit methodsFor: 'strategy' stamp: 'Ale 7/18/2004 20:24'!

gridRandom
    "Seleccionar esta estrategia de movimiento."
    self moveStrategy: (GridRandom new initializeWith: self)! !


!Fruit methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:25'!

fruitCollision: aPacman on: aBoard
    "No realizar ninguna accion."! !

!Fruit methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:25'!
ghostCollision: aGhost on: aBoard
    "No realizar ninguna accion."! !

!Fruit methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:24'!
pacManCollision: aPacman on: aBoard
    "En colision con aPacMan, fue comida por aPacMan."
    self eated: true.! !


!Fruit methodsFor: 'moving' stamp: 'Ale 7/18/2004 20:30'!

decreaseLiveTime
    "Decrementar la cantidad de turnos que le quedan a la fruit."
    self turnsToLive: self turnsToLive - 1
! !

!Fruit methodsFor: 'moving' stamp: 'Ale 7/17/2004 09:36'!
moveOn: aBoard
    "Moverse, luego revisar si ya es momento de salir del board."
    super moveOn: aBoard.
    self decreaseLiveTime.
    self removeIfExpired.! !

!Fruit methodsFor: 'moving' stamp: 'Ale 7/17/2004 09:37'!
removeIfExpired
    "Si es momento de salir del board, marcarse como que fue comida."
    self turnsToLive isZero
        ifTrue: [self score: 0; eated: true]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Fruit class
    instanceVariableNames: ''!

 


!Fruit class methodsFor: 'as yet unclassified' stamp: 'Ale 6/21/2004 09:02'!

new

    ^(super new) initialize.! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:03 am'!

Fruit subclass: #Cherry
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Fruits'!

 


!Cherry methodsFor: 'initializing' stamp: 'Ale 7/17/2004 19:56'!

defaultScore
    ^ 200! !

!Cherry methodsFor: 'initializing' stamp: 'Ale 7/18/2004 10:00'!
defaultSpeed
    ^ 4! !

!Cherry methodsFor: 'initializing' stamp: 'Ale 7/17/2004 19:55'!
defaultTurnsToLive
    ^ 80! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:03:04 am'!

Fruit subclass: #Apple
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Fruits'!

 


!Apple methodsFor: 'initializing' stamp: 'Ale 7/17/2004 19:58'!

defaultScore
    ^ 300! !

!Apple methodsFor: 'initializing' stamp: 'Ale 7/18/2004 10:00'!
defaultSpeed
    ^ 4! !

!Apple methodsFor: 'initializing' stamp: 'Ale 7/17/2004 19:58'!
defaultTurnsToLive
    ^ 60! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:03:07 am'!

Fruit subclass: #Bannana
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Fruits'!

 


!Bannana methodsFor: 'initializing' stamp: 'Ale 7/18/2004 09:58'!

defaultScore
    ^ 400! !

!Bannana methodsFor: 'initializing' stamp: 'Ale 7/18/2004 10:00'!
defaultSpeed
    ^ 4! !

!Bannana methodsFor: 'initializing' stamp: 'Ale 7/17/2004 19:57'!
defaultTurnsToLive
    ^ 50! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:03:10 am'!

Fruit subclass: #Peach
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Fruits'!

 


!Peach methodsFor: 'initializing' stamp: 'Ale 7/18/2004 10:00'!

defaultScore
    ^ 500! !

!Peach methodsFor: 'initializing' stamp: 'Ale 7/18/2004 10:00'!
defaultSpeed
    ^ 4! !

!Peach methodsFor: 'initializing' stamp: 'Ale 7/18/2004 10:00'!
defaultTurnsToLive
    ^ 30! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:04:46 am'!

MovilActor subclass: #PacMan
    instanceVariableNames: 'alive wantedDirection powerUp '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-PacMan'!

 


!PacMan methodsFor: 'accesors' stamp: 'Ale 7/17/2004 10:29'!

alive
    ^ alive! !

!PacMan methodsFor: 'accesors' stamp: 'Ale 7/17/2004 10:29'!
alive: aBoolean
    alive := aBoolean! !

!PacMan methodsFor: 'accesors' stamp: 'Ale 7/17/2004 10:30'!
powerUp
    ^ powerUp! !

!PacMan methodsFor: 'accesors' stamp: 'Ale 7/17/2004 10:30'!
powerUp: aBoolean
    powerUp := aBoolean! !

!PacMan methodsFor: 'accesors' stamp: 'Ale 7/17/2004 10:30'!
wantedDirection
    ^ wantedDirection! !

!PacMan methodsFor: 'accesors' stamp: 'Ale 7/17/2004 10:30'!
wantedDirection: aPoint
    wantedDirection := aPoint.! !


!PacMan methodsFor: 'moving' stamp: 'Ale 7/18/2004 20:35'!

calculateNewPositionOn: aBoard
    "Avanzar en la direccion deseada o quedarse en el lugar si no puede avanzar."

    | myPosition |
    myPosition := aBoard positionOf: self.
    (self collisionManager canAdvance: self on: aBoard)
        ifTrue: [ ^ (myPosition + self direction) ]
        ifFalse: [ ^ myPosition ].
! !


!PacMan methodsFor: 'colision actions' stamp: 'Ale 7/18/2004 20:03'!

shouldDeadWith: aGhost
    "Si aPacMan colisiona con aGhost y no esta powerUp, entonces muere."
    self powerUp
        ifFalse: [self alive: false].

! !


!PacMan methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:57'!

defaultExtent
    ^ (18@18)! !

!PacMan methodsFor: 'initializing' stamp: 'Ale 7/18/2004 20:03'!
initialize
    super initialize.
    self speed: 5.
    self direction: (-1@0).
    self wantedDirection: (-1@0).
    self resetState.
    self collisionSelector: #pacManCollision:on:.
    self collisionAskSelector: #canPacManCollision:on:.
    self userControlled.! !

!PacMan methodsFor: 'initializing' stamp: 'Ale 7/18/2004 20:01'!
resetState
    self alive: true; powerUp: false.! !


!PacMan methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:13'!

fruitCollision: aFruit on: aBoard
    "No realizar ninguna accion."! !

!PacMan methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:03'!
ghostCollision: aGhost on: aBoard
    "Si aPacMan colisiona con aGhost verificar si debe morir."
    aGhost eated
        ifFalse: [ self shouldDeadWith: aGhost ].


! !

!PacMan methodsFor: 'colision handling' stamp: 'Ale 7/18/2004 20:13'!
pacManCollision: aPacman on: aBoard
    "No realizar ninguna accion."! !


!PacMan methodsFor: 'strategy' stamp: 'Ale 7/18/2004 20:01'!

userControlled
    "Estrategia de movimiento controlada por el usuario."
    self moveStrategy: (UserControlled new initializeWith: self)! !


!PacMan methodsFor: 'state change' stamp: 'Ale 7/18/2004 20:00'!

beNormal
    self powerUp: false! !

!PacMan methodsFor: 'state change' stamp: 'Ale 7/18/2004 20:00'!
bePowerUp
    self powerUp: true! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PacMan class
    instanceVariableNames: ''!

 


!PacMan class methodsFor: 'as yet unclassified' stamp: 'Ale 6/23/2004 20:16'!

new

    ^ (super new) initialize! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:05:41 am'!

StaticActor subclass: #GhostHome
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Static'!

 


!GhostHome methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:12'!

addToLevel: aLevel
    aLevel ghostHome: self.! !

!GhostHome methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:12'!
defaultExtent
    ^ (1@1)! !


!GhostHome methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:12'!

canGhostCollision: aGhost on: aBoard
    ^ true! !

!GhostHome methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:16'!
ghostCollision: aGhost on: aBoard
    " Hubo una colision con aGhost, realizar las acciones del caso. "
    (self isAtCollision: aGhost on: aBoard)
        ifTrue: [self tryLeaveHome: aGhost]
! !

!GhostHome methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:17'!
tryLeaveHome: aGhost
    "Si aGhost esta comido, prepararlo para salir de casa."
    aGhost eated ifTrue: [aGhost beLeavingHome]
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GhostHome class
    instanceVariableNames: ''!

 


!GhostHome class methodsFor: 'as yet unclassified' stamp: 'Ale 7/16/2004 17:43'!

isMyLayoutId: aSymbol
    ^ aSymbol == #G! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:06:26 am'!

StaticActor subclass: #PacManHome
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Static'!

 


!PacManHome methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:20'!

addToLevel: aLevel
    aLevel pacManHome: self.! !

!PacManHome methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:20'!
defaultExtent
    ^ (1@1)! !


!PacManHome methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:20'!

canFruitCollision: aFruit on: aBoard
    ^ true! !

!PacManHome methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:20'!
canGhostCollision: aGhost on: aBoard
    ^ true! !

!PacManHome methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:20'!
canPacManCollision: aPacMan on: aBoard
    ^ true! !

!PacManHome methodsFor: 'collision handling' stamp: 'Ale 7/10/2004 16:04'!
fruitCollision: aFruit on: aBoard
! !

!PacManHome methodsFor: 'collision handling' stamp: 'Ale 7/10/2004 17:32'!
ghostCollision: aGhost on: aBoard
! !

!PacManHome methodsFor: 'collision handling' stamp: 'Ale 7/10/2004 17:33'!
pacManCollision: aPacMan on: aBoard
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PacManHome class
    instanceVariableNames: ''!

 


!PacManHome class methodsFor: 'as yet unclassified' stamp: 'Ale 7/16/2004 17:43'!

isMyLayoutId: aSymbol
    ^ aSymbol == #P! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:06:54 am'!

StaticActor subclass: #Pill
    instanceVariableNames: 'score eated '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Static'!

 


!Pill methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:21'!

addToLevel: aLevel
    aLevel addPill: self.! !

!Pill methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:21'!
defaultExtent
    ^ (5@5)! !

!Pill methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:21'!
initialize
    super initialize.
    self score: 10; eated: false.! !


!Pill methodsFor: 'accessing' stamp: 'Ale 7/18/2004 19:21'!

eated
    ^ eated! !

!Pill methodsFor: 'accessing' stamp: 'Ale 7/18/2004 19:21'!
eated: aBoolean
    eated := aBoolean! !

!Pill methodsFor: 'accessing' stamp: 'Ale 7/18/2004 19:21'!
score
    ^ score! !

!Pill methodsFor: 'accessing' stamp: 'Ale 7/18/2004 19:21'!
score: aNumber
    score := aNumber! !


!Pill methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:21'!

canFruitCollision: aFruit on: aBoard
    ^ true! !

!Pill methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:21'!
canGhostCollision: aGhost on: aBoard
    ^ true! !

!Pill methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:22'!
canPacManCollision: aPacMan on: aBoard
    ^ true! !

!Pill methodsFor: 'collision handling' stamp: 'Ale 7/10/2004 16:04'!
fruitCollision: aFruit on: aBoard
! !


!Pill methodsFor: 'collision handling' stamp: 'Ale 7/10/2004 17:38'!
ghostCollision: aGhost on: aBoard
! !

!Pill methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:26'!
pacManCollision: aPacMan on: aBoard
    " Si hay colision con aPacMan, la pill fue comida. "

    (self isAtCollision: aPacMan on: aBoard)
        ifTrue: [self eated: true]
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Pill class
    instanceVariableNames: ''!

 


!Pill class methodsFor: 'as yet unclassified' stamp: 'Ale 7/16/2004 17:43'!

isMyLayoutId: aSymbol
    ^ aSymbol == #p! !

!Pill class methodsFor: 'as yet unclassified' stamp: 'Ale 6/21/2004 08:52'!
new

    ^(super new) initialize! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:06:56 am'!

Pill subclass: #PowerPill
    instanceVariableNames: 'turnsToLive '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Static'!

 


!PowerPill methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:26'!

addToLevel: aLevel
    aLevel addPowerPill: self.! !

!PowerPill methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:27'!
defaultExtent
    ^ (8@8)! !

!PowerPill methodsFor: 'initializing' stamp: 'Ale 7/19/2004 15:47'!
initialize
    super initialize.
    self turnsToLive: 40.! !


!PowerPill methodsFor: 'accessing' stamp: 'Ale 7/18/2004 19:27'!

turnsToLive
    ^ turnsToLive! !

!PowerPill methodsFor: 'accessing' stamp: 'Ale 7/18/2004 19:27'!
turnsToLive: aNumber
    turnsToLive := aNumber! !


"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

PowerPill class
    instanceVariableNames: ''!

 


!PowerPill class methodsFor: 'as yet unclassified' stamp: 'Ale 7/16/2004 17:43'!

isMyLayoutId: aSymbol
    ^ aSymbol == #s! !

!PowerPill class methodsFor: 'as yet unclassified' stamp: 'Ale 6/26/2004 20:54'!
new

    ^(super new) initialize! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:07:43 am'!

StaticActor subclass: #Wall
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Static'!

 


!Wall methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:38'!

addToLevel: aLevel
    aLevel addWall: self.! !

!Wall methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:38'!
defaultExtent
    ^ (18@18)! !


!Wall methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:38'!

canFruitCollision: aFruit on: aBoard
    ^ false! !

!Wall methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:38'!
canGhostCollision: aGhost on: aBoard
    ^ false! !

!Wall methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:38'!
canPacManCollision: aPacMan on: aBoard
    ^ false! !

!Wall methodsFor: 'collision handling' stamp: 'Ale 7/10/2004 17:22'!
fruitCollision: aFruit on: aBoard! !

!Wall methodsFor: 'collision handling' stamp: 'Ale 7/10/2004 17:22'!
ghostCollision: aPacman on: aBoard
! !

!Wall methodsFor: 'collision handling' stamp: 'Ale 7/10/2004 17:22'!
pacManCollision: aPacman on: aBoard
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Wall class
    instanceVariableNames: ''!

 


!Wall class methodsFor: 'as yet unclassified' stamp: 'Ale 7/16/2004 17:43'!

isMyLayoutId: aSymbol
    ^ aSymbol == #w! !

!Wall class methodsFor: 'as yet unclassified' stamp: 'Ale 6/21/2004 08:52'!
new

    ^(super new) initialize! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:07:46 am'!

Wall subclass: #GhostOnlyWall
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Actors-Static'!

 


!GhostOnlyWall methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:20'!

addToLevel: aLevel
    aLevel addGhostOnlyWall: self.! !

!GhostOnlyWall methodsFor: 'collision handling' stamp: 'Ale 7/18/2004 19:20'!
canGhostCollision: aGhost on: aBoard
    " Solo pueden pasar ghosts comidos o que recien fueron revividos."
    ^ aGhost isLeavingHome or:[aGhost isGoingHome]
! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GhostOnlyWall class
    instanceVariableNames: ''!

 


!GhostOnlyWall class methodsFor: 'as yet unclassified' stamp: 'Ale 7/16/2004 17:43'!

isMyLayoutId: aSymbol
    ^ aSymbol == #d! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:10:50 am'!

AlignmentMorph subclass: #PacManGameView
    instanceVariableNames: 'game '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-General'!

 


!PacManGameView methodsFor: 'accessing' stamp: 'Ale 7/17/2004 20:59'!

game
    ^ game! !

!PacManGameView methodsFor: 'accessing' stamp: 'Ale 7/17/2004 20:59'!
game: aGame
    game := aGame! !


!PacManGameView methodsFor: 'initialization' stamp: 'Ale 7/18/2004 18:59'!

initialize
    super initialize.
    self game: PacManGame new newGame.
    self game addDependent: self.
    self position: (-2@-2).
    self color: Color black.
    self toggleStickiness.
    self openInWorld.
    self initializeView.! !

!PacManGameView methodsFor: 'initialization' stamp: 'Ale 7/18/2004 18:59'!
initializeView
    "Agrega las dos vistas principales: de tablero y de estado del juego."
    self removeAllMorphs.
    self addMorph: ((GameStatusView newColumn) initializeWith: self game).   
    self addMorph: ((BoardView new) initializeWith: self game).
! !


!PacManGameView methodsFor: 'updating' stamp: 'Ale 7/17/2004 21:11'!

handlesKeyboard: evt
    ^ true! !

!PacManGameView methodsFor: 'updating' stamp: 'Ale 7/18/2004 19:05'!
keyStroke: evt
    "Envio de acciones del usuario al modelo."
    | keyValue |
    keyValue _ evt keyValue.
    keyValue = 28 ifTrue:[self game pacManLeft].
    keyValue = 29 ifTrue:[self game pacManRight].
    keyValue = 30 ifTrue:[self game pacManUp].
    keyValue = 31 ifTrue:[self game pacManDown].
    keyValue = 32 ifTrue:[self game newGame].
! !

 

 


!PacManGameView methodsFor: 'updating' stamp: 'Ale 7/18/2004 19:04'!
update: aSymbol
    "Si hay que comenzar un juego nuevo reiniciar la vista."
    (aSymbol == #resetView)
        ifTrue: [self initializeView]
        ifFalse: [self submorphs do: [:each | each updateView]].
! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:11:52 am'!

Morph subclass: #BoardView
    instanceVariableNames: 'game checkForFruit '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-General'!

 


!BoardView methodsFor: 'updating' stamp: 'Ale 7/19/2004 15:33'!

updateView
    "Poner la fruta (si entro en juego) y actualizar la vista del board."
    checkForFruit
        ifTrue: [self createFruitsView: self game].
    self submorphs do: [:each | each updateView].
    self changed.! !


!BoardView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 18:22'!

checkForFruit
    ^ checkForFruit! !

!BoardView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 18:22'!
checkForFruit: aBoolean
    checkForFruit := aBoolean! !

!BoardView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 18:22'!
game
    ^ game! !

!BoardView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 18:22'!
game: aGame
    game := aGame! !


!BoardView methodsFor: 'initializing' stamp: 'Ale 7/19/2004 12:12'!

createActorsView: aGame
    "Crear la vista de cada actor movil del juego."
    self addMorph: (PacManView new initializeWith: aGame).
    aGame ghosts
        do:[:each |
            self addMorph: (GhostView new initializeWith: aGame ghost:each)].
! !

!BoardView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 18:45'!
createFruitsView: aGame
    "Crear la vista de cada powerPill del nivel."
    aGame fruits
        do:[:each |
            self addMorph: (FruitView new initializeWith: game fruit: each).
            self checkForFruit: false].
! !

 

 

 


!BoardView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 18:42'!
createPillsView: aGame
    "Crear la vista de cada pill del nivel."
    aGame level pills
        do: [ :each| |aPillView|
            aPillView := PillView new.
            self addMorph: aPillView.
            aPillView initializeWith: each on: (aGame board) ].
! !

!BoardView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 18:42'!
createPowerPillsView: aGame
    "Crear la vista de cada powerPill del nivel."
    aGame level powerPills
        do: [ :each| |aPowerPillView|
            aPowerPillView := PowerPillView new.
            self addMorph: aPowerPillView.
            aPowerPillView initializeWith: each on: (aGame board) ].
! !

!BoardView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 18:42'!
createViews: aGame
    "Crear las vistas de los objetos a mostrar en el juego."
    self createPillsView: aGame.
    self createPowerPillsView: aGame.
    self createWallsView: aGame.
    self createActorsView: aGame.
! !

!BoardView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 18:42'!
createWallsView: aGame
    "Crear la vista de cada wall del nivel."
    aGame level walls
        do: [ :each| |aWallView|
            aWallView := WallView new.
            self addMorph: aWallView.
            aWallView initializeWith: each on: (aGame board) ].
! !

!BoardView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 18:40'!
initializeWith: aGame
    self removeAllMorphs.
    self game: aGame.
    self color: Color black.
    self extent: aGame board extent.
    self checkForFruit: true.
    self createViews: aGame.! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:12:37 am'!

AlignmentMorph subclass: #GameStatusView
    instanceVariableNames: 'game '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-General'!

 


!GameStatusView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 00:22'!

game
    ^ game! !

!GameStatusView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 00:21'!
game: aGame
    game := aGame! !


!GameStatusView methodsFor: 'updating' stamp: 'Ale 7/19/2004 15:33'!

updateView
    self submorphs do: [:each | each updateView].
    self changed
! !


!GameStatusView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:08'!

initializeTexts: aGame
    self addMorph: (ScoreView new initializeWith: aGame).
    self addMorph: (GameStringView new contents: ' SCORE ' ; color: Color white).
    self addMorph: (GameStringView new contents: ' ' ;color: Color white).
    self addMorph: (LivesView new initializeWith: aGame).
    self addMorph: (GameStringView new contents: ' LIVES '; color: Color white).
    self addMorph: (GameStringView new contents: ' ' ;color: Color white).
    self addMorph: (LevelView new initializeWith: aGame).
    self addMorph: (GameStringView new contents: ' LEVEL ' ;color: Color white).
    self addMorph: (GameStringView new contents: ' ' ;color: Color white).
! !

!GameStatusView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:08'!
initializeWith: aGame
    self color: Color black.
    self game: aGame.
    self initializeTexts: aGame! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:13:02 am'!

StringMorph subclass: #GameStringView
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-General'!

 


!GameStringView methodsFor: 'updating' stamp: 'Ale 7/17/2004 20:42'!

updateView! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:13:55 am'!

EllipseMorph subclass: #FruitView
    instanceVariableNames: 'fruit game fruitsColor '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-Movil'!

 


!FruitView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 18:49'!

fruit
    ^ fruit! !

!FruitView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 18:49'!
fruit: aFruit
    fruit := aFruit! !

!FruitView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 00:30'!
fruitsColor
    ^ fruitsColor! !

!FruitView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 00:30'!
fruitsColor: aFruitsColor
    fruitsColor := aFruitsColor! !

!FruitView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 18:49'!
game
    ^ game! !

!FruitView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 18:49'!
game: aGame
    game:= aGame! !


!FruitView methodsFor: 'updating' stamp: 'Ale 7/18/2004 18:51'!

doUpdateView
    "Actualizar la posicion o esconderse si fue comida."
    (self fruit) eated
        ifTrue: [ self visible: fruit eated not]
        ifFalse: [ self center: ((self game board) positionOf: (self fruit))].


! !

!FruitView methodsFor: 'updating' stamp: 'Ale 7/18/2004 18:50'!
isOnBoard
    "Informa si fruit esa en el board."
    ^ self game board includes: (self fruit).! !

!FruitView methodsFor: 'updating' stamp: 'Ale 7/18/2004 18:50'!
updateView
    "Actualizar la vista si esta en el board, sino borrarse de la vista."
    self isOnBoard
        ifTrue: [ self doUpdateView ]
        ifFalse: [ self delete ]! !


!FruitView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 18:51'!

initializeFruitsColor
    "Contiene la asociacion entre la clase de fruit y su color."
    | aFruitsColor |
    aFruitsColor := Dictionary new.
    aFruitsColor at: Cherry put: (Color red).
    aFruitsColor at: Apple put: (Color lightGreen).
    aFruitsColor at: Bannana put: (Color lightYellow).
    aFruitsColor at: Peach put: (Color lightOrange).
    self fruitsColor: aFruitsColor
! !

!FruitView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 18:52'!
initializeWith: aGame fruit: aFruit
    self initializeFruitsColor.
    self game: aGame.
    self fruit: aFruit.

    self extent: aFruit extent.
    self color: (self fruitsColor at: (self fruit class)).
    self center: (aGame board positionOf: (aGame level fruitHome)).! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:13:56 am'!

RectangleMorph subclass: #GhostView
    instanceVariableNames: 'ghost game ghostsColor '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-Movil'!

 


!GhostView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 18:54'!

initializeGhostColor
    "Contiene la asociacion entre la clase de ghost y su color."
    | aGhostsColor |
    aGhostsColor := Dictionary new.
    aGhostsColor at: Blinky put: (Color red).
    aGhostsColor at: Pinky put: (Color lightRed).
    aGhostsColor at: Inky put: (Color lightCyan).
    aGhostsColor at: Sue put: (Color lightOrange).
    self ghostsColor: aGhostsColor
! !

!GhostView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 18:54'!
initializeWith: aGame ghost: aGhost
    self initializeGhostColor.
    self game: aGame.
    self ghost: aGhost.
    self extent: aGhost extent.
    self center: (aGame board positionOf: (aGame level ghostHome)).

! !

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 



!GhostView methodsFor: 'updating' stamp: 'Ale 7/18/2004 20:43'!

updateColor
    "Actualiza el color del ghost segun su estado. Si, esto es una especie de case y a mi
    me resulta tan desagradable como a ustedes, pero no encontre una forma mejor de
    hacerlo ya que el modelo no entiende de colores, y el mecanismo de dependent/update
    no me ayuda a distinguir el estado del ghost."

    (self ghost) weak
        ifTrue: [ self
            color: Color blue;
            borderColor: Color black].

    ((self ghost weak) and: [self ghost recovering])
        ifTrue: [ self
            color: Color white;
            borderColor: Color black].

    (self ghost) eated
        ifTrue: [ self
            color: Color black;
            borderColor: Color white].

    (((self ghost) eated not) and: [self ghost weak not] )
        ifTrue: [self
            color: (self ghostsColor at: (self ghost class));
            borderColor: Color black].
! !

!GhostView methodsFor: 'updating' stamp: 'Ale 7/18/2004 18:58'!
updateView

    self center: ((self game board) positionOf: (self ghost)).
    self updateColor! !


!GhostView methodsFor: 'accessing' stamp: 'Ale 6/26/2004 19:22'!

game

    ^ game! !

!GhostView methodsFor: 'accessing' stamp: 'Ale 6/26/2004 19:22'!
game: aGame

    game:= aGame! !

!GhostView methodsFor: 'accessing' stamp: 'Ale 6/26/2004 19:23'!
ghost

    ^ ghost! !

!GhostView methodsFor: 'accessing' stamp: 'Ale 6/26/2004 19:23'!
ghost: aGhost

    ghost := aGhost! !

!GhostView methodsFor: 'accessing' stamp: 'Ale 7/17/2004 13:21'!
ghostsColor
    ^ ghostsColor! !

!GhostView methodsFor: 'accessing' stamp: 'Ale 7/17/2004 13:21'!
ghostsColor: aDictionary
    ghostsColor := aDictionary! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:13:59 am'!

EllipseMorph subclass: #PacManView
    instanceVariableNames: 'pacMan game '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-Movil'!

 


!PacManView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 19:07'!

initializeWith: aGame
    self game: aGame.
    self pacMan: (aGame pacMan).
    self extent: aGame pacMan extent.
    self center: (aGame board positionOf: (aGame level pacManHome)).
! !


!PacManView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 00:23'!

game
    ^ game! !

!PacManView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 00:23'!
game: aGame
    game := aGame! !

!PacManView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 00:23'!
pacMan
    ^ pacMan! !

!PacManView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 00:23'!
pacMan: aPacMan
    pacMan := aPacMan! !


!PacManView methodsFor: 'updating' stamp: 'Ale 7/20/2004 02:19'!

updateView

    self center: ((self game board) positionOf: (self pacMan)).
    self changed.! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:15:35 am'!

StringMorph subclass: #LevelView
    instanceVariableNames: 'game '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-Static'!

 


!LevelView methodsFor: 'initializing' stamp: 'Ale 7/18/2004 00:20'!

initializeWith: aGame
    self game: aGame.
    self color: Color white.! !


!LevelView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 00:21'!

game
    ^ game! !

!LevelView methodsFor: 'accessing' stamp: 'Ale 7/18/2004 00:20'!
game: aGame.
    game := aGame! !


!LevelView methodsFor: 'updating' stamp: 'Ale 7/17/2004 20:36'!

updateView
    self contents: game levelNumber asString.! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:15:42 am'!

StringMorph subclass: #LivesView
    instanceVariableNames: 'game '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-Static'!

 


!LivesView methodsFor: 'as yet unclassified' stamp: 'Ale 7/18/2004 00:19'!

game
    ^ game
! !

!LivesView methodsFor: 'as yet unclassified' stamp: 'Ale 7/18/2004 00:19'!
game: aGame
    game := aGame.
! !

!LivesView methodsFor: 'as yet unclassified' stamp: 'Ale 7/18/2004 00:19'!
initializeWith: aGame
    self game: aGame.
    self color: Color white.! !

!LivesView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 20:36'!
updateView
    self contents: game lives asString.! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:16:40 am'!

StringMorph subclass: #ScoreView
    instanceVariableNames: 'game '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-Static'!

 


!ScoreView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 23:05'!

game
    ^ game! !

!ScoreView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 23:05'!
game: aGame
    game := aGame! !

!ScoreView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 23:06'!
initializeWith: aGame
    self game: aGame.
    self color: Color white! !

!ScoreView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 20:44'!
updateView
    self contents: game score asString! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:17:25 am'!

EllipseMorph subclass: #PillView
    instanceVariableNames: 'pill '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-Static'!

 


!PillView methodsFor: 'as yet unclassified' stamp: 'Ale 7/18/2004 00:18'!

initializeWith: aPill on: aBoard

    self pill: aPill.
    self extent: (aPill extent).   
    self center: (aBoard positionOf: aPill).
    self color: Color white.

! !

!PillView methodsFor: 'as yet unclassified' stamp: 'Ale 7/18/2004 00:19'!
pill
    ^ pill


! !

!PillView methodsFor: 'as yet unclassified' stamp: 'Ale 7/18/2004 00:18'!
pill: aPill
    pill := aPill


! !

!PillView methodsFor: 'as yet unclassified' stamp: 'Ale 7/18/2004 19:10'!
updateView
    self visible: pill eated not.
! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:17:27 am'!

EllipseMorph subclass: #PowerPillView
    instanceVariableNames: 'powerPill '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-Static'!

 


!PowerPillView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 23:08'!

initializeWith: aPowerPill on: aBoard
    self powerPill: aPowerPill.
    self extent: (aPowerPill extent).   
    self center: (aBoard positionOf: aPowerPill).
    self color: Color white.
! !

!PowerPillView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 23:07'!
powerPill
    ^ powerPill! !

!PowerPillView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 23:07'!
powerPill: aPowerPill
    powerPill := aPowerPill! !

!PowerPillView methodsFor: 'as yet unclassified' stamp: 'Ale 7/18/2004 19:11'!
updateView
    self visible: powerPill eated not.
! !


'From Squeak3.6 of ''6 October 2003'' [latest update: #5429] on 20 July 2004 at 3:17:29 am'!

RectangleMorph subclass: #WallView
    instanceVariableNames: 'wall '
    classVariableNames: ''
    poolDictionaries: ''
    category: 'TP-Morphic-Static'!

 


!WallView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 23:04'!

initializeWith: aWall on: aBoard
    self wall: aWall.
    self extent: (aWall extent).
    self center: (aBoard positionOf: aWall).
    self color: Color green.

    ! !

!WallView methodsFor: 'as yet unclassified' stamp: 'Ale 7/18/2004 19:11'!
updateView
! !

!WallView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 23:04'!
wall
    ^ wall
    ! !

!WallView methodsFor: 'as yet unclassified' stamp: 'Ale 7/17/2004 23:04'!
wall: aWall
    wall := aWall
    ! !


Apéndice B: Como iniciar el juego

 

En el CD que acompaña este trabajo, en el directorio tp1\pcMan se encuentra la imagen de Squeak donde desarrolle el trabajo. Al iniciar Squeak aparece un Transcript con un par de instrucciones para el docente y lo invita a evaluar:

 

            PacManGameView new.

 

Aparecerá en la esquina superior izquierda una vista del juego, para que la vista reciba los eventos del teclado es necesario minimizar el Transcript (y cualquier otro browser o inspector) y colocar el puntero del mouse sobre la vista. En esta situación las teclas con las que funciona el juego son:

 

            UP: PacMan hacia arriba

            DOWN: PacMan hacia abajo

            LEFT: PacMan hacia la izquierda

            RIGHT: PacMan hacia la derecha

            SPACE: Reset del juego

 

Notar que no se puede arrastrar la vista a otra posición de la pantalla, la vista no esta preparada para ser arrastrada (por favor, no lo haga se ve tan feo que me da pena L), al respecto hay una nota en la sección Cosas que sé que no están del todo bien.

 

 


 

Apéndice C: Artwork (un cierre informal)

 

Estos son algunos gráficos que surgieron en noches de frustración frente a la PC, me disculpo por la falta de seriedad de la cuestión :

 

 

A veces uno se golpea la cabeza buscando soluciones,

 

 

otras uno se da por vencido,

 

 

 

a veces uno sale a comerse el mundo,

 

 

 


 

 

y algunas noches de TP la soledad desespera,

 

 

a veces uno se afana tanto en algo que sigue ocupandose de eso en sueños,

 

 

 

 

 

 


y bueno....