Results 1 to 5 of 5

Thread: Asteroids (well, half-finished)

  1. #1
    Join Date
    Oct 2006
    Location
    I'm a figment of your imagination
    Posts
    422
    Mentioned
    0 Post(s)
    Quoted
    0 Post(s)

    Default Asteroids (well, half-finished)

    So I was bored and decided to recreate the classic arcade game of Asteroids. I sorta stopped halfway, I couldn't be bothered to implement proper collision detection between laser and asteroid and was too lazy to implement incrementing levels or anything like that. Right now it's just a spaceship floating around, shooting lasers and it'll tell you if you hit a asteroid or if your laser hit the asteroid (the last thing is kind of sketchy though and needs improvement).

    But what I have so far seems nice to keep developing, so I'll just post the code here.

    Controls are as follows:
    Up: accellerate the spaceship
    Left/Right: turn the spaceship left/right
    Down: decellerate the spaceship
    Spacebar: fire laser (sketchy, firing procedure + collision detection needs serious improvement)

    Enter: Starts the game from the start screen.

    Heres the code:

    Code:
    program Asteroids;
    
    type
      TAsteroid = record
        x, y, vectorX, vectorY : integer;
        size: (small, medium, large);
        rotation : extended;
      end;
      TSpaceship = record
        x, y, vectorX, vectorY, lives, accelleration, laserChargeTime, chargeTime : integer;
        orientation : extended;
        laserReady : boolean;
      end;
    
    const
      GameX = 1280; //Your screen width in px
      GameY = 800; //Your screen height in px
      StarNumber = 512; //More = more lag, max depends on your machine
      StarSize = 2;
      StarColorVariance = 50; //Look at all the pretty colours
      FPS = 30; //Tries to keep framerate at this constant, more = more lag
      fullscreen = false; //fullscreen? not reccomended if gamex and gamey arent set
                         //to your screen res (ctrl-alt-s exits script)
      debug = true; //debug mode?
    var
      Spaceship : TSpaceship;
      Asteroids : array of TAsteroid;
      level : byte;
      v : TVariantArray;
      frm : TForm;
      buffer, messagebox : TCanvas;
      FrameStartMark, FrameSleepTime, MessageTime, MessageDuration : integer;
      SpaceshipBMP, AsteroidSmallBMP, AsteroidMediumBMP, AsteroidLargeBMP : integer;
      MSGwaiting : boolean;
    
    procedure Goodbye(Sender : TObject; var Action : TCloseAction);
    begin
      if not debug then
        GetSelf.WindowState := wsMaximized;
      TerminateScript;
    end;
    
    procedure ResetShip;
    begin
      Spaceship.orientation := Degrees(0);
      Spaceship.x := GameX/2;
      Spaceship.y := GameY/2;
      Spaceship.vectorX := 0;
      Spaceship.vectorY := 0;
      Spaceship.laserReady := true;
    end;
    
    procedure Form;
    var
      TR : TRect;
    begin
      frm := CreateForm;
      frm.ClientHeight := GameY;
      frm.ClientWidth := GameX;
      frm.Position := poDesktopCenter;
      frm.BorderIcons := [biSystemMenu];
      frm.BorderStyle := bsNone;
      frm.WindowState := wsMaximized;
      if fullscreen then
        frm.SetBounds(TR.Left, TR.Top, TR.Right-TR.Left, TR.Bottom-TR.Top)
      else
        frm.Position := poDesktopCenter;
      frm.Caption := 'Asteroids';
      frm.OnClose := @Goodbye;
      frm.Show;
      if not debug then
        GetSelf.WindowState := wsMinimized;
    end;
    
    procedure InsertAsteroids();
    var
      i : integer;
    begin
      SetArrayLength(Asteroids, level);
      for i := 0 to GetArrayLength(Asteroids) - 1 do
      begin
        Asteroids[i].Size := large;
        Asteroids[i].x := random(GameX);
        Asteroids[i].y := random(GameY);
        Asteroids[i].vectorX := RandomRange(-10 * level, 10 * level);
        Asteroids[i].vectorY := RandomRange(-10 * level, 10 * level);
        Asteroids[i].rotation := Rand * level;
      end;
    end;
    
    procedure DrawStar(Canvas: TCanvas; Number, ColorVar, Size : integer);
    var
      x, y, i, col : integer;
    begin
      for i := 0 to number do
      begin
        x := random(GameX);
        y := random(GameY);
        col := RGBtoColor(255 - ColorVar + random(ColorVar), 255 - ColorVar + random(ColorVar), 255 - ColorVar + random(ColorVar));
        Canvas.Pen.Color := col;
        Canvas.Pen.Width := Size;
        Canvas.MoveTo(x, y);
        Canvas.LineTo(x + 1, y + 1);
      end;
    end;
    
    procedure Initialize;
    begin
      level := 1;
      
      Spaceship.accelleration := 2;
      Spaceship.lives := 3;
      Spaceship.laserChargeTime := 3000;
      ResetShip;
      
      InsertAsteroids;
      MSGwaiting := false;
      MessageTime := 0;
      
      //Bitmaps
      SpaceshipBMP := BitmapFromString(34, 34, 'beNrt1GEKwCAIBeAd' +
           '/R1tN2tjUEzT0qiGsIe/ZPWRi47DmZRrXRKtX/lModsJyhRvr5K0i' +
           'qU0iAJNVlKugAqfj6TM+/+UEKBpykkTWmEJrWybWCGWTmyDEvqOAW' +
           'DK3RGV58tBwqUMQMhxKS4Ir3gVIwQa9sIXpe7bIUjpKsoqBzGsiBD' +
           '0VDe2My4NQi8NxbDWRDBF6xhPtDAXVF6r+A==');
      AsteroidSmallBMP := BitmapFromString(8, 8, 'beNpjYICDhoYGBlT' +
           'QAAYHDhyAMJDFgYJouuCCB2AAqxSaOVjNx+UeLAAAds4sQQ==');
      AsteroidMediumBMP := BitmapFromString(17, 17, 'beNqdUlsKwDAI8' +
           '+g7Wo+2gRAkDynLR+nDaLSpIjyCWvEFHEFidcITYMv1TaIgQPX0cW' +
           '6IqPH6Csxa1AJVmRSMQimanOhNoRjVmYRp15TECrMTxopRW5YKS1+' +
           'zGGAxjM2/OO3elr/Nf4UXSLA2kA==');
      AsteroidLargeBMP := BitmapFromString(34, 34, 'beNrFl1kOwzAIR' +
           'H30HM1Ha6VKiAAaD0vS+eoXL3jYuhav6641Jx123zVClMjf3/ukGk' +
           'viizYhHmRS0IippMzjm7AhJcwUg4SiEzEyCPl4khImAqwxFciAfKE' +
           'aO7KUEOQp2A78YiEFII7Cda5BHQrfQSGFb0aGEvquH7zJ+gUJKbh4' +
           'fLJHa3ybXE4ApHvqCUpqhP6FwvtCugMoxxrz8w37UusXcrtN9f47E' +
           '4anlEGpmVyjFPZLAVTYlQUQoJDXRdMX5ljKZmSySN1+zc2YPTLJ+P' +
           '2b/Lmb/83/LzP6AEiJF5s=');
    end;
    
    procedure MessagePlayer(messagetext : string; duration : integer);
    begin
      messagebox := GetBitmapCanvas(BitmapFromString(GameX, 50, ''));
      messagebox.Brush.Style := bsDiagCross;
      messagebox.Brush.Color := clLime;
      messagebox.Rectangle(0, 0, GameX, 50);
      messagebox.Brush.Color := clGreen;
      messagebox.Brush.Style := bsBox;
      messagebox.Rectangle(10, 10, GameX - 10, 40);
      messagebox.Font.Name := 'Arial';
      messagebox.Font.Size := 12;
      messagebox.Font.Color := clRed;
    //messagebox.Font.Style := 3;
      messageBox.TextOut((GameX / 2) - (messagebox.TextWidth(messageText) / 2),
                         25 - (messagebox.TextHeight(messageText) / 2), messagetext);
      MessageDuration := duration;
      MessageTime := GetSystemTime;
      MSGwaiting := true;
    end;
    
    procedure StartScreen;
    var
      x, y, x2, y2: integer;
      down, right : boolean;
    begin
    
      buffer := GetBitmapCanvas(BitmapFromString(GameX + 1, GameY + 1, ''));
      ThreadSafeCall('Form', v);
    
      //start textual logo in random location
      x := random(GameX);
      y := random(GameY);
      
      repeat
        FrameStartMark := GetSystemTime;
        buffer.Rectangle(0, 0, GameX + 1, GameY + 1);
        DrawStar(buffer, StarNumber, StarColorVariance, StarSize);
    
        //Set Colors and stuff
        buffer.Pen.Color := clWhite;
        buffer.Brush.Color := clBlack;
        buffer.Font.Name := 'arial';
        buffer.Font.Size := 60;
        buffer.Font.Color := clWhite;
    
        //Floating text
        x2 := buffer.TextWidth('ASTEROIDS');
        y2 := buffer.TextHeight('ASTEROIDS');
    
        if(x + x2 > GameX) then
        //Logo trimmed on right
          right := false;
        if(x <= 0) then
        //Logo trimmed on left
          right := true;
        if(y + y2 > GameY) then
        //Logo trimmed on bottom
          down := false;
        if(y <= 0) then
        //Logo trimmed on top
          down := true;
    
        if right then x := x + 5 else x := x - 5;
        if down then y := y + 5 else y := y - 5;
    
        buffer.TextOut(x, y, 'ASTEROIDS');
    
        //Sleep to adjust FPS rate
        FrameSleepTime :=  (1000/FPS) - (GetSystemTime -  FrameStartMark);
        if FrameSleepTime > 0 then
          Sleep(FrameSleepTime);
          
        SafeCopyCanvas(buffer, frm.Canvas, 0, 0, GameX, GameY, 0, 0, GameX, GameY);
      until(IsKeyDown(chr(13)));
    end;
    
    function LineInBox(x1, y1, x2, y2 : integer; box : TBox) : boolean;
    var
      m, b : extended;
      x, y, distance : integer;
      mUndefined : boolean;
    begin
      mUndefined := false;
      result := false;
      if y1 - y2 <> 0 then
        m := (x1 - x2) / (y1 - y2)
      else
        mUndefined := true;
      if mUndefined then
        b := x1
      else
        b := y1 - m * x1;
    
      if debug then
      begin
        if mUndefined then
          writeln('Laser line is y = ' + FloatToStr(m) + 'x + ' + FloatToStr(b))
        else
          writeln('Laser line is x = '+ inttostr(x1));
      end;
      
      //brute force approach. perhaps computationally less complex to determine if
      //box lines + laser line cross within certain parameters? will do for now...
    
      if mUndefined then //vertical
      begin
        for distance := round(sqrt((x2-x1)*(x2-x1) + (y2-y1)*(y2-y1))) downto 0 do
        begin
          if PointInBox(IntToPoint(x1, y1 + distance), box) then
          begin
            result := true;
            exit;
          end;
        end;
      end else
      begin
        for distance := round(sqrt((x2-x1)*(x2-x1) + (y2-y1)*(y2-y1))) downto 0 do
        begin
          if PointInBox(IntToPoint(x1 + distance, round(m*(x1 + distance) + b)), box) then
          begin
            result := true;
            exit;
          end;
        end;
      end;
    end;
    
    procedure FireLaser;
    var
      i, lx1, ly1, lx2, ly2 : integer;
      AsteroidBox : TBox;
      AsteroidsNew : array of TAsteroid;
      laserReady : boolean;
    begin
      if Spaceship.laserReady then
      begin
        buffer.Pen.Color := clRed;
        buffer.Pen.Width := 1;
        lx1 := Spaceship.x + trunc(sin(Spaceship.orientation) * -16);
        ly1 := Spaceship.y + trunc(cos(Spaceship.orientation) * -16);
        lx2 := Spaceship.x + trunc(sin(Spaceship.orientation) * -300);
        ly2 := Spaceship.y + trunc(cos(Spaceship.orientation) * -300);
        buffer.MoveTo(lx1, ly1);
        buffer.LineTo(lx2, ly2);
    
        //Collision detection
        for i := 0 to GetArrayLength(Asteroids) - 1 do
        begin
          if Asteroids[i].size = large then
            AsteroidBox := IntToBox(Asteroids[i].x - 16, Asteroids[i].y - 16, Asteroids[i].x + 16, Asteroids[i].y + 16);
          if Asteroids[i].size = medium then
            AsteroidBox := IntToBox(Asteroids[i].x - 8, Asteroids[i].y - 8, Asteroids[i].x + 8, Asteroids[i].y + 8);
          if Asteroids[i].size = small then
            AsteroidBox := IntToBox(Asteroids[i].x - 4, Asteroids[i].y - 4, Asteroids[i].x + 4, Asteroids[i].y + 4);
    
          if LineInBox(lx1, ly1, lx2, ly2, AsteroidBox) then
          begin
            MessagePlayer('You destroyed the asteroid! Nicely done!', 5000);
               if Asteroids[i].size = small then
                 //remove asteroid from queue + score
               if Asteroids[i].size = medium then
                 //split into two small ones + score
               if Asteroids[i].size = large then
                 //split into three medium ones + score}
          end;
        end;
      
        //give the playa a challenge...
        if GetArrayLength(Asteroids) = 0 then
          level := level + 1;
      end;
    end;
    
    procedure Accellerate(ahead : boolean);
    var
      speed : integer;
    begin
      if ahead then
      begin
        Spaceship.vectorX := Spaceship.vectorX - trunc(sin(Spaceship.orientation) * Spaceship.accelleration);
        Spaceship.vectorY := Spaceship.vectorY - trunc(cos(Spaceship.orientation) * Spaceship.accelleration);
      end else
      //Reverse thrust omg fancy
      begin
        Spaceship.vectorX := Spaceship.vectorX + trunc(sin(Spaceship.orientation) * Spaceship.accelleration);
        Spaceship.vectorY := Spaceship.vectorY + trunc(cos(Spaceship.orientation) * Spaceship.accelleration);
      end;
      
      //You're too fast - ship wraps the window in less than 1 frame
      speed := trunc(sqrt(sqr(Spaceship.vectorX) + sqr(SpaceShip.vectorY)));
      if (speed > GameX) or (speed > GameY) then
      begin
        Spaceship.lives := Spaceship.lives - 1;
        MessagePlayer('Your ship just reached the speed of light causing a breakdown of the space-time continuum.', 5000);
        ResetShip;
      end;
    end;
    
    procedure DetectCourseChange;
    begin
      if(IsArrowDown(0))then
        Accellerate(true);
      if(IsArrowDown(2))then
        Accellerate(false);
      if(IsArrowDown(3))then
        Spaceship.orientation := Spaceship.orientation + Radians(5);
      if(IsArrowDown(1))then
        Spaceship.orientation := Spaceship.orientation - Radians(5);
      if(IsKeyDown(chr(32)))then
        FireLaser;
    end;
    
    function BoxesOverlap(box1, box2 : TBox) : boolean;
    begin
      if IntInBox(box1.x1, box1.y1, box2) or
         IntInBox(box1.x1, box1.y2, box2) or
         IntInBox(box1.x2, box1.y1, box2) or
         IntInBox(box1.x2, box1.y2, box2) or
         IntInBox(box2.x1, box2.y1, box1) or
         IntInBox(box2.x1, box2.y2, box1) or
         IntInBox(box2.x2, box2.y1, box1) or
         IntInBox(box2.x2, box2.y2, box1) then
      result := true else
      result := false;
    end;
    
    procedure CalculatePosition;
    begin
      Spaceship.x := Spaceship.x + Spaceship.vectorX;
      Spaceship.y := Spaceship.y + Spaceship.vectorY;
      
      //Wrap around
      if Spaceship.x > GameX then
        Spaceship.x := Spaceship.x mod GameX;
      if Spaceship.x < 0 then
        Spaceship.x := Spaceship.x + GameX;
      if Spaceship.y > GameY then
        Spaceship.y := Spaceship.y mod GameY;
      if Spaceship.y < 0 then
        Spaceship.y := Spaceship.y + GameY;
    end;
    
    procedure DetectCollision;
    var
      i : integer;
      ShipBox, AsteroidBox : TBox;
    begin
      ShipBox := IntToBox(Spaceship.x - 17, Spaceship.y - 17, Spaceship.x + 17, Spaceship.y + 17);
      for i := 0 to GetArrayLength(Asteroids) - 1 do
      begin
    
        if Asteroids[i].size = large then
          AsteroidBox := IntToBox(Asteroids[i].x - 16, Asteroids[i].y - 16, Asteroids[i].x + 16, Asteroids[i].y + 16);
        if Asteroids[i].size = medium then
          AsteroidBox := IntToBox(Asteroids[i].x - 8, Asteroids[i].y - 8, Asteroids[i].x + 8, Asteroids[i].y + 8);
        if Asteroids[i].size = small then
          AsteroidBox := IntToBox(Asteroids[i].x - 4, Asteroids[i].y - 4, Asteroids[i].x + 4, Asteroids[i].y + 4);
    
        if BoxesOverlap(ShipBox, AsteroidBox) then
        begin
          Spaceship.lives := Spaceship.lives - 1;
          MessagePlayer('You just hit an asteroid. Kaboom!', 3000);
          ResetShip;
        end;
      end;
    end;
    
    procedure DrawHud;
    var
      ship : TCanvas;
    begin
      buffer.Brush.Color := clBlack;
      buffer.Rectangle(0, 0, GameX + 1, GameY + 1);
    
      DrawStar(buffer, StarNumber, StarColorVariance, StarSize);
      
      ship := GetBitmapCanvas(RotateBitmap(SpaceshipBMP, Spaceship.orientation));
      CopyCanvas(ship, buffer, 0, 0, 34, 34, Spaceship.x - 17, Spaceship.y - 17, Spaceship.x + 17, Spaceship.y + 17);
      
      buffer.Font.Name := 'Sans';
      buffer.Font.Color := clLime;
      buffer.Font.Size := 10;
      buffer.TextOut(16, GameY - 16, 'Lives: ' + inttostr(Spaceship.lives) +
        ' Speed: ' +
        inttostr(round(sqrt(sqr(Spaceship.vectorX) + sqr(Spaceship.vectorY)))) + ' Heading: ' +
        inttostr(round(abs((Degrees(Spaceship.orientation) - 360))) mod 360) +
        ' Level: ' + inttostr(level) + ' Points: ');
    end;
    
    procedure DrawAsteroids;
    var
      i : integer;
    begin
      for i := 0 to GetArrayLength(Asteroids) - 1 do
      begin
        if(Asteroids[i].Size = small) then
          CopyCanvas(GetBitmapCanvas(AsteroidSmallBMP), buffer, 0, 0, 8, 8, Asteroids[i].x - 4, Asteroids[i].y - 4, Asteroids[i].x + 4, Asteroids[i].y + 4);
        if(Asteroids[i].Size = medium) then
          CopyCanvas(GetBitmapCanvas(AsteroidSmallBMP), buffer, 0, 0, 16, 16, Asteroids[i].x - 8, Asteroids[i].y - 8, Asteroids[i].x + 8, Asteroids[i].y + 8);
        if(Asteroids[i].Size = large) then
          CopyCanvas(GetBitmapCanvas(AsteroidLargeBMP), buffer, 0, 0, 32, 32, Asteroids[i].x - 16, Asteroids[i].y - 16, Asteroids[i].x + 16, Asteroids[i].y + 16);
      end;
    end;
    
    procedure UpdateAsteroids;
    var
      i : integer;
    begin
      for i := 0 to GetArrayLength(Asteroids) - 1 do
      begin
        Asteroids[i].x := Asteroids[i].x + Asteroids[i].vectorX;
        Asteroids[i].y := Asteroids[i].y + Asteroids[i].vectorY;
    
        //Wrap around
        if Asteroids[i].x > GameX then
          Asteroids[i].x := Asteroids[i].x mod GameX;
        if Asteroids[i].x < 0 then
          Asteroids[i].x := Asteroids[i].x + GameX;
        if Asteroids[i].y > GameY then
          Asteroids[i].y := Asteroids[i].y mod GameY;
        if Asteroids[i].y < 0 then
          Asteroids[i].y := Asteroids[i].y + GameY;
      end;
    end;
    
    procedure StartGame();
    begin
      repeat
        FrameStartMark := GetSystemTime;
    
        DrawHud;
        DetectCourseChange;
        CalculatePosition;
        if (GetSystemTime - Spaceship.chargeTime) < Spaceship.laserChargeTime then
          Spaceship.laserReady := false
        else
          Spaceship.laserReady := true;
          
        DrawAsteroids;
        DetectCollision;
        UpdateAsteroids;
        If (GetArrayLength(Asteroids) = 0) then
        begin
          level := level + 1;
          InsertAsteroids;
        end;
      
        //Check for message
        if MSGwaiting then
        begin;
          CopyCanvas(messageBox, buffer, 0, 0, GameX, 50, 0, 0, GameX, 50);
          if (GetSystemTime - MessageTime >= MessageDuration) then
            MSGwaiting := false;
        end;
        
        FrameSleepTime :=  (1000/FPS) - (GetSystemTime -  FrameStartMark);
        if FrameSleepTime > 0 then
          Sleep(FrameSleepTime);
        SafeCopyCanvas(buffer, frm.Canvas, 0, 0, GameX, GameY, 0, 0, GameX, GameY);
        
      until(Spaceship.lives = 0);
    end;
    
    begin
      repeat
      Initialize;
      StartScreen();
      StartGame();
      until(false);
    end.
    I'd be really glad if someone improved it or made something out of it. Don't forget to set it up properly to your screen res!

    It's been a while... but I'm BACK!!!

  2. #2
    Join Date
    Feb 2006
    Location
    Helsinki, Finland
    Posts
    1,395
    Mentioned
    30 Post(s)
    Quoted
    107 Post(s)

    Default

    Welcome back, Bot!

    Pretty amazing game you have "built" in SCAR... Don't give up working on it, it's gonna be great. Must <3 SCAR-based games, more these!
    Last edited by Janilabo; 09-11-2009 at 06:19 PM.

  3. #3
    Join Date
    May 2009
    Posts
    799
    Mentioned
    2 Post(s)
    Quoted
    16 Post(s)

    Default

    Nice : D Gotta use it for learning purposes.

    Good Job!

  4. #4
    Join Date
    Feb 2006
    Location
    Belgium
    Posts
    3,137
    Mentioned
    3 Post(s)
    Quoted
    5 Post(s)

    Default

    Looks great, if you finish it, I want it in SCAR, lol

  5. #5
    Join Date
    Aug 2008
    Location
    Finland
    Posts
    2,851
    Mentioned
    3 Post(s)
    Quoted
    2 Post(s)

    Default

    Wow dude! This beats my videopoker 6-nil

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
  •