Questo sito utilizza cookies, anche di terze parti, per mostrare pubblicità e servizi in linea con il tuo account. Leggi l'informativa sui cookies.
Username: Password: oppure
Snake V.2.0 - Snake.pas

Snake.pas

Caricato da: Dario DF
Scarica il programma completo

  1. program Snake;
  2.  
  3. //{$DEFINE DEBUG}
  4.  
  5. uses
  6.   Crt, Windows, SysUtils;
  7.  
  8. const
  9.   Ver = '2.0';
  10.  
  11. const
  12.   Su  = $4800; // 72 << 8
  13.   Giu = $5000; // 80 << 8
  14.   Sx  = $4B00; // 75 << 8
  15.   Dx  = $4D00; // 77 << 8
  16.   Esc = $1B;   // 27
  17.   Enter = $0D; // 13
  18.   Pause = Ord('P'); // 'P'
  19.  
  20.   VermLen = 5;
  21.  
  22.   ChSnake = #178;
  23.   ChFood = #184; // Scelte: #1, #2, #4, 'O', #184
  24.   RMenuSize = 10;
  25.  
  26.   MaxMenuSels = 4;
  27.  
  28.   StandardBack = Black;
  29.   MenuBack = Blue;
  30.   HintsBack = Green;
  31.  
  32.   SpeedArr: array[1..MaxMenuSels]of Cardinal = (90, 70, 50, 10);
  33.  
  34.   // GameState
  35.     gsDiff  = 1;
  36.     gsGame  = 2;
  37.     gsPause = 3;
  38.  
  39. type
  40.   TPoint = record
  41.     X, Y: byte;
  42.   end;
  43.  
  44. var
  45.   Running, WasPopped, Refresh: Boolean;
  46.   VermArray: array [word] of TPoint;
  47.   Index, Dir, Score: word;
  48.   DelSpeed: byte;
  49.   X, Y, VerManca, MenuSel: byte;
  50.   LastPopped, Food, ScoreVal: TPoint;
  51.   GameState: Byte;
  52.  
  53. // DrawTable
  54.  
  55. type
  56.   TTableType = record
  57.     TopLeft: Char;
  58.     Top: Char;
  59.     TopRight: Char;
  60.     Left: Char;
  61.     Center: Char;
  62.     Right: Char;
  63.     BottomLeft: Char;
  64.     Bottom: Char;
  65.     BottomRight: Char;
  66.   end;
  67.  
  68. { #201 #205 ... #205 #187
  69.   #186               #186
  70.   ...      TABLE     ...
  71.   #186               #186
  72.   #200 #205 ... #205 #188 }
  73.  
  74. const
  75.   Table: TTableType = (TopLeft:    #201; Top:    #205; TopRight:    #187;
  76.                        Left:       #186; Center:  ' '; Right:       #186;
  77.                        BottomLeft: #200; Bottom: #205; BottomRight: #188);
  78.  
  79. procedure DrawTable(StartX, StartY, Width, Height: Byte);
  80. var
  81.   I, J: byte;
  82. begin
  83.   with Table do
  84.   begin
  85.     GotoXY(StartX, StartY);
  86.     Write(TopLeft);
  87.     for I := 1 to Width - 2 do
  88.       Write(Top);
  89.     Write(TopRight);
  90.     for J := 1 to Height - 2 do
  91.     begin
  92.       GotoXY(StartX, StartY + J);
  93.       Write(Left);
  94.       for I := 1 to Width - 2 do
  95.         Write(Center);
  96.       Write(Right);
  97.     end;
  98.     GotoXY(StartX, StartY + Height - 1);
  99.     Write(BottomLeft);
  100.     for I := 1 to Width - 2 do
  101.       Write(Bottom);
  102.     Write(BottomRight);
  103.   end;
  104. end;
  105.  
  106. procedure GenFood;
  107. var
  108.   I: word;
  109.   Ok: Boolean;
  110. begin
  111.   repeat
  112.     Food.X := Random(WindMaxX - RMenuSize) + 1;
  113.     Food.Y := Random(WindMaxY) + 1;
  114.     Ok := True;
  115.     for I := 0 to Index - 1 do
  116.     begin
  117.       if(Food.X = VermArray[I].X) and (Food.Y = VermArray[I].Y)then
  118.       begin
  119.         Ok := False;
  120.         Break;
  121.       end;
  122.     end;
  123.   until Ok;
  124.   GotoXY(Food.X, Food.Y);
  125.   Write(ChFood);
  126. end;
  127.  
  128. procedure PushVermArray(PosX, PosY: byte);
  129. begin
  130.   VermArray[Index].X := PosX;
  131.   VermArray[Index].Y := PosY;
  132.   Inc(Index);
  133. end;
  134.  
  135. function PopVermArray: TPoint;
  136. var
  137.   I: word;
  138.   Pos: TPoint;
  139. begin
  140.   Pos.X := VermArray[0].X;
  141.   Pos.Y := VermArray[0].Y;
  142.   for I := 1 to Index - 1 do
  143.   begin
  144.     VermArray[I - 1].X := VermArray[I].X;
  145.     VermArray[I - 1].Y := VermArray[I].Y;
  146.   end;
  147.   Dec(Index);
  148.   PopVermArray := Pos;
  149. end;
  150.  
  151. procedure InitMenu;
  152. var
  153.   CX, CY: byte;
  154. begin
  155. {
  156. #201 #205 ... #205 #187
  157. #186               #186
  158. ...      TABLE     ...
  159. #186               #186
  160. #200 #205 ... #205 #188
  161.  
  162. Content:
  163.  
  164. <------------ 18 >
  165.  
  166. ################## A
  167. #                #
  168. #  Select Level  # 1
  169. #                # 0
  170. # [    EASY    ] #
  171. # [   MEDIUM   ] # |
  172. # [    HARD    ] # |
  173. # [ IMPOSSIBLE ] # |
  174. #                # |
  175. ################## V
  176.  
  177. }
  178.   GameState := gsDiff;
  179.   TextBackground(MenuBack);
  180.   CX := (WindMaxX - RMenuSize) div 2 - 9;
  181.   CY := WindMaxY div 2 - 5;
  182.   DrawTable(CX, CY, 18, 10);
  183.   GotoXY(CX + 3, CY + 2);
  184.   Write('Select Level');
  185.   Refresh := True;
  186. end;
  187.  
  188. procedure DrawMenu;
  189. var
  190.   CX, CY, J: byte;
  191. begin
  192.   if Refresh then
  193.   begin
  194.     CX := (WindMaxX - RMenuSize) div 2 - 7;
  195.     CY := WindMaxY div 2 - 2;
  196.     // Write Sels
  197.     for J := 1 to 4 do
  198.     begin
  199.       if J = MenuSel then
  200.         HighVideo;
  201.       GotoXY(CX, CY + J);
  202.       case J of
  203.         1: Write('[    EASY    ]');
  204.         2: Write('[   MEDIUM   ]');
  205.         3: Write('[    HARD    ]');
  206.         4: Write('[ IMPOSSIBLE ]');
  207.       end;
  208.       if J = MenuSel then
  209.         LowVideo;    
  210.     end;
  211.     Refresh := False;
  212.   end;
  213. end;
  214.  
  215. procedure DrawLateralBar;
  216. var
  217.   I: byte;
  218. begin
  219.   // Lateral Bar:
  220.   for I := 1 to WindMaxY do
  221.   begin
  222.     GotoXY(WindMaxX - RMenuSize + 1, I);
  223.     Write(#186);
  224.   end;
  225.   ScoreVal.X := WindMaxX - ((RMenuSize - 1) div 2);
  226.   ScoreVal.Y := WindMaxY div 2 + 1;
  227.   GotoXY(ScoreVal.X - 2, ScoreVal.Y - 2);
  228.   Write('Score');
  229. end;
  230.  
  231. procedure InitGame;
  232. begin
  233.   GameState := gsGame;
  234.   DelSpeed := SpeedArr[MenuSel];
  235.   //Clear the Game Area
  236.   TextBackground(StandardBack);
  237.   ClrScr;
  238.   DrawLateralBar;
  239.   X := (WindMaxX - RMenuSize) div 2;
  240.   Y := WindMaxY div 2;
  241.   VerManca := VermLen;
  242.   Index := 0;
  243.   PushVermArray(X, Y);
  244.   Dir := Su;
  245.   Score := 0;
  246.   Refresh := True;
  247.   GenFood;
  248. end;
  249.  
  250. procedure Init;
  251. begin
  252.   CursorOff;
  253.   TextBackground(StandardBack);
  254.   ClrScr;
  255.   Randomize;
  256.   DrawLateralBar;
  257.   // Menu
  258.   MenuSel := 1;
  259.   InitMenu;
  260. end;
  261.  
  262. procedure ComputeGameKey(C: word);
  263. var
  264.   I: word;
  265. begin
  266.   // Commands
  267.   case C of
  268.     Su, Giu, Sx, Dx: Dir := C;
  269.     {$IFDEF DEBUG}
  270.       Ord('A'): Inc(VerManca, 3); // Aumenta di 3
  271.       Ord('S'): Inc(VerManca); //Aumenta di 1
  272.       Ord('Q'): begin
  273.         Inc(Score); //Aumenta di 1 (Score)
  274.         Refresh := True;
  275.       end;
  276.     {$ENDIF}
  277.     Esc: Running := False;
  278.   end;
  279.   // Move
  280.   case Dir of
  281.     Su: Dec(Y);
  282.     Giu: Inc(Y);
  283.     Sx: Dec(X);
  284.     Dx: Inc(X);
  285.   end;
  286.   // Compute
  287.   if X > WindMaxX - RMenuSize then X := 1;
  288.   if X < 1 then X := WindMaxX - RMenuSize;
  289.   if Y > WindMaxY then Y := 1;
  290.   if Y < 1 then Y := WindMaxY;
  291.   // Insert
  292.   PushVermArray(X, Y);
  293.   if VerManca = 0 then
  294.   begin
  295.     LastPopped := PopVermArray;
  296.     WasPopped := True;
  297.   end else
  298.     Dec(VerManca);
  299.   // Control
  300.   if(X = Food.X) and (Y = Food.Y)then
  301.   begin
  302.     Inc(Score); // Ate Food (* Will BEEP *)
  303.     // Windows.Beep(4400, 50); // Slows Down Time
  304.     Refresh := True;
  305.     Inc(VerManca);
  306.     GenFood;
  307.   end;
  308.   if Index > 1 then
  309.   begin
  310.     for I := 0 to Index - 2 do
  311.     begin
  312.       if (X = VermArray[I].X) and (Y = VermArray[I].Y) then
  313.       begin
  314.         // You Lost!
  315.         //Running := False;
  316.         C := (WindMaxX - RMenuSize) div 2 - 6; // C non + utilizzata, uso quella
  317.         TextBackground(HintsBack);
  318.         DrawTable(C, 2, 12, 3);
  319.         GotoXY(C + 2, 3);
  320.         Write('You Lost');
  321.         InitMenu;
  322.         Break;
  323.       end;
  324.     end;
  325.   end;
  326. end;
  327.  
  328. procedure ComputeMenuKey(C: word);
  329. begin
  330.   // Commands
  331.   case C of
  332.     Su: begin
  333.       if MenuSel <= 1 then
  334.         MenuSel := MaxMenuSels
  335.       else
  336.         Dec(MenuSel);
  337.       Refresh := True;
  338.     end;
  339.     Giu: begin
  340.       if MenuSel >= MaxMenuSels then
  341.         MenuSel := 1
  342.       else
  343.         Inc(MenuSel);
  344.       Refresh := True;
  345.     end;
  346.     Enter: begin
  347.       InitGame;
  348.     end;
  349.     Esc: Running := False;
  350.   end;
  351. end;
  352.  
  353. procedure ComputePauseKey(C: word);
  354. begin
  355.   TODO!
  356.   // Controlla se premo "Pause" poi pulisci (ReDraw)
  357. end;
  358.  
  359. procedure ComputeKey(C: word);
  360. begin
  361.   case GameState of
  362.     gsGame:  ComputeGameKey(C);
  363.     gsDiff:  ComputeMenuKey(C);
  364.     gsPause: ComputePauseKey(C);
  365.   end;
  366. end;
  367.  
  368. procedure DrawPause;
  369. var
  370.   I: byte;
  371. begin
  372.   I := (WindMaxX - RMenuSize) div 2 - 9;
  373.   TextBackground(HintsBack);
  374.   DrawTable(I, 2, 18, 3);
  375.   GotoXY(I + 2, 3);
  376.   Write('Game Paused...');
  377. end;
  378.  
  379. procedure DrawGame;
  380. var
  381.   I: byte;
  382.   S: string;
  383. begin
  384.   if Refresh then
  385.   begin
  386.     GotoXY(ScoreVal.X - ((RMenuSize - 1) div 2), ScoreVal.Y);
  387.     for I := 2 to RMenuSize do
  388.       Write(' ');
  389.     S := IntToStr(Score);
  390.     GotoXY(ScoreVal.X - (Length(S) div 2), ScoreVal.Y);
  391.     Write(S);
  392.     Refresh := False;
  393.   end;
  394.   if WasPopped then
  395.   begin
  396.     GotoXY(LastPopped.X, LastPopped.Y);
  397.     Write(' ');
  398.     WasPopped := False;
  399.   end;
  400.   GotoXY(X, Y);
  401.   Write(ChSnake);
  402. end;
  403.  
  404. procedure Draw;
  405. begin
  406.   case GameState of
  407.     gsGame:  DrawGame;
  408.     gsDiff:  DrawMenu;
  409.     gsPause: DrawPause;
  410.   end;
  411. end;
  412.  
  413. var
  414.   C: word;
  415.   STicks: Cardinal;
  416.  
  417. begin
  418.   Init;
  419.   Running := True;
  420.   while Running do
  421.   begin
  422.     STicks := GetTickCount;
  423.     C := 0;
  424.     if KeyPressed then
  425.     begin
  426.       C := Ord(UpCase(ReadKey));
  427.       if C = 0 then C := Ord(ReadKey) << 8;
  428.     end;
  429.     ComputeKey(C);
  430.     Draw;
  431.     STicks := GetTickCount - STicks;
  432.     if(DelSpeed > STicks)then
  433.       Delay(DelSpeed - STicks);
  434.   end;
  435. end.