{$N+,A+,G+,F+,D-,E+,L-,R-,S-,Q-,Y-,I-}

{ The effect was coded especially for Demoded }
{ Code: bitl/7dump 2025 }

const
VGA = $A000;

type
  Virtualscreen = Array[1..65535] of byte;
  Virscr = ^VirtualScreen;
var
 scr, scr2, scr3: virscr;
 vaddr, vaddr2, vaddr3: word;

procedure SetUpVirtual(VAR screenname:virscr;VAR add : word);
var n:word;
begin
  GetMem (Screenname,65535);
  add := seg (Screenname^);
  for n:=0 to 65535 do mem[add:n]:=0;
end;

procedure WaitVR; Assembler;
asm
  mov  dx, 3DAh
@w1:
    in   al, dx
    test al, 8h
  jnz  @w1
@w2:
    in   al, dx
    test al, 8h
  jz   @w2
end;

procedure setonecolor(c,r,g,b:byte);assembler;
asm
  mov dx,3c8h
  mov al,c
  out dx,al
  inc dx
  mov al,r
  out dx,al
  mov al,g
  out dx,al
  mov al,b
  out dx,al
end;


procedure Ifer_Table1(x0,y0,y_start, buf:word);
var
n,p:word;
x,y:integer;
c:integer;
color:byte;
begin
     n:=0; x:=0; y:=y_start;
     for p:=0 to (512*128)-2 do
       begin
          c:=round(cos(sqrt((y-y0)*(y-y0)+(x / 2-x0)*(x / 2-x0))/8)*30+30)+1;{}
          if (c>255) then color := abs(255-c) else color := c;
          mem[buf:n]:=color;
          x:=x+1;
          if (x=512) then
             begin
               x:=0;
               y:=y+1;
             end;
        n:=n+1;
       end;
end;

procedure Ifer_Table2(x0,y0,y_start, buf:word);
var
n,p:word;
x,y:integer;
c:integer;
color:byte;
a:single;
begin
     n:=0; x:=0; y:=y_start;
     for p:=0 to (512*128)-2 do
       begin
          if (x/2-x0>0) and (y-y0>=0) then a:=arctan((y-y0) / (x/2-x0));
          if (x/2-x0=0) and (y-y0>=0) then a:=1.57;
          if (x/2-x0>0) and (y-y0<0)  then a:=arctan((y-y0) / (x/2-x0))+2*pi;
          if (x/2-x0=0) and (y-y0<0)  then a:=-1.57 +2*pi;
          if (x/2-x0<0) then a:=arctan((y-y0) / (x/2-x0))+pi;
          a:=a / (2*pi);

          c:=integer(round(a*256));
          c:=c+round(sin(sqrt((y-y0)*(y-y0)+(x/2-x0)*(x/2-x0))/16)*38+38);{}

          if (c>255) then color := abs(255-c) else color := c;
          mem[buf:n]:=color;
          x:=x+1;
          if (x=512) then
             begin
               x:=0;
               y:=y+1;
             end;
        n:=n+1;
       end;
end;

procedure Ifer_table3(x0,y0,y_start, buf:word);
var
n,p:word;
x,y:integer;
c:integer;
color:byte;
begin
     n:=0; x:=0; y:=y_start;
     for p:=0 to (512*128)-2 do
       begin
          c:=round(sin(sqrt((y-y0)*(y-y0)+(x / 2-x0)*(x/2-x0))/18)*48);{}
          if (c>255) then color := abs(255-c) else color := c;
          mem[buf:n]:=color;
          x:=x+1;
          if (x=512) then
             begin
               x:=0;
               y:=y+1;
             end;
        n:=n+1;
       end;
end;




const
pattern: array[0..4*4-1] of byte = (0,8,2,10, 12,4,14,6, 3,11,1,9, 15,7,13,5);

var
Timer: Longint ABSOLUTE $0040:$006C;
Aantal,T1               :longint;
q,n, output             :word;
x1,y1,x2,y2,x3,y3,x4,y4 :integer;
l1,l2,l3,l4             :byte;
o1,o2,o3,o4             :word;
plasma_type             :byte;
roll                    :single;

begin
{SetUpVirtual(scr,  vaddr);}
SetUpVirtual(scr2, vaddr2);
SetUpVirtual(scr3, vaddr3);

plasma_type:=2;

output:=VGA;

asm
  mov ax,13h
  int 10h
end;

case plasma_type of
1: begin
     for n:=254 downto 1 do SetOneColor(n,round(cos(n/40)*31+32),round(cos(n/40+1)*31+32),round(cos(n/60+2)*31+32));{}
     Ifer_table1(128,127,0,    vaddr2);
     Ifer_table1(128,127,128,  vaddr3);
   end;
2: begin
     for n:=0 to 255 do SetOneColor(n,round(cos(n/20)*31+32),round(cos(n/25+1)*31+32),round(cos(n/30+2)*21+42));{}
     Ifer_table2(128,127,0,    vaddr2);
     Ifer_table2(128,127,128,  vaddr3);
   end;
3: begin
     for n:=0 to 255 do SetOneColor(n,round(cos(n/21)*31+32),round(cos(n/25+1)*31+32),round(cos(n/28+2)*31+32));{}
     Ifer_table3(128,127,0,    vaddr2);
     Ifer_table3(128,127,128,  vaddr3);
   end;
end;

{Prepare dither-pattern}
for n:=0 to 15 do mem[vaddr3:word(n+65504)] := shortint(pattern[n] shr 1);


Aantal:=0; T1:=Timer;

repeat

roll:=roll+0.02;

x1 := round(cos(roll)*96+96);
y1 := round(sin(roll*2)*56+56);
x2 := round(-cos(roll)*96+96);
y2 := round(cos(roll)*56+56);
x3 := round(-cos(roll+2)*96+96);
y3 := round(sin(roll*4)*56+56);
x4 := round(cos(roll*2)*96+96);
y4 := round(cos(roll+2)*56+56);


{call count lines for switch segment}
l1:=byte(128-y1);
l2:=byte(128-y2);
l3:=byte(128-y3);
l4:=byte(128-y4);

{call offset quad 1}
o1:=word( y1 shl 9 + x1);
o2:=word((y2 shl 9 + x2) - o1);
o3:=word((y3 shl 9 + x3) - o1);
o4:=word((y4 shl 9 + x4) - o1);


WaitVR;          {Wait vertical retrace}

asm
  push bp

  mov es, output
  mov ax, vaddr2
  db $8e,$e0 {mov fs, ax}
  mov ax, vaddr3
  db $8e,$e8 {mov gs, ax}

  xor     di, di

  mov bl, l1
  mov bh, l2
  mov dl, l3
  mov dh, l4

  mov si, o1

  {---------------self-modify---------------}
  mov ax, o2
  mov cs:[offset @m2+4], ax
  mov ax, o3
  mov cs:[offset @m3+4], ax
  mov ax, o4
  mov cs:[offset @m4+4], ax
  mov byte ptr cs:[offset @m1], 64h
  mov byte ptr cs:[offset @m2], 64h
  mov byte ptr cs:[offset @m3], 64h
  mov byte ptr cs:[offset @m4], 64h
  jmp @clear_prefetch; @clear_prefetch:
  {-----------------------------------------}

  xor bp, bp
  cld
  mov ch, 100 { count screen line}

@mainloop:

  cmp bl, 0
  je  @switch_segment1
  cmp bh, 0
  je  @switch_segment2
  cmp dl, 0
  je  @switch_segment3
  cmp dh, 0
  je  @switch_segment4

  {-------------self-modify-----------------}
  db $65,$66; mov ax, [bp+65504]
  db $66; mov word ptr cs:[offset @dither1+2], ax
  db $65,$66; mov ax, [bp+65504+4]
  db $66; mov word ptr cs:[offset @dither2+2], ax
  jmp @clear_prefetch2; @clear_prefetch2:
  {-----------------------------------------}

  mov cl, 80
    @inerloop:
       @m1: db $64,$66; mov ax, [si]
       @m2: db $64,$66; add ax, [si+1111h]
       @m3: db $64,$66; add ax, [si+1111h]
       @m4: db $64,$66; add ax, [si+1111h]

       @dither1: db $66; add ax, 1234h; dw $5678; {dither}
       db $66; mov es:[di], ax

       @dither2: db $66; add ax, 1234h; dw $5678; {dither}
       db $66; mov es:[di+320], ax

       add di, 4
       add si, 4
       dec cl
    jnz @inerloop

  add bp, 8
  and bp, 15

  add di, 320
  add si, 192
  dec bl
  dec bh
  dec dl
  dec dh

  dec ch
  jnz @mainloop
  jmp @exit

@switch_segment1:
    mov byte ptr cs:[offset @m1], 65h
    mov bl, 255
    jmp @mainloop
@switch_segment2:
    mov byte ptr cs:[offset @m2], 65h
    mov bh, 255
    jmp @mainloop
@switch_segment3:
    mov byte ptr cs:[offset @m3], 65h
    mov dl, 255
    jmp @mainloop
@switch_segment4:
    mov byte ptr cs:[offset @m4], 65h
    mov dh, 255
    jmp @mainloop

@exit:
pop bp
end;



Inc(Aantal);    {this call nomber of frame, for calling fps}

until port[$60]=1;

asm
  mov ax,3
  int 10h
end;

T1:=timer-T1;
WriteLn(Aantal/(T1/18.2):2:1,' Frames per second');


end.
