src/gohamster.pas

@@ -1,54 +1,86 @@
 program go_hamster;
 uses crt;
 
-{ Implement come back }
+{ Implement figure cuts (check CutField) }
-{ Implement death on trace cross }
+{ Implement interface }
-{ Implement  }
+    { Implement lifes }
+    { Implement bar }
+    { Implement score }
+{ Implement bonuses }
+    { Implement hamster speed up }
+    { Implement life up }
+{ Implement ghost }
+{ Implement creature death }
+    { Implement enemy slow }
+
+{ Implement sun }
+{ Implement snake }
+{ Implement bobr }
+{ Implement hamster animation }
+{ Implement ghost animation }
+{ Implement sun animation }
+{ Implement snake animation }
+{ Implement bobr animation }
 
 const
-      GameFieldH = 33; { 33 }
+      ArenaH = 33;
-      GameFieldW = 40; { 40 }
+      ArenaW = 41;
+      InterfaceH = 6;
       CellSize = 2;
       BorderSize = 1;
-      ScreenW = GameFieldW * CellSize + BorderSize * 2; { 82 }
+      ScreenW = (ArenaW - 1) * CellSize + BorderSize * 2; { 80 }
-      FieldHeight = ScreenW - 3; {wtf? why? maybe later}
+      ScreenH = (ArenaH + InterfaceH) * CellSize + BorderSize;
-      MinScreenH = FieldHeight;
       WidthCoefficient = 2;
       MinScreenW = ScreenW * WidthCoefficient; 
-      InterfaceBarH = ScreenW - GameFieldH * CellSize - BorderSize * 2; { 14 }
+      InterfaceBarH = ScreenW - ArenaH * CellSize - BorderSize * 2; { 14 }
-      FieldBorder = '#';
+      BorderSymbol = '#';
       HamsterSymbol = '*';
-      DelaySizeMs = 100;
+      TraceSymbol = '@';
-      EscCode = 27;
+      DelaySizeMs = 150;
-      CtrlCCode = 3;
+      SpaceOrd = 32;
+      EscOrd = 27;
+      CtrlCOrd = 3;
       ArrowLeftOrd = -75;
       ArrowRightOrd = -77;
       ArrowDownOrd = -80;
       ArrowUpOrd = -72;
+      PreviousTraceIdx = 3;
+      HamsterDelta = 2;
+      DebugMsg = '==============bObr=kUrwa=============';
 
 type
-    character = record
+    creature = record
         curX, curY, dX, dY: integer;
+        symbol: char
     end;
 
+    tracePtr = ^trace;
+
+    trace = record
+        curX, curY: integer;
+        prev: tracePtr
+    end;
+
+    arena = array [1..ArenaH, 1..ArenaW] of boolean;
+
 function IsTerminalValid: boolean;
 begin
     IsTerminalValid := 
-        (ScreenWidth >= MinScreenW) and (ScreenHeight >= MinScreenH)
+        (ScreenWidth >= ScreenW) and (ScreenHeight >= ScreenH)
 end;
 
 procedure PrintTerminalHelp;
 begin
     writeln('Increase your terminal size and try again.');
-    if ScreenWidth < MinScreenW then
+    if ScreenWidth < ScreenW then
     begin
         writeln('Your terminal width: ', ScreenWidth,
-                '. Required: ', MinScreenW, '.')
+                '. Required: ', ScreenW, '.')
     end;
-    if ScreenHeight < MinScreenH then
+    if ScreenHeight < ScreenH then
     begin
         writeln('Your terminal height: ', ScreenHeight,
-                '. Required: ', MinScreenH, '.')
+                '. Required: ', ScreenH, '.')
     end
 end;
 
@@ -74,7 +106,7 @@ var
 begin
     GotoXY(x, y);
     for i := 1 to len do
-        write(FieldBorder);
+        write(BorderSymbol);
     GotoXY(1, 1)
 end;
 
@@ -85,7 +117,7 @@ begin
     for i := 1 to len do
     begin
         GotoXY(x, y + i - 1);
-        write(FieldBorder)
+        write(BorderSymbol)
     end;
     GotoXY(1, 1)
 end;
@@ -94,14 +126,13 @@ procedure DrawRectangle(x0, y0, h, w: integer);
 var
     i: integer;
 begin
-    clrscr;
     DrawLineX(x0, y0, w);
     for i := 1 to h - 2 do
     begin
         GotoXY(x0, y0 + i);
-        write(FieldBorder);
+        write(BorderSymbol);
         GotoXY(x0 + w - 1, y0 + i);
