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

interface


procedure scene_dodec;

implementation

uses global, math2, screen, palette, resource, memory, triangle;

CONST
{Dodecahedron}
numvertex=20;
numpoly=36;
cubic: array[0..20*3-1] of shortint = (
 71,   71,   -71,
 44,   0  ,  -115,
 -71,  71,   -71,
 0,    115,  -44,
 -44,  0  ,  -115,
 115,  44 ,   0,
 71,  -71 ,  -71,
 115, -44 ,   0,
 71,   71 ,   71,
 0,    115,   44,
 -71, -71 ,  -71,
 0,   -115,  -44,
 71,  -71 ,   71,
 44,   0  ,   115,
 -71,  71 ,   71,
 -115, 44 ,   0,
 -115, -44 ,  0,
 -44,  0  ,   115,
 0,    -115,  44,
 -71,  -71 ,  71);

pindexc: array[0..36*3-1] of byte = (
 0, 1, 2,
 2, 3, 0,
 1, 4, 2,
 0, 5, 6,
 6, 1, 0,
 5, 7, 6,
 0, 3, 8,
 8, 5, 0,
 3, 9, 8,
 1, 6, 10,
 10, 4, 1,
 6, 11, 10,
 5, 8, 12,
 12, 7, 5,
 8, 13, 12,
 3, 2, 14,
 14, 9, 3,
 2, 15, 14,
 4, 10, 15,
 15, 2, 4,
 10, 16, 15,
 14, 17, 8,
 8, 9, 14,
 17, 13, 8,
 12, 18, 6,
 6, 7, 12,
 18, 11, 6,
 19, 16, 11,
 11, 18, 19,
 16, 10, 11,
 19, 17, 15,
 15, 16, 19,
 17, 14, 15,
 19, 18, 13,
 13, 17, 19,
 18, 12, 13);


 var
 pom,v1,v2,v3,u1,u2,u3,n1,n2,n3,qq,zoom,per,scale: single;
 temp,q3,xx,yy,zz,nn:integer;
 cubeDc:array[0..30*3] of single;
 xt,yt,zt,Xr,Yr,Zr:single;
 Cosxan,Sinxan,Cosyan,Sinyan,Coszan,Sinzan:single;
 q:word;



PROCEDURE GouraudHorline(xbeg,xend,y:integer; c1,c2:byte;where : word);
var delta : integer;
begin
 if (Xend=Xbeg) then begin
       if (xBeg>=0) and (xBeg<320) then
       asm
       mov es, Where
       mov ax, y
       shl ax, 6
       mov di, ax
       shl ax, 2
       add di, ax
       add di, xbeg
       mov al, c1
       mov es:[di], al
       end;
 end
 else
 begin

 delta := ((c2-c1) shl 8) div (Xend-Xbeg);
 if xBeg<0 then begin c1:=byte(c1-(xBeg*delta) shr 8); xBeg:=0; end;
 if xEnd>319 then xEnd:=319;

asm
  mov es, where
  mov bx, xbeg
  mov cx, Xend
  inc cx
  sub cx, bx
  mov ax, y
  shl ax, 6
  mov di, ax
  shl ax, 2
  add di, ax
  add di, bx

  mov bx, delta
  mov ah, c1

  mov si, cx

  shr cx, 2; jz @less_four
 @l_dw:

  mov es:[di], ah
  add ax, bx

  mov es:[di+1], ah
  add ax, bx

  mov es:[di+2], ah
  add ax, bx

  mov es:[di+3], ah
  add ax, bx

  add di, 4
  dec cx
 jnz @l_dw

 @less_four:
  test si, 2; jz @less_two

  mov es:[di], ah
  add ax, bx
  mov es:[di+1], ah
  add ax, bx

  add di, 2
 @less_two:
 test si, 1; jz @exit
  mov es:[di], ah
 @exit:
end;
end;
end;



