[Back to SCREEN SWAG index]  [Back to Main SWAG index]  [Original]

{
A while back someone asked for a "cascade" type screen thingy, and a also a
screen wipe that would look sort of like a TV screen powering down... Here
they are... & I would like them to get into the next SWAG... 8)
}
Program Cascade1;

{causes entire screen to "fall", character by character, to the bottom of the }
{     screen...                                                               }
{                                                                             }
{              Released for SWAG use!  Use freely!                            }
{                                                                             }
{   But if you do use it, please let me know...                               }
{                                                                             }
{         Allen Walker  - Crazy Train ][  (604)383-2201                       }
{                                                                             }

Uses CRT;

Var MGAScreenMem:Array[0..1999] of Word Absolute $B000:0000;
    CGAScreenMem:Array[0..1999] of Word Absolute $B800:0000;

Function Mono_Colour:Boolean;
{Mono = False, Color = True}
Var I,J,X,Y:Integer;
    A,B,C,D:Word;
begin
  X:=WhereX-1; Y:=WhereY-1;
  C:=MGAScreenMem[Y*80+X]; D:=CGAScreenMem[Y*80+X];
  Write('A'+Chr(8));
  A:=MGAScreenMem[Y*80+X]; B:=CGAScreenMem[Y*80+X];
  MGAScreenMem[Y*80+X]:=C; CGAScreenMem[Y*80+X]:=D;
  If (A mod 256) =$41 then begin Mono_Colour:=False; Exit; end;
  If (B mod 256) =$41 then begin Mono_Colour:=True; Exit; end;
end;

Procedure Cascade;
Var L,I,X : Word;
    MC    : Boolean;
begin
  MC:=Mono_Colour;
  For L:=1 to 25 do
  begin
    For I:=1999 downto 80 do
    begin
      If MC then
      begin
        If (CGAScreenMem[I] and $70FF =32) and
                     (CGAScreenMem[I-80] and $70FF <>32) then
        begin
          X:=CGAScreenMem[I]; CGAScreenMem[I]:=CGAScreenMem[I-80];
          CGAScreenMem[I-80]:=X;
        end;
      end
        else
      begin
        If (MGAScreenMem[I] and $70FF =32) and
                     (MGAScreenMem[I-80] and $70FF <>32) then
        begin
          X:=MGAScreenMem[I]; MGAScreenMem[I]:=MGAScreenMem[I-80];
          MGAScreenMem[I-80]:=X;
        end;
      end;
    end;
      Delay(100);
  end;
end;

begin
  Cascade;
end.





Program CRTWipe;
{Causes screen to wipe from bottom & top towards the middle, then from the    }
{   sides to the center...                                                    }
{                                                                             }
{              Released for SWAG use!  Use freely!                            }
{                                                                             }
{   But if you do use it, please let me know...                               }
{                                                                             }
{         Allen Walker  - Crazy Train ][  (604)383-2201                       }
{                                                                             }
Uses CRT;

Var MGAScreenMem:Array[0..1999] of Word Absolute $B000:0000;
    CGAScreenMem:Array[0..1999] of Word Absolute $B800:0000;
    MC : Boolean;

Function Mono_Colour:Boolean;
{Mono = False, Color = True}
Var I,J,X,Y:Integer;
    A,B,C,D:Word;
begin
  X:=WhereX-1; Y:=WhereY-1;
  C:=MGAScreenMem[Y*80+X]; D:=CGAScreenMem[Y*80+X];
  Write('A'+Chr(8));
  A:=MGAScreenMem[Y*80+X]; B:=CGAScreenMem[Y*80+X];
  MGAScreenMem[Y*80+X]:=C; CGAScreenMem[Y*80+X]:=D;
  If (A mod 256) =$41 then begin Mono_Colour:=False; Exit; end;
  If (B mod 256) =$41 then begin Mono_Colour:=True; Exit; end;
end;

Procedure SetChar(N,Z:Word);
begin
  If MC then CGAScreenMem[N]:=Z else MGAScreenMem[N]:=Z;
end;

Function ReadChar(N:Word):Word;
begin
  If MC then ReadChar:=CGAScreenMem[N] else ReadChar:=MGAScreenMem[N];
end;

Procedure WipeIt;
Var L,X,Y,Z : Word;
begin
  MC:=Mono_Colour;
  For L:=1 to 12 do
  For Y:=12 downto 0 do
  begin
    For X:=0 to 79 do
    begin
      Z:=ReadChar(X+(80*Y)); SetChar(X+(80*Y)+80,Z); SetChar(X+(80*Y),1792);
    end;
    For X:=0 to 79 do
    begin
      Z:=ReadChar(X+(80*(25-Y))); SetChar(X+(80*(25-Y))-80,Z);
      SetChar(X+(80*(25-Y)),1792);
    end;
  end;
  Delay(100);
  For X:=0 to 39 do
  begin
    SetChar(X+960,1792); SetChar(1039-X,1792); Delay(10);
  end;
end;

begin
  WipeIt;
end.

[Back to SCREEN SWAG index]  [Back to Main SWAG index]  [Original]