VGA-Grafikeffekte

Program Bloodyrain;
uses crt;


var p : integer;




Procedure RotatePal; {Für das Colorcycling}
Var a : Word;


begin
 inc(p); {Neuer Durchgang}
 a := 100;
 port[968] := 35; {Starte mit Farbe 35}
 
 while a > 1 do {neue Farbwerte berechnen}
 begin
   port[969] := 255-(a+p); {Rot}
   port[969] := 0; {Grün}
   port[969] := 0; {Blau}
   dec(a);
 end;
end;










Procedure Makerain;
Var x,y,c,d:word;


begin
 d:=1;
 randomize;
 
 for x := 0 to 320 do
 begin
  c := random(65); {Zufällige Farbe fr den Start}
  for y:= 1 to 200 do
  begin
    if c > 64 then c := 1; {Wir benutzen dafür 64 Farben}
    mem[$a000:x+320*y] := 35+c; {setzte Pixel in Farbe}
    inc(c,d);
  end;
  d:=random(5)+1;
 end;
end;






begin


asm
 mov ax,13h {Modus 320x200 mit 256 Farben}
 int 10h
end;


while keypressed do readkey; {Tastaturpuffer leeren}


makerain; {Einmal zeichnen...}


repeat


 rotatepal; {...und für die Bewegung dann nur noch die Farben rotieren lassen}


 delay(10); {Aber nicht zu schnell!}


until keypressed; {Ende bei Tastendruck}
while keypressed do readkey;


asm
 mov ax,03h {Zurück in den Textmodus}
 int 10h
end;


end.

Program Fading;
uses crt;


var


palrec     : array[0..255] of longint;
xp,yp      : word;
vseg       : word;
p          : pointer;








{---------------------------- Timing ------------------------------------}


function GetClock : LongInt;
{Direkt über die RTC und nicht über das OS.
 Gibt den aktuellen Timerstand in Ticks zurück}
assembler;
asm
    mov  ah,0
    int  01Ah       {Zeitzähler von der Realtimeclock holen, CX und DX enthalten den Zähler}
    mov  ah,dl
    mov  dl,dh
    mov  dh,cl
    mov  al,0
    out  $43  ,al   {Wir verwenden Timer 0}
    mov  al,1
    out  $43  ,al   {In Betriebsmodus 1}
    in   al,$40     {Timerstand holen}
    in   al,$40
    neg  al
end;




function timer:real;
begin
timer:=getclock/4608; 
end;




{--------------------------- DAC / Farbpalette ----------------------}




Procedure Setrgb(index:word;R,G,B:Byte);
begin;
 port[968]:=index;   {Farbindex}
 port[969]:=r;       {Rot}
 port[969]:=g;       {Grün}
 port[969]:=b;       {Blau}
end;




Procedure Getrgb(Index :word;var R :byte;  var G :byte; var B:byte);
begin
 port[968]:=index;      {Farbindex}
 R        :=port[969];  {Rot}
 G        :=port[969];  {Grün}
 B        :=port[969];  {Blau}
end;




Procedure Savepalette;
{Aktuelle Palette speichern}
var t,rr,gg,bb:byte;
begin;
 for t:= 0 to 255 do begin;
  getrgb(t,rr,gg,bb);
  palrec[t]:=(rr and 63)+
             (gg and 63)*256+
             (bb and 63)*65536;
 end;
end;




Procedure Settoblack;
{Alle Farben auf Schwarz setzen}
var z : byte;
begin
   for z := 0 to 255 do {Alles auf 0}
   begin
      setrgb(z,0,0,0);
   end;
end;




Procedure SetBluePal;
{Erzeugt eine blaue Farbpalette}
var z : byte;
begin
   for z := 0 to 255 do {Nur den Blau Wert hochzählen}
   begin
      setrgb(z,0,0,z);
   end;
end;




{--------------------- VGA / Garfikeffekte --------------------------}




Procedure flip(source,dest:Word); assembler;
  {Kopiert den Inhalt des Segments in "Source" in "Dest"}
