SuperHack/SuperHack CD.bin/CODING/DEMOS/ACGSTRS.ZIP/STARS.PAS

Pascal/Delphi Source File | 1995-08-24 | 5.4 KB | 211 lines

Program ParallaxScrolling; {My OWN try, after I know the basics!}
Uses Crt,GFX3;
Type PalT = Array [0..255,0..2] of Byte;
Const
     VgaAddr = $a000;
     MaxStars = 50;
     MaxLayers = 4;
Var
     Stars : Array [1..maxlayers,1..maxstars] of Array[0..1] of integer;
     Pallete : PalT;
     Ticks : Word;
     i:Word;
     ch:Char;
{--------------------------------------------------------------------------}
Procedure ClrVGA;
var i : word;
begin
 for i := 0 to 64000 do
 meml[$A000:i] := 0;
end;
{-------------------------------------------------------------------------}
Procedure VideoMode ( Mode : Byte );
Begin { VideoMode }
 Asm
  Mov  AH,00
  Mov  AL,Mode
  Int  10h
 End;
End;
{-------------------------------------------------------------------------}
Procedure Pal(Col, R, G, B : Byte);
Begin
   Asm
      mov   dx, 3c8h
      mov   al, [Col]
      out   dx, al
      inc   dx
      mov   al, [R]
      out   dx, al
      mov   al, [G]
      out   dx, al
      mov   al, [B]
      out   dx, al
   End;
End;
{--------------------------------------------------------------------------}
Procedure GetPal(Col : Byte; Var R, G, B : Byte);
Var
   Rt,Gt,Bt : Byte;
Begin
   Asm
      mov   dx, 3c7h
      mov   al, [Col]
      out   dx, al
      inc   dx
      inc   dx
      in    al, dx
      mov   [Rt],al
      in    al, dx
      mov   [Gt],al
      in    al, dx
      mov   [Bt],al
   End;
   R := Rt;
   G := Gt;
   B := Bt;
End;
{----------------------------------------------------------------------------}
Procedure UpdPalette(Pallt:PalT);
Var  AA:Word;
Begin
 For AA:=0 to 255 do pal(AA,Pallt[AA,0],Pallt[AA,1],Pallt[AA,2]);
End;
{----------------------------------------------------------------------------}
Procedure CheckVga;
Var ok:byte;
begin
 asm;
     mov ah,1ah
     mov al,0
     int 10h
     mov ok,al
 end;
 if ok<>$1a then
     begin
          VideoMode($3);
          clrscr;
           Writeln('VGA Card not found. Aborting...');
          halt(255);
     end;
end;
{----------------------------------------------------------------------------}
Procedure SetupStars;
Var i:Byte;
    j:Integer;
    x:integer;
    y:byte;
Begin
    For i:=1 to Maxlayers do
        for j:=1 to maxstars do
        Begin
        x:=random(320);
            y:=random(200);
            stars[i][j][0]:=x;
            stars[i][j][1]:=y;
        End;
End;
{---------------------------------------------------------------------------}
Procedure SetUpPallete;
Var i : 0..2;
Begin
for i:=0 to 2 do
    Pallete[1][i]:=63;
for i:=0 to 2 do
    Pallete[2][i]:=40;
for i:=0 to 2 do
    Pallete[3][i]:=30;
for i:=0 to 2 do
    Pallete[4][i]:=20;
end;
{-------------------------------------------------------------------------}
procedure WaitRetrace;
begin
  repeat until (Port[$03da] and 8) <> 0;
end;
{-------------------------------------------------------------------------}
procedure WaitNotRetrace;
begin
  repeat until (Port[$03da] and 8) <> 8;
end;
{-------------------------------------------------------------------------}
Procedure UpDateScreen;
var i,j:integer;
Begin
    For i:=1 to maxlayers do
        for j:=1 to maxstars do
        begin
         PutPixel(stars[i][j][0],stars[i][j][1],i,vgaaddr);
    end;
end;
{----------------------------------------------------------------------------}
Procedure DeleteOldStuff;
var i,j:integer;
Begin
     For i:=1 to maxlayers do
        for j:=1 to maxstars do
         begin
         PutPixel(stars[i][j][0],stars[i][j][1],0,vgaaddr);
    end;
end;
(****************************-=■Main■=-**************************************)
Begin
    Randomize;
    CheckVga;
    Videomode($13);
    setuppallete;
    updpalette(pallete);
    setupstars;
    Ticks:=0;
    Repeat
        waitretrace;
        DeleteOldStuff;
           inc(ticks);
            For i:=1 to maxstars do
                if (stars[1][i][0]<>319) then
            Inc(stars[1][i][0])
                else
                     stars[1][i][0]:=0;
                {if (stars[1][i][1]<>199) then
            Inc(stars[1][i][1])
                else
                     stars[1][i][1]:=0;}
        if (ticks mod maxlayers)<3 then
             For i:=1 to maxstars do
                if (stars[2][i][0]<>319) then
            Inc(stars[2][i][0])
                else
                     stars[2][i][0]:=0;
                {if (stars[2][i][1]<>199) then
            Inc(stars[2][i][1])
                else
                     stars[2][i][1]:=0;}
        if (ticks mod maxlayers)<2 then
             For i:=1 to maxstars do
                if (stars[3][i][0]<>319) then
            Inc(stars[3][i][0])
                else
                     stars[3][i][0]:=0;
                {if (stars[3][i][1]<>199) then
            Inc(stars[3][i][1])
                else
                     stars[3][i][1]:=0;}
        if (ticks mod maxlayers)<1 then
             For i:=1 to maxstars do
                if (stars[4][i][0]<>319) then
            Inc(stars[4][i][0])
                else
                     stars[4][i][0]:=0;
                {if (stars[4][i][1]<>199) then
            Inc(stars[4][i][1])
                else
                     stars[4][i][1]:=0;}
        updatescreen;
        if ticks=65535 then
       ticks:=0;
        if keypressed then ch:=readkey;
    until ch=#27;
    Videomode($3);
    writeln('Coded by ScorpioS / ACG ''95. Rip ''n'' die.');
End.