Results 1 to 8 of 8

Thread: Tetris in Simba o.O

  1. #1
    Join Date
    Feb 2012
    Location
    Norway
    Posts
    995
    Mentioned
    145 Post(s)
    Quoted
    596 Post(s)

    Default Tetris in Simba o.O

    So, I've hacked together a game in Simba just to make time fly, and because I've never done anything like this in Simba before. I bet you never expected to see this in Simba!
    The actual game might be a bit iffy, but heck.. Didn't wanna spend that much time on it

    Only requirement is the Simba 1.2RC release.



    The script:
    Simba Code:
    program Tetris;
    (*
      A hacked together tetris game that uses the builtin debug image.
      Requires Simba 1.2-RC5 or later.
    *)


    const
      //** CONFIGUREATION **//
      TURN_RIGHT = VK_D;
      TURN_LEFT  = VK_A;

      MOVE_LEFT  = VK_LEFT;
      MOVE_RIGHT = VK_RIGHT;

      MOVE_DOWN  = VK_DOWN;
      DROP_DOWN  = VK_SPACE;

      RESTART_GAME = VK_F5;
      PAUSE_GAME = VK_P;

      START_LEVEL = 1;

      //special conf:
      GAME_WIDTH  = 10;
      GAME_HEIGHT = 20;

      BASE_TICK = 700;

      POINTSIZE = 24;


    //----------------------------------------------------------------------------\\
    //----------------------------------------------------------------------------\\

    type
      TFace = (f0,f1,f2,f3);
      TState = (stRunning, stCompleted);

      TBrick = record
        id: Int32;
        pos: TPoint;
        face: TFace;
      end;
      TBrickArray = array of TBrick;

      TTetris = record
        Width,Height:Int32;
        Bounds:TBox;
        Board:TMufasaBitmap;
        Active, Original, Next:TBrick;
        State:TState;
        Score:Int32;

        Level:Int32;
        Tick:Int32;
        CollapseCount:Int32;
      end;

    const
      GLOB_BRICKS:T2DPointArray = [
        [[0,0],[0,1],[1,0],[2,0]], // :''
        [[0,0],[1,0],[2,0],[3,0]], // ....
        [[0,0],[1,0],[2,0],[1,1]], // ':'
        [[1,0],[2,0],[0,1],[1,1]], // .:'
        [[0,0],[1,0],[1,1],[2,1]], // ':.
        [[0,0],[1,0],[0,1],[1,1]], // ::
        [[0,0],[1,0],[2,0],[2,1]]  // '':
      ];

      GLOB_COLORS:TIntegerArray = [
        $3388FF,  //orange
        $FFCC33,  //cyan
        $FF33BB,  //purple
        $33FF77,  //green
        $3333FF,  //red / pink
        $33DDFF,  //yellow
        $FF9000   //blue
      ];

      BACKGROUND = $333333;


    function TBrick.GetBrickTPA(): TPointArray; constref;
    begin
      Result := GLOB_BRICKS[self.id];
      case self.face of
        f0: Result := Copy(Result);
        f1: Result := RotatePoints(Result, radians(90), 1,0);
        f2: Result := RotatePoints(Result, radians(180), 1,0);
        f3: Result := RotatePoints(Result, radians(270), 1,0);
      end;
      OffsetTPA(Result, Self.pos);
    end;

    procedure TTetris.FillBox(x,y:Int32; color:Int32=BACKGROUND);
    var
      h,s,l:Extended;
    begin
      x *= POINTSIZE;
      y *= POINTSIZE;
      try
        self.Board.DrawTPA(TPAFromBox([x,y,x+POINTSIZE-2,y+POINTSIZE-2]), color);
        if color <> BACKGROUND then
        begin
          ColorToHSL(color, H,S,L);
          color := HSLToColor(H,S-15,L-15);
          self.Board.DrawTPA(EdgeFromBox([x,y,x+POINTSIZE-2,y+POINTSIZE-2]), color);
        end;
      except
      end;
    end;

    function TTetris.IsFilled(x,y:Int32): Boolean;
    begin
      Result := (y > 0) and (self.board.GetPixel(x * POINTSIZE, y * POINTSIZE) <> BACKGROUND);
    end;

    procedure TTetris.DrawBrick(brick:TBrick);
    var pt:TPoint;
    begin
      for pt in brick.GetBrickTPA() do
        self.FillBox(pt.x,pt.y, GLOB_COLORS[brick.id]);
    end;

    procedure TTetris.UndrawBrick(brick:TBrick);
    var pt:TPoint;
    begin
      for pt in brick.GetBrickTPA() do
        self.FillBox(pt.x,pt.y);
    end;

    function TTetris.Collides(): Boolean;
    var
      pt:TPoint;
    begin
      for pt in active.GetBrickTPA() do
        if (not(InRange(pt.x, Bounds.x1, Bounds.x2) and InRange(pt.y, Bounds.y1, Bounds.y2))) or
           self.IsFilled(pt.x,pt.y) then
          Exit(True);
    end;

    function TTetris.TryRotateCW(): Boolean;
    var
      pt:TPoint;
      oldface:TFace;
    begin
      Result := True;
      self.UndrawBrick(self.Active);

      oldface := active.face;
      if active.face = f3 then active.face := f0
      else Inc(active.face);

      if self.Collides() then
      begin
        active.face := oldface;
        self.DrawBrick(self.Active);
        Result := False;
      end;
    end;

    function TTetris.TryRotateCCW(): Boolean;
    var
      pt:TPoint;
      oldface:TFace;
    begin
      Result := True;
      self.UndrawBrick(self.Active);

      oldface := active.face;
      if active.face = f0 then active.face := f3
      else Dec(active.face);

      if self.Collides() then
      begin
        active.face := oldface;
        self.DrawBrick(self.Active);
        Result := False;
      end;
    end;

    function TTetris.TryMove(ox,oy:Int32): Boolean;
    var
      pt:TPoint;
      oldpos:TPoint;
    begin
      Result := True;
      self.UndrawBrick(self.Active);

      oldpos := active.pos;
      active.pos.x += ox;
      active.pos.y += oy;

      if self.Collides() then
      begin
        active.pos := oldpos;
        self.DrawBrick(self.Active);
        Result := False;
      end;
    end;

    procedure TTetris.UpdateBrick();
    begin
      self.UndrawBrick(Original);
      self.DrawBrick(Active);
      self.Update();
    end;

    procedure TTetris.LevelUp();
    begin
      self.Tick := Ceil(self.Tick*0.75);
      if self.Tick < 1 then self.Tick := 1;
      self.Level += 1;
      self.collapseCount := 0;
    end;

    procedure TTetris.CheckRows();
    var
      x,y,counter:Int32;
      procedure RemoveRow(row:Int32);
      var x,y,color:Int32;
      begin
        counter += 1;
        for y:=row-1 downto 0 do
          for x:=0 to Bounds.X2 do
          begin
            color := self.board.GetPixel(x * POINTSIZE+1, y * POINTSIZE+1);
            self.FillBox(x,y);
            self.FillBox(x,y+1, color);
          end;
      end;
    begin
      for y:=0 to Bounds.Y2 do
      begin
        for x:=0 to Bounds.X2 do
          if not self.IsFilled(x,y) then
            break;
        if (x = self.Width) then RemoveRow(y);
      end;
      self.Score += counter*self.Width;
      self.collapseCount += counter;
      if self.collapseCount >= 10 then self.LevelUp();
    end;

    procedure TTetris.NewBrick();
    begin
      self.Original := self.Next;
      self.Active   := self.Next;

      self.Next.pos  := Point(self.Width div 2 - 1, -1);
      self.Next.face := f0;
      self.Next.id   := Random(0,High(GLOB_BRICKS));
    end;

    procedure TTetris.Debug();
    var
      x:Int32;
      pt:TPoint;
      brick:TBrick;
      procedure _FillBrick(x,y:Int32; size:Int32=15);
      begin
        for pt in brick.GetBrickTPA() do
        begin
          pt.x := x+pt.x*size;
          pt.y := y+pt.y*size;
          self.Board.DrawTPA(TPAFromBox([pt.x,pt.y, pt.x+size-2,pt.y+size-2]), $FFFFFF);
        end;
      end;

    begin
      x := self.Width*POINTSIZE + 20;

      if self.score = 0 then
      begin
        self.Board.DrawText('Score:', 'UpChars07', Point(x,20),  False, $AAAAAA);
        self.Board.DrawText('Level:', 'UpChars07', Point(x,80),  False, $AAAAAA);
        self.Board.DrawText('Speed:', 'UpChars07', Point(x,140), False, $AAAAAA);
        self.Board.DrawText('Next:', 'UpChars07',  Point(x,200), False, $AAAAAA);
      end;

      //clear
      self.Board.DrawTPA(TPAFromBox([x,40,Board.GetWidth()-1,60]), 0);
      self.Board.DrawTPA(TPAFromBox([x,100,Board.GetWidth()-1,120]), 0);
      self.Board.DrawTPA(TPAFromBox([x,160,Board.GetWidth()-1,180]), 0);
      self.Board.DrawTPA(TPAFromBox([x,220,Board.GetWidth()-1, 220+50]), 0);

      //draw
      self.Board.DrawText(ToStr(self.Score), 'SmallChars07', Point(x,40),  False, $FFFFFF);
      self.Board.DrawText(ToStr(self.Level), 'SmallChars07', Point(x,100),  False, $FFFFFF);
      self.Board.DrawText(ToStr(Round(BASE_TICK/self.Tick,2)), 'SmallChars07', Point(x,160), False, $FFFFFF);

      brick := self.Next;
      brick.pos := [0,0];
      _FillBrick(x,220,15);

      //----
      if self.State = stCompleted then
      begin
         ClearDebug();
         WriteLn('Game over!!');
      end;
    end;

    procedure TTetris.RestartGame();
    var x,y:Int32;
    begin
      Self.Tick := 1000;
      for x:=0 to Width-1 do
        for y:=0 to Height-1 do
          Self.FillBox(x,y);

      Self.Level := 1;
      Self.Tick := BASE_TICK;
      for 1 to START_LEVEL-1 do Self.LevelUp();
      Self.Score := 0;
      Self.State := stRunning;
      Self.NewBrick();
      Self.Debug();
    end;

    procedure TTetris.HandleEvent();
    var t,t2:UInt64;
    begin
      t := GetTickCount() + Tick;
      while GetTickCount() < t do
      begin
        self.UpdateBrick();
        Original := Active;
        t2 := GetTickCount() + 196;
        if isKeyDown(TURN_RIGHT) then
        begin
          TryRotateCW();
          while isKeyDown(TURN_RIGHT) and (GetTickCount() < t2) do Wait(2);
        end
        else if isKeyDown(TURN_LEFT) then
        begin
          TryRotateCCW();
          while isKeyDown(TURN_LEFT) and (GetTickCount() < t2) do Wait(2);
        end
        else if isKeyDown(MOVE_LEFT) then
        begin
          TryMove(-1,0);
          while isKeyDown(MOVE_LEFT) and (GetTickCount() < t2) do Wait(2);
        end
        else if isKeyDown(MOVE_RIGHT) then
        begin
          TryMove(1,0);
          while isKeyDown(MOVE_RIGHT) and (GetTickCount() < t2) do Wait(2);
        end
        else if isKeyDown(MOVE_DOWN) then
        begin
          while isKeyDown(MOVE_DOWN) and TryMove(0,1) do
          begin
            self.UpdateBrick();
            Wait(4);
          end;
        end
        else if isKeyDown(DROP_DOWN) then
        begin
          while TryMove(0,1) do
          begin
            self.UpdateBrick();
            Wait(4);
          end;
        end
        else if isKeyDown(RESTART_GAME) then
        begin
          self.RestartGame();
        end
        else if isKeyDown(PAUSE_GAME) then
        begin
          ClearDebug();
          WriteLn(self.Score);
          WriteLn('Game is paused!');
          while isKeyDown(PAUSE_GAME) do Wait(16);
          while not isKeyDown(PAUSE_GAME) do Wait(16);
          while isKeyDown(PAUSE_GAME) do Wait(16);
          ClearDebug();
          WriteLn(self.Score);
          WriteLn('Game has been resumed!');
        end;
        Wait(2);
      end;
      self.UpdateBrick();
    end;

    function TTetris.Create(AWidth,AHeight:Int32): TTetris; static;
    var
      x,y:Int32;
    begin
      Result.Width  := AWidth;
      Result.Height := AHeight;
      Result.Board.Init(client.getMBitmaps);
      Result.Board.SetSize(AWidth*POINTSIZE+150, AHeight*POINTSIZE);
      Result.Bounds := [0,-3,Result.Width-1,Result.Height-1];

      x := AWidth*POINTSIZE;
      Result.Board.DrawTPA(TPAFromBox([x,0,x, AHeight*POINTSIZE-1]), $999999);

      Result.Level := 1;
      Result.Tick := BASE_TICK;
      for 1 to START_LEVEL-1 do Result.LevelUp();

      for x:=0 to AWidth-1 do
        for y:=0 to AHeight-1 do
          Result.FillBox(x,y);
    end;

    procedure TTetris.Display(); constref;
    begin
      DisplayDebugImgWindow(Self.board.GetWidth,Self.Board.GetHeight);
      DrawBitmapDebugImg(Self.Board.GetIndex());
    end;

    procedure TTetris.Update(); constref;
    begin
      DrawBitmapDebugImg(Self.Board.GetIndex());
    end;

    procedure TTetris.Focus(); constref;
    {$IFNDEF LINUX}
    var proc:TSysProc;
    function SetForegroundWindow(HWND:UInt64): LongBool; external 'SetForegroundWindow@User32.dll';
    begin
      for proc in GetProcesses() do
        if proc.Title = 'DebugImgForm' then
          SetForegroundWindow(proc.Handle);
    end;
    {$ELSE}
    begin
      WriteLn('Click / Focus the debug window manually, starting in 1 second');
      Wait(1000);
    end;
    {$ENDIF}

    function TTetris.Run(): Boolean;
    begin
      self.State := stRunning;
      self.Display();
      self.Focus();
      self.NewBrick();
      self.Debug();

      while True do
      begin
        self.HandleEvent();
        Original := Active;

        if not self.TryMove(0,1) then
        begin
          self.Score += self.Active.pos.y;

          if self.Active.pos.y = -1 then
            self.State := stCompleted
          else
          begin
            self.CheckRows();
            self.NewBrick();
            self.Debug();
            Wait(170);
          end;
        end;

        while self.State = stCompleted do
        begin
          Self.Debug();
          self.HandleEvent();
          Wait(8);
        end;
      end;
    end;


    var
      Tetris:TTetris;
      tmp:TBrick;
    begin
      Tetris := TTetris.Create(GAME_WIDTH,GAME_HEIGHT);
      Tetris.Run();
    end.

    Have fun, and don't forget to share your score!
    Last edited by slacky; 07-18-2016 at 02:03 PM.
    !No priv. messages please

  2. #2
    Join Date
    Sep 2006
    Posts
    6,089
    Mentioned
    77 Post(s)
    Quoted
    43 Post(s)

    Default

    Awesome!
    Hup Holland Hup!

  3. #3
    Join Date
    Mar 2013
    Location
    Argentina
    Posts
    758
    Mentioned
    27 Post(s)
    Quoted
    365 Post(s)

    Default

    leechers will leech. Next big game on play store :P
    Formerly known as Undorak7

  4. #4
    Join Date
    Dec 2006
    Location
    Program TEXAS home of AUTOERS
    Posts
    7,934
    Mentioned
    26 Post(s)
    Quoted
    237 Post(s)

    Default

    Cool! Hopefully I remember to play it tonight.

  5. #5
    Join Date
    Sep 2008
    Location
    Not here.
    Posts
    5,422
    Mentioned
    13 Post(s)
    Quoted
    242 Post(s)

    Default

    Would it be faster to represent the matrix virtually? Completely separate render from matrix logic.

  6. #6
    Join Date
    Feb 2012
    Location
    Norway
    Posts
    995
    Mentioned
    145 Post(s)
    Quoted
    596 Post(s)

    Default

    Quote Originally Posted by tls View Post
    Would it be faster to represent the matrix virtually? Completely separate render from matrix logic.
    I guess that could speed it up a tad, will at least help simplify the code over all.

    On another note, I finally got to level 8 (4.8K score)
    Last edited by slacky; 07-19-2016 at 03:20 AM.
    !No priv. messages please

  7. #7
    Join Date
    Sep 2010
    Posts
    5,762
    Mentioned
    136 Post(s)
    Quoted
    2739 Post(s)

    Default

    Now somebody make a script to play it

  8. #8
    Join Date
    Feb 2012
    Location
    Norway
    Posts
    995
    Mentioned
    145 Post(s)
    Quoted
    596 Post(s)

    Default

    Quote Originally Posted by rj View Post
    Now somebody make a script to play it
    Hehe
    Last edited by slacky; 07-31-2017 at 06:45 PM.
    !No priv. messages please

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •