home *** CD-ROM | disk | FTP | other *** search
/ PC Spiel 1995 December / PCS1295.ISO / bonus / plasma / effekt.pas < prev   
Pascal/Delphi Source File  |  1995-10-09  |  2KB  |  93 lines
  1. { Hey! Don't forget: Give credits if you use my code, okay? }
  2. {written by Ansgar Scherp of vIRTUAL tECHNOLOGIES}
  3. uses crt;
  4.  
  5. var x,y    : word;
  6.     f_x    : array[0..99] of byte;
  7.     f_y    : array[0..99] of byte;
  8.     rgbpal : array[0..767] of byte;
  9.     teiler_1,teiler_2 : integer;
  10.     r : char;
  11.  
  12. procedure init;
  13.   var a,x,y : integer;
  14.    begin
  15.     randomize;
  16.       for a := 1 to 9900 do begin
  17.         repeat y := random(100); x := random(101);
  18.         until mem[$a000+(y*2)*20:x*2+59] <> 100;
  19.         mem[$a000+(y*2)*20:x*2+59] := 100;
  20.       end;
  21.     for y := 0 to 99 do for x := 0 to 100 do
  22.       mem[$a000+(y*2)*20:(x*2+59)] := 100;
  23.    end;
  24.  
  25. procedure zeichne;
  26.   begin
  27.     for y := 0 to 99 do for x := 0 to 99 do
  28.         mem[$a000+(y*2)*20:(x*2+60)] := (f_x[x]+f_y[y]);
  29.   end;
  30.  
  31. procedure farben_setzen;
  32.  begin
  33.     for x := 0 to 99 do f_x[x] := trunc(x*teiler_1*0.01);
  34.     for x := 0 to 99 do f_y[x] := trunc(x*x*teiler_2*0.001);
  35.     {farben setzen nach dem schema RGB.
  36.     mit diesem kurzen ASM-Proggi wird die gesammte Palette
  37.     von 0 bis 255 gesetzt! }
  38.     asm
  39.       mov ax,1012h
  40.       xor bx,bx
  41.       mov cx,0100h
  42.       push ds
  43.       pop es
  44.       mov dx,offset rgbpal
  45.       int 10h
  46.     end;
  47.   end;
  48.  
  49. procedure farben;
  50. begin
  51.     for x := 0 to 63 do begin
  52.         y := x * 3;
  53.         rgbpal[y+0] := 0;
  54.         rgbpal[y+1] := 0;
  55.         rgbpal[y+2] := 0;
  56.         rgbpal[y+192] := 63-x;
  57.         rgbpal[y+193] := x;
  58.         rgbpal[y+194] := 0;
  59.         rgbpal[y+384] := 0;
  60.         rgbpal[y+385] := 63-x;
  61.         rgbpal[y+386] := x;
  62.         rgbpal[y+576] := x;
  63.         rgbpal[y+577] := x;
  64.         rgbpal[y+578] := 63-x;
  65.       end;
  66. end;
  67.  
  68. begin
  69.   teiler_1 := 0;
  70.   teiler_2 := 0;
  71.   asm
  72.     mov ax,0013h
  73.     int 10h
  74.   end;
  75.      farben;
  76.      farben_setzen;
  77.      init;
  78.      while keypressed do r := readkey;
  79.   repeat
  80.     zeichne;
  81.     inc(teiler_1,trunc(sqrt(abs(teiler_1))*0.5)+1);
  82.     inc(teiler_2,trunc(sqrt(abs(teiler_2))*0.5)+1);
  83.     farben_setzen;
  84.     if keypressed then r := readkey;
  85.   until (port[$60] = 1) or (teiler_1 >= 25500);
  86.   asm
  87. {    mov ax,0
  88.     int 16h}
  89.     mov ax,03
  90.     int 10h
  91.   end;
  92. end.
  93.