-        write(FieldBorder)
+        write(BorderSymbol)
     end;
     DrawLineX(x0, y0 + h - 1, w);
     GotoXY(1, 1)
@@ -116,12 +147,133 @@ begin
     DrawLineY(cellW * 2 * WidthCoefficient + 1, 1, InterfaceBarH)
 end;
 
-procedure DrawArena(ScreenW, FieldHeight: integer);
+procedure DrawInterface(ScreenH, ScreenW: integer);
 begin
-    DrawRectangle(1, 1, FieldHeight, ScreenW * WidthCoefficient);
+    DrawRectangle(1, 1, ScreenH, ScreenW * WidthCoefficient);
     DrawInterface
 end;
 
+procedure
+InitiateCreature(var cr: creature; curX, curY, dX, dY: integer; symbol: char);
+begin
+    cr.curX := curX;
+    cr.curY := curY;
+    cr.dX := dX;
+    cr.dY := dY;
+    cr.symbol := symbol
+end;
+
+function IsOnBorder(var cr: creature): boolean;
+begin
+    IsOnBorder :=  
+        (cr.curX = 1) or (cr.curX = ArenaW) or (cr.curY = 1) or
+        (cr.curY = ArenaH)
+end;
+
+procedure FillArenaCell(arenaX, arenaY: integer; symbol: char);
+var
+    i, screenX, screenY: integer;
+begin
+    screenX := BorderSize + (arenaX - 1) * CellSize * WidthCoefficient;
+    screenY := InterfaceBarH + (arenaY - 1) * CellSize;
+    GotoXY(screenX, screenY);
+    for i := 1 to CellSize * WidthCoefficient  do
+        write(symbol);
+    GotoXY(screenX, screenY + 1); { later change to nested for }
+    for i := 1 to CellSize * WidthCoefficient  do
+        write(symbol);
+    GotoXY(1, 1)
+end;
+
+procedure CutField(var t: tracePtr);
+var
+    traceTmp: tracePtr;
+begin
+    GotoXY(2, 2);
+    writeln('        ');
+    GotoXY(2, 2);
+    writeln(t^.curX, ' ', t^.curY);
+    while t <> nil do
+    begin
+        FillArenaCell(t^.curX, t^.curY, ' ');
+        traceTmp := t^.prev;
+        dispose(t);
+        t := traceTmp
+    end
+end;
+
+function IsTraceExists(var t: tracePtr; x, y: integer): boolean;
+begin
+    if t = nil then
+        IsTraceExists := false
+    else
+    if (t^.curX = x) and (t^.curY = y) then
+        IsTraceExists := true
+    else
+        IsTraceExists := IsTraceExists(t^.prev, x, y)
+end;
+
+function FindIdx(var t: tracePtr; x, y, curIdx: integer): integer;
+begin
+    if t = nil then
+        FindIdx := -1
+    else
+    if (t^.curX = x) and (t^.curY = y) then
+        FindIdx := curIdx
+    else
+        FindIdx := FindIdx(t^.prev, x, y, curIdx + 1)
+end;
+
+function HamsterMovePossible(var h: creature; var t: tracePtr): boolean;
+var
+    nextX, nextY, idx: integer;
+begin
+    nextX := h.curX + h.dX;
+    nextY := h.curY + h.dY;
+    idx := FindIdx(t, nextX, nextY, 1);
+    HamsterMovePossible := (idx <= PreviousTraceIdx)
+end;
+
+procedure StopCreature(var cr: creature);
+begin
+    cr.dX := 0;
+    cr.dY := 0
+end;
+
+procedure DrawArena;
+begin
+    DrawRectangle(1, InterfaceBarH,
+                  ScreenH - InterfaceBarH + 1, ScreenW * WidthCoefficient)
+end;
+
+procedure UpdateDelta(keyCode: integer; var cr: creature); { Refactor later }
+begin
+    case keyCode of
+        ArrowLeftOrd:
+        begin
+            cr.dX := -HamsterDelta;
+            cr.dY := 0
+        end;
+        ArrowRightOrd:
+        begin
+            cr.dX := HamsterDelta;
+            cr.dY := 0
+        end;
+        ArrowUpOrd:
+        begin
+            cr.dX := 0;
+            cr.dY := -HamsterDelta
+        end;
+        ArrowDownOrd:
+        begin
+            cr.dX := 0;
+            cr.dY := HamsterDelta
+        end;
+        SpaceOrd:
+            StopCreature(cr)
+    end
+end;
+
 function Clamp(val, min, max: integer): integer;
 begin
     Clamp := val;
@@ -131,99 +283,210 @@ begin
         Clamp := max
 end;
 