procedure triangleGourant(ax,ay,az,bx,by,bz,cx,cy,cz:longint;where:word);
var
sy,x1,x2,z1,z2, temp:integer;
Clockwise, Zit1,Zit2, zeta1, zeta2, zeta3, delta1, delta2, delta3, Xit1, Xit2:longint;
begin

 if (ay>by) then begin temp:=ay; ay:=by; by:=temp; temp:=ax; ax:=bx; bx:=temp;
                                                   temp:=az; az:=bz; bz:=temp; end;
 if (by>cy) then begin temp:=by; by:=cy; cy:=temp; temp:=bx; bx:=cx; cx:=temp;
                                                   temp:=bz; bz:=cz; cz:=temp; end;
 if (ay>by) then begin temp:=ay; ay:=by; by:=temp; temp:=ax; ax:=bx; bx:=temp;
                                                   temp:=az; az:=bz; bz:=temp; end;

 if (ay=cy) or (cy<0) or (ay>199) then exit;

 clockwise:=(BX - AX) * (CY-AY) - (BY-AY) * (CX - AX);


 Xit1:=AX shl 8;
 delta1 := ((CX - AX) shl 8) div (CY - AY);

 Zit1:=AZ shl 8;
 zeta1 :=  ((CZ - AZ) shl 8) div (CY - AY);

 if (BY<>AY) then
      begin
           delta2 := ((BX - AX) shl 8) div (BY - AY);  Xit2:=AX shl 8;
           zeta2  := ((BZ - AZ) shl 8) div (BY - AY);  Zit2:=AZ shl 8;
      end
 else begin
           delta2 := (CX - AX) shl 8; Xit2:=BX shl 8;
           zeta2  := (CZ - AZ) shl 8; Zit2:=BZ shl 8;
           end;

 if (CY<>BY) then begin
           delta3 := ((CX - BX) shl 8) div (CY - BY);
           zeta3  := ((CZ - BZ) shl 8) div (CY - BY);
           end;

 if AY<0 then begin Xit1:=Xit1+delta1*abs(ay); Xit2:=Xit2+delta2*abs(ay);
                    Zit1:=Zit1+zeta1*abs(ay); Zit2:=Zit2+zeta2*abs(ay);
    if BY<0 then begin
                    Xit2:=BX shl 8+delta3*abs(by);
                    Zit2:=BZ shl 8+zeta3*abs(by);
                    BY:=0;
                 end;
    AY:=0;
 end;

 if CY>199 then CY:=199;

if clockwise<0 then
    for SY:=AY to CY do begin
        x2:=Xit1 shr 8;
        x1:=Xit2 shr 8;
        z2:=Zit1 shr 8;
        z1:=Zit2 shr 8;

        if (x2>=0) and (x1<320) then begin
             {if x1<0 then x1:=0; if x2>319 then x2:=319;}
             if (x2>=x1) then GouraudHorline(x1,x2,sy, z1,z2, where);
             end;
        Xit1:=Xit1+delta1;
        Zit1:=Zit1+zeta1;
        if SY < BY then begin
                        Xit2:=Xit2 + delta2;
                        Zit2:=Zit2 + zeta2;
                        end
                   else begin
                        Xit2:=Xit2 + delta3;
                        Zit2:=Zit2 + zeta3;
                        end;
    end else
        for SY:=AY to CY do begin
        x1:=Xit1 shr 8;
        x2:=Xit2 shr 8;
        z1:=Zit1 shr 8;
        z2:=Zit2 shr 8;

        if (x2>=0) and (x1<320) then begin
             {if x1<0 then x1:=0; if x2>319 then x2:=319;}
             if (x2>=x1) then GouraudHorline(x1,x2,sy, z1,z2, where);
             end;
        Xit1:=Xit1+delta1;
        Zit1:=Zit1+zeta1;
        if SY < BY then begin
                        Xit2:=Xit2 + delta2;
                        Zit2:=Zit2 + zeta2;
                        end
                   else begin
                        Xit2:=Xit2 + delta3;
                        Zit2:=Zit2 + zeta3;
                        end;
       end;
end;


PROCEDURE EnveronHorline(xbeg,xend,y:integer; c1,c2, color:byte; texture,where : word);
begin
 if (Xend=Xbeg) then
       asm
       mov es, where
       mov ax, y
       shl ax, 6
       mov di, ax
       shl ax, 2
       add di, ax
       add di, xbeg
       mov al, c1
{       mov es:[di], al}
       end
 else begin
