Upload New File

ATLADD.PAS

@@ -0,0 +1,149 @@
+Program Atlantis;
+Uses
+  ATL_Logo,    {  _Back_Pic & _Img_Pal  }
+  ATL_Back,    {  _Logo_Pic   }
+  GraphV2,
+  CRT,DOS;
+Type
+  BulTyp = record
+             X,Y : Integer;
+             C   : Byte;
+           end;
+const
+  MaxBul = 100;
+var
+ Bulle   : Array[1..MaxBul] of BulTyp;
+ P       : Pointer;
+ Go      : Boolean;
+ MaxCur  : Word;
+
+procedure copyfrom(p : pointer);
+begin
+  move(p^,pageW^,64000);
+end;
+
+procedure copyTo( p   : pointer;
+                  d,s : Word);
+var
+  I : Word;
+  a : Byte;
+  Sg,Os : Word;
+begin
+  SG := seg(P^);
+  Os := Ofs(P^);
+  for I:=0 to s do
+    begin
+      A := Mem[Sg:Os+i];
+      if (A<>0) then
+        mem[pagews:pageWo+D+I] := A;
+    End;
+End;
+
+procedure init;
+var
+  I : word;
+begin
+  initgraph(VGA);
+  paletteoff;
+  copyfrom(@Back_Pic);
+  viewpage;
+  getmem(P,$FFFF);
+  move(Screen^,P^,64000);
+  fadein(0,64,@pal_Img,1);
+  MaxCur := 1;
+  for I:=1 to maxBul do
+    begin
+      Bulle[i].x := random(320)+1;
+      bulle[i].y := 201;
+      bulle[i].c := random(3)+1;
+    End;
+end;
+
+procedure anim;
+var
+  i : Word;
+begin
+  move(P^,PageW^,64000);
+  If MaxCur<MaxBul Then Inc(MaxCur);
+  if (MaxCur=MaxBul) AND NOT GO Then begin
+    copyTo(@logo_pic,72*320,55*320);  { logo }
+    go := true;
+    move(PageW^,P^,64000);
+  End;
+  for i:=1 to maxcur do
+    with Bulle[i] do
+      begin
+        dec(y,c);
+        if (Y<0) then begin
+          X := random(320)+1;
+          Y := 199;
+          c := random(3)+1;
+        end;
+        Case (C) of
+          1,0 : If (GetPixel(x,Y)<32) then PutPixel(X,Y,(c*2)+24);
+          2   : Begin
+                  if (getpixel(x,y)<32)
+                  then putpixel(x,y,(c*2)+24)
+                  else
+                    if (getpixel(x-c,y)<32) then begin
+                      dec(x,c);
+                      putpixel(x,y,(c*2)+24);
+                    end
+                    else begin
+                      inc(x,c);
+                      putpixel(x,y,(c*2)+24);
+                    end;
+                end;
+           else PutPixel(X,Y,(c*2)+24);
+        end;
+    end;
+  waitvbl;
+  waitvbl;
+  waitvbl;
+  viewpage;
+end;
+
+procedure FillTxtScreen;
+Var
+  C : Char;
+  P : Pointer;
+  D : Pointer;
+begin
+  while (keypressed) do
+    C := readkey;
+  P := @Nfo_txt;
+  D := ptr($B800,0);
+  Asm
+    Push   DS
+    LDS    SI,P
+    mov    ax,0B800h
+    mov    ES,ax
+    xor    Di,DI
+    mov    CX,2000
+    Rep    MovsW
+    Pop    DS
+  end;
+  textAttr:=$0C;
+  gotoXY(1,24);
+  Writeln('Ugly Code By DUSH REAct (C) 1994 31 Dec');
+  Write('GFX Logo By R.D.O REAct (C) 1994 31 Dec');
+  while (not keypressed) do begin end;
+end;
+
+begin
+  init;
+  Go := False;
+  while (not keypressed) do
+    anim;
+  copyTo(@logo_pic,72*320,55*320);
+  viewpage;
+  fadeout(0,31,2);
+  viewpage;
+  waitvbl;
+  waitvbl;
+  waitvbl;
+  fadeout(0,$FF,3);
+  closegraph;
+  FillTxtScreen;
+end.
+