-procedure DrawCell(fieldX, fieldY: integer);
+procedure MoveCreature(var cr: creature);
-var
-    i: integer;
 begin
-    GotoXY(fieldX, fieldY);
+    cr.curX := Clamp(cr.curX + cr.dX, 1, ArenaW);
-    for i := 1 to CellSize * WidthCoefficient  do
+    cr.curY := Clamp(cr.curY + cr.dY, 1, ArenaH)
-        write(HamsterSymbol);
-    GotoXY(fieldX, fieldY + 1);
-    for i := 1 to CellSize * WidthCoefficient  do
-        write(HamsterSymbol)
 end;
 
-procedure DrawHamster(var hamster: character);
+procedure AddTrace(var t: tracePtr; nextX, nextY: integer);
 var
-    fieldX, fieldY: integer;
+    nextTrace: tracePtr;
 begin
-    hamster.curX := Clamp(hamster.curX, 1, GameFieldW + 1);
+    new(nextTrace);
-    hamster.curY := Clamp(hamster.curY, 1, GameFieldH);
+    nextTrace^.curX := nextX;
-    fieldX := 1 + (hamster.curX - 1) * CellSize * WidthCoefficient;
+    nextTrace^.curY := nextY;
-    fieldY := InterfaceBarH + (hamster.curY - 1) * CellSize;
+    nextTrace^.prev := t;
-    DrawCell(fieldX, fieldY)
+    t := nextTrace
 end;
 
-procedure UpdateDelta(keyCode: integer; var hamster: character);
+procedure AddBorderTrace(var t: tracePtr; var hamster: creature; var a: arena);
 begin
-    case keyCode of
+    if hamster.dX = 2 then
-        ArrowLeftOrd:
+        AddTrace(t, hamster.curX - 2, hamster.curY)
+    else
+    if hamster.dX = -2 then
+        AddTrace(t, hamster.curX + 2, hamster.curY)
+    else
+    if hamster.dY = 2 then
+        AddTrace(t, hamster.curX, hamster.curY - 2)
+    else
+        AddTrace(t, hamster.curX, hamster.curY + 2);
+    FillArenaCell(t^.curX, t^.curY, TraceSymbol);
+    a[t^.curX][t^.curY] := true
+end;
+
+function IsOnTrace(var t: tracePtr; var cr: creature): boolean;
+var
+    tmp: tracePtr;
+begin
+    tmp := t;
+    IsOnTrace := false;
+    while tmp <> nil do
+    begin
+        if (tmp^.curX = cr.curX) and (tmp^.curY = cr.curY) then
         begin
-            hamster.dX := -1;
+            IsOnTrace := true;
-            hamster.dY := 0
+            break
         end;
-        ArrowRightOrd:
+        tmp := tmp^.prev
-        begin
-            hamster.dX := 1;
-            hamster.dY := 0
-        end;
-        ArrowUpOrd:
-        begin
-            hamster.dX := 0;
-            hamster.dY := -1
-        end;
-        ArrowDownOrd:
-        begin
-            hamster.dX := 0;
-            hamster.dY := 1
-        end
     end
 end;
 
-{
+procedure PopTrace(var t: tracePtr);
-procedure ShowHamster(var hamster: character);
+var
+    tmpPrev: tracePtr;
 begin
-    GotoXY()
+    tmpPrev := t^.prev;
+    dispose(t);
+    t := tmpPrev
 end;
-}
 
+procedure PopHamsterTrace(var t: tracePtr; var a: arena);
+begin
+    FillArenaCell(t^.curX, t^.curY, ' ');
+    a[t^.curY][t^.curX] := false;
+    PopTrace(t)
+end;
+
+procedure AddHamsterTrace(var t: tracePtr; var h: creature; var a: arena);
+var
+    nextX, nextY: integer;
+begin
+    if h.curX > t^.curX then
+    begin   { to right }
+        nextX := t^.curX + 1;
+        nextY := t^.curY
+    end
+    else
+    if h.curX < t^.curX then
+    begin   { to left }
+        nextX := t^.curX - 1;
+        nextY := t^.curY
+    end
+    else
+    if h.curY > t^.curY then
+    begin   { to down }
+        nextX := t^.curX;
+        nextY := t^.curY + 1
+    end
+    else
+    if h.curY < t^.curY then
+    begin   { to up }
+        nextX := t^.curX;
+        nextY := t^.curY - 1
+    end
+    else
+    begin
+        nextX := h.curX;
+        nextY := h.curY
+    end;
+    AddTrace(t, nextX, nextY);
+    FillArenaCell(t^.curX, t^.curY, TraceSymbol);
+    a[t^.curY][t^.curX] := true
+end;
+
+procedure
+ChangeHamsterTrace(var t: tracePtr; var h: creature;
+                   var a: arena; var redrawArena: boolean);
+var
+    i: integer;
+begin
+    if IsOnTrace(t, h) then
+    begin
+        if t^.prev = nil then       { Hamster backed to border }
+            PopHamsterTrace(t, a)
+        else
+            for i := 1 to HamsterDelta do
+                PopHamsterTrace(t, a)
+    end
+    else
+    begin
+        if t = nil then
+        begin
+            AddBorderTrace(t, h, a);
+            redrawArena := true
+        end;
+        for i := 1 to HamsterDelta do
+            AddHamsterTrace(t, h, a)
+    end
+end;
+
+procedure HandleKey(var hamster: creature; var continueLevel: boolean);
 var
     keyCode: integer;
