unit upacman; interface uses sysutils, classes, types, web, js; const TimerInterval = 20; GridXSize = 30; GridYSize = 33; DrawGrid = False; ControlCount = 5; ControlNames : Array[1..ControlCount] of string = ('left','right','down','up','pause'); type TAudio = (aStart,aDie,aEatGhost,aEatPill); TStr4 = String; // set of N,E,S,W TSprite=record SpImg : TJSHTMLImageElement; // Image of a ghost XY : TPoint; // Grid x and y Sx,Sy : double; // smooth x and y between 0 en 1 Dir : char; // N,E,S,W Spd : double; StartPos : TPoint; end; TCell=record WallType :(wtNone,wtEW,wtNS,wtNE,wtNW,wtSW,wtSE,wtNoGo); PillType :(ptNone,ptPill,ptSuperPill); I :integer; // used for searching the maze Dirty : Boolean; end; TField = array[0..GridYSize-1] of String; { TPacman } TProcedure = Procedure Of Object; { TPacmanAudio } TPacmanAudio = Class private FOnLoaded: TNotifyEvent; FLoaded : Boolean; procedure AudioLoaded; function CheckEnd(Event: TEventListenerEvent): boolean; function CheckplayOK(Event: TEventListenerEvent): boolean; published files : Array [TAudio] of TJSHTMLAudioElement; filesOK : Array [TAudio] of Boolean; Playing : Array [TAudio] of Boolean; Procedure LoadAudio; Procedure play(aAudio : Taudio); Procedure DisableSound; Procedure Pause; Procedure Resume; Property Loaded : Boolean Read FLoaded Write FLoaded; Property OnLoaded : TNotifyEvent Read FOnLoaded Write FonLoaded; end; TPacman = class(TComponent) Private // Html image elements // 0 = pacman, virtual // 1..4 : Ghost // 5 = scared ImgGhost : Array[0..5] of TJSHTMLImageElement; ImgBonus: TJSHTMLImageElement; SpriteTimer: NativeInt; pnBonusBarOuter: TJSHTMLElement; pnBonusBarInner: TJSHTMLElement; pnScareBarOuter: TJSHTMLElement; pnScareBarInner: TJSHTMLElement; lbBonusCnt: TJSHTMLElement; lbLives: TJSHTMLElement; lbScore: TJSHTMLElement; lbStatus: TJSHTMLElement; lbHiscore: TJSHTMLElement; lbGhostCnt: TJSHTMLElement; FCanvasEl:TJSHTMLCanvasElement; FCanvas:TJSCanvasRenderingContext2D; FCBXSound:TJSHTMLInputElement; FBtnReset : TJSHTMLButtonElement; FAudio : TPacmanAudio; function CheckSound(Event: TEventListenerEvent): boolean; procedure DoAudioLoaded(Sender: TObject); function DoResetClick(aEvent: TJSMouseEvent): boolean; procedure InitAudio; procedure MarkCellsDirty; private FAudioDisabled: Boolean; FCanvasID: String; FResetID: String; Pause:boolean; LivesLeft:integer; BonusCnt :integer; GhostCnt :integer; BonusTimer:integer; ScareTimer:integer; PacMouthOpen:integer; PacMouthOpenDir:integer; PillsLeft:integer; PacmanDir:char; score,HiScore:integer; // 0: Packman. // 1..4 : ghost // 5: Bonus Sprite:array[0..5] of TSprite; Cells:array[0..GridXSize-1,0..GridYSize] of TCell; FDying : Boolean; // Maze solving code function SolveMaze (P1,P2: TPoint): boolean; function SolveMazeStep1(P1,P2: TPoint): boolean; function SolveMazeStep2(P1,P2: TPoint): boolean; function SolveMazeStep3(P1,P2: TPoint): boolean; // Display code procedure line(x1, y1, x2, y2: integer); procedure DrawCells(DirtyOnly : Boolean = False); procedure DrawPacman(); procedure CheckGameOver; procedure StartTimer; procedure ShowText(aText: string; OnDone : TProcedure); procedure UpdateScore(); procedure UpdateStatus(aText : String); // Initializing code procedure InitSprite(var aSprite: TSprite; aImg: TJSHTMLImageElement; aSpd: Double); procedure InitSprites(); procedure InitVars(aField: TField); procedure InitCells(aField: TField); procedure SetGhostScared(aScared: boolean); // Business code: TestAndGet function GetGhostDir(aXY:TPoint; aOldDir: char): char; function GetBestDir(aXY:TPoint): char; function GetPossibleDir(aXY:TPoint): TStr4; function GetPacmanDir(aXY:TPoint; aOldDir: char): char; procedure GetRandomCellAndDir(var aXY:TPoint; var aDir: char); // Business code: Actions procedure StopTimer; Function DoRestartClick(aEvent: TJSMouseEvent): boolean; procedure EatPill(aXY: TPoint); procedure EatSuperPill(aXY: TPoint); procedure EatBonus(); procedure EatGhost(var aGhost: TSprite); procedure ClearCell(aXY: TPoint); procedure MoveSprite(aSpriteInx:integer); function DoBonusTimer(): boolean; procedure DoScareTimer(); Procedure DrawScene; // Business code: Decisions procedure CollisionDetect(var aXY:TPoint); procedure RestartGame(); procedure RestartLevel(); procedure PacmanDies(); procedure NextLevel(); procedure GameOver(); // Debug & Test // procedure DbgShow(); // Business code: Actions Procedure PlaySound(aAudio : TAudio); procedure DoSpriteTimer; // User response code function HandleKeyPress(k : TJSKeyBoardEvent) : Boolean; function DoMouseClick(aEvent: TJSMouseEvent): boolean; Public // Initializing code Constructor Create(aOwner : TComponent); override; Procedure SetupPacman; Procedure Start; Property CanvasID : String Read FCanvasID Write FCanvasID; Property ResetID : String Read FResetID Write FResetID; Property AudioDisabled : Boolean Read FAudioDisabled Write FAudioDisabled; end; implementation //============================================================================== // Generic constants //============================================================================== // These constants define the look and feel of the game. // They set speeds and timeouts, and the define a playing field // To make the definition of a different playing field easier it is defined as // an array of strings, in which each character defines specific cell-properties // The initialization code reads this and uses it to build an array of type TCell[]. // // The const Level1field defines a playing field. // These are the characters used to define the habitat of the ghosts and pacman // 'x' : a NoGo area. It shows up empty on the screen, but ghosts, pacman // and bonusses cannot go there. // '-','|' : a horizontal or verical wall // '/','\' : a cornerwall, which one depends on surrounding cells // '1'..'4' : starting position of ghost 1 to 4 // 'P' : starting position of Pacman // ' ' : empty space, Pacman, ghosts and bonusses can go there // '.' : simple pill, Pacman, ghosts and bonusses can go there // 'o' : super pill, Pacman, ghosts and bonusses can go there. // This also sets the "ScareTheGhosts" timer //============================================================================== const CellSize = 16; // do not change... GhostSpeedScared = 0.10; // Speed of ghosts when scared GhostSpeedNormal = 0.20; // Speed of ghosts when not scared. PacmanSpeed = 0.25; // Speed of Pacman BonusSpeed = 0.04; // speed of cherries BonusTimeOut1 = 500; // time for cherries not visible BonusTimeOut2 = 300; // time for cherries visible ScareTimeOut = 300; // time that the ghosts stay scared HuntFactor = 0.5; // 0.0:ghosts move random, 1.0=ghosts really hunt AudioNames : Array[TAudio] of string = ('start','die','eatghost','eatpill'); const Level1Field : TField = ('xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx', 'x/------------\/------------\x', 'x|............||............|x', 'x|./--\./---\.||./---\./--\.|x', 'x|o|xx|.|xxx|.||.|xxx|.|xx|o|x', 'x|.\--/.\---/.\/.\---/.\--/.|x', 'x|..........................|x', 'x|./--\./\./------\./\./--\.|x', 'x|.\--/.||.\--\/--/.||.\--/.|x', 'x|......||....||....||......|x', 'x\----\.|\--\ || /--/|./----/x', 'xxxxxx|.|/--/ \/ \--\|.|xxxxxx', 'xxxxxx|.|| ||.|xxxxxx', 'xxxxxx|.|| /-- --\ ||.|xxxxxx', '------/.\/ | 1 3 | \/.\------', ' . | 2 4 | . ', '------\./\ | | /\./------', 'xxxxxx|.|| \------/ ||.|xxxxxx', 'xxxxxx|.|| ||.|xxxxxx', 'xxxxxx|.|| /------\ ||.|xxxxxx', 'x/----/.\/ \--\/--/ \/.\----\x', 'x|............||............|x', 'x|./--\./---\.||./---\./--\.|x', 'x|.\-\|.\---/.\/.\---/.|/-/.|x', 'x|o..||.......P........||..o|x', 'x\-\.||./\./------\./\.||./-/x', 'x/-/.\/.||.\--\/--/.||.\/.\-\x', 'x|......||....||....||......|x', 'x|./----/\--\.||./--/\----\.|x', 'x|.\--------/.\/.\--------/.|x', 'x|..........................|x', 'x\--------------------------/x', 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'); const WallSet = ['-','|','\','/']; clBlack = 'black'; clWhite = 'white'; clRed = 'red'; clYellow = '#FFFF00'; clBlue = 'blue'; clLime = 'lime'; { TPacman } constructor TPacman.Create(aOwner: TComponent); begin inherited; FaudioDisabled:=True; FAudio:=TPacmanAudio.Create; Faudio.OnLoaded:=@DoAudioLoaded; SetupPacman; end; //============================================================================== // Display code //============================================================================== // This code is responsible for showing pacman, ghosts, bonuses, scores on the // screen It uses global variables and the Cells[] array to know where and what // ShowText() this code shows a flashing text (how surprising) in the // middle of the playing field for about 3 seconds // Line() draws a line on img.canvas (should be a standard function!!!) // DrawCells() clears and draws the complete playingfield according to the // cell properties in the Cell[] array. Does not draw Pacman, // ghosts or flying bonusses. // DrawPacman() Draws an image of Pacman in sprite[0] depending on direction // UpdateScore() Updates the labels for lives, score, hiscore etc. Type { TFlashText } TFlashText = Class(TObject) FPacMan : TPacMan; FText : String; FFlashInterval : NativeInt; FCount : Integer; FonDone : TProcedure; Procedure DoFlash; Constructor Create(aPacMan : TPacMan; aText : String; aOnDone : TProcedure); end; { TFlashText } procedure TFlashText.DoFlash; var n,x,y:integer; FS : TJSTextMetrics; begin // FPacMan.FCanvas.fillStyle:=clBlack; if FCount mod 2=0 then FPacMan.FCanvas.FillStyle:=clRed //textbackground is black else FPacMan.FCanvas.FillStyle:=clYellow; //textbackground is black FPacMan.FCanvas.Font:='40px Roboto'; //make text really big // position text in the middle of the field FS:=FPacMan.FCanvas.measureText(FText); x:=FPacMan.FCanvasEl.Width div 2-Round(FS.width) div 2; y:=FPacMan.FCanvasEl.Height div 2- 20 { Round(FS.actualBoundingBoxAscent) div 2}; FPacMan.FCanvas.FillText(FText,x,y); Inc(FCount); if FCount>=10 then begin window.ClearInterval(FFlashInterval); FPacMan.DrawScene; if Assigned(FonDone) then FonDone(); Free; end; end; constructor TFlashText.Create(aPacMan : TPacMan; aText: String; aOnDone : TProcedure); begin FPacMan:=aPacMan; FText:=aText; FOnDone:=aOnDone; DoFlash; FFlashInterval:=window.setInterval(@DoFlash,150); end; procedure TPacman.ShowText(aText: string; OnDone : TProcedure); begin TFlashText.Create(Self,aText,OnDone); end; procedure TPacman.line(x1, y1, x2, y2: integer); begin // should be a standard method of a canvas... FCanvas.BeginPath; FCanvas.MoveTo(x1,y1); FCanvas.LineTo(x2,y2); FCanvas.stroke(); end; procedure TPacman.DrawCells(DirtyOnly : Boolean = False); const Sze=CellSize; HSze=CellSize div 2; Procedure DoArc(x,y,r,a1,a2 : Double; anti : boolean = false); begin FCanvas.BeginPath; FCanvas.Arc(x,y,r,a1,a2,anti); FCanvas.Stroke; end; var x,y,sx,sy,r:integer; begin // Clear where necessary with FCanvas do if DirtyOnly then begin // Only selected cells StrokeStyle:=clBlack; FillStyle:=clBlack; for x:=0 to GridXSize-1 do for y:=0 to GridYSize-1 do if Cells[x,y].Dirty or not DirtyOnly then begin sx:=x*Sze; sy:=y*Sze; //calculate pixel position on screen FillRect(sx,sy,sze,sze); end; end else begin // clear screen to black FillStyle:='black'; FillRect(0,0, FCanvasEl.Width,FCanvasEl.Height); // Draw supportGrid (helpfull during development, not needed) if DrawGrid then begin lineWidth:=2; // Pen.width:=1; StrokeStyle:='#202020'; for x:=0 to GridXSize do line(x*Sze,0,x*Sze,Sze*(GridYSize)); for y:=0 to GridYSize do line(0,y*Sze,Sze*(GridXSize),y*Sze); end; end; // Draw pills With FCanvas do begin // Draw Pills StrokeStyle:=clWhite; FillStyle:=clWhite; for x:=0 to GridXSize-1 do for y:=0 to GridYSize-1 do if Cells[x,y].Dirty or not DirtyOnly then begin sx:=x*Sze+HSze; sy:=y*Sze+HSze; r:=0; case Cells[x,y].PillType of ptPill : r:=2; ptSuperPill : r:=6; end; if r>0 then begin BeginPath; Arc(sx,sy,r,0,2*Pi); Fill; end; end; end; // Draw Walls per cell With FCanvas do begin StrokeStyle:=clBlue; FillStyle:=clBlue; LineWidth:=sze div 4; for x:=0 to GridXSize-1 do for y:=0 to GridYSize-1 do if Cells[x,y].Dirty or not DirtyOnly then begin sx:=x*Sze; sy:=y*Sze; //calculate pixel position on screen case Cells[x,y].WallType of wtEW: line(sx,sy+hsze,sx+sze,sy+hsze); // left to right wtNS: line(sx+hsze,sy,sx+hsze,sy+sze); // top to bottom wtSW: DoArc(sx , sy+Sze, Sze / 2,0 ,(3*Pi/2),true); // bottom to left wtNE: DoArc(sx+Sze, sy , Sze / 2,Pi/2,Pi); // top to right wtSE: DoArc(sx+Sze, sy+Sze, Sze / 2,Pi ,Pi*3/2); // bottom to right wtNW: DoArc(sx , sy , Sze / 2,0 ,Pi/2); // top to left end; Cells[x,y].Dirty:=False; end; end; end; procedure TPacman.DrawPacman(); Const Radius = 12; Offset = CellSize; EyeY = CellSize * 2/3; LeftEyeX = CellSize * 2/3; RightEyeX = CellSize * 4/3; MouthRadius = CellSize * 1/3; EyeRadius = 1.5; Var X,Y : Double; Procedure Pie(aAngle : double); Var aStart,aEnd : Double; begin if PacMouthOpen=0 then begin aStart:=0; aEnd:=2*pi end else begin aStart:=aAngle + (PacMouthOpen/90)*(Pi/2); if aStart>2*Pi then aStart:=aStart-2*pi; aEnd :=aAngle - (PacMouthOpen/90)*(Pi/2); { // Draw this to clear first FCtx.fillStyle:=clBlack; FCtx.StrokeStyle:=clBlack; FCtx.Arc(X+15,Y+15,Radius,0,2*pi,True); FCtx.Fill; } end; With FCanvas do begin BeginPath; MoveTo(X+OffSet,Y+Offset); Arc(X+Offset,Y+Offset,Radius,aStart,aEnd); LineTo(X+Offset,Y+Offset); Fill; end; end; begin X:=Sprite[0].XY.x*CellSize-CellSize/2; Y:=Sprite[0].XY.y*CellSize-CellSize/2; if PacMouthOpen>40 then PacMouthOpenDir:=-10 // if maxopen then start closing else if PacMouthOpen<2 then PacMouthOpenDir:= 10; // if minopen then start opening inc(PacMouthOpen,PacMouthOpenDir); // adjust mouth opening with FCanvas do begin FillStyle:=clYellow; // set face color to yellow StrokeStyle:=clYellow; // pen too case Sprite[0].Dir of // draw face depending on direction (opposite to what you'd expect) 'E': Pie(Pi); // to the right 'W': Pie(0); // to the left 'N': Pie(3*Pi/2); // to the top 'S': Pie(Pi/2); // to the bottom else beginPath; Arc(X+OffSet,y+OffSet,Radius,0,2*pi); // whole face area Fill(); FillStyle:=clBlack; // StrokeStyle:=clBlack; // beginPath; Arc(X+LeftEyeX,Y+EyeY,EyeRadius,0,2*pi); // left eye Stroke; beginPath; Arc(X+RightEyeX,Y+EyeY,Eyeradius,0,2*pi); // right eye Stroke; LineWidth:=3; // beginPath; arc(X+offSet,Y+OffSet,MouthRadius,0,Pi);//mouth Stroke; end; end; end; procedure TPacman.UpdateScore(); begin if Score>HiScore then HiScore:=Score; lbScore.InnerText := inttostr(Score); lbHiScore.InnerText := inttostr(HiScore); lbLives.InnerText := inttostr(LivesLeft); lbBonusCnt.InnerText:= inttostr(BonusCnt); lbGhostCnt.InnerText:= inttostr(GhostCnt); end; procedure TPacman.UpdateStatus(aText: String); begin lbStatus.InnerText:=aText; end; //============================================================================== // Initialization code //============================================================================== // There are several moments in the game something needs to be put in the // beginstate. // InitSprite() Called by InitSprites on Create(), creates images and presets // sprite variables // InitSprites() This code first creates and initializes all objects and // variables sets their beginstate values. Called only once !! // InitVars() This gets some sprite properties from a TField constant // and resets counters prior to a new game // InitCells() This copies the cell-properties from a TField constant // SetGhostScared() sets images and speeds of the 4 ghosts depending on param. procedure TPacman.InitSprite(var aSprite: TSprite; aImg: TJSHTMLImageElement; aSpd: Double); begin aSprite.spImg := aImg; // get an image instance, owned aSprite.SpImg.Width:=28; // make the black pixels transparent aSprite.SpImg.Height:=28; // make the black pixels transparent aSprite.dir := '-'; // no direction aSprite.Spd := aSpd; // default speed aSprite.XY := point(1,1); // Just a non error generating value aSprite.Sx := 0; // partial X in the middle of a cell aSprite.Sy := 0; // partial Y in the middle of a cell aSprite.StartPos:=point(2,2); // Just a non error generating value end; procedure TPacman.InitSprites(); var I : integer; begin Sprite[0].SpImg:=Nil; For I:=1 to 4 do InitSprite(Sprite[I],ImgGhost[i],GhostSpeedNormal); Sprite[0].Spd:=PacmanSpeed; // the image is overwritten later InitSprite(Sprite[5],ImgBonus ,BonusSpeed); end; procedure TPacman.InitVars(aField: TField); // Uses a TField definition to set the global variable PillCount and the initial // positions of Pacman and the Ghosts, Also (pre)sets timers and pacman's mouth. var x,y,n:integer; begin PillsLeft:=0; Score :=0; LivesLeft:=3; BonusCnt :=0; GhostCnt :=0; Pause :=false; pacMouthopen:=0; pacMouthopenDir:=10; //startvalues for open mouth of pacman for x:=0 to GridXSize-1 do for y:=0 to GridYSize-1 do begin case aField[y][x+1] of '.','o': inc(PillsLeft); // normal and superpills 'P' : sprite[0].StartPos:=point(x,y); // starting position of PacMan '1' : sprite[1].StartPos:=point(x,y); // starting position of Ghost #1 '2' : sprite[2].StartPos:=point(x,y); // starting position of Ghost #2 '3' : sprite[3].StartPos:=point(x,y); // starting position of Ghost #3 '4' : sprite[4].StartPos:=point(x,y); // starting position of Ghost #4 end; end; for n:=0 to 4 do sprite[n].XY:=sprite[n].StartPos; ScareTimer:=0; BonusTimer:=0; end; procedure TPacman.InitCells(aField: TField); // Uses a TField definition to set properties of all cells in the Cell[] array const wsH=['-','\','/']; // set of wall chars used in SW-NE detection wsV=['|','\','/']; // set of wall chars used in SE-NW detection var x,y:integer; c : char; begin for y:=0 to GridYSize-1 do for x:=0 to GridXSize-1 do begin // Set values for WallType from string-field definition c:=aField[y][x+1]; case c of '|': Cells[x,y].WallType:=wtNS; // top to bottom '-': Cells[x,y].WallType:=wtEW; // left to right '\': if (aField[y][x] in wsH) and (aField[y+1][x+1] in wsV) then Cells[x,y].WallType:=wtSW // bottom to left else Cells[x,y].WallType:=wtNE; // top to right '/': if (aField[y][x+2] in wsH) and (aField[y+1][x+1] in wsV) then Cells[x,y].WallType:=wtSE // bottom to right else Cells[x,y].WallType:=wtNW; // top to left 'x': Cells[x,y].Walltype:=wtNoGo; // no visible wall, but still occupied else Cells[x,y].WallType:=wtNone; // no obstacle to pacman and ghosts end; // set values for PillType from string-field definition case c of '.': Cells[x,y].PillType := ptPill; // this cell contains a Pill 'o': Cells[x,y].PillType := ptSuperPill; // this cell a SuperPill else Cells[x,y].PillType := ptNone; // walls and empty space, no points end; end; end; procedure TPacman.SetGhostScared(aScared: boolean); Procedure DoImg(Idx: Integer;aImg : TJSHTMLImageElement; aSpeed : Double); begin Sprite[Idx].spImg:=aImg; Sprite[Idx].Spd:=aSpeed; end; var i : Integer; begin if aScared then begin // assign "scared" images and set speed to scared for I:=1 to 4 do DoImg(i,ImgGhost[5],GhostSpeedScared); end else begin // assign normal ghost images and set speed to normal For i:=1 to 4 do DoImg(I,ImgGhost[i],GhostSpeedNormal); end; end; //============================================================================== // User input code //============================================================================== // This is a very simple piece of code, the only function is FormKeyDown (which // is an eventproperty of the form) which sets the direction Pacman should go. // for now only 4 keys are valid, arrow up,down,left,right. function TPacman.HandleKeyPress(k: TJSKeyBoardEvent): Boolean; Var aCode : String; begin Result:=True; if FDying then exit; aCode:=k.Key; if aCode='' then aCode:=K.Code; case aCode of // For some reason, it is opposite of what you'd expect... 'Right', TJSKeyNames.ArrowRight : PacManDir:='W'; 'Up', TJSKeyNames.ArrowUp : PacManDir:='N'; 'Left', TJSKeyNames.ArrowLeft : PacManDir:='E'; 'Down', TJSKeyNames.ArrowDown : PacManDir:='S'; 'P', 'KeyP' : Pause:=not Pause; end; k.preventDefault; end; function TPacman.DoResetClick(aEvent: TJSMouseEvent): boolean; begin Result:=True; FDying:=True; StopTimer; RestartGame(); end; function TPacman.CheckSound(Event: TEventListenerEvent): boolean; begin Result:=True; AudioDisabled:=Not FCBXSound.checked; if AudioDisabled then FAudio.DisableSound else If not FAudio.Loaded then begin FAudio.OnLoaded:=Nil; FAudio.LoadAudio; end; end; procedure TPacman.DoAudioLoaded(Sender: TObject); begin Start; end; function TPacman.DoMouseClick(aEvent: TJSMouseEvent): boolean; Const SControl = 'control-'; Var S : String; begin Result:=true; S:=aEvent.currentTargetElement.ID; aEvent.preventDefault; if Copy(S,1,Length(SControl))=SControl then begin Delete(S,1,Length(sControl)); Case S of 'left' : PacManDir:='E'; 'right' : PacManDir:='W'; 'down' : PacManDir:='S'; 'up' : PacManDir:='N'; 'pause' : Pause:=Not Pause; end; end; end; //============================================================================== // Business logic, rules of the game. //============================================================================== // The ghosts are aware of the position of pacman. Depending on their fear for // him they try to get to him (Fear=-1) or to get away from him (Fear=1) or anything in // between. // // Every once in a while a bonuscherry starts moving around for a some time. // When Pacman eats the cherry the score is incremented and the cherry disappears. // Whenever Pacman eats a small pill the score is incremented and the pill disappears // Whenever Pacman eats a large pill the score is incremented, the pill diappears, // and a timer is started that keeps the ghosts to a Fearlavel of 1 al long as the // timer runs. after that the ghosts wil gradually return to fear=-1; // When pacman eats a scared ghost the score is incremented and the ghost is sent // back to his cave... // When pacman eats a not so scared ghost he dies... // In this case all ghosts are sent home, and if there are stil lives left the // game continues with one life less... // When Pacman runs out of lives the game is ended and a new game is started. // If all pills are eaten the game is also ended and a new game is started. //============================================================================== // Business code: TestAndGet //============================================================================== // GetPossibleDir() // GetGhostDir() // GetPacmanDir() // GetRandomCellAndDir() function TPacman.GetPossibleDir(aXY: TPoint): TStr4; begin result:=''; // Start with an empty string if Cells[aXY.X,aXY.Y-1].WallType=wtNone then result:=result+'N'; // up is possible if Cells[aXY.X-1,aXY.Y].WallType=wtNone then result:=result+'E'; // left is possible if Cells[aXY.X,aXY.Y+1].WallType=wtNone then result:=result+'S'; // down is possible if Cells[aXY.X+1,aXY.Y].WallType=wtNone then result:=result+'W'; // right is possible end; function TPacman.GetBestDir(aXY: TPoint): char; begin result:='-'; if SolveMaze(aXY,sprite[0].XY) then begin // fill the SearchIndexes cell[x,y].i if Cells[aXY.X,aXY.Y-1].I<-10 then result:='N'; // up is best if Cells[aXY.X-1,aXY.Y].I<-10 then result:='E'; // left is best if Cells[aXY.X,aXY.Y+1].I<-10 then result:='S'; // down is best if Cells[aXY.X+1,aXY.Y].I<-10 then result:='W'; // right is best end; end; function TPacman.GetGhostDir(aXY: TPoint; aOldDir: char): char; var BestDir:char; D:Char;s:TStr4; begin result:='-'; s:=GetPossibleDir(aXY); case aOldDir of // get the direction opposite of the current direction 'W':D:='E'; 'E':D:='W'; 'S':D:='N'; 'N':D:='S'; else D:='-'; end; if (length(s)>1) then begin // more than one direction: make a choice BestDir:=GetBestDir(aXY); if (scaretimer=0) and (BestDir<>'-') then begin// if random < Huntfactor then s:=BestDir; // hunt depends on factor end else begin delete(s,pos(BestDir,s),1); // fleeing does not end; end; // if other than the reverse direction are possible then remove the reverse direction if (length(s)>1) and (pos(d,s)<>0) then delete(s,pos(d,s),1); if (length(s)=1) then result:=s[1]; // only one direction possible: Go if (length(s)>1) then result:=s[1+random(length(s))]; // choose at random end; function TPacman.GetPacmanDir(aXY: TPoint; aOldDir: char): char; var s:TStr4; begin s:=GetPossibleDir(aXY); if pos(PacmanDir,s)>0 then s:=pacmandir else if pos(aOldDir,s)>0 then s:=aOldDir else s:='-'; result:=s[1]; end; procedure TPacman.GetRandomCellAndDir(var aXY: TPoint; var aDir: char); begin repeat aXY:=point(1+random(GridXSize-3),random(GridYSize-3)); until (Cells[aXY.x,aXY.y].WallType=wtnone); aDir:=GetGhostDir(aXY,'-'); end; procedure TPacman.StopTimer; begin Window.clearInterval(SpriteTimer); end; procedure TPacman.MarkCellsDirty; Var n,maxn,x,y,i,j : Integer; begin maxn:=4; if BonusTimer>0 then inc(maxn); for n:=0 to 4 do begin X:=Sprite[n].XY.x; Y:=Sprite[n].XY.Y; for i:=-1 to 1 do for j:=-1 to 1 do Cells[X+i,Y+j].Dirty:=True; end; end; procedure TPacman.DoSpriteTimer; var n:integer; begin if Pause=false then begin MarkCellsDirty; DrawCells(True); for n:=0 to 4 do MoveSprite(n); // for 'Pacman' and each 'Ghost' if DoBonusTimer() then MoveSprite(5); // update bonustimer plus cherry DoScareTimer(); // update the timer that controls scaring of the ghosts DrawPacman(); // the images have moved, update the pacmanface end; end; //============================================================================== // Business code: Actions //============================================================================== // OnRestartMessage() // EatPill() // EatSuperPill() // EatBonus() // EatGhost() // ClearCell() // MoveSprite() // DoBonusTimer() // DoScareTimer() // OnSpriteTimer() function TPacman.DoRestartClick(aEvent: TJSMouseEvent): boolean; begin RestartGame(); // start game after VCL is ready drawing the screen end; procedure TPacman.EatPill(aXY: TPoint); begin inc(Score, 1); ClearCell(aXY); dec(PillsLeft); UpdateScore(); playsound(aEatPill); if PillsLeft=0 then NextLevel(); end; procedure TPacman.EatSuperPill(aXY: TPoint); begin ClearCell(aXY); ScareTimer:=ScareTimeOut; // Make 'm scared for a while... inc(Score,10); playsound(aEatPill); UpdateScore(); dec(PillsLeft); if PillsLeft=0 then NextLevel(); end; procedure TPacman.EatBonus(); begin BonusTimer:=0; // remove cherry inc(Score,50); inc(BonusCnt); UpdateScore(); // write scores to screen end; procedure TPacman.EatGhost(var aGhost: TSprite); begin playsound(aEatGhost); aGhost.XY:=aGhost.StartPos; // send ghost home inc(Score,20); inc(GhostCnt); UpdateScore(); // write scores to screen end; procedure TPacman.ClearCell(aXY: TPoint); var sx,sy:integer; begin cells[aXY.X,aXY.Y].PillType:=ptNone; // clear cell in Cell[] array Fcanvas.FillStyle:=clBlack; // also clear this part of the canvas sx:=aXY.x*CellSize; sy:=aXY.y*CellSize; FCanvas.fillrect(sx,sy,cellsize,cellsize); end; procedure TPacman.MoveSprite(aSpriteInx: integer); var oXY:TPoint; begin with Sprite[aSpriteInx] do begin // change position depending on direction oXY:=XY; case Dir of 'N': begin Sy:=Sy-Spd; if Sy<=-1 then begin dec(XY.y); Sy:=Sy+1; end; end; 'E': begin Sx:=Sx-Spd; if Sx<=-1 then begin dec(XY.x); Sx:=Sx+1; end; end; 'S': begin Sy:=Sy+Spd; if Sy>= 1 then begin inc(XY.y); Sy:=Sy-1; end; end; 'W': begin Sx:=Sx+Spd; if Sx>= 1 then begin inc(XY.x); Sx:=Sx-1; end; end; else begin oXY:=point(0,0); Sx:=0;Sy:=0; end; end; //if cell changed then choose new direction depending on wall limitations if (XY.x<>oXY.x) or (XY.y<>oXY.y) then begin if aSpriteInx=0 then dir:=GetPacmanDir(XY,dir) else dir:=GetGhostDir (XY,dir); if dir in ['E','W'] then //correct partial displacements sy:=0 else sx:=0; if aSpriteInx=0 then CollisionDetect(XY); //only for The Man himself... end; // if position goes offgrid then reenter on the other side of the screen if XY.x>GridXSize-3 then XY.x:=2; if XY.x<2 then XY.x:=GridXSize-3; if XY.y>GridYSize-3 then XY.y:=2; if XY.y<2 then XY.y:=GridYSize-3; // set sprite image position according to new Cx:Sx,Cy,Sy // Pacman is drawn separately if aSpriteInx<>0 then FCanvas.drawImage(spimg,(XY.x+Sx+0.5)*CellSize-SpImg.Width/2, (XY.y+Sy+0.5)*CellSize-SpImg.Height/2); // SpImg.Left := round(); // SPImg.Top := round((XY.y+Sy+0.5)*CellSize-SpImg.picture.Height/2); end; end; function TPacman.DoBonusTimer(): boolean; Var S : String; w : Integer; begin if BonusTimer>=0 then begin // bonustimer is positive: cherry is onscreen dec(BonusTimer); if BonusTimer<=0 then begin // if decrement makes it negative then // sprite[5].SpImg.visible:=false; // remove cherry from screen, and BonusTimer:=-BonusTimeOut1-random(BonusTimeOut1); // set a negative timeout end; end else begin // if bonus timer is negative then cherry is not onscreen inc(BonusTimer); if BonusTimer>=0 then begin // when increment makes it positive then // sprite[5].SpImg.visible:=true; // make cherry visible, // sprite[5].Sx:=0; sprite[5].Sy:=0;// set partial position to zero, and GetRandomCellAndDir(Sprite[5].XY,Sprite[5].Dir);// choose a random position BonusTimer:=+BonusTimeOut2+random(BonusTimeOut2); // Set a positive timeout end; end; // update a custom made progressbar on the screen S:='background-color: '; W:=bonustimer*Round(pnBonusBarOuter.clientWidth) div (2*BonusTimeOut2); if BonusTimer>0 then S:=S+clLime+'; width: '+IntToStr(W)+'px;' else S:=S+clRed+'; width: 0px;'; pnbonusbarInner['style']:=S; result:=BonusTimer>0; end; procedure TPacman.DoScareTimer(); Var S: String; w : integer; begin // just after superpill is eaten the caretimer is set to ScareTimeOut if scaretimer>=ScareTimeOut then SetGhostScared(true); //frighten them !! if ScareTimer>0 then begin dec(ScareTimer); // if scaretimer becomes zero then scare time is over: return to normal if scaretimer=0 then SetGhostScared(false); // fun is over... // update a custom made progressbar on the screen if ScareTimer>ScareTimeOut div 5 then S:='background-color: '+clLime else S:='background-color: '+clRed; // make bar red for last 20% of the time W:=ScareTimer*pnScareBarOuter.Clientwidth div ScareTimeOut; S:=S+'; width: '+IntToStr(w)+'px;'; pnScareBarInner.Attrs['style']:=S; end; end; procedure TPacman.DrawScene; Var I : Integer; begin DrawCells(); for I:=0 to 4 do MoveSprite(I); // For 'Pacman' and each 'Ghost' DrawPacMan; end; procedure TPacman.SetupPacman; Function GetElement(aName : String) : TJSHTMLElement; begin Result:=TJSHTMLElement(Document.getElementById(aName)); end; Var I : integer; El : TJSElement; begin if FCanvasID='' then FCanvasID:='my-canvas'; if FResetID='' then FResetID:='btn-reset'; FCanvasEl:=TJSHTMLCanvasElement(Document.getElementById(FCanvasID)); FCanvas:=TJSCanvasRenderingContext2D(FCanvasEl.getContext('2d')); FBtnReset:=TJSHTMLButtonElement(Document.getElementById(FResetID)); FCBXSound:=TJSHTMLInputElement(GetElement('cbx-sound')); FCBXSound.onchange:=@CheckSound; if Assigned(FBtnReset) then FBtnReset.OnClick:=@DoResetClick; FCanvasEl.width := Round(FCanvasEl.OffsetWidth); FCanvasEl.height := Round(FCanvasEl.OffsetHeight); for I:=1 to 4 do ImgGhost[i]:=TJSHTMLImageElement(GetElement('ghost'+IntToStr(i))) ; ImgGhost[5]:=TJSHTMLImageElement(GetElement('ghost-scared')); ImgBonus:=TJSHTMLImageElement(GetElement('cherry')); for I:=1 to ControlCount do begin El:=GetElement('control-'+ControlNames[i]); if Assigned(El) then TJSHTMLElement(El).onClick:=@DoMouseClick; end; pnBonusBarOuter:=GetElement('bonus-outer'); pnBonusBarInner:= GetElement('bonus-inner'); pnScareBarOuter:=GetElement('scare-outer'); pnScareBarInner:=GetElement('scare-inner'); lbScore:=GetElement('score'); lbStatus:=GetElement('status'); lbHiscore:=GetElement('highscore'); lbLives:=GetElement('lives'); lbBonusCnt:=GetElement('bonus'); lbGhostCnt:=GetElement('ghosts'); // Sprites need the images, so this can only be done in this part InitSprites(); document.onkeydown:=@HandleKeyPress; if not AudioDisabled then InitAudio() end; procedure TPacman.InitAudio; begin Faudio.LoadAudio; end; procedure TPacman.StartTimer; begin FDying:=False; UpdateStatus('Playing'); SpriteTimer:=window.setInterval(@DoSpriteTimer,TimerInterval); end; procedure TPacman.Start; begin RestartGame; end; //============================================================================== // Business code: Decisions //============================================================================== // CollisionDetect() // RestartGame() // RestartLevel() // PacmanDies() // NextLevel() // GameOver() procedure TPacman.CollisionDetect(var aXY: TPoint); var n,ix,dX,dY:integer; begin case cells[aXY.X,aXY.Y].PillType of ptPill :EatPill(aXY); ptSuperPill :EatSuperPill(aXY); end; ix:=0; for n:=1 to 5 do begin dX:=sprite[n].XY.x-aXY.x; dY:=sprite[n].XY.y-aXY.y; if (abs(dX)<=1) and (abs(dY)<=1) then ix:=n; end; if (ix=5) and (BonusTimer>0) then EatBonus(); if ix in [1..4] then begin if ScareTimer>0 then EatGhost(sprite[ix]) else PacmanDies(); end; end; procedure TPacman.RestartGame(); begin InitVars(Level1Field); InitCells(Level1Field); RestartLevel(); UpdateStatus('Playing'); end; procedure TPacman.RestartLevel(); var n:integer; begin for n:=0 to 4 do Sprite[n].XY:=Sprite[n].StartPos; UpdateScore(); SetGhostScared(false); DrawScene; PacmanDir:='-'; DrawPacman(); // the images have moved, set the pacmanface PlaySound(aStart); ShowText('GET READY !!!',@StartTimer); PacmanDir:='-'; end; procedure TPacman.CheckGameOver; begin if LivesLeft<=0 then GameOver() else ReStartLevel(); end; procedure TPacman.PacmanDies(); begin //exit; if FDying then exit; FDying:=True; StopTimer; playsound(aDie); dec(LivesLeft); UpdateScore(); PacmanDir:='-'; UpdateStatus('You died'); ShowText('YOU DIE !!!',@CheckGameOver); end; procedure TPacman.NextLevel(); begin StopTimer; ShowText('YOU WIN !!!',@RestartGame); UpdateStatus('You win'); end; procedure TPacman.GameOver(); begin ShowText('YOU LOST !!!',@RestartGame); UpdateStatus('You lost'); end; procedure TPacman.PlaySound(aAudio: TAudio); begin if (not AudioDisabled) and (FAudio.Loaded) then FAudio.play(aAudio); end; //============================================================================== // Maze solving //============================================================================== // Solving a maze is implemented here as a 3 step process. // Step 1: // All accessible maze cells get an searchindex of 0, all blocked cells // (f.i. Walls) get an index of -1. // Step 2: // Two arrays are used to keep track of a set of cells that are tested // This step begins with adding the first point to the primary array. // This now contains exactly one cell. Then a loop starts: for each cell in // the primary array the 4 surrounding cells are tested (left,right,up down) // If the index of such a cell is 0 then the cell is free and it is added to // a secondary array of cell coordinates. The searchindex of the cell is set // to a value that is one higher than the searchindex of original cell. // If the neighbour cells of all cells in the primary array are tested then // the secondary array is copied to the primary array and the secondary array // is cleared. // There are 2 reasons to end this loop: // 1: The cell that was searched for is found // 2: There are no more cells with a searchindex of 0, secondary array is empty // When this is all done the cells have a search index that increments as the // cell is further away from the originating point. Not all cells are tested. // When the loop finds the target in say 10 steps the testing stops, so no cell // will get an index higher than 10. // Imagine an octopus with growing tentacles that stops when the prey is found // Step 3: // Now that the target is found we have to find "the tentacle that leads back // to the octopus", the shortest way back to the originating point. // This is done by starting at the endpoint, and looking in the surrounding // cells for a valid searchindex that is smaller than the cells own searchindex. // Move the cellpointer to the adjacing cell with a smaller index and eventually // you get back to the source. // Imagine a river valley in which a lot of streams go down to the middle. Just // follow gravity and you will end up in the center. // On the way back the cells are marked, and that way you will have a set of // cells that give you the shortest route form A to B. // // For debugging the searchindexes are set to 10 and higher for the tested cells // on routes without result, and -10 and lower for the tested cells that are part // of the shortest route. SearchIndex = 10 or -10 is the startingpoint. // Blocked cells are -1, Untested cells are 0. // Cells with an index of -10 or less are the solution. // // For this game we are only interested in the first direction decision of a // Ghost, so after step 1 to 3 we only look which cell in the adjacent cells of // a Ghost is in the path, and send the Ghost that way (or opposite when it is // scared). function TPacman.SolveMaze(P1, P2: TPoint): boolean; begin // 3 step maze solving algorithm result := SolveMazeStep1(P1,P2); // step1 if result then result := SolveMazeStep2(P1,P2); // step2 if result then result := SolveMazeStep3(P1,P2); // step3 end; function TPacman.SolveMazeStep1(P1, P2: TPoint): boolean; var x,y:integer; begin for x:=0 to GridXSize-1 do for y:=0 to GridYSize-1 do begin if Cells[x,y].WallType=wtNone then Cells[x,y].I:=0 // these cells can be part of a route else Cells[x,y].I:=-1; // these cells can not... end; // no search is usefull if P1 or P1 is not a valid cell... result:= (cells[P1.x ,P1.y].I=0) and (cells[P2.x,P2.y].I=0) end; // In the procedure below a fixed size is used for SArr1 and SArr2. // Of course it is much better to use a dynamic array that is never too small // I tested the maximum number of alternative routes in this maze is 17, and the // maximum number of searchloops is 54. // To keep code as simple as possible the arraysizes are set to 64 (17 needed). function TPacman.SolveMazeStep2(P1, P2: TPoint): boolean; var SArr1,SArr2:array[0..63] of tpoint; SArr1Cnt,SArr2Cnt:integer; SI:integer; n:integer; procedure AddLS2(x,y:integer); begin if (x<0) or (x>=GridXSize) then exit; // index offgrid: do nothing if (y<0) or (y>=GridYSize) then exit; // index offgrid: do nothing if cells[x,y].i<>0 then exit; // cell is blocked: do nothing cells[x,y].i:=SI; // cell is usable: give index SArr2[SArr2Cnt]:=point(x,y); inc(SArr2Cnt); // add cell to SArr2 for next run if (x=P2.x) and (y=P2.y) then Result:=true; // if endpoint is found then stop end; begin SI:=10; Result:=false; // start at 10 to have some special numbers to spare cells[p1.x,p1.y].i:=SI; // for debugging, set the searchindex of first cell SArr1Cnt:=1; SArr1[0]:=P1;// prepare primary array with one (the first) cell repeat // now start searching for PacMan !! inc(SI); // increment search index SArr2Cnt:=0; // clear secondary array for n:=0 to SArr1Cnt-1 do begin // for all points in primary array do AddLS2(SArr1[n].x+1,SArr1[n].y );// Test and maybe add cell to the right AddLS2(SArr1[n].x ,SArr1[n].y+1);// Test and maybe add cell below AddLS2(SArr1[n].x-1,SArr1[n].y );// Test and maybe add cell to the left AddLS2(SArr1[n].x ,SArr1[n].y-1);// Test and maybe add cell above end; //now copy alle new searchpoints in SArr2 to sArr1, and set the number of points for n:=0 to SArr2Cnt-1 do SArr1[n]:=SArr2[n]; SArr1Cnt:=SArr2Cnt; until Result or (SArr2Cnt=0); // repeat until pacman is found or all cells tested end; function TPacman.SolveMazeStep3(P1, P2: TPoint): boolean; var Rdy:boolean; dP:TPoint; I:integer; procedure Check(x,y:integer); var It:integer; begin if (x<0) or (x>=GridXSize) then exit; // index offgrid: do nothing if (y<0) or (y>=GridYSize) then exit; // index offgrid: do nothing It:=cells[x,y].I; // make a long name short... if (It>0) and (It0 I:=It; // then make I the smaller index dP:=point(x,y); // and make the next cell the tested cell end; end; begin repeat I:=cells[P2.x,P2.y].i; // inx of current cell (P) dP:=P2; // make next p equal to current cell Check(P2.x+1,P2.y ); // test right Check(P2.x-1,P2.y ); // test left Check(P2.x ,P2.y+1); // test bottom Check(P2.x ,P2.y-1); // test top Rdy:=(dP.x=P2.x)and(dP.y=P2.y); // if dP still equal to P than search is over cells[p2.x,p2.y].i := -cells[p2.x,p2.y].i;// mark this cell as returnpath P2:=dP; // move current cell to the next one until Rdy; result:=(P2.x=P1.x)and(P2.y=P1.y);// what can possibly go wrong??? end; procedure TPacmanAudio.AudioLoaded; Var AllLoaded : Boolean; A : TAudio; begin allLoaded:=True; For a in TAudio do AllLoaded:=AllLoaded and FilesOK[a]; FLoaded:=allLoaded; if Assigned(FonLoaded) then FOnLoaded(Self); end; function TPacmanAudio.CheckEnd(Event: TEventListenerEvent): boolean; var a : TAudio; begin For a in TAudio do if (Files[a]=Event.target) then Playing[a]:=False; end; function TPacmanAudio.CheckplayOK (Event: TEventListenerEvent): boolean; var a : TAudio; begin For a in TAudio do if (Files[a]=Event.target) then begin Files[a].oncanplaythrough:=nil; FilesOK[a]:=True; AudioLoaded; end; end; procedure TPacmanAudio.LoadAudio; var F : TJSHTMLAudioElement; A : TAudio; begin for a in TAudio do begin F:=TJSHTMLAudioElement(Document.GetElementByID('audio-'+audionames[a])); Files[a]:=F; FilesOK[a]:=F.readyState>=3; if not FilesOK[a] then F.oncanplaythrough:=@CheckPlayOK; end; AudioLoaded; end; procedure TPacmanAudio.DisableSound; var a : TAudio; begin For a in TAudio do if Playing[a] then begin files[a].pause(); files[a].currentTime := 0; end; end; procedure TPacmanAudio.play(aAudio: Taudio); begin Writeln('Attempting to play:',AudioNames[aAudio]); if FilesOK[aAudio] then begin Playing[aAudio]:=true; Files[aAudio].play; Files[aAudio].onended:=@CheckEnd; end; end; procedure TPacmanAudio.Pause; var a : TAudio; begin For a in TAudio do if Playing[a] and not Files[a].paused then files[a].pause(); end; procedure TPacmanAudio.Resume; var a : TAudio; begin For a in TAudio do if Playing[a] and Files[a].paused then files[a].play(); end; end.