asm
  mov es, where
  mov dx, xbeg
  mov cx, Xend

  inc cx
  sub cx, dx     {call length}

  mov ax, y
  mov bx, ax     {call texture Y offset}
  shl bx, 8
  add bh, c2  {56{}
  mov bl, c1

  shl ax, 6      {call start offset}
  mov di, ax
  shl ax, 2
  add di, ax
  add di, dx

  mov dl, color
  mov dh, dl
  mov ax, dx
  db $66; shl dx, 16
  mov dx, ax

  push ds
  mov ds, texture

  mov si, cx
  shr si, 2
  jz @less_four
 @l_d:
  db $66; mov ax, ds:[bx]
  db $66; add ax, dx
  db $66; mov es:[di], ax
  add bx, 4
  add di, 4
  dec si
jnz @l_d

@less_four:
test cx, 2; jz @less_two
  mov ax, ds:[bx]
  add ax, dx
  mov es:[di], ax
  add di, 2
  add bx, 2

@less_two:
  test cx, 1; jz @exit
  mov al, ds:[bx]
  add al, dl
  mov es:[di], al

@exit:
pop ds
end;
end;
end;

procedure triangleEnveron(ax,ay,bx,by,cx,cy:longint; shift_x, shift_y, col:byte;texture, where:word);
var
sy,x1,x2, temp:integer;
clockwise, delta1, delta2, delta3, Xit1, Xit2:longint;
begin

 if (ay>by) then begin temp:=ay; ay:=by; by:=temp; temp:=ax; ax:=bx; bx:=temp; end;
 if (by>cy) then begin temp:=by; by:=cy; cy:=temp; temp:=bx; bx:=cx; cx:=temp; end;
 if (ay>by) then begin temp:=ay; ay:=by; by:=temp; temp:=ax; ax:=bx; bx:=temp; end;

 if (ay=cy) or (cy<0) or (ay>199) then exit;

 clockwise:=(BX - AX) * (CY-AY) - (BY-AY) * (CX - AX);

 Xit1:=AX shl 8;
 delta1 := ((CX - AX) shl 8) div (CY - AY);

 if (BY<>AY) then
      begin
           delta2 := ((BX - AX) shl 8) div (BY - AY);  Xit2:=AX shl 8;
      end
 else begin delta2 := (CX - AX) shl 8; Xit2:=BX shl 8; end;

 if (CY<>BY) then delta3 := ((CX - BX) shl 8) div (CY - BY);

 if AY<0 then begin Xit1:=Xit1+delta1*abs(ay); Xit2:=Xit2+delta2*abs(ay);
    if BY<0 then begin Xit2:=BX shl 8+delta3*abs(by); BY:=0; end;
    AY:=0;
 end;
 if CY>199 then CY:=199;

if clockwise<0 then
    for SY:=AY to CY do begin
        x2:=Xit1 shr 8;
        x1:=Xit2 shr 8;
        if (x2>=0) and (x1<320) then begin
             if x1<0 then x1:=0; if x2>319 then x2:=319;
             if (x2>=x1) then EnveronHorline(x1,x2,sy, byte(x1+shift_x) , shift_y , col, texture, where);
             end;
        Xit1:=Xit1+delta1;
        if SY < BY then Xit2:=Xit2 + delta2 else Xit2:=Xit2 + delta3;
    end else
        for SY:=AY to CY do begin
        x1:=Xit1 shr 8;
        x2:=Xit2 shr 8;
        if (x2>=0) and (x1<320) then begin
             if x1<0 then x1:=0; if x2>319 then x2:=319;
             if (x2>=x1) then EnveronHorline(x1,x2,sy, byte(x1+shift_x), shift_y, col, texture, where);
             end;
        Xit1:=Xit1+delta1;
        if SY < BY then Xit2:=Xit2 + delta2 else Xit2:=Xit2 + delta3;
       end;
end;





var
mode_shade, face_color:array[0..numpoly-1] of byte;
light:array[0..5] of shortint;
pom_x,pom_y:array[0..12] of integer;
y_bg_rotate:word;
procedure drawcubic(mode:byte; texture, outp : word);
var
x1,x2,x3,x4,y1,y2,y3:integer;
col,color,n, p, z1,z2,z3:integer;
sqrt_4, ax,ay,az,bx,by,bz,nx,ny,nz:single;
real_face:byte;
p3, pind3, pind31, pind32:word;
begin

for p:=0 to numpoly-1 do face_color[p]:=0;
for p:=0 to 5 do light[p]:=0;
for p:=0 to 11 do begin pom_x[p]:=0; pom_y[p]:=0; end;

 for p:=0 to numpoly-1 do begin
  p3:=p*3;
  pind3:=pindexc[p3]*3;
  ax:=cubeDc[pindexc[p3+2]*3]  -cubeDc[pind3];
  ay:=cubeDc[pindexc[p3+2]*3+1]-cubeDc[pind3+1];
  az:=cubeDc[pindexc[p3+2]*3+2]-cubeDc[pind3+2];
  bx:=cubeDc[pindexc[p3+1]*3]  -cubeDc[pind3];
  by:=cubeDc[pindexc[p3+1]*3+1]-cubeDc[pind3+1];
  bz:=cubeDc[pindexc[p3+1]*3+2]-cubeDc[pind3+2];
  nx:=ay*bz-az*by;
  ny:=az*bx-ax*bz;
  nz:=ax*by-ay*bx;
  pom:=nz*-4+nx*ax+ny*ay+nz*az;

  if (pom>0) then begin
   pind3:= pindexc[p3]*3;
   pind31:=pindexc[p3+1]*3;
   pind32:=pindexc[p3+2]*3;

   x1:=round(cubeDc[pind3])+xx;
   y1:=round(cubeDc[pind3+1])+yy;
   z1:=round(cubeDc[pind3+2])+zz;

   x3:=round(cubeDc[pind31])+xx;
   y3:=round(cubeDc[pind31+1])+yy;
   z3:=round(cubeDc[pind31+2])+zz;

   x2:=round(cubeDc[pind32])+xx;
   y2:=round(cubeDc[pind32+1])+yy;
   z2:=round(cubeDc[pind32+2])+zz;


       if mode_shade[p]=0 then begin
          if z1<1 then z1:=1; if z2<1 then z2:=1; if z3<1 then z3:=1;
          if z1>127 then z1:=127; if z2>127 then z2:=127;
          if z3>127 then z3:=127;
          TriangleGourant(x1,y1,z1,x2,y2,z2,x3,y3,z3,outp);{}
       end;

       if mode_shade[p]=1 then begin
          real_face:=p div 3;
          if face_color[real_face]=0 then
               begin
                col:=round((nz*-4)/(sqrt(nx*nx+ny*ny+nz*nz)*4)*100);{}
                face_color[real_face]:=col;
               end;
          Triangle_asm(x1,y1,x2,y2,x3,y3,face_color[real_face], outp);{}
       end;

       if mode_shade[p]=2 then begin
          real_face:=p div 3;
          if face_color[real_face]=0 then
               begin
                 col:=round((nz*-4)/(sqrt(nx*nx+ny*ny+nz*nz)*4)*31)+192;{}
                 face_color[real_face]:=col;
               end;
          Triangle_asm(x1,y1,x2,y2,x3,y3,face_color[real_face], outp);{}
       end;

       if mode_shade[p]=3 then begin
           {real faces col = 0..4}
           color:=p div 3;
           if color>7 then color:=color-8;
           if color=7 then color:=1;
           if color=6 then color:=4;
           if color=5 then color:=3;
           color:=color+1;
           sqrt_4:=sqrt(nx*nx+ny*ny+nz*nz)*4;
           col:=round((nz*-4)/sqrt_4 *32)-16;{}

           real_face:=p div 3;
           if pom_x[real_face]=0 then
             pom_x[real_face]:=round((nx*-4)/sqrt_4 *70);{}

           if pom_y[real_face]=0 then
             pom_y[real_face]:=round((ny*-4)/sqrt_4 *50+50);{}

           TriangleEnveron(x1,y1,x2,y2,x3,y3,
              byte(pom_x[real_face]),byte(pom_y[real_face]-y_bg_rotate), color shl 5, texture,outp);

           if col>11 then col:=col+col+col shr 1;
           light[color]:=col;
       end;

   end
   else begin
      mode_shade[p]:=mode;
   end;
 end;
end;

procedure rotateCubic(scalec:single);
var x,y,z,X1,Y1,Z1:single;
p,p3:integer;
begin
 p3:=0;
 for p:=0 to numvertex-1 do begin
  x:=cubic[p3];
  y:=cubic[p3+1];
  z:=cubic[p3+2];
  x1:=cosyan*x-sinyan*z;
  z1:=sinyan*x+cosyan*z;
  x:=coszan*x1+sinzan*y;
  y1:=coszan*y-sinzan*x1;
  z:=cosxan*z1-sinxan*y1;
  y:=sinxan*z1+cosxan*y1;
  CubeDc[p3]:=(x*per/(z-per)*scalec);
  CubeDc[p3+1]:=(y*per/(z-per)*scalec);
  CubeDc[p3+2]:=(-z*per/(z-per)*scalec);
  p3:=p3+3;
end;
end;

procedure Background(xrotate,yrotate, texture, map, where:word);
var xx,yy:word;
begin
xx:=xrotate;
yy:=yrotate shl 8;

   asm
   mov es, where
   mov ax, texture
   db $8e,$e0 {mov fs, ax}
   mov si, xx
   add si, yy
   push ds
   push bp
   mov ds, map
   xor di, di
{   mov di, 320*100{}
   xor bp, bp
   mov dx, 100
@y:
   mov cx, 80
   @x:{for x:=0 to 319 do begin}
      {m:=memw[vaddr2:(y*320+x) shl 1]+n}
      db $66; mov bx, ds:[bp+4]
      db $64; mov al, [si+bx]
      db $66; shr bx, 16
      db $64; mov ah, [si+bx]
      db $66; shl ax, 16

      db $66; mov bx, ds:[bp]
      db $64; mov al, [si+bx]
      db $66; shr bx, 16
      db $64; mov ah, [si+bx]

{      db $66; add ax, 2020h; dw $2020;{}
      db $66; mov es:[di], ax
      db $66; mov es:[di+320], ax{}
      add di, 4
      add bp, 8
   dec cx
   jnz @x
add di, 320{}
dec dx
jnz @y
pop bp
pop ds
end;
end;


var palette_process_dodec:byte;
procedure Pal2Pal_4dodec(startcol, endcol:byte; speed:integer; seg_where,ofs_where, outp:word);
var
vsi,endcol_6:word;
otsechka:byte;
begin
{sound(500); delay(10); nosound;{}
if speed>127 then speed:=127;
vsi:=(startcol*6) + ofs_where;
endcol_6:=endcol*6;
  asm
  {------self-modify-------}
  mov al, byte ptr speed
  mov cs:[offset @speed+2], al
  mov ax, endcol_6
  cmp ax, 128
  jb @next1
      mov word ptr cs:[offset @count], 0fe81h
      mov cs:[offset @count+2], ax; jmp @next
  @next1:
      mov cs:[offset @count+2], al
  @next:
  jmp @clear_prefetch; @clear_prefetch:
  {-------------------------}

  mov es, seg_where
  mov ax, outp
  db $8e,$e0 {mov fs, ax}

  mov cl, startcol
  xor ch, ch
  mov si, vsi
  push bp
  @c:
     {for c:=startcol to endcol do begin}
     mov bp, 4
     @n:{for n:=0 to 2 do begin}
       mov dx, es:[bp+si +256*3*2*2] {delta:=memw[where:(n+c*3) shl 1 + (256*3*2)*2] * speed;}
       @speed: imul dx, dx, 1

       mov bx, es:[bp+si]            {x:=memw[where:(n+c*3) shl 1];}
       mov di, es:[bp+si +256*3*2]   {y:=memw[where:(n+c*3) shl 1 + 256*3*2];}

       cmp bx, di {if x>y then begin}
       jle @skip1
          sub bx, dx      {x:=x-delta;}
          cmp bx, di; jge @sk1; mov bx, di; @sk1: {if x<y then x:=y;}
          mov es:[bp+si], bx {memw[where:(n+c*3) shl 1]:=x;}
          mov ch, 1
       @skip1:    {end;}

       cmp bx, di {if x<y then begin}
       jge @skip2
          add bx, dx      {x:=x+delta;}
          cmp bx, di; jle @sk2; mov bx, di; @sk2: {if x>y then x:=y;}
          mov es:[bp+si], bx {memw[where:(n+c*3) shl 1]:=x;}
          mov ch, 1
       @skip2:    {end;}

       mov al, bh  {=r/g/b shr 8}
       db $66; shl ax, 8

     sub bp, 2
     jns @n {end;}

  {setonecolor(c, r,g,b);}
  xor bx, bx
  xor dx, dx
  mov dl, cl
  mov bx, dx
  add bx, dx
  add bx, dx

  db $64; mov [bx], ah
  db $66; shr ax, 16
  db $64; mov [bx+1], ax

  inc cl
  add si, 3*2
  @count: cmp si, 6
  nop
  jbe @c
  pop bp
  mov otsechka, ch
end;
if otsechka=0 then palette_process_dodec:=0;
end;


procedure Draw_floor(h, color_buf, where:word);
begin
if h<80 then begin
h:=h*320;
asm
push ds
mov es, where
mov di, 120*320
add di, h
mov ds, color_buf
mov si, 80
@y: {for m:=0 to 79 do begin}
    mov al, ds:[si] {col:=mem[vaddr2+4000:m];}
    mov dl, al
    mov dh, dl
    db $66; shl dx, 16
    mov dl, al
    mov dh, al

    {y:=m+h+120;}
    cmp di, 199*320 {if y<200 then}
    ja @nodrawline
    mov cx, 320/4
    @x:{for n:=0 to 319 do}
       {if mem[vaddr:n+y*320]<col then mem[vaddr:n+y*320]:=col;}
       db $66; mov bx, es:[di]
       db $66; test bx, bx
       jnz @no_zero
          db $66; mov bx, dx
          jmp @draw
       @no_zero:
       cmp al, bl
       jb @skip_draw_1
           mov bl, al
       @skip_draw_1:
       cmp al, bh
       jb @skip_draw_2
           mov bh, al
       @skip_draw_2:

       db $66; rol bx, 16

       cmp al, bl
       jb @skip_draw_3
           mov bl, al
       @skip_draw_3:
       cmp al, bh
       jb @skip_draw_4
           mov bh, al
       @skip_draw_4:

       db $66; rol bx, 16

       @draw:
       db $66; mov es:[di], bx
       add di, 4
    dec cx
    jnz @x
@nodrawline:
dec si
jnz @y
pop ds
end;{}
end;
end;


procedure palette_processing(where:word);
var
m, poly3:integer;
poly:byte;
light_poly:shortint;
begin
     for m:=0 to 5 do begin
           poly:=m shl 5;
           poly3:=poly+poly+poly;
           light_poly:=light[m];
           if light_poly<>0 then
           asm
           mov es, where
           mov di, poly3
           mov bl, poly
           mov bh, light_poly
           xor cx, cx
              @n:{for n:=0 to 31 do begin}
                 {r_:=mem[vaddr+4000:n*3   +poly*3] +light_poly;}
                 {g_:=mem[vaddr+4000:n*3+1 +poly*3] +light_poly;}
                 {b_:=mem[vaddr+4000:n*3+2 +poly*3] +light_poly;}
                 {if b_<0 then b_:=0; if g_<0 then g_:=0; if r_<0 then r_:=0;}
                 {if b_>63 then b_:=63; if g_>63 then g_:=63; if r_>63 then r_:=63;}

                 mov ah, es:[di+2]
                 add ah, bh
                 cmp ah, 64; jl @skip_b64; mov ah, 63; @skip_b64:
                 cmp ah, 0; jge @skip_b0;  xor ah, ah; @skip_b0:

                 mov al, es:[di+1]
                 add al, bh
                 cmp al, 64; jl @skip_g64; mov al, 63; @skip_g64:
                 cmp al, 0; jge @skip_g0;  xor al, al; @skip_g0:

                 db $66; shl ax, 16

                 mov ah, es:[di]
                 add ah, bh
                 cmp ah, 64; jl @skip_r64; mov ah, 63; @skip_r64:
                 cmp ah, 0; jge @skip_r0;  xor ah, ah; @skip_r0:

                 {setonecolor(n+poly, r_,g_,b_);}
                 mov dx, 3c8h
                 mov al, cl
                 add al, bl
                 out dx, al
                 inc dx
                 mov al, ah
                 out dx, al
                 db $66; shr ax, 16
                 out dx, al
                 mov al, ah
                 out dx, al

              add di, 3
              inc cx
              cmp cx, 32
              jb @n{end;}
           end;
     end;
end;


{Procedure DodecBGTable(x0,y0: word; buf1:word);
var
x,y:integer;
r:single;
u,v:byte;
begin
    for y:=0 to 99 do
     for x:=0 to 319 do
       begin
          r:=sqrt_((y*2-y0)*(y*2-y0)+(x-x0)*(x-x0));
          v:= byte(((X-x0)*192) div (256-round(128-r)));
          u:= byte(((Y*2-y0)*192) div (256-round(128-r)));
          memw[buf1:word((x+y*320) shl 1)]:=v+u*256;
       end;
end;
}


var
Aantal, T1: word;
start_time, old_time:word;
elapsed_time:word;

super_pal, blink_num, stage, mode, col, amp_dec:byte;
poly,  n,x1,x2,x3,x4,x5,y,v,h:integer;
speed_pal, m, f:word;
r,g,b:byte;
light_poly,r_,g_,b_:shortint;
blink_sin, blink_amp, amp_:single;
jump_on:array[0..1] of word;


function jump1(var jump_this:word; d, speed:single):single;
var jump:single;
begin
  jump:= sin((q-jump_this)/speed)*d;
  if jump<0 then begin jump_this:=0; jump:=0;end;
  jump1:=jump;
end;

procedure load_pal(name:string);
begin
   LoadBin(name,  seg_palitra,  ofs_palitra+palette2);
   init_pal2pal(seg_palitra, ofs_palitra);
   palette_process_dodec:=1;
   speed_pal:=16;
end;



procedure Scene_dodec;
begin
Clear(0, 65535, vaddr);
Clear(0, 65535, vaddr2);
Clear(0, 65535, vaddr3);

{floor color precals}
for m:=0 to 79 do begin
f:=(m shl 8) shr 7 +256;
mem[vaddr2+4000:+79-m]:=(m * f)  shr 8;
end;{}

{--------------------color scheme 1-------------------------------}
for n:=0 to 255 do setonecolor2memW(n, 33, 33, 43, palette1, seg_palitra,ofs_palitra);

setonecolor2memW(0, 2,0,10, palette2, seg_palitra, ofs_palitra);
for n:=1 to 63 do setonecolor2memW(n, n shr 1+2  ,n shr 1  ,n shr 1+10, palette2, seg_palitra, ofs_palitra);
for n:=0 to 63  do begin
   r:=32+n shr 2+3;
   g:=32+n shr 1;
   b:=42+n shr 1;
   if b>63 then b:=63; if g>63 then g:=63; if r>63 then r:=63;
   setonecolor2memW(n+64, r, g, b, palette2, seg_palitra, ofs_palitra);
end;{}
for n:=0 to 31 do setonecolor2memW(n+192, n+2  ,n  ,n +10, palette2, seg_palitra, ofs_palitra);

setonecolor2memW(255, 0,0,0, palette2, seg_palitra, ofs_palitra);

init_pal2pal(seg_palitra,ofs_palitra);
palette_process[0]:=1;
palette_process[1]:=1;

{-------------------------start unfade----------------------------}

Midas_WaitVR;
setpalette_from_memW(palette1,seg_palitra,ofs_palitra);

set_border_color(255);

Clear(0, 64000, vga);
draw_floor(0, vaddr2+4000, vga);

repeat
Midas_WaitVR;
if palette_process[0]=1 then Pal2Pal_asm(palette_process[0], 0, 127,  4, seg_palitra,ofs_palitra);
if palette_process[1]=1 then Pal2Pal_asm(palette_process[1], 128, 255, 8, seg_palitra,ofs_palitra);

until (palette_process[0]=0) and (palette_process[1]=0);
{-----------------------------------------------------------------}



LoadBin('dod_tbl.bin', vaddr2, 0);
LoadBinUnpack('text4_3.bin',  {load->}vaddr,{-unpack->}vaddr3,  0);
LoadBin('text4_3.pal',  seg_palitra,  ofs_palitra+palette2);

clear_palette2memW(palette1, seg_palitra, ofs_palitra);


{--------------------color shceme 2-------------------------------}
for n:=0 to 31 do begin
mem[vaddr+4000:n*3]:=  memw[seg_palitra:ofs_palitra+ palette2 +n*6] shr 8;
mem[vaddr+4000:n*3+1]:=memw[seg_palitra:ofs_palitra+ palette2 +n*6+2] shr 8;
mem[vaddr+4000:n*3+2]:=memw[seg_palitra:ofs_palitra+ palette2 +n*6+4] shr 8;

setonecolor2memW(n,2,0,10, palette1, seg_palitra, ofs_palitra);
end;

for n:=32 to 191 do begin
mem[vaddr+4000:n*3]:=18;
mem[vaddr+4000:n*3+1]:=16;
mem[vaddr+4000:n*3+2]:=26;
setonecolor2memW(n,18,16,26, palette1, seg_palitra, ofs_palitra);
end;{}
{-----------------------------------------------------------------}

init_pal2pal(seg_palitra, ofs_palitra);
palette_process_dodec:=1;

mode:=0; stage:=0;
for n:=0 to numpoly-1 do mode_shade[n]:=mode;

amp_:=1; amp_dec:=0;
yy:=100;
h:=0; f:=0; n:=0; q3:=-4; Per:=300;
y_bg_rotate:=0;
blink_num:=0;
blink_amp:=0;
super_pal:=0;
speed_pal:=2;

Aantal:=0; T1:=mTimer;
old_time:=mtimer;
start_time:=mtimer;

repeat
q:=mtimer-start_time;
elapsed_time:=(mtimer-old_time);
old_time:=mtimer;


if mode<3 then Clear(0, 64000,Vaddr) else
Background(q, y_bg_rotate, vaddr3, vaddr2, vaddr);{}

if (elapsed_time>0) or (aantal=0) then begin
   MP^.GetInformation(@info);

end;


Xr:=rad(q);
Yr:=rad(q)*2;
Zr:=rad(q)*3;
CosXan:=cos_(Xr);SinXan:=sin_(Xr);
CosYan:=cos_(Yr);SinYan:=sin_(Yr);
CosZan:=cos_(Zr);SinZan:=sin_(Zr);

xx:=160; zz:=30;


yy:=round(cos_(q/90)*(140*amp_)+100)+y_bg_rotate;{}

if amp_dec=0 then if (sin_(q/120*2)<0) then amp_dec:=1;

if (amp_dec=1) and (amp_>0) then
   begin
     amp_:=amp_ - elapsed_time/200;
     if amp_<0 then amp_:=0;
   end;

if (amp_dec=1) and (h<80) then h:=h+elapsed_time;{}


if (q>160) and (stage=0) then
    begin
       mode:=1; stage:=1;
    end;
if (q>300) and (stage=1) then
    begin
       mode:=2; stage:=2;
    end;
if (q>380) and (stage=2) then
    begin
       mode:=3; stage:=3;
       for n:=0 to 31 do setonecolor(n,2,0,10);
       for n:=32 to 191 do setonecolor(n,18,16,26);
    end;
if (q>400) and (stage=3) then
    begin
       stage:=4;
    end;{}

rotateCubic(0.55);

drawcubic(mode, vaddr3, vaddr);{}

if h<80 then draw_floor(h, vaddr2+4000, vaddr);{}


if (stage=4) then begin
   light[0]:=1;
   if palette_process_dodec=1 then Pal2Pal_4dodec(0, 192, speed_pal*elapsed_time, seg_palitra, ofs_palitra, vaddr+4000);{}

   blink_sin:=cos_(q/20)*2+2;
   {мигание яркостью фона в такт музыке}
   if (info^.row > 0 + blink_num shl 3) and
      (info^.row < 0 + (blink_num+1) shl 3) then
         begin
            jump_on[1]:=q;
            inc(blink_num);
            blink_num:=blink_num and 7;
         end;
   if (jump_on[1]>0) then light[0]:=round(jump1(jump_on[1], blink_amp, 10)-blink_amp/2+blink_sin)
                     else light[0]:=round(blink_sin);
   if blink_amp<6 then begin
                          blink_amp:=blink_amp+elapsed_time/4;
                          if blink_amp>6 then blink_amp:=6;
                        end;
   for n:=1 to 5 do if light[n]<>0 then light[n]:=(light[n]+light[0] shl 1);

   {-------------------------------------}
   case super_pal of
   0: if music_pos(52,48) then begin
            load_pal('dodec2.pal');
            inc(super_pal); end;
   1: if music_pos(53,0) then begin
            load_pal('dodec4.pal');
            inc(super_pal); end;
   2: if music_pos(53,4) then begin
            load_pal('dodec2.pal');
            inc(super_pal); end;
   3: if music_pos(53,54) then begin
            load_pal('dodec3.pal');
            inc(super_pal); end;
   4: if music_pos(54,0) then begin
            load_pal('text4_3.pal');
            inc(super_pal); end;
   5: if music_pos(54,32) then begin
            load_pal('dodec2.pal');
            inc(super_pal); end;
   6: if music_pos(55,0) then begin
            load_pal('dodec4.pal');
            inc(super_pal); end;
   7: if music_pos(55,4) then begin
            load_pal('dodec2.pal');
            inc(super_pal); end;
   8: if music_pos(55,54) then begin
            clear_palette2memW(palette2, seg_palitra, ofs_palitra);
            init_pal2pal(seg_palitra, ofs_palitra);
            palette_process_dodec:=1;
            speed_pal:=8;
            inc(super_pal); end;
   end;

   if music_pos(55,48) then
     begin
        if y_bg_rotate<200 then y_bg_rotate:=y_bg_rotate+elapsed_time*3;
     end;
end;



if Vsync_mode=1 then Midas_WaitVR;{}

if mode=3 then palette_processing(vaddr+4000);

FlipScreen(vaddr,VGA);

Inc(Aantal);
if FPS_Mode=1 then WriteFps(100, mtimer, T1, Aantal, vga);

until (esc_test) or (y_bg_rotate>=200) or (music_pos(56,0));
end;

end.