-    hamster: character;
+begin
+    GetKey(keyCode);
+    if (keyCode = ArrowLeftOrd) or (keyCode = ArrowRightOrd) or
+        (keyCode = ArrowUpOrd) or (keyCode = ArrowDownOrd) or
+        (keyCode = SpaceOrd) then
+    begin
+        UpdateDelta(keyCode, hamster)
+    end;
+    if (keyCode = EscOrd) or (keyCode = CtrlCOrd) then
+        continueLevel := false
+end;
+
+procedure PrintHamsterDebug(var hamster: creature);
+var
+    i: integer;
+begin
+    GotoXY(2, 2);
+    for i := 1 to 20 do
+        write(' ');
+    GotoXY(2, 2);
+    writeln(hamster.curX, ' ', hamster.curY, ' ', hamster.dX, ' ', hamster.dY)
+end;
+
+procedure RunLevel;
+var
+    hamster: creature;
+    arenaCells: arena;
+    hamsterTrace: tracePtr = nil;
+    continueLevel: boolean = true;
+    redrawArena: boolean = false;
+begin
+    InitiateCreature(hamster, 5, 1, 0, 0, HamsterSymbol);
+    FillArenaCell(hamster.curX, hamster.curY, hamster.symbol);
+    while continueLevel do
+    begin
+        delay(DelaySizeMs);
+        if (hamsterTrace <> nil) and IsOnBorder(hamster) and
+            (hamsterTrace^.prev <> nil) then
+        begin
+            CutField(hamsterTrace)
+        end;
+        if keypressed then
+            HandleKey(hamster, continueLevel);
+        if not HamsterMovePossible(hamster, hamsterTrace) then
+            StopCreature(hamster);
+        if (hamster.dX = 0) and (hamster.dY = 0) then
+            continue;
+        if not IsOnBorder(hamster) then
+            FillArenaCell(hamster.curX, hamster.curY, TraceSymbol)
+        else
+            FillArenaCell(hamster.curX, hamster.curY, ' ');
+        MoveCreature(hamster);
+        if IsOnBorder(hamster) and (hamsterTrace = nil) then
+            redrawArena := true
+        else
+            ChangeHamsterTrace(hamsterTrace, hamster, arenaCells, redrawArena);
+        if redrawArena then
+        begin
+            DrawArena;
+            redrawArena := false
+        end;
+        FillArenaCell(hamster.curX, hamster.curY, hamster.symbol)
+    end
+end;
+
 begin
     if not IsTerminalValid then
     begin
         PrintTerminalHelp;
         exit
     end;
-    hamster.curX := 1;
+    clrscr;
-    hamster.curY := 1;
+    DrawInterface(ScreenH, ScreenW);
-    DrawArena(ScreenW, FieldHeight);
+    RunLevel;
-    while true do
-    begin
-        delay(DelaySizeMs);
-        if keypressed then
-        begin
-            GetKey(keyCode);
-            { writeln(keyCode); }
-            if (keyCode = ArrowLeftOrd) or (keyCode = ArrowRightOrd) or
-                (keyCode = ArrowUpOrd) or (keyCode = ArrowDownOrd) then
-            begin
-                UpdateDelta(keyCode, hamster)
-            end;
-            if (keyCode = EscCode) or (keyCode = CtrlCCode) then
-                break
-        end;
-        DrawHamster(hamster);
-        {
-        if (hamster.curX <> 1) and (hamster.curY <> GameFieldW) and
-            (hamster.curY <> 1) and (hamster.curY <> GameFieldH) then
-        begin
-            DrawHamster(hamster)
-        end;
-        }
-        hamster.curX := hamster.curX + hamster.dX;
-        hamster.curY := hamster.curY + hamster.dY
-    end
 end.
-