asm
  push    ds
  mov     ax, [Dest]
  mov     es, ax
  mov     ax, [Source]
  mov     ds, ax
  xor     si, si
  xor     di, di
  mov     cx, 16000
  db      $F3, $66, $A5  {rep movsd (schneller 32-Bit Datentransfer, 386 oder besser nötig!}
  pop     ds
end;




Function detectVGA : Boolean;
{Ist die Grafikkarte VGA-kompatibel? }
assembler;
asm
  mov ah,$1a            {Funktion 1A von Interrupt 10 aufrufen}
  xor al,al
  int 10h
  cmp al,$1a            {ist al 1Ah ? }
  jne @NoVGAdetected    {Wenn nicht, dann keine VGA}
  cmp bl,$08            {ist bl 08h ? }
  jne @NoVGAdetected    {Wenn nicht, dann keine VGA}
  mov al,true           {Wenn beides stimmt, dann true zurückgeben}
  jmp @Exit             {und zum "exit"}
@NoVGAdetected:
  mov al,false          {Ansonsten false zurückgeben}
@Exit:
end;




Procedure Fadedown(speed : word);
{Dimmt alle Farben innerhalb der angegeben Zeit auf schwarz}
var
T,g,rr,gg,bb   :integer;
gt             :longint;
rrr,ggg,bbb    :byte;
ti             :real;
begin
  savepalette;                   {Aktuelle Palette speichern}
  ti:=timer*1000;		 {Timer initialisieren}
  if speed = 0 then speed:=1;
  repeat
   gt := trunc( (timer) * 1000 );
    t := trunc( ((gt - ti) / speed)*63);
  for g := 0 to 255 do
  begin
   rrr := palrec[g] and 63;
   ggg := (palrec[g] div 256) and 63;
   bbb := (palrec[g] div 65536) and 63;
   rr := rrr - t;
   gg := ggg - t;
   bb := bbb - t;
   if rr < 0 then rr:= 0;
   if gg < 0 then gg:= 0;
   if bb < 0 then bb:= 0;
   if rr > 63 then rr:= 63;
   if gg > 63 then gg:= 63;
   if bb > 63 then bb:= 63;
   setrgb(g,rr,gg,bb);
  end;
 until ti+speed < timer*1000;		{bis die Zeit um ist}
 Settoblack;
end;




Procedure Fadeup(speed :word);
var
            T,g :integer;
             gt :longint;
    rrr,ggg,bbb :byte;
    z, rr,gg,bb :integer;
             ti :real;
 begin
   ti := timer*1000; {Timer initalisieren}
  if speed = 0 then speed := 1; {mit 0 geht's nicht}
  repeat;
     gt := trunc((timer)*1000);
      t  := 63-trunc(((gt - ti) / speed)*63);
     for z := 0 to 255 do
     begin;
         rrr :=  palrec[z] and 63;
         ggg := (palrec[z] div 256) and 63;
         bbb := (palrec[z] div 65536) and 63;
         rr := rrr - t;
         gg := ggg - t;
         bb := bbb - t;
         if rr < 0 then rr:= 0;
         if gg < 0 then gg:= 0;
         if bb < 0 then bb:= 0;
         if rr > 63 then rr:= 63;
         if gg > 63 then gg:= 63;
         if bb > 63 then bb:= 63;
         setrgb(z,rr,gg,bb);
         setrgb(0,00,00,00);
      end;
     until (ti+speed<timer*1000) or (keypressed);
  end;




Procedure DrawXORpattern;
{Zeichnet ein hübsches Muster}
begin
     for yp := 0 to 199 do
     begin
          for xp := 0 to 319 do
          begin
             if ((xp XOR yp) <> 1) then mem[vseg:xp+(320*yp)] := (xp xor yp);
          end;
      end;
end;




{------------------------------ Hauptprogramm -----------------------}




begin
 write('Prüfe auf VGA-Grafikkarte...');


 if not detectVGA then           {Haben wir eine VGA?}
 begin
   writeln('Nicht gefunden!');
   writeln;
   writeln('Hierfür wird eine VGA-Grafikkarte ben”tigt!');
   writeln;
   halt(1);
 end;


 writeln('OK'); 
 writeln('Reserviere zusätzlichen Arbeitsspeicher als Puffer für Grafiken');
 getmem(p,64000);           {64000 Bytes für Pufffer reservieren}
 vseg:= seg(p^);            {Segmentadresse des Puffers sichern}
 writeln;
 writeln('Und los geht''s!');


 fadedown(3000);           {Textmodus ausblenden}


 asm
   mov ax,13h
   int 10h
 end;


 setbluepal;       {Jetzt wird's blau}
 savepalette;      {Speichern, denn bisher haben wir ja nur die 16 Farben des Textmodus gesichert}
 settoblack;       {Alles auf 0}
 DrawXORPattern;   {Muster in den Puffer malen}
 flip(vseg,$0A000);{Puffer in den Grafikspeicher schieben}


 fadeup(3000);     {Und langsam einblenden...}


 while keypressed do readkey;       {evtl. Tastendruck löschen}
 repeat until keypressed;           {Auf Tastendruck warten}


 fadedown(3000);                    {Ausblenden}


 asm
   mov ax,03h                         {Zurück in den Textmodus}
   int 10h
 end;


 freemem(p,64000);                  {Speicher wieder freigeben}
end.                               {Fertig}