program Snaik; { "Snaik" v 0.15 Written in Pascal and using the OpenGL Library - Snaik is a clone of the popular mobile phone game 'Snake'. I started writing it for my Advanced Higher programming project at Portobello High School on 04/11/08, and finished roughly 20/03/2009. Copyright (C) 2009 Elliot Walmsley This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . } {$LongStrings ON} {$mode objfpc}{$H+} uses Gl, Glut, Glu; // OpenGL library includes const PI = 3.141; FSMode = '1280x1024:32@60'; // Mode to set the resolution, colour depth and frequency WIDTH = 1280; HEIGHT = 1024; DIFFUSE : array [0..3] of GLfloat = (0.9, 0.9, 0.9, 1); // Lighting GRIDWIDTH = 20; GRIDHEIGHT = 20; BERRYNUM = 10; PARTICLENUM = 100; INITSNAKELENGTH = 3; // Initial snake length // Used to stop the program crashing when the snake fills the grid MAXSNAKELENGTH = ((GRIDWIDTH - 2) * (GRIDHEIGHT - 2)) - BERRYNUM - 10; // Markers on the grid BLANKB = '0'; SNAKEB = '1'; BERRYB = '2'; WALLB = '3'; SNAKEHEADB = '5'; // Menu positioning MENUTITLEHEIGHT = 3; CONTENTHEIGHT = 2.5; LEFTMARGIN = -5; // Keys ESC_KEY = 27; ENTER_KEY = 13; {$IFDEF UNIX} SAVE = '/Volumes/Data/Snaik'; {$ELSE} SAVE = 'C:/Snaik'; {$ENDIF} type ep = ^e; e = record // Snake dynamic data structure, lots of blocks x, y : integer; // Location of Snake Block next, prev : ep; end; type scores = record // High Scores data structure name : string; score : smallint; end; highScoresFileArray = array [1..20] of scores; gridArray = array [1..GRIDWIDTH, 1..GRIDHEIGHT] of char; // 2D Array for the Grid // --------------------------- // berry Class // --------------------------- type pberry = ^tberry; // Pointer to a berry tberry = object private x, y : smallint; public constructor init; destructor destroy; function getX : smallint; function getY : smallint; procedure randomPlacement(); procedure eat(); end; berryArray = array [1..BERRYNUM] of pberry; // --------------------------- // particle Class // --------------------------- type pparticle = ^tparticle; // Pointer to a particle tparticle = object private x, y : real; dir : real; // Direction energy : real; acc, grav : real; // Acceleration, Gravity public constructor init(cart : boolean; x1, y1, g, a, e : real); destructor destroy(); procedure move(); function getX : real; function getY : real; function getEnergy : real; function reduceEnergy(num : real) : smallInt; end; particleArray = array [1..PARTICLENUM] of pparticle; // --------------------------- // emitter Class // --------------------------- type pemitter = ^temitter; // Pointer to Emitter temitter = object private parts : particleArray; active : boolean; x, y : real; startEnergy : real; deadParticles : smallInt; red, green, blue : real; public constructor init(cart : boolean; x1, y1, g, a, e, redc, greenc, bluec : real); // Create particles destructor destroy; procedure draw(); procedure move(); function isActive : boolean; function getDeadParticles : smallInt; procedure reduceEnergy(); end; type emitp = ^emit; // Structure for dynamic queue of emitters emit = record e : pemitter; next, prev : emitp; end; // ======================== // Global Variables // ======================== var T : integer; // T is the global MilliSeconds passed since the start of the program dt : real; // Time inbetween each frame oldTime, FPSTime : integer; // Used for calculating the time between frames frameCount : integer; // Frames rendered since start score, lives, option, room, difficulty : smallint; path, direction : char; s, sh, st : ep; // Snake pointers em, emh, emt : emitp; // Emitter pointer grid : gridArray; // 2D playing field berries : berryArray; // 1D array of berry objects timeSinceSnake, cooldown, pause : smallInt; highScoresFile : text; // Text file to save scores txtArray : array [1..20] of scores; // High scores in memory crashed : boolean; pauseMessage : string; pauseLeftMargin, gridZoom : real; // ============================= // PROCEDURES AND FUNCTIONS // ============================= function convert(x : real) : real; // Change cartesian coordinates to grid values begin convert := (x - (GRIDWIDTH div 2)) * 10 / GRIDWIDTH; end; // ------------- // High Scores // ------------- procedure setupHighScores(); // Assign a file location, and create file if it doesnt already exist begin assign(highScoresFile, concat(SAVE, 'highScores.txt')); // assign highScoresFile to a File location {$I-} reset(highScoresFile); {$I+} if (IOResult <> 0) then // Make the file if its not there (Returns an Error) begin rewrite(highScoresFile); writeln(highScoresFile, ''); writeln('Created new file.'); end; close(highScoresFile); end; procedure saveHighScores(); // Save the txtArray containing the highscores to the assigned file var i : smallint; begin rewrite(highScoresFile); // Setup file for writing for i := 1 to 10 do begin writeln(highScoresFile, txtArray[i].name); writeln(highScoresFile, txtArray[i].score); writeln('Saving: ', txtArray[i].name, ' : ', txtArray[i].score); end; close(highScoresFile); end; procedure loadHighScores(); // Load scores from a file into an array var i : smallint; sc : scores; begin reset(highScoresFile); // read from the file i := 1; repeat readln(highScoresFile, sc.name); txtArray[i].name := sc.name; readln(highScoresFile, sc.score); txtArray[i].score := sc.score; writeln('Loading: ', txtArray[i].name, ' : ', txtArray[i].score); i := i + 1; until eof(highScoresFile); // Fill the empty spots with placeholders if txtArray[10].score = 0 then begin for i := (i - 1) to 10 do begin txtArray[i].name := 'AAA'; txtArray[i].score := 0; end; end; close(highScoresFile); end; procedure sortHighScores(); // Sort the high Scores array var i, j : smallint; temp : scores; begin for j := 1 to 9 do // Bubble Sort for i := 1 to 9 do if txtArray[i].score < txtArray[i+1].score then // Descending order begin temp := txtArray[i]; txtArray[i] := txtArray[i+1]; txtArray[i+1] := temp; end; end; procedure clearHighScoresFile(); // Erases all values in the array, and then saves it to file var i : smallint; begin for i := 1 to 10 do // Overwrite with placeholders begin txtArray[i].name := 'AAA'; txtArray[i].score := 0; end; saveHighScores(); writeln('Cleared File.'); end; function getTotalTime : single; // Return time in seconds begin getTotalTime := glutGet(GLUT_ELAPSED_TIME) / 1000; end; function getDeltaTime : single; // Return the time between each frame var newTime: integer; begin newTime := glutGet(GLUT_ELAPSED_TIME); result := (newTime - oldTime) / 1000; oldTime := newTime; end; function getFPS : real; // Returns Frames Per Seconds var newTime: integer; begin newTime := glutGet(GLUT_ELAPSED_TIME); getFPS := frameCount / ((newTime - FPSTime) / 1000); FPSTime := newTime; frameCount := 0; end; procedure drawBackground(); var j : smallint; begin glPushMatrix(); // Save current matrix for later glLoadIdentity; glDisable(GL_LIGHTING); // Disable lighting for 2D // Attributes glColor4f (0.9, 0.9, 0.1, 0.15); glLineWidth(5); // Matrix glTranslatef(1, 1, -50); glRotatef(90 * sin(T / 500), 0, -1, -1); glBegin(GL_LINES); // Draw the background pattern for j := -30 to 30 do begin glVertex2f(-30 + j, -30 - j); glVertex2f(30 + j, 30 - j); end; glEnd(); glEnable(GL_LIGHTING); glPopMatrix(); // Go back to old matrix end; function getBerryIndex(x, y : smallint) : smallint; // Return the index of the berry at location (x,y) var i : smallint; begin i := 0; repeat i := i + 1; // Loop through until it finds a match at (x,y) OR until its gone through all the Berries until ((x = berries[i]^.getX) and (y = berries[i]^.getY)) or (i = BERRYNUM); if ((x = berries[i]^.getX) and (y = berries[i]^.getY)) then // If it found the berry getBerryIndex := i else getBerryIndex := 0; end; procedure setupEmitter(); // Setup the emitter pointers begin new(emt); new(em); new(emh); emt := NIL; emh := em; em^.prev := NIL; em^.next := NIL; end; procedure stepEmitters(); // Move all the emitters one step begin em := emt; while em^.next <> NIL do begin em^.e^.move(); em := em^.next; end; em^.e^.move(); end; procedure removeEmitter(remove : emitp); // Remove an emitter from the queue begin if emt <> emh then // if there is something in the queue begin if (remove = emt) then // Tail begin emt := emt^.next; dispose(remove^.e, destroy); emt^.prev := NIL; end else if (remove = emh) then // Head begin emh := emh^.prev; dispose(remove^.e, destroy); emh^.next := NIL; end else // Other begin dispose(remove^.e, destroy); remove^.prev := remove^.next; end; end else begin // Last emitter dispose(remove^.e, destroy); emt := NIL; em^.prev := NIL; end; end; procedure checkEmitters(); // Check if the top emitter is finished, and delete it if so begin em := emh; if em^.e^.getDeadParticles = PARTICLENUM then removeEmitter(em); end; procedure reduceEnergyEmitters(); // Go through emitters and reduce energy begin em := emt; while em^.next <> NIL do begin em^.e^.reduceEnergy(); em := em^.next; end; em^.e^.reduceEnergy(); end; procedure drawEmitters(); // Draw all emitters begin em := emt; while em^.next <> NIL do begin em^.e^.draw(); em := em^.next; end; em^.e^.draw(); end; procedure addEmitter(cart : boolean; x, y, g, a, e, redc, greenc, bluec : real); // Adds an emitter to the tail of the queue begin // Diagram showing queue structure below // t - - - - - - - h // When the queue is empty, t will be NIL // When the queue has one object in it, t will equal h if emt = nil then // If there are no emitters begin emt := emh; em := emt; // Go to tail end else begin em := emt; // Go to tail new(em^.prev); // Make a new emitter before em^.prev^.next := em; // Make the new emitter connect with the current em := em^.prev; em^.prev := NIL; emt := em; // Assign the new tail end; new(em^.e, init(cart, x, y, g, a, e, redc, greenc, bluec)); // Initialise the new emitter end; procedure addChunk(x, y : integer); // Add a Chunk to the snake at (x,y) begin // Diagram showing queue structure below // t - - - - - - - h // When the queue is empty, t will be NIL // When the queue has one object in it, t will equal h s := st; // Go to the tail new(s^.prev); // Make a new chunk before s^.prev^.next := s; // Make the new chunk point to current chunk s := s^.prev; // Go to the new chunk s^.x := x; // Set values s^.y := y; s^.prev := NIL; st := s; // Set the new Tail end; procedure setupSnake(x, y, size : smallInt); // Create the snake and set variables var i : integer; begin crashed := FALSE; path := 'w'; direction := 'w'; new(s); new(sh); new(st); sh := s; // Set head st := s; // Set tail s^.prev := NIL; s^.next := NIL; s^.x := x; s^.y := y; for i := 1 to size do // Create the snake addChunk(x, y); end; procedure setupBerries(var berries : berryArray); // Create berries in an array var i : smallint; begin for i := 1 to BERRYNUM do new(berries[i], init); end; procedure setupGrid(var grid : gridArray); var x, y : smallint; begin // Draw the walls and Blank space onto the Grid for x := 2 to (GRIDWIDTH - 1) do // Fill the screen with 0s for y := 2 to (GRIDHEIGHT -1) do grid[x, y] := BLANKB; y := 1; for x := 1 to GRIDWIDTH do // EDGE WALLS grid[x, y] := WALLB; y := GRIDHEIGHT; for x := 1 to GRIDWIDTH do grid[x, y] := WALLB; x := 1; for y := 2 to (GRIDHEIGHT - 1) do grid[x, y] := WALLB; x := GRIDWIDTH; for y := 2 to (GRIDHEIGHT - 1) do grid[x, y] := WALLB; end; procedure drawText(x, y, scale : real; text : string); // Draw Text var i, len : integer; begin glLoadIdentity; glColor3f(1, 1, 0); glTranslatef(x, y, -15); glScalef(scale, scale, scale); len := length(text); glLineWidth(1); for i := 1 to len do // Write each Character as a Bitmap to the screen glutStrokeCharacter(GLUT_STROKE_MONO_ROMAN, integer(Text[i])); end; procedure drawCube(solid : boolean; x, y : real; size : real; rot : real; r, g, b : real); begin glLoadIdentity; x := convert(x); y := convert(y); glTranslatef(x, y, -15 + gridZoom); // Center rotation around object glRotatef(rot, 0, 0, -1); glColor3f(r, g, b); if solid = TRUE then glutSolidCube(size * 10 / GRIDWIDTH) else glutWireCube(size * 10 / GRIDWIDTH); end; procedure drawSphere(solid : boolean; x, y : real; size : real; slice : integer; rot : real; r, g, b : real); begin glLoadIdentity; x := convert(x); y := convert(y); glTranslatef(x, y, -15 + gridZoom); // Center rotation around object glRotatef(rot, 0, 0, -1); glColor3f(r, g, b); if solid = TRUE then glutSolidSphere(size * 10 / GRIDWIDTH, slice, slice) else glutWireSphere(size * 10 / GRIDWIDTH, slice, slice); end; procedure exitGame(); begin saveHighScores(); glutLeaveGameMode(); halt(0); end; procedure crash(var l : smallint); // Handle what happens when the snake crashes var temp : string; j, i : smallint; m : smallInt; begin if pause = 0 then if l > 1 then begin if crashed = FALSE then begin crashed := TRUE; pause := 2000; m := random(5) + 1; // Choose a random message to play after crashing case m of 1 : begin pauseMessage := 'Oops!'; pauseLeftMargin := -3; end; 2 : begin pauseMessage := 'Ouch!'; pauseLeftMargin := -3; end; 3 : begin pauseMessage := 'Crunch!'; pauseLeftMargin := -3.5; end; 4 : begin pauseMessage := 'Whack!'; pauseLeftMargin := -3.2; end; 5 : begin pauseMessage := 'Urgh...'; pauseLeftMargin := -3.5; end; end; addEmitter(TRUE, sh^.x, sh^.y, 0.000, 0.000, 0.05, 1, 1, 0); end; if pause = 0 then // Check again begin l := l - 1; setupGrid(grid); setupSnake(GRIDWIDTH div 2, GRIDHEIGHT div 2, INITSNAKELENGTH + score); setupBerries(berries); if (gridZoom <> 0) then gridZoom := 0; end; end else begin if crashed = FALSE then begin pause := 3000; pauseMessage := 'Game Over!'; pauseLeftMargin := -4.5; crashed := TRUE; addEmitter(TRUE, sh^.x, sh^.y, 0.000, 0.000, 0.05, 1, 1, 0); end; if pause = 0 then begin sortHighScores(); if score > txtArray[10].score then // is score high enough to be put on the highscores board? begin j := 11; for i := 1 to 10 do if score > txtArray[i].score then // Find the position to enter into the scores j := j - 1; if j < 10 then for i := 10 downto (j+1) do // Shuffle down the other scores txtArray[i] := txtArray[i-1]; txtArray[j].score := score; // Place the score in the correct place case difficulty of 1 : temp := '1 - Anaconda'; 2 : temp := '2 - Python'; 3 : temp := '3 - Viper'; 4 : temp := '4 - Black Mamba'; end; txtArray[j].name := concat('Player 1', ' - ', temp); end; room := 2; end; end; end; procedure setGrid(); // Places all the objects onto the grid var x, y, i : smallint; s : ep; begin // Clear the Grid for x := 2 to (GRIDWIDTH - 1) do // Fill the screen with BLANK for y := 2 to (GRIDHEIGHT - 1) do grid[x, y] := BLANKB; // Put snake on Grid s := sh; // Go to head of snake grid[s^.x, s^.y] := SNAKEHEADB; s := s^.prev; while s^.prev <> NIL do begin grid[s^.x, s^.y] := SNAKEB; s := s^.prev; end; grid[s^.x, s^.y] := SNAKEB; // Last one // Place berries on the Grid for i := 1 to BERRYNUM do grid[berries[i]^.getX(), berries[i]^.getY()] := BERRYB; end; procedure catchUp(x1, y1 : integer); begin // This procedure moves all of the snake up one block when the head moves to its next position. s := st; while s^.next <> sh do begin writeln('Making (', s^.x,', ', s^.y,') equal to (', s^.next^.x, ', ', s^.next^.y, ').'); s^.x := s^.next^.x; // Give it the position of the chunk infront s^.y := s^.next^.y; s := s^.next; end; writeln('Making (', s^.x,', ', s^.y,') equal to (', x1, ', ', y1, ').'); s^.x := x1; s^.y := y1; end; procedure moveInDirection; // Move the snake in the current direction var x1, y1 : integer; begin path := direction; x1 := sh^.x; y1 := sh^.y; // Save the top position of the head before it moves case direction of 'd' : sh^.x := sh^.x + 1; // Right 'a' : sh^.x := sh^.x - 1; // Left 'w' : sh^.y := sh^.y + 1; // Up 's' : sh^.y := sh^.y - 1; // Down end; catchUp(x1, y1); end; procedure moveAcross; // Make the snake across the board horizontally or vertically var x1, y1 : integer; begin path := direction; x1 := sh^.x; y1 := sh^.y; // Save the top position of the head before it moves case direction of 'a' : sh^.x := GRIDWIDTH - 1; // MOVE 'd' : sh^.x := 2; 'w' : sh^.y := 2; 's' : sh^.y := GRIDHEIGHT - 1; end; catchUp(x1, y1); end; procedure directionMove; var objInfront, objOpposite : char; x, y : smallint; begin case direction of // get the position infront of the snake 'a' : begin x := sh^.x - 1; y := sh^.y; end; 'd' : begin x := sh^.x + 1; y := sh^.y; end; 'w' : begin y := sh^.y + 1; x := sh^.x; end; 's' : begin y := sh^.y - 1; x := sh^.x; end; end; objInfront := grid[x, y]; case objInfront of BLANKB : moveInDirection; BERRYB : begin berries[getBerryIndex(x, y)]^.eat(); moveInDirection; // Move Snake addEmitter(TRUE, x, y, 0.000, 0.000, 0.13, 0, 1, 0); if ((INITSNAKELENGTH + score) <= MAXSNAKELENGTH) then addChunk(sh^.x, sh^.y); end; SNAKEB : begin crash(lives); end; WALLB : begin case direction of // Get the position of the object ACROSS the grid 'a' : begin x := GRIDWIDTH - 1; y := sh^.y; end; 'd' : begin x := 2; y := sh^.y; end; 'w' : begin x := sh^.x; y := 2; end; 's' : begin x := sh^.x; y := GRIDHEIGHT - 1; end; end; objOpposite := grid[x, y]; // Get the Object at the position case objOpposite of BERRYB : begin berries[getBerryIndex(x, y)]^.eat(); moveAcross; addEmitter(TRUE, sh^.x, sh^.y, 0.000, 0.000, 0.15, 0, 1, 0); if ((INITSNAKELENGTH + score) <= MAXSNAKELENGTH) then addChunk(sh^.x, sh^.y); end; SNAKEB : begin crash(lives); end; BLANKB : moveAcross; end; end; end; end; procedure drawGrid(var grid : gridArray); var x, y : smallint; r, g, b : real; temp : string; begin glDisable(GL_LIGHTING); // Disable lighting for 2D str(score, temp); drawText(-6.8, 2.5, 0.006, temp); str(lives, temp); drawText(6, 2.5, 0.006, temp); str(getFPS : 2 : 2, temp); drawText(-4.5, -5.5, 0.003, concat('FPS: ', temp)); drawText(0.6, -5.5, 0.003, 'Elliot Walmsley'); glEnable(GL_LIGHTING); r := 0; g := 1; b := 0; for x := 1 to GRIDWIDTH do for y := 1 to GRIDHEIGHT do case grid[x, y] of SNAKEB : drawSphere(TRUE, x, y, 0.3, 8, 0, r, g, b); SNAKEHEADB : drawSphere(TRUE, x, y, 0.4, 8, 0, r, g, b); WALLB : drawCube(TRUE, x, y, 0.45, 0, r, g, b); BERRYB : drawSphere(FALSE, x, y, 0.5, 5, T / 3, r, g, b); end; end; procedure drawMainMenu(); var i : smallint; mainMenu : array [1..4] of string; begin glDisable(GL_LIGHTING); // Disable lighting for 2D drawText(LEFTMARGIN, MENUTITLEHEIGHT, 0.006, '.o0[ SNAIK ]0o.'); mainMenu[1] := 'New Game'; mainMenu[2] := 'High Scores'; mainMenu[3] := 'Settings'; mainMenu[4] := 'Exit'; for i := 1 to 4 do drawText(LEFTMARGIN, CONTENTHEIGHT - (i*1.3), 0.006, mainMenu[i]); drawText(LEFTMARGIN - 1, CONTENTHEIGHT - (option*1.3) + 0.3, 0.006, '.'); glEnable(GL_LIGHTING); end; procedure drawHighScoresMenu(); var i : smallint; highScoresMenu : array [1..2] of string; temp : string; begin glDisable(GL_LIGHTING); // Disable lighting for 2D drawText(LEFTMARGIN, MENUTITLEHEIGHT, 0.006, '... High Scores ...'); highScoresMenu[1] := 'Back'; highScoresMenu[2] := 'Reset'; for i := 1 to 2 do drawText(LEFTMARGIN, CONTENTHEIGHT - (i*1.3), 0.006, highScoresMenu[i]); drawText(LEFTMARGIN - 1, CONTENTHEIGHT - (option*1.3) + 0.3, 0.006, '.'); for i := 1 to 10 do begin drawText(0.8, CONTENTHEIGHT - (i*0.6), 0.002, txtArray[i].name); str(txtArray[i].score, temp); drawText(-0.2, CONTENTHEIGHT - (i*0.6), 0.002, temp); end; glEnable(GL_LIGHTING); end; procedure drawSettingsMenu(); var i : smallint; settingsMenu : array [1..4] of string; temp : string; begin glDisable(GL_LIGHTING); // Disable lighting for 2D drawText(LEFTMARGIN, MENUTITLEHEIGHT, 0.006, '... Settings ...'); settingsMenu[1] := 'Back'; settingsMenu[2] := 'Size'; settingsMenu[3] := 'Difficulty'; settingsMenu[4] := 'Berries'; for i := 1 to 4 do drawText(LEFTMARGIN, CONTENTHEIGHT - (i*1.3), 0.006, settingsMenu[i]); drawText(LEFTMARGIN - 1, CONTENTHEIGHT - (option*1.3) + 0.3, 0.006, '.'); str(gridHeight, temp); drawText(1, CONTENTHEIGHT - 0.5 - (1*0.4), 0.002, concat('Size: [', temp, ' x ', temp, ']')); case difficulty of 1 : temp := '1 - Anaconda'; 2 : temp := '2 - Python'; 3 : temp := '3 - Viper'; 4 : temp := '4 - Black Mamba'; end; drawText(1, CONTENTHEIGHT - 0.5 - (2*0.4), 0.002, concat('Difficulty: ', temp)); str(berryNum, temp); drawText(1, CONTENTHEIGHT - 0.5 - (3*0.4), 0.002, concat('Berries: ', temp)); glEnable(GL_LIGHTING); end; // ---------------- // Handlers // ---------------- procedure resizeScene(width, height: integer); cdecl; // Resize Handler begin glViewport(0, 0, width, height); glMatrixMode(GL_PROJECTION); glLoadIdentity; gluPerspective(45, width / height, 0.1, 1000); glMatrixMode(GL_MODELVIEW); glLoadIdentity; gluLookAt(0, 0, 0, 0, 0, 0, 0, 1, 0); // CAMERA end; procedure gameDraw; cdecl; // Draw Handler var timeAdd : smallInt; begin // Variable updates dt := getDeltaTime; // Get time inbetween each frame T := glutGet(GLUT_ELAPSED_TIME); // Time passed in MilliSeconds timeAdd := trunc(dt * 1000); cooldown := cooldown - timeAdd; // Decrease cooldown time if pause > 0 then // Decrease pause time pause := pause - timeAdd; if pause < 0 then // Dont let it fall below 0 pause := 0; glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); if (emt <> NIL) then // Make sure emitters exist begin stepEmitters(); // Move the emitters one step reduceEnergyEmitters(); // Reduce the energy of the emitters checkEmitters(); // Check to see if all are dead end; if emt <> NIL then // May have deleted some, so check again drawEmitters(); // Draw the emitters case room of 0 : drawMainMenu(); 1 : begin timeSinceSnake := timeSinceSnake + timeAdd; // Delay moving the snake dependant on Difficulty if (timeSinceSnake > (200 - (40 * difficulty))) then begin timeSinceSnake := 0; directionMove(); setGrid(); end; if pause > 0 then begin // A pause is happening glDisable(GL_LIGHTING); // Disable lighting for 2D drawText(pauseLeftMargin, 0, 0.01, pauseMessage); gridZoom := gridZoom + 0.15; glEnable(GL_LIGHTING); end; drawGrid(grid); end; 2 : drawHighScoresMenu(); 3 : drawSettingsMenu(); end; drawBackground; glutSwapBuffers; frameCount := frameCount + 1; end; // ----------------------- // Keyboard Handler // ----------------------- procedure specialKeyboard(key, x, y : longint); cdecl; // keyboard handler for special keys begin if pause = 0 then case room of 0 : if cooldown <= 0 then // MAIN MENU begin // Up/Down if (key = GLUT_KEY_UP) then begin cooldown := 200; if option > 1 then option := option - 1 else option := 4; end; if (key = GLUT_KEY_DOWN) then begin cooldown := 200; if option < 4 then option := option + 1 else option := 1; end; addEmitter(FALSE, LEFTMARGIN - 0.6, (CONTENTHEIGHT - (option*1.3) + 0.3), 0.000, 0.000, 0.05, 0, 1, 0); end; 1 : case key of // GAME GLUT_KEY_LEFT : if path <> 'd' then direction := 'a'; // LEFT GLUT_KEY_RIGHT : if path <> 'a' then direction := 'd'; // RIGHT GLUT_KEY_DOWN : if path <> 'w' then direction := 's'; // DOWN GLUT_KEY_UP : if path <> 's' then direction := 'w'; // UP end; 2 : if cooldown <= 0 then // HIGH SCORES begin // Up/Down if (key = GLUT_KEY_UP) then begin cooldown := 200; if option > 1 then option := option - 1 else option := 2; end; if (key = GLUT_KEY_DOWN) then begin cooldown := 200; if option < 2 then option := option + 1 else option := 1; end; addEmitter(FALSE, LEFTMARGIN - 0.6, (CONTENTHEIGHT - (option*1.3) + 0.3), 0.000, 0.000, 0.05, 0, 1, 0); end; 3 : if cooldown <= 0 then // SETTINGS begin // Up/Down if (key = GLUT_KEY_UP) then begin cooldown := 200; if option > 1 then option := option - 1 else option := 4; end; if (key = GLUT_KEY_DOWN) then begin cooldown := 200; if option < 4 then option := option + 1 else option := 1; end; addEmitter(FALSE, LEFTMARGIN - 0.6, (CONTENTHEIGHT - (option*1.3) + 0.3), 0.000, 0.000, 0.05, 0, 1, 0); end; end; end; procedure gameKeyboard(key : byte; x, y : longint); cdecl; // In-Game Keyboard Handler begin if pause = 0 then case room of 0 : if cooldown <= 0 then // MAIN MENU begin // Up/Down if (key = ord('w')) or (key = GLUT_KEY_UP) then begin cooldown := 200; if option > 1 then option := option - 1 else option := 4; end; if (key = ord('s')) or (key = GLUT_KEY_DOWN) then begin cooldown := 200; if option < 4 then option := option + 1 else option := 1; end; if key = ENTER_KEY then // Enter key begin cooldown := 400; // Delay between each menu for the Enter key case option of 1 : begin score := 0; lives := 3; gridZoom := 0; setupGrid(grid); setupSnake(GRIDWIDTH div 2, GRIDHEIGHT div 2, INITSNAKELENGTH + score); setupBerries(berries); room := 1; end; 2 : begin sortHighScores(); option := 1; room := 2; end; 3 : begin option := 1; room := 3; end; 4 : exitGame(); end; end; addEmitter(FALSE, LEFTMARGIN - 0.6, (CONTENTHEIGHT - (option*1.3) + 0.3), 0.000, 0.000, 0.05, 0, 1, 0); end; 1 : case key of // GAME ESC_KEY : room := 0; // Esc ord('a'), 75 : if path <> 'd' then direction := 'a'; // LEFT ord('d'), 77 : if path <> 'a' then direction := 'd'; // RIGHT ord('s'), 80 : if path <> 'w' then direction := 's'; // DOWN ord('w'), 72 : if path <> 's' then direction := 'w'; // UP end; 2 : if cooldown <= 0 then // HIGH SCORES begin // Up/Down if (key = ord('w')) or (key = 72) then begin cooldown := 200; if option > 1 then option := option - 1 else option := 2; end; if (key = ord('s')) or (key = 80) then begin cooldown := 200; if option < 2 then option := option + 1 else option := 1; end; if key = ENTER_KEY then // Enter key begin cooldown := 400; // Delay between each menu for the Enter key case option of 1 : begin room := 0; option := 1; end; 2 : clearHighScoresFile(); // Reset highscores end; end; addEmitter(FALSE, LEFTMARGIN - 0.6, (CONTENTHEIGHT - (option*1.3) + 0.3), 0.000, 0.000, 0.05, 0, 1, 0); end; 3 : if cooldown <= 0 then // SETTINGS begin // Up/Down if (key = ord('w')) or (key = 72) then begin cooldown := 200; if option > 1 then option := option - 1 else option := 4; end; if (key = ord('s')) or (key = 80) then begin cooldown := 200; if option < 4 then option := option + 1 else option := 1; end; if key = ENTER_KEY then // Enter key begin cooldown := 500; // Delay between each menu for the Enter key case option of 1 : begin room := 0; option := 1; end; 2 : ; // Resolution 3 : if difficulty < 4 then difficulty := difficulty + 1 else difficulty := 1; // Difficulty 4 : ; // Number of Berries end; end; addEmitter(FALSE, LEFTMARGIN - 0.6, (CONTENTHEIGHT - (option*1.3) + 0.3), 0.000, 0.000, 0.05, 0, 1, 0); end; end; end; procedure KeyboardUp(key : byte; x, y : longint); cdecl; // Keyboard Handler begin cooldown := 0; // Reset any cooldowns on the keyboard UP-PRESS so that the user can tap the keys fast end; procedure specialKeyboardUp(key, x, y : longint); cdecl; // Keyboard Handler begin cooldown := 0; // Reset any cooldowns on the keyboard UP-PRESS so that the user can tap the keys fast end; // ========================== // Class Methods // ========================== // ----------------- // emitter methods // ----------------- constructor temitter.init(cart : boolean; x1, y1, g, a, e, redc, greenc, bluec : real); // Create particles var i : smallint; begin x := x1; // Place the Emitter y := y1; red := redc; green := greenc; blue := bluec; if cart = TRUE then // If it uses cartesian, then fix to grid begin x := convert(x); y := convert(y); end; active := TRUE; // Activate the emitter startEnergy := e; for i := 1 to PARTICLENUM do // Create all the particles new(parts[i], init(cart, x, y, g, a, e)); end; destructor temitter.destroy; // Destroy particles var i : smallInt; begin for i := 1 to PARTICLENUM do dispose(parts[i], destroy); // Free used memory! end; procedure temitter.draw(); // Draw all the particles var i : smallint; begin glDisable(GL_LIGHTING); // Disable lighting for 2D // Loop through all particles and position them, then draw for i := 1 to PARTICLENUM do begin // Size and opacity scale with energy glPointSize(10 * (parts[i]^.getEnergy / startEnergy)); glColor4f (red, green, blue, parts[i]^.getEnergy / startEnergy); glLoadIdentity; glBegin(GL_POINTS); glVertex3f(parts[i]^.getX, parts[i]^.getY, -15); glEnd(); end; glEnable(GL_LIGHTING); end; procedure temitter.reduceEnergy(); // Reduce the enery of the emitter and particles var i : smallInt; begin deadParticles := 0; for i := 1 to PARTICLENUM do begin // Reduces energy of each particle and returns whether it killed it or not deadParticles := deadParticles + parts[i]^.reduceEnergy(0.03 * dt); end; end; procedure temitter.move(); // Moves all Particles in the emitter var i : smallint; begin for i := 1 to PARTICLENUM do parts[i]^.move(); end; function temitter.isActive : boolean; begin isActive := active; end; function temitter.getDeadParticles : smallInt; begin getDeadParticles := deadParticles; end; // --------------------------- // particle methods // --------------------------- constructor tparticle.init(cart : boolean; x1, y1, g, a, e : real); begin x := x1; // Current Pos y := y1; dir := random(360); // Random direction energy := e + (random(10)/10 * (e/10)); // Random amount of starting energy grav := g; acc := a; end; destructor tparticle.destroy(); begin end; // Reduce the energy of a particle, and report back with a 1 if it kills it function tparticle.reduceEnergy(num : real) : smallInt; begin reduceEnergy := 0; // Default energy := energy - num; if energy < 0 then // Dont let it go backwards begin energy := 0; reduceEnergy := 1; end; end; procedure tparticle.move(); begin // Move the particle dependant on energy and gravity x := x + (sin(dir) * energy); y := y + (cos(dir) * energy); acc := acc + grav; // Increase gravitational acceleration end; function tparticle.getX() : real; begin getX := x; end; function tparticle.getY() : real; begin getY := y; end; function tparticle.getEnergy() : real; begin getEnergy := energy; end; // ------------- // berry methods // ------------- constructor tberry.init; begin randomPlacement; end; destructor tberry.destroy; begin end; function tberry.getX : smallint; begin getX := x; end; function tberry.getY : smallint; begin getY := y; end; procedure tberry.randomPlacement; begin x := random(GRIDWIDTH - 2) + 2; y := random(GRIDHEIGHT - 2) + 2; while ((grid[x, y] = SNAKEB) or (grid[x, y] = BERRYB) or (grid[x, y] = SNAKEHEADB) or ((x = GRIDWIDTH div 2) and ( y = GRIDWIDTH div 2))) do begin // Berry collision, choose different coords x := random(GRIDWIDTH - 2) + 2; y := random(GRIDHEIGHT - 2) + 2; end; grid[x, y] := BERRYB; addEmitter(TRUE, x, y, 0.000, 0.000, 0.05, 1, 1, 0); end; procedure tberry.eat(); begin score := score + 1; randomPlacement; end; // ======================== // // MAIN PROGRAM // // ======================== begin randomize; // init the random function // Set starting variables T := 1; score := 0; room := 0; timeSinceSnake := 0; difficulty := 2; lives := 3; cooldown := 0; option := 1; frameCount := 0; oldTime := 0; FPSTime := 0; pause := 0; gridZoom := 0; setupHighScores(); loadHighScores(); setupEmitter(); // --------------- // OpenGL // --------------- glutSetKeyRepeat(GLUT_KEY_REPEAT_ON); // No Delay for Key repeats (improves responsiveness of keyboard input) glutInit(@argc, @argv); glutInitDisplayMode(GLUT_DOUBLE or GLUT_RGB or GLUT_DEPTH); glutGameModeString(FSMode); // Resolution glutEnterGameMode; // Fullscreen glutSetCursor(GLUT_CURSOR_NONE); glEnable(GL_DEPTH_TEST); glEnable(GL_TEXTURE); glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glEnable(GL_POINT_SMOOTH); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); // ------ // Light // ------ glEnable(GL_LIGHTING); glEnable(GL_COLOR_MATERIAL); // Enable light on Textures glColorMaterial(GL_FRONT, GL_AMBIENT_AND_DIFFUSE); // LIGHT No. 0 glLightfv(GL_LIGHT0, GL_DIFFUSE, DIFFUSE); glEnable(GL_LIGHT0); glClearColor(0, 0.2, 0, 0.0); // -------- // Handlers // -------- // Keyboard glutKeyboardFunc(@gameKeyboard); glutkeyboardUpFunc(@KeyboardUp); glutSpecialUpFunc(@specialKeyboardUp); glutSpecialFunc(@specialKeyboard); glutDisplayFunc(@gameDraw); glutIdleFunc(@gameDraw); glutReshapeFunc(@resizeScene); glutMainLoop; end. // THE END!