diff --git a/demo/pacman/audio/die.mp3 b/demo/pacman/audio/die.mp3 new file mode 100644 index 0000000..57e32c9 Binary files /dev/null and b/demo/pacman/audio/die.mp3 differ diff --git a/demo/pacman/audio/eatghost.mp3 b/demo/pacman/audio/eatghost.mp3 new file mode 100644 index 0000000..0bccf3b Binary files /dev/null and b/demo/pacman/audio/eatghost.mp3 differ diff --git a/demo/pacman/audio/eating.mp3 b/demo/pacman/audio/eating.mp3 new file mode 100644 index 0000000..7630181 Binary files /dev/null and b/demo/pacman/audio/eating.mp3 differ diff --git a/demo/pacman/audio/start.mp3 b/demo/pacman/audio/start.mp3 new file mode 100644 index 0000000..f295eb3 Binary files /dev/null and b/demo/pacman/audio/start.mp3 differ diff --git a/demo/pacman/cherry.png b/demo/pacman/cherry.png new file mode 100644 index 0000000..50184f3 Binary files /dev/null and b/demo/pacman/cherry.png differ diff --git a/demo/pacman/ghost-scared.png b/demo/pacman/ghost-scared.png new file mode 100644 index 0000000..861f557 Binary files /dev/null and b/demo/pacman/ghost-scared.png differ diff --git a/demo/pacman/ghost1.png b/demo/pacman/ghost1.png new file mode 100644 index 0000000..897526f Binary files /dev/null and b/demo/pacman/ghost1.png differ diff --git a/demo/pacman/ghost2.png b/demo/pacman/ghost2.png new file mode 100644 index 0000000..7440263 Binary files /dev/null and b/demo/pacman/ghost2.png differ diff --git a/demo/pacman/ghost3.png b/demo/pacman/ghost3.png new file mode 100644 index 0000000..e094889 Binary files /dev/null and b/demo/pacman/ghost3.png differ diff --git a/demo/pacman/ghost4.png b/demo/pacman/ghost4.png new file mode 100644 index 0000000..d24576a Binary files /dev/null and b/demo/pacman/ghost4.png differ diff --git a/demo/pacman/pacman.css b/demo/pacman/pacman.css new file mode 100644 index 0000000..ad6c149 --- /dev/null +++ b/demo/pacman/pacman.css @@ -0,0 +1,189 @@ +* { + box-sizing: border-box; + margin: 0; + padding: 0; +} + +body { + font-family: 'Roboto', serif; +} + +.progress { + border: 2px solid #B0B0B0; + border-radius: 5px; +} + +.progress-inner { + height: 20px; + margin: 2px; +} + +#pacman { + display: flex; + width: 560px; + margin: 3em auto; +} + +#my-canvas { + width: 482px; + height: 528px; +} + +#info { + display: flex; + flex-direction: column; + justify-content: space-between; + height: 470px; + width: 240px; +} + +#info > #logo { + flex-basis: auto; + margin-top: 7px; + padding: 5px 0; + display: flex; + align-items: center; + justify-content: center; + background-color: #b8caf4; +} + +#info > #score-envelope { + flex-basis: 8%; + border: 2px solid #B0B0B0; + border-radius: 5px; + display: flex; + align-items: center; + font-weight: bold; +} + +#info > #highscore-envelope { + flex-basis: 8%; + border: 2px solid #B0B0B0; + border-radius: 5px; + display: flex; + align-items: center; + font-weight: bold; +} + +#info > #ghosts-envelope { + flex-basis: 8%; + border: 2px solid #B0B0B0; + border-radius: 5px; + display: flex; + align-items: center; + font-weight: bold; +} + + +#info > #bonus-envelope { + flex-basis: 8%; + border: 2px solid #B0B0B0; + border-radius: 5px; + display: flex; + align-items: center; + font-weight: bold; +} + +#info > #lives-envelope { + flex-basis: 8%; + border: 2px solid #B0B0B0; + border-radius: 5px; + display: flex; + align-items: center; + font-weight: bold; +} + +#info > #status-envelope { + flex-basis: 8%; + border: 2px solid #B0B0B0; + border-radius: 5px; + display: flex; + align-items: center; + font-weight: bold; +} + +#info > #controls-envelope { + flex-basis: auto; + border: 2px solid #B0B0B0; + border-radius: 5px; + padding: 0.5em 0; + display: flex; + flex-direction: column; + justify-content: center; +} + +#info > #btn-reset { + flex-basis: auto; +} + +.button { + margin: 0.4em; + padding: 1em; + text-align: center; + cursor: pointer; + outline: none; + color: #fff; + min-width: 100px; + font-weight: bold; + background-color: #537fe4; + border: none; + border-radius: 15px; + box-shadow: 1px 2px #aaa; + } + +.button:hover { + background-color: #2B60DE; +} + +.button:active { + background-color: #2B60DE; + box-shadow: 0 3px #888; + transform: translateY(2px); +} + +#controls > .one-btn { + display: flex; + justify-content: center; +} + +#controls > .two-btn { + display: flex; + justify-content: space-between; +} + +.label { + text-transform: uppercase; + font-weight: bold; + margin-right: 0.5em; + padding-left: 0.5em; +} + +.source { + display: flex; + width: 540px; + margin: -40px auto; + font-size: 12px; +} + +#btn-reset{ + background: #2B60DE; + color: #fff; + font-weight: bold; + border: 0; + padding: 12px 0; + width: 100%; + border-radius: 5px; + text-transform: uppercase; + font-size: 14px; + cursor: pointer; + outline: none; +} + +#btn-reset:hover { + background-color: #1e4fc2; +} + +#btn-reset:active { + background-color: #1e4fc2; + transform: translateY(2px); +} diff --git a/demo/pacman/pacman.html b/demo/pacman/pacman.html new file mode 100644 index 0000000..692b5ab --- /dev/null +++ b/demo/pacman/pacman.html @@ -0,0 +1,94 @@ + + + + + + + Pacman using pas2js + + + + + + + + + +
+
+ +
+
+ +
+
+
+
+
+
+
+
High Score:
+
0
+
+
+
Score:
+
0
+
+
+
Lives:
+
3
+
+
+
Game status:
+
Playing
+
+
+
+
0
+
+
+
+
0
+
+
+
Controls:
+
+
+ +
+
+ + +
+
+ +
+
+ +
+
+
+ +
+
Sound:
+
+
+
+
+
+ Created using   pas2js.   Sources:   Program   unit. +
+
+ + + + +
+ + + diff --git a/demo/pacman/pacman.lpi b/demo/pacman/pacman.lpi new file mode 100644 index 0000000..84c51ef --- /dev/null +++ b/demo/pacman/pacman.lpi @@ -0,0 +1,96 @@ + + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <CustomData Count="5"> + <Item0 Name="MaintainHTML" Value="1"/> + <Item1 Name="PasJSHTMLFile" Value="project1.html"/> + <Item2 Name="PasJSPort" Value="0"/> + <Item3 Name="PasJSWebBrowserProject" Value="1"/> + <Item4 Name="RunAtReady" Value="1"/> + </CustomData> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <Units> + <Unit> + <Filename Value="pacman.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="pacman.html"/> + <IsPartOfProject Value="True"/> + <CustomData Count="1"> + <Item0 Name="PasJSIsProjectHTMLFile" Value="1"/> + </CustomData> + </Unit> + <Unit> + <Filename Value="upacman.pp"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target FileExt=".js"> + <Filename Value="pacman"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="js"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <TargetOS Value="browser"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + <UseLineInfoUnit Value="False"/> + </Debugging> + </Linking> + <Other> + <CustomOptions Value="-Jeutf-8 -Jirtl.js -Jc -Jminclude"/> + <CompilerPath Value="$(pas2js)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/demo/pacman/pacman.lpr b/demo/pacman/pacman.lpr new file mode 100644 index 0000000..3ad3ee6 --- /dev/null +++ b/demo/pacman/pacman.lpr @@ -0,0 +1,30 @@ +program pacman; + +{$mode objfpc} + +uses + browserapp, JS, Classes, SysUtils, Web, upacman; + +type + TMyApplication = class(TBrowserApplication) + FPacMan : TPacMan; + procedure doRun; override; + end; + +procedure TMyApplication.doRun; + +begin + FPacMan:=TPacMan.Create(Self); + // Your code here + Terminate; +end; + +var + Application : TMyApplication; + +begin + Application:=TMyApplication.Create(nil); + Application.Initialize; + Application.Run; +// Application.Free; +end. diff --git a/demo/pacman/upacman.pp b/demo/pacman/upacman.pp new file mode 100644 index 0000000..4b6062b --- /dev/null +++ b/demo/pacman/upacman.pp @@ -0,0 +1,1465 @@ +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; + 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 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; + 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(); +// 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; + +//============================================================================== +// 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; + +begin + Result:=True; + if FDying then exit; + case k.Code of + // For some reason, it is opposite of what you'd expect... + TJSKeyNames.ArrowRight : PacManDir:='W'; + TJSKeyNames.ArrowUp : PacManDir:='N'; + TJSKeyNames.ArrowLeft : PacManDir:='E'; + TJSKeyNames.ArrowDown : PacManDir:='S'; + '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; +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.currentTarget.ID; + aEvent.preventDefault; + if Copy(S,1,Length(SControl))=SControl then + begin + Delete(S,1,Length(sControl)); + Case S of + 'left' : PacManDir:='W'; + 'right' : PacManDir:='E'; + '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; + +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(Document.getElementById('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(Document.getElementById('ghost'+IntToStr(i))) ; + ImgGhost[5]:=TJSHTMLImageElement(Document.getElementById('ghost-scared')); + ImgBonus:=TJSHTMLImageElement(Document.getElementById('cherry')); + pnBonusBarOuter:=TJSHTMLElement(Document.getElementById('bonus-outer')); + pnBonusBarInner:= TJSHTMLElement(Document.getElementById('bonus-inner')); + pnScareBarOuter:=TJSHTMLElement(Document.getElementById('scare-outer')); + pnScareBarInner:=TJSHTMLElement(Document.getElementById('scare-inner')); + for I:=1 to ControlCount do + begin + El:=Document.GetElementById('control-'+ControlNames[i]); + if Assigned(El) then + TJSHTMLElement(El).onClick:=@DoMouseClick; + end; + lbScore:=TJSHTMLCanvasElement(Document.getElementById('score')); + lbHiscore:=TJSHTMLCanvasElement(Document.getElementById('highscore')); + lbLives:=TJSHTMLCanvasElement(Document.getElementById('lives')); + lbBonusCnt:=TJSHTMLCanvasElement(Document.getElementById('bonus')); + lbGhostCnt:=TJSHTMLCanvasElement(Document.getElementById('ghosts')); + // Sprites need the images, so this can only be done in this part + InitSprites(); + document.onkeydown:=@HandleKeyPress; + InitAudio(); +end; + +procedure TPacman.InitAudio; + +begin + Faudio.LoadAudio; +end; + +procedure TPacman.StartTimer; + +begin + FDying:=False; + 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(); +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 + if not AudioDisabled then + FAudio.Play(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:='-'; + ShowText('YOU DIE !!!',@CheckGameOver); +end; + +procedure TPacman.NextLevel(); +begin + StopTimer; + ShowText('YOU WIN !!!',@RestartGame); +end; + +procedure TPacman.GameOver(); +begin + ShowText('YOU LOOSE !!!',@RestartGame); +end; + +procedure TPacman.playsound(aAudio: TAudio); +begin + if not AudioDisabled 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 (It<I) then begin // if index is smaller than the last but >0 + 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]; + if allLoaded and Assigned(FonLoaded) then + begin + Writeln('All Loaded'); + FOnLoaded(Self); + end; +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; +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.